aboutsummaryrefslogtreecommitdiffstats
path: root/erts/emulator
diff options
context:
space:
mode:
Diffstat (limited to 'erts/emulator')
-rw-r--r--erts/emulator/Makefile23
-rw-r--r--erts/emulator/Makefile.in291
-rw-r--r--erts/emulator/beam/atom.c81
-rw-r--r--erts/emulator/beam/atom.h35
-rw-r--r--erts/emulator/beam/atom.names166
-rw-r--r--erts/emulator/beam/beam_bif_load.c1515
-rw-r--r--erts/emulator/beam/beam_bp.c831
-rw-r--r--erts/emulator/beam/beam_bp.h128
-rw-r--r--erts/emulator/beam/beam_catches.c27
-rw-r--r--erts/emulator/beam/beam_catches.h21
-rw-r--r--erts/emulator/beam/beam_debug.c773
-rw-r--r--erts/emulator/beam/beam_emu.c3982
-rw-r--r--erts/emulator/beam/beam_load.c2372
-rw-r--r--erts/emulator/beam/beam_load.h195
-rw-r--r--erts/emulator/beam/beam_ranges.c263
-rw-r--r--erts/emulator/beam/benchmark.c363
-rw-r--r--erts/emulator/beam/benchmark.h329
-rw-r--r--erts/emulator/beam/bif.c2225
-rw-r--r--erts/emulator/beam/bif.h307
-rw-r--r--erts/emulator/beam/bif.tab177
-rw-r--r--erts/emulator/beam/big.c615
-rw-r--r--erts/emulator/beam/big.h66
-rw-r--r--erts/emulator/beam/binary.c1270
-rw-r--r--erts/emulator/beam/break.c484
-rw-r--r--erts/emulator/beam/code_ix.c33
-rw-r--r--erts/emulator/beam/code_ix.h105
-rw-r--r--erts/emulator/beam/copy.c1643
-rw-r--r--erts/emulator/beam/dist.c708
-rw-r--r--erts/emulator/beam/dist.h126
-rw-r--r--erts/emulator/beam/dtrace-wrapper.h23
-rw-r--r--erts/emulator/beam/elib_memmove.c23
-rw-r--r--erts/emulator/beam/erl_afit_alloc.c29
-rw-r--r--erts/emulator/beam/erl_afit_alloc.h23
-rw-r--r--erts/emulator/beam/erl_alloc.c758
-rw-r--r--erts/emulator/beam/erl_alloc.h103
-rw-r--r--erts/emulator/beam/erl_alloc.types140
-rw-r--r--erts/emulator/beam/erl_alloc_util.c1058
-rw-r--r--erts/emulator/beam/erl_alloc_util.h138
-rw-r--r--erts/emulator/beam/erl_ao_firstfit_alloc.c53
-rw-r--r--erts/emulator/beam/erl_ao_firstfit_alloc.h23
-rw-r--r--erts/emulator/beam/erl_arith.c37
-rw-r--r--erts/emulator/beam/erl_async.c91
-rw-r--r--erts/emulator/beam/erl_async.h29
-rw-r--r--erts/emulator/beam/erl_bestfit_alloc.c29
-rw-r--r--erts/emulator/beam/erl_bestfit_alloc.h23
-rw-r--r--erts/emulator/beam/erl_bif_binary.c1065
-rw-r--r--erts/emulator/beam/erl_bif_chksum.c21
-rw-r--r--erts/emulator/beam/erl_bif_ddll.c83
-rw-r--r--erts/emulator/beam/erl_bif_guard.c127
-rw-r--r--[-rwxr-xr-x]erts/emulator/beam/erl_bif_info.c1900
-rw-r--r--erts/emulator/beam/erl_bif_lists.c124
-rw-r--r--erts/emulator/beam/erl_bif_op.c37
-rw-r--r--erts/emulator/beam/erl_bif_os.c37
-rw-r--r--erts/emulator/beam/erl_bif_port.c165
-rw-r--r--erts/emulator/beam/erl_bif_re.c94
-rw-r--r--erts/emulator/beam/erl_bif_timer.c705
-rw-r--r--erts/emulator/beam/erl_bif_timer.h36
-rw-r--r--erts/emulator/beam/erl_bif_trace.c1062
-rw-r--r--erts/emulator/beam/erl_bif_unique.c851
-rw-r--r--erts/emulator/beam/erl_bif_unique.h440
-rw-r--r--erts/emulator/beam/erl_binary.h365
-rw-r--r--erts/emulator/beam/erl_bits.c123
-rw-r--r--erts/emulator/beam/erl_bits.h43
-rw-r--r--erts/emulator/beam/erl_cpu_topology.c102
-rw-r--r--erts/emulator/beam/erl_cpu_topology.h29
-rw-r--r--erts/emulator/beam/erl_db.c2341
-rw-r--r--erts/emulator/beam/erl_db.h88
-rw-r--r--erts/emulator/beam/erl_db_hash.c2959
-rw-r--r--erts/emulator/beam/erl_db_hash.h55
-rw-r--r--erts/emulator/beam/erl_db_tree.c913
-rw-r--r--erts/emulator/beam/erl_db_tree.h23
-rw-r--r--erts/emulator/beam/erl_db_util.c1738
-rw-r--r--erts/emulator/beam/erl_db_util.h223
-rw-r--r--erts/emulator/beam/erl_debug.c87
-rw-r--r--erts/emulator/beam/erl_debug.h26
-rw-r--r--erts/emulator/beam/erl_dirty_bif.tab87
-rw-r--r--erts/emulator/beam/erl_driver.h198
-rw-r--r--erts/emulator/beam/erl_drv_nif.h143
-rw-r--r--erts/emulator/beam/erl_drv_thread.c139
-rw-r--r--erts/emulator/beam/erl_fun.c126
-rw-r--r--erts/emulator/beam/erl_fun.h39
-rw-r--r--erts/emulator/beam/erl_gc.c2428
-rw-r--r--erts/emulator/beam/erl_gc.h199
-rw-r--r--erts/emulator/beam/erl_goodfit_alloc.c29
-rw-r--r--erts/emulator/beam/erl_goodfit_alloc.h21
-rw-r--r--erts/emulator/beam/erl_hl_timer.c3541
-rw-r--r--erts/emulator/beam/erl_hl_timer.h88
-rw-r--r--erts/emulator/beam/erl_init.c660
-rw-r--r--erts/emulator/beam/erl_instrument.c103
-rw-r--r--erts/emulator/beam/erl_instrument.h27
-rw-r--r--erts/emulator/beam/erl_io_queue.c1231
-rw-r--r--erts/emulator/beam/erl_io_queue.h201
-rw-r--r--erts/emulator/beam/erl_lock_check.c362
-rw-r--r--erts/emulator/beam/erl_lock_check.h73
-rw-r--r--erts/emulator/beam/erl_lock_count.c1009
-rw-r--r--erts/emulator/beam/erl_lock_count.h1024
-rw-r--r--erts/emulator/beam/erl_lock_flags.c59
-rw-r--r--erts/emulator/beam/erl_lock_flags.h78
-rw-r--r--erts/emulator/beam/erl_map.c3175
-rw-r--r--erts/emulator/beam/erl_map.h199
-rw-r--r--erts/emulator/beam/erl_math.c54
-rw-r--r--erts/emulator/beam/erl_message.c2148
-rw-r--r--erts/emulator/beam/erl_message.h482
-rw-r--r--erts/emulator/beam/erl_monitors.c103
-rw-r--r--erts/emulator/beam/erl_monitors.h43
-rw-r--r--erts/emulator/beam/erl_msacc.c490
-rw-r--r--erts/emulator/beam/erl_msacc.h434
-rw-r--r--erts/emulator/beam/erl_mtrace.c36
-rw-r--r--erts/emulator/beam/erl_mtrace.h23
-rw-r--r--erts/emulator/beam/erl_nfunc_sched.c180
-rw-r--r--erts/emulator/beam/erl_nfunc_sched.h332
-rw-r--r--erts/emulator/beam/erl_nif.c3097
-rw-r--r--erts/emulator/beam/erl_nif.h245
-rw-r--r--erts/emulator/beam/erl_nif_api_funcs.h134
-rw-r--r--erts/emulator/beam/erl_node_container_utils.h64
-rw-r--r--erts/emulator/beam/erl_node_tables.c650
-rw-r--r--erts/emulator/beam/erl_node_tables.h60
-rw-r--r--erts/emulator/beam/erl_port.h248
-rw-r--r--erts/emulator/beam/erl_port_task.c247
-rw-r--r--erts/emulator/beam/erl_port_task.h38
-rw-r--r--erts/emulator/beam/erl_printf_term.c278
-rw-r--r--erts/emulator/beam/erl_printf_term.h26
-rw-r--r--erts/emulator/beam/erl_process.c7908
-rw-r--r--erts/emulator/beam/erl_process.h1030
-rw-r--r--erts/emulator/beam/erl_process_dict.c351
-rw-r--r--erts/emulator/beam/erl_process_dict.h41
-rw-r--r--erts/emulator/beam/erl_process_dump.c631
-rw-r--r--erts/emulator/beam/erl_process_lock.c541
-rw-r--r--erts/emulator/beam/erl_process_lock.h334
-rw-r--r--erts/emulator/beam/erl_ptab.c167
-rw-r--r--erts/emulator/beam/erl_ptab.h139
-rw-r--r--erts/emulator/beam/erl_rbtree.h1757
-rw-r--r--erts/emulator/beam/erl_sched_spec_pre_alloc.c23
-rw-r--r--erts/emulator/beam/erl_sched_spec_pre_alloc.h21
-rw-r--r--erts/emulator/beam/erl_smp.h376
-rw-r--r--erts/emulator/beam/erl_sock.h23
-rw-r--r--erts/emulator/beam/erl_sys_driver.h23
-rw-r--r--erts/emulator/beam/erl_term.c170
-rw-r--r--erts/emulator/beam/erl_term.h653
-rw-r--r--erts/emulator/beam/erl_thr_progress.c198
-rw-r--r--erts/emulator/beam/erl_thr_progress.h85
-rw-r--r--erts/emulator/beam/erl_thr_queue.c59
-rw-r--r--erts/emulator/beam/erl_thr_queue.h25
-rw-r--r--erts/emulator/beam/erl_threads.h1194
-rw-r--r--erts/emulator/beam/erl_time.h559
-rw-r--r--erts/emulator/beam/erl_time_sup.c2466
-rw-r--r--erts/emulator/beam/erl_trace.c3729
-rw-r--r--erts/emulator/beam/erl_trace.h161
-rw-r--r--erts/emulator/beam/erl_unicode.c181
-rw-r--r--erts/emulator/beam/erl_unicode.h23
-rw-r--r--erts/emulator/beam/erl_unicode_normalize.h35
-rw-r--r--erts/emulator/beam/erl_utils.h147
-rw-r--r--erts/emulator/beam/erl_vm.h72
-rw-r--r--erts/emulator/beam/erl_zlib.c23
-rw-r--r--erts/emulator/beam/erl_zlib.h23
-rw-r--r--erts/emulator/beam/erlang_dtrace.d50
-rw-r--r--erts/emulator/beam/erlang_lttng.c32
-rw-r--r--erts/emulator/beam/erlang_lttng.h424
-rw-r--r--erts/emulator/beam/error.h118
-rw-r--r--erts/emulator/beam/export.c80
-rw-r--r--erts/emulator/beam/export.h47
-rw-r--r--erts/emulator/beam/external.c1455
-rw-r--r--erts/emulator/beam/external.h45
-rw-r--r--[-rwxr-xr-x]erts/emulator/beam/global.h1204
-rw-r--r--erts/emulator/beam/hash.c188
-rw-r--r--erts/emulator/beam/hash.h58
-rw-r--r--erts/emulator/beam/index.c38
-rw-r--r--erts/emulator/beam/index.h42
-rw-r--r--erts/emulator/beam/io.c3164
-rw-r--r--erts/emulator/beam/lttng-wrapper.h107
-rw-r--r--erts/emulator/beam/module.c90
-rw-r--r--erts/emulator/beam/module.h35
-rw-r--r--erts/emulator/beam/ops.tab1100
-rw-r--r--erts/emulator/beam/packet_parser.c28
-rw-r--r--erts/emulator/beam/packet_parser.h26
-rw-r--r--erts/emulator/beam/register.c109
-rw-r--r--erts/emulator/beam/register.h27
-rw-r--r--erts/emulator/beam/safe_hash.c46
-rw-r--r--erts/emulator/beam/safe_hash.h35
-rw-r--r--erts/emulator/beam/sys.h631
-rw-r--r--erts/emulator/beam/time.c1762
-rw-r--r--erts/emulator/beam/utils.c2994
-rw-r--r--erts/emulator/beam/version.h23
-rw-r--r--erts/emulator/drivers/common/efile_drv.c116
-rw-r--r--erts/emulator/drivers/common/erl_efile.h27
-rw-r--r--erts/emulator/drivers/common/gzio.c2
-rw-r--r--erts/emulator/drivers/common/gzio.h23
-rw-r--r--erts/emulator/drivers/common/gzio_zutil.h23
-rw-r--r--erts/emulator/drivers/common/inet_drv.c1965
-rw-r--r--erts/emulator/drivers/common/ram_file_drv.c21
-rw-r--r--erts/emulator/drivers/common/zlib_drv.c662
-rw-r--r--erts/emulator/drivers/ose/ose_efile.c1124
-rw-r--r--erts/emulator/drivers/ose/ose_signal_drv.c896
-rw-r--r--erts/emulator/drivers/ose/ttsl_drv.c68
-rw-r--r--erts/emulator/drivers/unix/bin_drv.c23
-rw-r--r--erts/emulator/drivers/unix/multi_drv.c25
-rw-r--r--erts/emulator/drivers/unix/sig_drv.c25
-rw-r--r--erts/emulator/drivers/unix/ttsl_drv.c501
-rw-r--r--erts/emulator/drivers/unix/unix_efile.c160
-rw-r--r--erts/emulator/drivers/vxworks/vxworks_resolv.c23
-rw-r--r--erts/emulator/drivers/win32/registry_drv.c23
-rw-r--r--erts/emulator/drivers/win32/ttsl_drv.c39
-rw-r--r--erts/emulator/drivers/win32/win_con.c27
-rw-r--r--erts/emulator/drivers/win32/win_con.h23
-rw-r--r--erts/emulator/drivers/win32/win_efile.c25
-rw-r--r--erts/emulator/hipe/TODO21
-rw-r--r--erts/emulator/hipe/elf64ppc.x25
-rw-r--r--erts/emulator/hipe/hipe_amd64.c226
-rw-r--r--erts/emulator/hipe/hipe_amd64.h21
-rw-r--r--erts/emulator/hipe/hipe_amd64.tab21
-rw-r--r--erts/emulator/hipe/hipe_amd64_abi.txt2
-rw-r--r--erts/emulator/hipe/hipe_amd64_asm.m498
-rw-r--r--erts/emulator/hipe/hipe_amd64_bifs.m4115
-rw-r--r--erts/emulator/hipe/hipe_amd64_gc.h21
-rw-r--r--erts/emulator/hipe/hipe_amd64_glue.S40
-rw-r--r--erts/emulator/hipe/hipe_amd64_glue.h21
-rw-r--r--erts/emulator/hipe/hipe_amd64_primops.h21
-rw-r--r--erts/emulator/hipe/hipe_arch.h32
-rw-r--r--erts/emulator/hipe/hipe_arm.c232
-rw-r--r--erts/emulator/hipe/hipe_arm.h25
-rw-r--r--erts/emulator/hipe/hipe_arm.tab21
-rw-r--r--erts/emulator/hipe/hipe_arm_asm.m470
-rw-r--r--erts/emulator/hipe/hipe_arm_bifs.m4168
-rw-r--r--erts/emulator/hipe/hipe_arm_gc.h21
-rw-r--r--erts/emulator/hipe/hipe_arm_glue.S87
-rw-r--r--erts/emulator/hipe/hipe_arm_glue.h21
-rw-r--r--erts/emulator/hipe/hipe_arm_primops.h21
-rw-r--r--erts/emulator/hipe/hipe_bif0.c1490
-rw-r--r--erts/emulator/hipe/hipe_bif0.h40
-rw-r--r--erts/emulator/hipe/hipe_bif0.tab48
-rw-r--r--erts/emulator/hipe/hipe_bif1.c874
-rw-r--r--erts/emulator/hipe/hipe_bif1.h21
-rw-r--r--erts/emulator/hipe/hipe_bif1.tab44
-rw-r--r--erts/emulator/hipe/hipe_bif2.c31
-rw-r--r--erts/emulator/hipe/hipe_bif2.tab23
-rw-r--r--erts/emulator/hipe/hipe_bif64.c21
-rw-r--r--erts/emulator/hipe/hipe_bif64.h21
-rw-r--r--erts/emulator/hipe/hipe_bif64.tab21
-rw-r--r--erts/emulator/hipe/hipe_bif_list.m4100
-rw-r--r--erts/emulator/hipe/hipe_debug.c51
-rw-r--r--erts/emulator/hipe/hipe_debug.h21
-rw-r--r--erts/emulator/hipe/hipe_gbif_list.h21
-rw-r--r--erts/emulator/hipe/hipe_gc.c236
-rw-r--r--erts/emulator/hipe/hipe_gc.h21
-rw-r--r--erts/emulator/hipe/hipe_load.c106
-rw-r--r--erts/emulator/hipe/hipe_load.h48
-rw-r--r--erts/emulator/hipe/hipe_mkliterals.c48
-rw-r--r--erts/emulator/hipe/hipe_mode_switch.c226
-rw-r--r--erts/emulator/hipe/hipe_mode_switch.h78
-rw-r--r--erts/emulator/hipe/hipe_module.c35
-rw-r--r--erts/emulator/hipe/hipe_module.h45
-rw-r--r--erts/emulator/hipe/hipe_native_bif.c165
-rw-r--r--erts/emulator/hipe/hipe_native_bif.h46
-rw-r--r--erts/emulator/hipe/hipe_ops.tab21
-rw-r--r--erts/emulator/hipe/hipe_perfctr.c229
-rw-r--r--erts/emulator/hipe/hipe_perfctr.tab25
-rw-r--r--erts/emulator/hipe/hipe_ppc.c237
-rw-r--r--erts/emulator/hipe/hipe_ppc.h25
-rw-r--r--erts/emulator/hipe/hipe_ppc.tab21
-rw-r--r--erts/emulator/hipe/hipe_ppc64.tab23
-rw-r--r--erts/emulator/hipe/hipe_ppc_asm.m453
-rw-r--r--erts/emulator/hipe/hipe_ppc_bifs.m4100
-rw-r--r--erts/emulator/hipe/hipe_ppc_gc.h21
-rw-r--r--erts/emulator/hipe/hipe_ppc_glue.S44
-rw-r--r--erts/emulator/hipe/hipe_ppc_glue.h21
-rw-r--r--erts/emulator/hipe/hipe_ppc_primops.h21
-rw-r--r--erts/emulator/hipe/hipe_primops.h25
-rw-r--r--erts/emulator/hipe/hipe_process.h38
-rw-r--r--erts/emulator/hipe/hipe_risc_gc.h46
-rw-r--r--erts/emulator/hipe/hipe_risc_glue.h47
-rw-r--r--erts/emulator/hipe/hipe_risc_stack.c41
-rw-r--r--erts/emulator/hipe/hipe_signal.h21
-rw-r--r--erts/emulator/hipe/hipe_sparc.c143
-rw-r--r--erts/emulator/hipe/hipe_sparc.h25
-rw-r--r--erts/emulator/hipe/hipe_sparc.tab21
-rw-r--r--erts/emulator/hipe/hipe_sparc_asm.m439
-rw-r--r--erts/emulator/hipe/hipe_sparc_bifs.m496
-rw-r--r--erts/emulator/hipe/hipe_sparc_gc.h21
-rw-r--r--erts/emulator/hipe/hipe_sparc_glue.S44
-rw-r--r--erts/emulator/hipe/hipe_sparc_glue.h21
-rw-r--r--erts/emulator/hipe/hipe_sparc_primops.h21
-rw-r--r--erts/emulator/hipe/hipe_stack.c137
-rw-r--r--erts/emulator/hipe/hipe_stack.h91
-rw-r--r--erts/emulator/hipe/hipe_x86.c176
-rw-r--r--erts/emulator/hipe/hipe_x86.h25
-rw-r--r--erts/emulator/hipe/hipe_x86.tab21
-rw-r--r--erts/emulator/hipe/hipe_x86_abi.txt21
-rw-r--r--erts/emulator/hipe/hipe_x86_asm.m447
-rw-r--r--erts/emulator/hipe/hipe_x86_bifs.m475
-rw-r--r--erts/emulator/hipe/hipe_x86_gc.h69
-rw-r--r--erts/emulator/hipe/hipe_x86_glue.S38
-rw-r--r--erts/emulator/hipe/hipe_x86_glue.h50
-rw-r--r--erts/emulator/hipe/hipe_x86_primops.h21
-rw-r--r--erts/emulator/hipe/hipe_x86_signal.c219
-rw-r--r--erts/emulator/hipe/hipe_x86_stack.c48
-rw-r--r--erts/emulator/internal_doc/CarrierMigration.md134
-rw-r--r--erts/emulator/internal_doc/DelayedDealloc.md18
-rw-r--r--erts/emulator/internal_doc/PortSignals.md2
-rw-r--r--erts/emulator/internal_doc/SuperCarrier.md191
-rw-r--r--erts/emulator/internal_doc/ThreadProgress.md8
-rw-r--r--erts/emulator/internal_doc/Tracing.md4
-rw-r--r--erts/emulator/internal_doc/dec.erl42
-rw-r--r--erts/emulator/internal_doc/erl_ext_dist.txt21
-rw-r--r--erts/emulator/nifs/common/erl_tracer_nif.c257
-rw-r--r--erts/emulator/nifs/common/zlib_nif.c1028
-rw-r--r--erts/emulator/pcre/README.pcre_update.md18
-rw-r--r--erts/emulator/pcre/local_config.h12
-rw-r--r--erts/emulator/pcre/pcre-8.33.tar.bz2bin1440869 -> 0 bytes
-rw-r--r--erts/emulator/pcre/pcre-8.33_1370.diff60
-rw-r--r--erts/emulator/pcre/pcre-8.41.tar.bz2bin0 -> 1561874 bytes
-rw-r--r--erts/emulator/pcre/pcre.h24
-rw-r--r--erts/emulator/pcre/pcre.mk21
-rw-r--r--erts/emulator/pcre/pcre_byte_order.c6
-rw-r--r--erts/emulator/pcre/pcre_chartables.c2
-rw-r--r--erts/emulator/pcre/pcre_compile.c4301
-rw-r--r--erts/emulator/pcre/pcre_config.c4
-rw-r--r--erts/emulator/pcre/pcre_dfa_exec.c230
-rw-r--r--erts/emulator/pcre/pcre_exec.c907
-rw-r--r--erts/emulator/pcre/pcre_fullinfo.c4
-rw-r--r--erts/emulator/pcre/pcre_get.c23
-rw-r--r--erts/emulator/pcre/pcre_globals.c4
-rw-r--r--erts/emulator/pcre/pcre_internal.h452
-rw-r--r--erts/emulator/pcre/pcre_jit_compile.c6548
-rw-r--r--erts/emulator/pcre/pcre_latin_1_table.c2
-rw-r--r--erts/emulator/pcre/pcre_maketables.c27
-rw-r--r--erts/emulator/pcre/pcre_string_utils.c8
-rw-r--r--erts/emulator/pcre/pcre_study.c236
-rw-r--r--erts/emulator/pcre/pcre_tables.c353
-rw-r--r--erts/emulator/pcre/pcre_ucd.c5062
-rw-r--r--erts/emulator/pcre/pcre_xclass.c94
-rw-r--r--erts/emulator/pcre/ucp.h31
-rw-r--r--erts/emulator/sys/common/erl_check_io.c1738
-rw-r--r--erts/emulator/sys/common/erl_check_io.h101
-rw-r--r--erts/emulator/sys/common/erl_mmap.c759
-rw-r--r--erts/emulator/sys/common/erl_mmap.h165
-rw-r--r--erts/emulator/sys/common/erl_mseg.c545
-rw-r--r--erts/emulator/sys/common/erl_mseg.h46
-rw-r--r--erts/emulator/sys/common/erl_mtrace_sys_wrap.c23
-rw-r--r--erts/emulator/sys/common/erl_os_monotonic_time_extender.c89
-rw-r--r--erts/emulator/sys/common/erl_os_monotonic_time_extender.h66
-rw-r--r--erts/emulator/sys/common/erl_poll.c547
-rw-r--r--erts/emulator/sys/common/erl_poll.h67
-rw-r--r--erts/emulator/sys/common/erl_sys_common_misc.c31
-rw-r--r--erts/emulator/sys/common/erl_util_queue.h21
-rw-r--r--erts/emulator/sys/ose/beam.lmconf26
-rw-r--r--erts/emulator/sys/ose/erl_main.c53
-rw-r--r--erts/emulator/sys/ose/erl_ose_sys.h353
-rw-r--r--erts/emulator/sys/ose/erl_ose_sys_ddll.c126
-rw-r--r--erts/emulator/sys/ose/erl_poll.c780
-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.c1846
-rw-r--r--erts/emulator/sys/ose/sys_float.c844
-rw-r--r--erts/emulator/sys/ose/sys_time.c56
-rw-r--r--erts/emulator/sys/unix/driver_int.h23
-rw-r--r--erts/emulator/sys/unix/erl_child_setup.c645
-rw-r--r--erts/emulator/sys/unix/erl_child_setup.h77
-rw-r--r--erts/emulator/sys/unix/erl_main.c23
-rw-r--r--erts/emulator/sys/unix/erl_unix_sys.h294
-rw-r--r--erts/emulator/sys/unix/erl_unix_sys_ddll.c23
-rw-r--r--erts/emulator/sys/unix/sys.c2479
-rw-r--r--erts/emulator/sys/unix/sys_drivers.c1878
-rw-r--r--erts/emulator/sys/unix/sys_float.c139
-rw-r--r--erts/emulator/sys/unix/sys_time.c997
-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/dosmap.c23
-rw-r--r--erts/emulator/sys/win32/driver_int.h23
-rw-r--r--erts/emulator/sys/win32/erl_main.c23
-rw-r--r--erts/emulator/sys/win32/erl_poll.c121
-rw-r--r--erts/emulator/sys/win32/erl_win32_sys_ddll.c26
-rw-r--r--erts/emulator/sys/win32/erl_win_dyn_driver.h41
-rw-r--r--erts/emulator/sys/win32/erl_win_sys.h133
-rw-r--r--[-rwxr-xr-x]erts/emulator/sys/win32/sys.c237
-rw-r--r--erts/emulator/sys/win32/sys_env.c24
-rw-r--r--erts/emulator/sys/win32/sys_float.c26
-rw-r--r--erts/emulator/sys/win32/sys_interrupt.c29
-rw-r--r--erts/emulator/sys/win32/sys_time.c421
-rw-r--r--erts/emulator/test/Makefile47
-rw-r--r--erts/emulator/test/a_SUITE.erl146
-rw-r--r--erts/emulator/test/after_SUITE.erl250
-rw-r--r--erts/emulator/test/alloc_SUITE.erl460
-rw-r--r--erts/emulator/test/alloc_SUITE_data/Makefile.src24
-rw-r--r--erts/emulator/test/alloc_SUITE_data/allocator_test.h41
-rw-r--r--erts/emulator/test/alloc_SUITE_data/basic.c24
-rw-r--r--erts/emulator/test/alloc_SUITE_data/basic.erl10
-rw-r--r--erts/emulator/test/alloc_SUITE_data/bucket_index.c23
-rw-r--r--erts/emulator/test/alloc_SUITE_data/bucket_index.erl10
-rw-r--r--erts/emulator/test/alloc_SUITE_data/bucket_mask.c25
-rw-r--r--erts/emulator/test/alloc_SUITE_data/bucket_mask.erl10
-rw-r--r--erts/emulator/test/alloc_SUITE_data/coalesce.c24
-rw-r--r--erts/emulator/test/alloc_SUITE_data/coalesce.erl10
-rw-r--r--erts/emulator/test/alloc_SUITE_data/cpool.c30
-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.c24
-rw-r--r--erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.erl10
-rw-r--r--erts/emulator/test/alloc_SUITE_data/rbtree.c35
-rw-r--r--erts/emulator/test/alloc_SUITE_data/rbtree.erl10
-rw-r--r--erts/emulator/test/alloc_SUITE_data/realloc_copy.c23
-rw-r--r--erts/emulator/test/alloc_SUITE_data/realloc_copy.erl10
-rw-r--r--erts/emulator/test/alloc_SUITE_data/testcase_driver.c276
-rw-r--r--erts/emulator/test/alloc_SUITE_data/testcase_driver.h36
-rw-r--r--erts/emulator/test/alloc_SUITE_data/threads.c48
-rw-r--r--erts/emulator/test/alloc_SUITE_data/threads.erl10
-rw-r--r--erts/emulator/test/async_ports_SUITE.erl117
-rw-r--r--erts/emulator/test/async_ports_SUITE_data/Makefile.src15
-rw-r--r--erts/emulator/test/async_ports_SUITE_data/cport.c81
-rw-r--r--erts/emulator/test/beam_SUITE.erl154
-rw-r--r--erts/emulator/test/beam_literals_SUITE.erl226
-rw-r--r--erts/emulator/test/bif_SUITE.erl706
-rw-r--r--erts/emulator/test/big_SUITE.erl238
-rw-r--r--erts/emulator/test/big_SUITE_data/borders.dat35
-rw-r--r--erts/emulator/test/big_SUITE_data/literal_test.erl23
-rw-r--r--erts/emulator/test/binary_SUITE.erl1151
-rw-r--r--erts/emulator/test/bs_bincomp_SUITE.erl25
-rw-r--r--erts/emulator/test/bs_bit_binaries_SUITE.erl113
-rw-r--r--erts/emulator/test/bs_construct_SUITE.erl439
-rw-r--r--erts/emulator/test/bs_match_bin_SUITE.erl79
-rw-r--r--erts/emulator/test/bs_match_int_SUITE.erl121
-rw-r--r--erts/emulator/test/bs_match_misc_SUITE.erl255
-rw-r--r--erts/emulator/test/bs_match_tail_SUITE.erl100
-rw-r--r--erts/emulator/test/bs_utf_SUITE.erl133
-rw-r--r--erts/emulator/test/busy_port_SUITE.erl715
-rw-r--r--erts/emulator/test/busy_port_SUITE_data/Makefile.src23
-rw-r--r--erts/emulator/test/busy_port_SUITE_data/hard_busy_drv.c23
-rw-r--r--erts/emulator/test/busy_port_SUITE_data/hs_busy_drv.c23
-rw-r--r--erts/emulator/test/busy_port_SUITE_data/scheduling_drv.c23
-rw-r--r--erts/emulator/test/busy_port_SUITE_data/soft_busy_drv.c23
-rw-r--r--erts/emulator/test/call_trace_SUITE.erl1649
-rw-r--r--erts/emulator/test/code_SUITE.erl1013
-rw-r--r--erts/emulator/test/code_SUITE_data/another_code_test.erl23
-rw-r--r--erts/emulator/test/code_SUITE_data/call_purged_fun_tester.erl186
-rw-r--r--erts/emulator/test/code_SUITE_data/cpbugx.erl23
-rw-r--r--erts/emulator/test/code_SUITE_data/fun_confusion.erl23
-rw-r--r--erts/emulator/test/code_SUITE_data/literals.erl30
-rw-r--r--erts/emulator/test/code_SUITE_data/many_funs.erl23
-rw-r--r--erts/emulator/test/code_SUITE_data/my_code_test.erl25
-rw-r--r--erts/emulator/test/code_SUITE_data/my_code_test2.erl32
-rw-r--r--erts/emulator/test/code_SUITE_data/versions.erl21
-rw-r--r--erts/emulator/test/code_parallel_load_SUITE.erl78
-rw-r--r--erts/emulator/test/crypto_SUITE.erl422
-rw-r--r--erts/emulator/test/crypto_reference.erl23
-rw-r--r--erts/emulator/test/ddll_SUITE.erl1634
-rw-r--r--erts/emulator/test/decode_packet_SUITE.erl570
-rw-r--r--erts/emulator/test/dgawd_handler.erl23
-rw-r--r--erts/emulator/test/dirty_bif_SUITE.erl580
-rw-r--r--erts/emulator/test/dirty_bif_SUITE_data/.gitignore0
-rw-r--r--erts/emulator/test/dirty_nif_SUITE.erl683
-rw-r--r--erts/emulator/test/dirty_nif_SUITE_data/Makefile.src6
-rw-r--r--erts/emulator/test/dirty_nif_SUITE_data/dirty_nif_SUITE.c445
-rw-r--r--erts/emulator/test/dirty_nif_SUITE_data/echo_drv.c62
-rw-r--r--erts/emulator/test/distribution_SUITE.erl2904
-rw-r--r--erts/emulator/test/distribution_SUITE_data/run.erl70
-rw-r--r--erts/emulator/test/driver_SUITE.erl3209
-rw-r--r--erts/emulator/test/driver_SUITE_data/async_blast_drv.c21
-rw-r--r--erts/emulator/test/driver_SUITE_data/caller_drv.c21
-rw-r--r--erts/emulator/test/driver_SUITE_data/chkio_drv.c35
-rw-r--r--erts/emulator/test/driver_SUITE_data/consume_timeslice_drv.c21
-rw-r--r--erts/emulator/test/driver_SUITE_data/invalid_extended_marker_drv.c21
-rw-r--r--erts/emulator/test/driver_SUITE_data/io_ready_exit_drv.c21
-rw-r--r--erts/emulator/test/driver_SUITE_data/ioq_exit_drv.c21
-rw-r--r--erts/emulator/test/driver_SUITE_data/larger_major_vsn_drv.c21
-rw-r--r--erts/emulator/test/driver_SUITE_data/larger_minor_vsn_drv.c21
-rw-r--r--erts/emulator/test/driver_SUITE_data/missing_callback_drv.c21
-rw-r--r--erts/emulator/test/driver_SUITE_data/monitor_drv.c21
-rw-r--r--erts/emulator/test/driver_SUITE_data/otp_6879_drv.c21
-rw-r--r--erts/emulator/test/driver_SUITE_data/otp_9302_drv.c21
-rw-r--r--erts/emulator/test/driver_SUITE_data/peek_non_existing_queue_drv.c21
-rw-r--r--erts/emulator/test/driver_SUITE_data/smaller_major_vsn_drv.c21
-rw-r--r--erts/emulator/test/driver_SUITE_data/smaller_minor_vsn_drv.c21
-rw-r--r--erts/emulator/test/driver_SUITE_data/sys_info_base_drv.c28
-rw-r--r--erts/emulator/test/driver_SUITE_data/sys_info_curr_drv.c32
-rw-r--r--erts/emulator/test/driver_SUITE_data/sys_info_drv_impl.c21
-rw-r--r--erts/emulator/test/driver_SUITE_data/sys_info_drv_impl.h21
-rw-r--r--erts/emulator/test/driver_SUITE_data/sys_info_prev_drv.c28
-rw-r--r--erts/emulator/test/driver_SUITE_data/thr_alloc_drv.c21
-rw-r--r--erts/emulator/test/driver_SUITE_data/thr_free_drv.c21
-rw-r--r--erts/emulator/test/driver_SUITE_data/thr_msg_blast_drv.c21
-rw-r--r--erts/emulator/test/driver_SUITE_data/timer_drv.c44
-rw-r--r--erts/emulator/test/driver_SUITE_data/vsn_mismatch_drv_impl.c21
-rw-r--r--erts/emulator/test/driver_SUITE_data/zero_extended_marker_garb_drv.c21
-rw-r--r--erts/emulator/test/efile_SUITE.erl168
-rw-r--r--erts/emulator/test/emulator.spec.ose2
-rw-r--r--erts/emulator/test/emulator_node_container_SUITE.spec2
-rw-r--r--erts/emulator/test/emulator_smoke.spec12
-rw-r--r--erts/emulator/test/erl_drv_thread_SUITE.erl143
-rw-r--r--erts/emulator/test/erl_drv_thread_SUITE_data/Makefile.src21
-rw-r--r--erts/emulator/test/erl_drv_thread_SUITE_data/basic.c21
-rw-r--r--erts/emulator/test/erl_drv_thread_SUITE_data/rwlock.c21
-rw-r--r--erts/emulator/test/erl_drv_thread_SUITE_data/testcase_driver.c21
-rw-r--r--erts/emulator/test/erl_drv_thread_SUITE_data/testcase_driver.h21
-rw-r--r--erts/emulator/test/erl_drv_thread_SUITE_data/tsd.c21
-rw-r--r--erts/emulator/test/erl_link_SUITE.erl1551
-rw-r--r--erts/emulator/test/erts_debug_SUITE.erl191
-rw-r--r--erts/emulator/test/estone_SUITE.erl111
-rw-r--r--erts/emulator/test/evil_SUITE.erl485
-rw-r--r--erts/emulator/test/exception_SUITE.erl654
-rw-r--r--erts/emulator/test/float_SUITE.erl422
-rw-r--r--erts/emulator/test/float_SUITE_data/fp_drv.c39
-rw-r--r--erts/emulator/test/float_SUITE_data/has_fpe_bug.erl23
-rw-r--r--erts/emulator/test/fun_SUITE.erl871
-rw-r--r--erts/emulator/test/fun_r13_SUITE.erl97
-rw-r--r--erts/emulator/test/gc_SUITE.erl211
-rw-r--r--erts/emulator/test/guard_SUITE.erl346
-rw-r--r--erts/emulator/test/hash_SUITE.erl174
-rw-r--r--erts/emulator/test/hibernate_SUITE.erl281
-rw-r--r--erts/emulator/test/hipe_SUITE.erl188
-rw-r--r--erts/emulator/test/hipe_SUITE_data/literals.erl26
-rw-r--r--erts/emulator/test/hipe_SUITE_data/ref_cell.erl64
-rw-r--r--erts/emulator/test/hipe_SUITE_data/trycatch_1.erl14
-rw-r--r--erts/emulator/test/hipe_SUITE_data/trycatch_2.erl10
-rw-r--r--erts/emulator/test/hipe_SUITE_data/trycatch_3.erl9
-rw-r--r--erts/emulator/test/ignore_cores.erl35
-rw-r--r--erts/emulator/test/iovec_SUITE.erl176
-rw-r--r--erts/emulator/test/lcnt_SUITE.erl156
-rw-r--r--erts/emulator/test/list_bif_SUITE.erl211
-rw-r--r--erts/emulator/test/long_timers_test.erl261
-rw-r--r--erts/emulator/test/lttng_SUITE.erl502
-rw-r--r--erts/emulator/test/lttng_SUITE_data/Makefile.src7
-rw-r--r--erts/emulator/test/lttng_SUITE_data/caller_drv.c159
-rw-r--r--erts/emulator/test/map_SUITE.erl2707
-rw-r--r--erts/emulator/test/map_SUITE_data/badmap_17.beambin0 -> 592 bytes
-rw-r--r--erts/emulator/test/map_SUITE_data/badmap_17.erl26
-rw-r--r--erts/emulator/test/match_spec_SUITE.erl1367
-rw-r--r--erts/emulator/test/message_queue_data_SUITE.erl207
-rw-r--r--erts/emulator/test/module_info_SUITE.erl167
-rw-r--r--erts/emulator/test/module_info_SUITE_data/module_info_test.erl24
-rw-r--r--erts/emulator/test/monitor_SUITE.erl1301
-rw-r--r--erts/emulator/test/mtx_SUITE.erl427
-rw-r--r--erts/emulator/test/mtx_SUITE_data/Makefile.src23
-rw-r--r--erts/emulator/test/mtx_SUITE_data/mtx_SUITE.c23
-rw-r--r--erts/emulator/test/multi_load_SUITE.erl181
-rw-r--r--erts/emulator/test/nested_SUITE.erl119
-rw-r--r--erts/emulator/test/nif_SUITE.erl2765
-rw-r--r--erts/emulator/test/nif_SUITE_data/Makefile.src13
-rw-r--r--erts/emulator/test/nif_SUITE_data/echo_drv.c62
-rw-r--r--erts/emulator/test/nif_SUITE_data/hipe_compiled.erl6
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_SUITE.c1985
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_api_2_0/README5
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_api_2_0/erl_drv_nif.h (renamed from erts/emulator/sys/ose/driver_int.h)37
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_api_2_0/erl_nif.h206
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_api_2_0/erl_nif_api_funcs.h257
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_api_2_4/README6
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_api_2_4/erl_drv_nif.h (renamed from erts/emulator/hipe/hipe_perfctr.h)33
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_api_2_4/erl_nif.h237
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_api_2_4/erl_nif_api_funcs.h503
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_mod.1.2_0.c4
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_mod.1.2_4.c4
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_mod.2.2_0.c4
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_mod.2.2_4.c4
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_mod.3.2_0.c4
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_mod.3.2_4.c4
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_mod.c40
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_mod.erl64
-rw-r--r--erts/emulator/test/nif_SUITE_data/testcase_driver.h23
-rw-r--r--erts/emulator/test/nif_SUITE_data/tester.c6
-rw-r--r--erts/emulator/test/nif_SUITE_data/tester.erl5
-rw-r--r--erts/emulator/test/node_container_SUITE.erl1687
-rw-r--r--erts/emulator/test/nofrag_SUITE.erl129
-rw-r--r--erts/emulator/test/num_bif_SUITE.erl249
-rw-r--r--erts/emulator/test/old_mod.erl47
-rw-r--r--erts/emulator/test/old_scheduler_SUITE.erl414
-rw-r--r--erts/emulator/test/op_SUITE.erl340
-rw-r--r--erts/emulator/test/os_signal_SUITE.erl357
-rw-r--r--erts/emulator/test/os_signal_SUITE_data/Makefile.src6
-rw-r--r--erts/emulator/test/os_signal_SUITE_data/os_signal_nif.c66
-rw-r--r--erts/emulator/test/port_SUITE.erl2675
-rw-r--r--erts/emulator/test/port_SUITE_data/Makefile.src8
-rw-r--r--erts/emulator/test/port_SUITE_data/dead_port.c21
-rw-r--r--erts/emulator/test/port_SUITE_data/echo_drv.c31
-rw-r--r--erts/emulator/test/port_SUITE_data/port_test.c53
-rw-r--r--erts/emulator/test/port_SUITE_data/port_test.erl23
-rw-r--r--erts/emulator/test/port_SUITE_data/sleep_failure_drv.c76
-rw-r--r--erts/emulator/test/port_bif_SUITE.erl144
-rw-r--r--erts/emulator/test/port_bif_SUITE_data/port_test.c2
-rw-r--r--erts/emulator/test/port_trace_SUITE.erl652
-rw-r--r--erts/emulator/test/port_trace_SUITE_data/Makefile.src3
-rw-r--r--erts/emulator/test/port_trace_SUITE_data/echo_drv.c296
-rw-r--r--erts/emulator/test/prim_eval_SUITE.erl78
-rw-r--r--erts/emulator/test/process_SUITE.erl589
-rw-r--r--erts/emulator/test/pseudoknot_SUITE.erl23
-rw-r--r--erts/emulator/test/random_iolist.erl39
-rw-r--r--erts/emulator/test/receive_SUITE.erl112
-rw-r--r--erts/emulator/test/ref_SUITE.erl74
-rw-r--r--erts/emulator/test/register_SUITE.erl94
-rw-r--r--erts/emulator/test/save_calls_SUITE.erl298
-rw-r--r--erts/emulator/test/scheduler_SUITE.erl2058
-rw-r--r--erts/emulator/test/send_term_SUITE.erl221
-rw-r--r--erts/emulator/test/send_term_SUITE_data/ext_terms.binbin476 -> 914 bytes
-rw-r--r--erts/emulator/test/send_term_SUITE_data/ext_terms.h147
-rw-r--r--erts/emulator/test/send_term_SUITE_data/send_term_drv.c21
-rw-r--r--erts/emulator/test/sensitive_SUITE.erl528
-rw-r--r--erts/emulator/test/signal_SUITE.erl469
-rw-r--r--erts/emulator/test/smoke_test_SUITE.erl83
-rw-r--r--erts/emulator/test/statistics_SUITE.erl774
-rw-r--r--erts/emulator/test/system_info_SUITE.erl356
-rw-r--r--erts/emulator/test/system_profile_SUITE.erl288
-rw-r--r--erts/emulator/test/time_SUITE.erl754
-rw-r--r--erts/emulator/test/timer_bif_SUITE.erl848
-rw-r--r--erts/emulator/test/trace_SUITE.erl2642
-rw-r--r--erts/emulator/test/trace_bif_SUITE.erl485
-rw-r--r--erts/emulator/test/trace_call_count_SUITE.erl337
-rw-r--r--erts/emulator/test/trace_call_time_SUITE.erl690
-rw-r--r--erts/emulator/test/trace_call_time_SUITE_data/trace_nif.c9
-rw-r--r--erts/emulator/test/trace_local_SUITE.erl1522
-rw-r--r--erts/emulator/test/trace_local_SUITE_data/trace_local_dummy.erl23
-rw-r--r--erts/emulator/test/trace_meta_SUITE.erl707
-rw-r--r--erts/emulator/test/trace_nif_SUITE.erl367
-rw-r--r--erts/emulator/test/trace_nif_SUITE_data/trace_nif.c13
-rw-r--r--erts/emulator/test/trace_port_SUITE.erl791
-rw-r--r--erts/emulator/test/trace_port_SUITE_data/echo_drv.c12
-rw-r--r--erts/emulator/test/tracer_SUITE.erl696
-rw-r--r--erts/emulator/test/tracer_SUITE_data/Makefile.src8
-rw-r--r--erts/emulator/test/tracer_SUITE_data/tracer_test.c116
-rw-r--r--erts/emulator/test/tracer_test.erl55
-rw-r--r--erts/emulator/test/tuple_SUITE.erl126
-rw-r--r--erts/emulator/test/unique_SUITE.erl375
-rw-r--r--erts/emulator/test/z_SUITE.erl420
-rwxr-xr-xerts/emulator/utils/beam_makeops606
-rwxr-xr-xerts/emulator/utils/beam_strip23
-rwxr-xr-xerts/emulator/utils/count21
-rwxr-xr-xerts/emulator/utils/gen_git_version6
-rw-r--r--erts/emulator/utils/loaded21
-rwxr-xr-xerts/emulator/utils/make_alloc_types46
-rwxr-xr-xerts/emulator/utils/make_compiler_flags23
-rwxr-xr-xerts/emulator/utils/make_driver_tab36
-rwxr-xr-xerts/emulator/utils/make_preload49
-rwxr-xr-xerts/emulator/utils/make_tables248
-rwxr-xr-xerts/emulator/utils/make_version29
-rw-r--r--erts/emulator/utils/mkver.c29
-rw-r--r--erts/emulator/valgrind/suppress.halfword56
-rw-r--r--erts/emulator/valgrind/suppress.patched.3.6.024
-rw-r--r--erts/emulator/valgrind/suppress.standard25
-rw-r--r--erts/emulator/zlib/zlib.mk21
637 files changed, 136639 insertions, 80640 deletions
diff --git a/erts/emulator/Makefile b/erts/emulator/Makefile
index 2db3b349b6..65fdbdb747 100644
--- a/erts/emulator/Makefile
+++ b/erts/emulator/Makefile
@@ -1,18 +1,19 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1997-2009. All Rights Reserved.
+# Copyright Ericsson AB 1997-2016. 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.
+# 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%
#
diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in
index 7145824f91..1916b97a89 100644
--- a/erts/emulator/Makefile.in
+++ b/erts/emulator/Makefile.in
@@ -1,18 +1,19 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1996-2013. All Rights Reserved.
+# Copyright Ericsson AB 1996-2017. 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/.
+# 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
#
-# 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.
+# 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%
#
@@ -22,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@
@@ -52,6 +49,10 @@ CREATE_DIRS=
LDFLAGS=@LDFLAGS@
ARFLAGS=rc
OMIT_OMIT_FP=no
+TYPE_LIBS=
+
+DIRTY_SCHEDULER_SUPPORT=@DIRTY_SCHEDULER_SUPPORT@
+DIRTY_SCHEDULER_TEST=@DIRTY_SCHEDULER_TEST@
ifeq ($(TYPE),debug)
PURIFY =
@@ -90,7 +91,7 @@ PURIFY =
TYPEMARKER = .gcov
TYPE_FLAGS = $(DEBUG_CFLAGS) -DERTS_GCOV -DNO_JUMP_TABLE -fprofile-arcs -ftest-coverage -O0 -DERTS_CAN_INLINE=0 -DERTS_INLINE=
ifneq ($(findstring solaris,$(TARGET)),solaris)
-LIBS += -lgcov
+TYPE_LIBS = -lgcov
endif
ENABLE_ALLOC_TYPE_VARS += debug
else
@@ -112,18 +113,25 @@ NO_INLINE_FUNCTIONS=true
else
ifeq ($(TYPE),lcnt)
-PURIFY =
+PURIFY =
TYPEMARKER = .lcnt
TYPE_FLAGS = @CFLAGS@ -DERTS_ENABLE_LOCK_COUNT
+ENABLE_ALLOC_TYPE_VARS += lcnt
else
ifeq ($(TYPE),frmptr)
-PURIFY =
+PURIFY =
OMIT_OMIT_FP=yes
TYPEMARKER = .frmptr
TYPE_FLAGS = @CFLAGS@ -DERTS_FRMPTR
else
+ifeq ($(TYPE),icount)
+PURIFY =
+TYPEMARKER = .icount
+TYPE_FLAGS = @CFLAGS@ -DERTS_OPCODE_COUNTER_SUPPORT
+else
+
# If type isn't one of the above, it *is* opt type...
override TYPE=opt
PURIFY =
@@ -138,6 +146,11 @@ endif
endif
endif
endif
+endif
+
+LIBS += $(TYPE_LIBS)
+
+ORIG_LIBS:= $(LIBS)
comma:=,
space:=
@@ -165,33 +178,52 @@ endif
# NOTE: When adding a new type update ERL_BUILD_TYPE_MARKER in sys/unix/sys.c
#
-ifeq ($(FLAVOR),smp)
-FLAVOR_MARKER=.smp
-FLAVOR_FLAGS=-DERTS_SMP
-ENABLE_ALLOC_TYPE_VARS += smp nofrag
-M4FLAGS += -DERTS_SMP=1
-else
+FLAVOR=$(DEFAULT_FLAVOR)
+
+ifeq ($(FLAVOR),plain)
+
+DS_SUPPORT=no
+DS_TEST=no
-# If flavor isn't one of the above, it *is* plain flavor...
-override FLAVOR=plain
FLAVOR_MARKER=
FLAVOR_FLAGS=
ENABLE_ALLOC_TYPE_VARS += nofrag
M4FLAGS +=
-endif
+else # FLAVOR
+
+# If flavor isn't one of the above, it *is* smp flavor...
+override FLAVOR=smp
+
+FLAVOR_MARKER=.smp
+FLAVOR_FLAGS=-DERTS_SMP
+ENABLE_ALLOC_TYPE_VARS += smp nofrag
+M4FLAGS += -DERTS_SMP=1
+ifeq ($(DIRTY_SCHEDULER_SUPPORT),yes)
+THR_DEFS += -DERTS_DIRTY_SCHEDULERS
+DS_SUPPORT=yes
+
+ifeq ($(DIRTY_SCHEDULER_TEST),yes)
+DS_TEST=yes
+THR_DEFS += -DERTS_DIRTY_SCHEDULERS_TEST
+else # DIRTY_SCHEDULER_TEST
+DS_TEST=no
+endif # DIRTY_SCHEDULER_TEST
+
+else # DIRTY_SCHEDULER_SUPPORT
+DS_SUPPORT=no
+DS_TEST=no
+endif # DIRTY_SCHEDULER_SUPPORT
+
+endif # FLAVOR
TF_MARKER=$(TYPEMARKER)$(FLAVOR_MARKER)
-ifeq ($(FLAVOR)-@ERTS_BUILD_SMP_EMU@,smp-no)
-VOID_EMULATOR = '*** SMP emulator disabled by configure'
-else
ifeq ($(TYPE)-@HAVE_VALGRIND@,valgrind-no)
VOID_EMULATOR = '*** valgrind emulator disabled by configure'
else
VOID_EMULATOR =
endif
-endif
OPSYS=@OPSYS@
sol2CFLAGS=
@@ -237,9 +269,7 @@ HCC = @HCC@
LD = @LD@
DEXPORT = @DEXPORT@
RANLIB = @RANLIB@
-ifneq ($(findstring ose,$(TARGET)),ose)
STRIP = strip
-endif
PERL = @PERL@
RM = @RM@
MKDIR = @MKDIR@
@@ -315,7 +345,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@
@@ -342,16 +372,6 @@ endif
EPCRE_LIB = $(ERL_TOP)/erts/emulator/pcre/obj/$(TARGET)/$(TYPE)/$(LIB_PREFIX)epcre$(LIB_SUFFIX)
DEPLIBS += $(EPCRE_LIB)
-PERFCTR_PATH=@PERFCTR_PATH@
-USE_PERFCTR=@USE_PERFCTR@
-ifdef PERFCTR_PATH
-LIBS += $(PERFCTR_PATH)/usr.lib/libperfctr.a
-else
-ifdef USE_PERFCTR
-LIBS += -lperfctr
-endif
-endif
-
LIBSCTP = @LIBSCTP@
ORG_THR_LIBS=@EMU_THR_LIBS@
@@ -406,7 +426,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)
# ----------------------------------------------------------------------
@@ -548,8 +568,10 @@ GENERATE += $(TTF_DIR)/OPCODES-GENERATED
# bif and atom table
ATOMS= beam/atom.names
+DIRTY_BIFS = beam/erl_dirty_bif.tab
BIFS = beam/bif.tab
ifdef HIPE_ENABLED
+HIPE=yes
HIPE_ARCH64_TAB=hipe/hipe_bif64.tab
HIPE_x86_TAB=hipe/hipe_x86.tab
HIPE_amd64_TAB=hipe/hipe_amd64.tab $(HIPE_ARCH64_TAB)
@@ -559,23 +581,26 @@ HIPE_ppc64_TAB=hipe/hipe_ppc64.tab $(HIPE_ARCH64_TAB)
HIPE_arm_TAB=hipe/hipe_arm.tab
HIPE_ARCH_TAB=$(HIPE_$(ARCH)_TAB)
BIFS += hipe/hipe_bif0.tab hipe/hipe_bif1.tab hipe/hipe_bif2.tab $(HIPE_ARCH_TAB)
-ifdef USE_PERFCTR
-BIFS += hipe/hipe_perfctr.tab
-endif
-endif
-
-$(TARGET)/erl_bif_table.c \
-$(TARGET)/erl_bif_table.h \
-$(TARGET)/erl_bif_wrap.c \
-$(TARGET)/erl_bif_list.h \
-$(TARGET)/erl_atom_table.c \
-$(TARGET)/erl_atom_table.h \
-$(TARGET)/erl_pbifs.c \
- : $(TARGET)/TABLES-GENERATED
-$(TARGET)/TABLES-GENERATED: $(ATOMS) $(BIFS) utils/make_tables
- $(gen_verbose)LANG=C $(PERL) utils/make_tables -src $(TARGET) -include $(TARGET)\
- $(ATOMS) $(BIFS) && echo $? >$(TARGET)/TABLES-GENERATED
-GENERATE += $(TARGET)/TABLES-GENERATED
+HIPE_NBIF_FILES=$(TTF_DIR)/hipe_nbif_impl.h $(TTF_DIR)/hipe_nbif_impl.c
+else
+HIPE=no
+HIPE_NBIF_FILES=
+endif
+
+$(TTF_DIR)/erl_bif_table.c \
+$(TTF_DIR)/erl_bif_table.h \
+$(TTF_DIR)/erl_bif_wrap.c \
+$(TTF_DIR)/erl_bif_list.h \
+$(TTF_DIR)/erl_atom_table.c \
+$(TTF_DIR)/erl_atom_table.h \
+$(TTF_DIR)/erl_guard_bifs.c \
+$(TTF_DIR)/erl_dirty_bif_wrap.c \
+$(HIPE_NBIF_FILES) \
+ : $(TTF_DIR)/TABLES-GENERATED
+$(TTF_DIR)/TABLES-GENERATED: $(ATOMS) $(DIRTY_BIFS) $(BIFS) utils/make_tables
+ $(gen_verbose)LANG=C $(PERL) utils/make_tables -src $(TTF_DIR) -include $(TTF_DIR)\
+ -ds $(DS_SUPPORT) -dst $(DS_TEST) -hipe $(HIPE) $(ATOMS) $(DIRTY_BIFS) $(BIFS) && echo $? >$(TTF_DIR)/TABLES-GENERATED
+GENERATE += $(TTF_DIR)/TABLES-GENERATED
$(TTF_DIR)/erl_alloc_types.h: beam/erl_alloc.types utils/make_alloc_types
$(gen_verbose)LANG=C $(PERL) utils/make_alloc_types -src $< -dst $@ $(ENABLE_ALLOC_TYPE_VARS)
@@ -588,7 +613,7 @@ GENERATE += $(TARGET)/erl_version.h
# driver table
$(TTF_DIR)/driver_tab.c: Makefile.in utils/make_driver_tab
- $(gen_verbose)LANG=C $(PERL) utils/make_driver_tab -o $@ -nifs $(STATIC_NIF_LIBS) -drivers $(DRV_OBJS) $(STATIC_DRIVER_LIBS)
+ $(gen_verbose)LANG=C $(PERL) utils/make_driver_tab -o $@ -nifs $(NIF_OBJS) $(STATIC_NIF_LIBS) -drivers $(DRV_OBJS) $(STATIC_DRIVER_LIBS)
GENERATE += $(TTF_DIR)/driver_tab.c
@@ -597,11 +622,9 @@ GENERATE += $(TTF_DIR)/driver_tab.c
#
# This list must be consistent with PRE_LOADED_MODULES in
# erts/preloaded/src/Makefile.
-ifeq ($(TARGET),win32)
-# On windows the preloaded objects are in a resource object.
-PRELOAD_OBJ = $(OBJDIR)/beams.$(RES_EXT)
-PRELOAD_SRC = $(TARGET)/beams.rc
-$(PRELOAD_SRC): $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \
+
+PRELOAD_BEAM = $(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 \
@@ -610,21 +633,21 @@ $(PRELOAD_SRC): $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \
$(ERL_TOP)/erts/preloaded/ebin/prim_zip.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
+ $(ERL_TOP)/erts/preloaded/ebin/erts_internal.beam \
+ $(ERL_TOP)/erts/preloaded/ebin/erl_tracer.beam \
+ $(ERL_TOP)/erts/preloaded/ebin/erts_literal_area_collector.beam \
+ $(ERL_TOP)/erts/preloaded/ebin/erts_dirty_process_code_checker.beam
+
+ifeq ($(TARGET),win32)
+# On windows the preloaded objects are in a resource object.
+PRELOAD_OBJ = $(OBJDIR)/beams.$(RES_EXT)
+PRELOAD_SRC = $(TARGET)/beams.rc
+$(PRELOAD_SRC): $(PRELOAD_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/init.beam \
- $(ERL_TOP)/erts/preloaded/ebin/prim_eval.beam \
- $(ERL_TOP)/erts/preloaded/ebin/prim_inet.beam \
- $(ERL_TOP)/erts/preloaded/ebin/prim_file.beam \
- $(ERL_TOP)/erts/preloaded/ebin/zlib.beam \
- $(ERL_TOP)/erts/preloaded/ebin/prim_zip.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
+$(PRELOAD_SRC): $(PRELOAD_BEAM)
$(gen_verbose)LANG=C $(PERL) utils/make_preload -old $^ > $@
endif
@@ -637,6 +660,10 @@ generate: $(TTF_DIR)/GENERATED $(PRELOAD_SRC)
$(TTF_DIR)/GENERATED: $(GENERATE)
$(gen_verbose)echo $? >$(TTF_DIR)/GENERATED
+
+# Regenerate if Makefile has changed
+$(GENERATE): $(TARGET)/Makefile
+
endif
$(TARGET)/erlang_dtrace.h: beam/erlang_dtrace.d
@@ -657,10 +684,6 @@ COMMON_INCLUDES += -I../include/internal -I../include/internal/$(TARGET)
INCLUDES = -I$(TTF_DIR) $(COMMON_INCLUDES)
-ifdef PERFCTR_PATH
-INCLUDES += -I$(PERFCTR_PATH)/usr.lib -I$(PERFCTR_PATH)/linux/include
-endif
-
ifeq ($(TARGET),win32)
$(OBJDIR)/dll_sys.o: sys/$(ERLANG_OSTYPE)/sys.c
$(V_CC) $(CFLAGS) -DERL_RUN_SHARED_LIB=1 $(INCLUDES) -c $< -o $@
@@ -693,14 +716,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 $@
@@ -710,14 +725,17 @@ $(OBJDIR)/%.o: drivers/common/%.c
$(OBJDIR)/%.o: drivers/$(ERLANG_OSTYPE)/%.c
$(V_CC) $(CFLAGS) $(INCLUDES) -Idrivers/common -Idrivers/$(ERLANG_OSTYPE) -I../etc/$(ERLANG_OSTYPE) -c $< -o $@
+$(OBJDIR)/%.o: nifs/common/%.c
+ $(V_CC) $(CFLAGS) -DLIBSCTP=$(LIBSCTP) $(INCLUDES) -Inifs/common -Inifs/$(ERLANG_OSTYPE) -c $< -o $@
+
# ----------------------------------------------------------------------
# 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 $@
@@ -755,7 +773,6 @@ EMU_OBJS = \
$(OBJDIR)/beam_ranges.o
RUN_OBJS = \
- $(OBJDIR)/erl_pbifs.o $(OBJDIR)/benchmark.o \
$(OBJDIR)/erl_alloc.o $(OBJDIR)/erl_mtrace.o \
$(OBJDIR)/erl_alloc_util.o $(OBJDIR)/erl_goodfit_alloc.o \
$(OBJDIR)/erl_bestfit_alloc.o $(OBJDIR)/erl_afit_alloc.o \
@@ -764,7 +781,9 @@ RUN_OBJS = \
$(OBJDIR)/erl_bif_ddll.o $(OBJDIR)/erl_bif_guard.o \
$(OBJDIR)/erl_bif_info.o $(OBJDIR)/erl_bif_op.o \
$(OBJDIR)/erl_bif_os.o $(OBJDIR)/erl_bif_lists.o \
- $(OBJDIR)/erl_bif_trace.o $(OBJDIR)/erl_bif_wrap.o \
+ $(OBJDIR)/erl_bif_trace.o $(OBJDIR)/erl_bif_unique.o \
+ $(OBJDIR)/erl_bif_wrap.o $(OBJDIR)/erl_nfunc_sched.o \
+ $(OBJDIR)/erl_guard_bifs.o $(OBJDIR)/erl_dirty_bif_wrap.o \
$(OBJDIR)/erl_trace.o $(OBJDIR)/copy.o \
$(OBJDIR)/utils.o $(OBJDIR)/bif.o \
$(OBJDIR)/io.o $(OBJDIR)/erl_printf_term.o\
@@ -788,21 +807,27 @@ RUN_OBJS = \
$(OBJDIR)/erl_fun.o $(OBJDIR)/erl_bif_port.o \
$(OBJDIR)/erl_term.o $(OBJDIR)/erl_node_tables.o \
$(OBJDIR)/erl_monitors.o $(OBJDIR)/erl_process_dump.o \
- $(OBJDIR)/erl_bif_timer.o $(OBJDIR)/erl_cpu_topology.o \
+ $(OBJDIR)/erl_hl_timer.o $(OBJDIR)/erl_cpu_topology.o \
$(OBJDIR)/erl_drv_thread.o $(OBJDIR)/erl_bif_chksum.o \
$(OBJDIR)/erl_bif_re.o $(OBJDIR)/erl_unicode.o \
$(OBJDIR)/packet_parser.o $(OBJDIR)/safe_hash.o \
$(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 $(OBJDIR)/erl_lock_flags.o \
+ $(OBJDIR)/erl_io_queue.o
+
+LTTNG_OBJS = $(OBJDIR)/erlang_lttng.o
+NIF_OBJS = \
+ $(OBJDIR)/erl_tracer_nif.o \
+ $(OBJDIR)/zlib_nif.o
ifeq ($(TARGET),win32)
DRV_OBJS = \
$(OBJDIR)/registry_drv.o \
$(OBJDIR)/efile_drv.o \
$(OBJDIR)/inet_drv.o \
- $(OBJDIR)/zlib_drv.o \
$(OBJDIR)/ram_file_drv.o \
$(OBJDIR)/ttsl_drv.o
OS_OBJS = \
@@ -818,31 +843,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 \
@@ -853,11 +857,9 @@ OS_OBJS = \
DRV_OBJS = \
$(OBJDIR)/efile_drv.o \
$(OBJDIR)/inet_drv.o \
- $(OBJDIR)/zlib_drv.o \
$(OBJDIR)/ram_file_drv.o \
$(OBJDIR)/ttsl_drv.o
endif
-endif
ifneq ($(STATIC_NIFS),no)
STATIC_NIF_LIBS = $(STATIC_NIFS)
@@ -897,7 +899,8 @@ OS_OBJS += $(OBJDIR)/erl_mseg.o \
$(OBJDIR)/erl_mmap.o \
$(OBJDIR)/erl_$(ERLANG_OSTYPE)_sys_ddll.o \
$(OBJDIR)/erl_mtrace_sys_wrap.o \
- $(OBJDIR)/erl_sys_common_misc.o
+ $(OBJDIR)/erl_sys_common_misc.o \
+ $(OBJDIR)/erl_os_monotonic_time_extender.o
HIPE_ARCH64_OBJS=$(OBJDIR)/hipe_bif64.o
@@ -912,24 +915,24 @@ HIPE_noarch_OBJS=
HIPE_ARCH_OBJS=$(HIPE_$(ARCH)_OBJS)
HIPE_OBJS= \
+ $(OBJDIR)/hipe_nbif_impl.o \
$(OBJDIR)/hipe_bif0.o \
$(OBJDIR)/hipe_bif1.o \
$(OBJDIR)/hipe_bif2.o \
$(OBJDIR)/hipe_debug.o \
$(OBJDIR)/hipe_gc.o \
+ $(OBJDIR)/hipe_load.o \
$(OBJDIR)/hipe_mode_switch.o \
+ $(OBJDIR)/hipe_module.o \
$(OBJDIR)/hipe_native_bif.o \
$(OBJDIR)/hipe_stack.o $(HIPE_ARCH_OBJS)
-ifdef USE_PERFCTR
-HIPE_OBJS += $(OBJDIR)/hipe_perfctr.o
-endif
ifdef HIPE_ENABLED
EXTRA_BASE_OBJS += $(HIPE_OBJS)
endif
-BASE_OBJS = $(RUN_OBJS) $(EMU_OBJS) $(OS_OBJS) $(EXTRA_BASE_OBJS)
+BASE_OBJS = $(EMU_OBJS) $(RUN_OBJS) $(OS_OBJS) $(EXTRA_BASE_OBJS) $(LTTNG_OBJS)
-before_DTrace_OBJS = $(BASE_OBJS) $(DRV_OBJS)
+before_DTrace_OBJS = $(BASE_OBJS) $(DRV_OBJS) $(NIF_OBJS)
DTRACE_OBJS =
ifdef DTRACE_ENABLED_2STEP
@@ -948,7 +951,7 @@ $(OBJS): $(TTF_DIR)/GENERATED
########################################
# HiPE section
-M4FLAGS += -DTARGET=$(TARGET) -DOPSYS=$(OPSYS) -DARCH=$(ARCH)
+M4FLAGS += -DTARGET=$(TARGET) -DTTF_DIR=$(TTF_DIR) -DOPSYS=$(OPSYS) -DARCH=$(ARCH)
$(TTF_DIR)/%.S: hipe/%.m4
$(m4_verbose)m4 $(M4FLAGS) $< > $@
@@ -966,10 +969,10 @@ $(OBJDIR)/%.o: hipe/%.c
$(V_CC) $(subst O2,O3, $(CFLAGS)) $(INCLUDES) -c $< -o $@
$(BINDIR)/hipe_mkliterals$(TF_MARKER): $(OBJDIR)/hipe_mkliterals.o
- $(ld_verbose)$(CC) $(CFLAGS) $(INCLUDES) -o $@ $<
+ $(ld_verbose)$(CC) $(LDFLAGS) -o $@ $< $(ORIG_LIBS)
$(OBJDIR)/hipe_mkliterals.o: $(HIPE_ASM) $(TTF_DIR)/erl_alloc_types.h $(DTRACE_HEADERS) \
- $(TTF_DIR)/OPCODES-GENERATED $(TARGET)/TABLES-GENERATED
+ $(TTF_DIR)/OPCODES-GENERATED $(TTF_DIR)/TABLES-GENERATED
$(TTF_DIR)/hipe_literals.h: $(BINDIR)/hipe_mkliterals$(TF_MARKER)
$(gen_verbose)$(BINDIR)/hipe_mkliterals$(TF_MARKER) -c > $@
@@ -978,7 +981,7 @@ $(OBJDIR)/hipe_x86_glue.o: hipe/hipe_x86_glue.S \
$(TTF_DIR)/hipe_x86_asm.h $(TTF_DIR)/hipe_literals.h \
hipe/hipe_mode_switch.h
$(TTF_DIR)/hipe_x86_bifs.S: hipe/hipe_x86_bifs.m4 hipe/hipe_x86_asm.m4 \
- hipe/hipe_bif_list.m4 $(TARGET)/erl_bif_list.h hipe/hipe_gbif_list.h
+ hipe/hipe_bif_list.m4 $(TTF_DIR)/erl_bif_list.h hipe/hipe_gbif_list.h
$(OBJDIR)/hipe_x86_bifs.o: $(TTF_DIR)/hipe_x86_bifs.S \
$(TTF_DIR)/hipe_literals.h
@@ -986,7 +989,7 @@ $(OBJDIR)/hipe_amd64_glue.o: hipe/hipe_amd64_glue.S \
$(TTF_DIR)/hipe_amd64_asm.h $(TTF_DIR)/hipe_literals.h \
hipe/hipe_mode_switch.h
$(TTF_DIR)/hipe_amd64_bifs.S: hipe/hipe_amd64_bifs.m4 hipe/hipe_amd64_asm.m4 \
- hipe/hipe_bif_list.m4 $(TARGET)/erl_bif_list.h hipe/hipe_gbif_list.h
+ hipe/hipe_bif_list.m4 $(TTF_DIR)/erl_bif_list.h hipe/hipe_gbif_list.h
$(OBJDIR)/hipe_amd64_bifs.o: $(TTF_DIR)/hipe_amd64_bifs.S \
$(TTF_DIR)/hipe_literals.h
@@ -994,21 +997,21 @@ $(OBJDIR)/hipe_sparc_glue.o: hipe/hipe_sparc_glue.S \
$(TTF_DIR)/hipe_sparc_asm.h hipe/hipe_mode_switch.h \
$(TTF_DIR)/hipe_literals.h
$(TTF_DIR)/hipe_sparc_bifs.S: hipe/hipe_sparc_bifs.m4 hipe/hipe_sparc_asm.m4 \
- hipe/hipe_bif_list.m4 $(TARGET)/erl_bif_list.h hipe/hipe_gbif_list.h
+ hipe/hipe_bif_list.m4 $(TTF_DIR)/erl_bif_list.h hipe/hipe_gbif_list.h
$(OBJDIR)/hipe_sparc_bifs.o: $(TTF_DIR)/hipe_sparc_bifs.S \
$(TTF_DIR)/hipe_literals.h
$(OBJDIR)/hipe_ppc_glue.o: hipe/hipe_ppc_glue.S $(TTF_DIR)/hipe_ppc_asm.h \
hipe/hipe_mode_switch.h $(TTF_DIR)/hipe_literals.h
$(TTF_DIR)/hipe_ppc_bifs.S: hipe/hipe_ppc_bifs.m4 hipe/hipe_ppc_asm.m4 \
- hipe/hipe_bif_list.m4 $(TARGET)/erl_bif_list.h hipe/hipe_gbif_list.h
+ hipe/hipe_bif_list.m4 $(TTF_DIR)/erl_bif_list.h hipe/hipe_gbif_list.h
$(OBJDIR)/hipe_ppc_bifs.o: $(TTF_DIR)/hipe_ppc_bifs.S \
$(TTF_DIR)/hipe_literals.h
$(OBJDIR)/hipe_arm_glue.o: hipe/hipe_arm_glue.S $(TTF_DIR)/hipe_arm_asm.h \
hipe/hipe_mode_switch.h $(TTF_DIR)/hipe_literals.h
$(TTF_DIR)/hipe_arm_bifs.S: hipe/hipe_arm_bifs.m4 hipe/hipe_arm_asm.m4 \
- hipe/hipe_bif_list.m4 $(TARGET)/erl_bif_list.h hipe/hipe_gbif_list.h
+ hipe/hipe_bif_list.m4 $(TTF_DIR)/erl_bif_list.h hipe/hipe_gbif_list.h
$(OBJDIR)/hipe_arm_bifs.o: $(TTF_DIR)/hipe_arm_bifs.S \
$(TTF_DIR)/hipe_literals.h
@@ -1032,19 +1035,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
@@ -1089,6 +1085,7 @@ endif
BEAM_SRC=$(wildcard beam/*.c)
DRV_COMMON_SRC=$(wildcard drivers/common/*.c)
DRV_OSTYPE_SRC=$(wildcard drivers/$(ERLANG_OSTYPE)/*.c)
+NIF_COMMON_SRC=$(wildcard nifs/common/*.c)
ALL_SYS_SRC=$(wildcard sys/$(ERLANG_OSTYPE)/*.c) $(wildcard sys/common/*.c)
# We use $(shell ls) here instead of wildcard as $(wildcard ) resolved at
# loadtime of the makefile and at that time these files are not generated yet.
@@ -1121,7 +1118,7 @@ MG_FLAG=-MG
endif
DEP_CC=$(CC)
-DEP_FLAGS=-MM $(MG_FLAG) $(CFLAGS) $(INCLUDES) -Idrivers/common -Idrivers/$(ERLANG_OSTYPE)
+DEP_FLAGS=-MM $(MG_FLAG) $(CFLAGS) $(INCLUDES) -Inifs/common -Idrivers/common -Idrivers/$(ERLANG_OSTYPE)
SYS_SRC=$(ALL_SYS_SRC)
endif
@@ -1146,6 +1143,8 @@ $(TTF_DIR)/depend.mk: $(TTF_DIR)/GENERATED $(PRELOAD_SRC)
| $(SED_DEPEND) >> $(TTF_DIR)/depend.mk
$(V_at)$(DEP_CC) $(DEP_FLAGS) -I../etc/$(ERLANG_OSTYPE) $(DRV_OSTYPE_SRC) \
| $(SED_DEPEND) >> $(TTF_DIR)/depend.mk
+ $(V_at)$(DEP_CC) $(DEP_FLAGS) $(NIF_COMMON_SRC) \
+ | $(SED_DEPEND) >> $(TTF_DIR)/depend.mk
$(V_at)$(DEP_CC) $(DEP_FLAGS) $(SYS_SRC) \
| $(SED_DEPEND) >> $(TTF_DIR)/depend.mk
$(V_at)$(DEP_CC) $(DEP_FLAGS) $(TARGET_SRC) \
diff --git a/erts/emulator/beam/atom.c b/erts/emulator/beam/atom.c
index 84d2d5e3ed..38e02c386f 100644
--- a/erts/emulator/beam/atom.c
+++ b/erts/emulator/beam/atom.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -67,7 +68,7 @@ static Uint atom_space; /* Amount of atom text space used */
/*
* Print info about atom tables
*/
-void atom_info(int to, void *to_arg)
+void atom_info(fmtfn_t to, void *to_arg)
{
int lock = !ERTS_IS_CRASH_DUMPING;
if (lock)
@@ -137,7 +138,7 @@ atom_hash(Atom* obj)
while(len--) {
v = *p++;
/* latin1 clutch for r16 */
- if ((v & 0xFE) == 0xC2 && (*p & 0xC0) == 0x80) {
+ if (len && (v & 0xFE) == 0xC2 && (*p & 0xC0) == 0x80) {
v = (v << 6) | (*p & 0x3F);
p++; len--;
}
@@ -175,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.
@@ -198,7 +199,7 @@ atom_alloc(Atom* tmpl)
static void
atom_free(Atom* obj)
{
- erts_free(ERTS_ALC_T_ATOM, (void*) obj);
+ ASSERT(obj->slot.index == atom_val(am_ErtsSecretAtom));
}
static void latin1_to_utf8(byte* conv_buf, const byte** srcp, int* lenp)
@@ -232,10 +233,10 @@ need_convertion:
}
/*
- * erts_atom_put() may fail. If it fails THE_NON_VALUE is returned!
+ * erts_atom_put_index() may fail. Returns negative indexes for errors.
*/
-Eterm
-erts_atom_put(const byte *name, int len, ErtsAtomEncoding enc, int trunc)
+int
+erts_atom_put_index(const byte *name, int len, ErtsAtomEncoding enc, int trunc)
{
byte utf8_copy[MAX_ATOM_SZ_FROM_LATIN1];
const byte *text = name;
@@ -252,7 +253,7 @@ erts_atom_put(const byte *name, int len, ErtsAtomEncoding enc, int trunc)
if (trunc)
tlen = 0;
else
- return THE_NON_VALUE;
+ return ATOM_MAX_CHARS_ERROR;
}
switch (enc) {
@@ -261,7 +262,7 @@ erts_atom_put(const byte *name, int len, ErtsAtomEncoding enc, int trunc)
if (trunc)
tlen = MAX_ATOM_CHARACTERS;
else
- return THE_NON_VALUE;
+ return ATOM_MAX_CHARS_ERROR;
}
#ifdef DEBUG
for (aix = 0; aix < len; aix++) {
@@ -275,7 +276,7 @@ erts_atom_put(const byte *name, int len, ErtsAtomEncoding enc, int trunc)
if (trunc)
tlen = MAX_ATOM_CHARACTERS;
else
- return THE_NON_VALUE;
+ return ATOM_MAX_CHARS_ERROR;
}
no_latin1_chars = tlen;
latin1_to_utf8(utf8_copy, &text, &tlen);
@@ -283,7 +284,7 @@ erts_atom_put(const byte *name, int len, ErtsAtomEncoding enc, int trunc)
case ERTS_ATOM_ENC_UTF8:
/* First sanity check; need to verify later */
if (tlen > MAX_ATOM_SZ_LIMIT && !trunc)
- return THE_NON_VALUE;
+ return ATOM_MAX_CHARS_ERROR;
break;
}
@@ -294,7 +295,7 @@ erts_atom_put(const byte *name, int len, ErtsAtomEncoding enc, int trunc)
atom_read_unlock();
if (aix >= 0) {
/* Already in table no need to verify it */
- return make_atom(aix);
+ return aix;
}
if (enc == ERTS_ATOM_ENC_UTF8) {
@@ -313,13 +314,13 @@ erts_atom_put(const byte *name, int len, ErtsAtomEncoding enc, int trunc)
case ERTS_UTF8_OK_MAX_CHARS:
/* Truncated... */
if (!trunc)
- return THE_NON_VALUE;
+ return ATOM_MAX_CHARS_ERROR;
ASSERT(no_chars == MAX_ATOM_CHARACTERS);
tlen = err_pos - text;
break;
default:
/* Bad utf8... */
- return THE_NON_VALUE;
+ return ATOM_BAD_ENCODING_ERROR;
}
}
@@ -332,7 +333,20 @@ erts_atom_put(const byte *name, int len, ErtsAtomEncoding enc, int trunc)
atom_write_lock();
aix = index_put(&erts_atom_table, (void*) &a);
atom_write_unlock();
- return make_atom(aix);
+ return aix;
+}
+
+/*
+ * erts_atom_put() may fail. If it fails THE_NON_VALUE is returned!
+ */
+Eterm
+erts_atom_put(const byte *name, int len, ErtsAtomEncoding enc, int trunc)
+{
+ int aix = erts_atom_put_index(name, len, enc, trunc);
+ if (aix >= 0)
+ return make_atom(aix);
+ else
+ return THE_NON_VALUE;
}
Eterm
@@ -428,12 +442,16 @@ init_atom_table(void)
erts_smp_atomic_init_nob(&atom_put_ops, 0);
#endif
- erts_smp_rwmtx_init_opt(&atom_table_lock, &rwmtx_opt, "atom_tab");
+ erts_smp_rwmtx_init_opt(&atom_table_lock, &rwmtx_opt, "atom_tab", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
f.hash = (H_FUN) atom_hash;
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;
@@ -463,10 +481,13 @@ init_atom_table(void)
atom_space -= a.len;
atom_tab(ix)->name = (byte*)erl_atom_names[i];
}
+
+ /* Hide am_ErtsSecretAtom */
+ hash_erase(&erts_atom_table.htable, atom_tab(atom_val(am_ErtsSecretAtom)));
}
void
-dump_atoms(int to, void *to_arg)
+dump_atoms(fmtfn_t to, void *to_arg)
{
int i = erts_atom_table.entries;
@@ -479,3 +500,9 @@ dump_atoms(int to, void *to_arg)
}
}
}
+
+Uint
+erts_get_atom_limit(void)
+{
+ return erts_atom_table.limit;
+} \ No newline at end of file
diff --git a/erts/emulator/beam/atom.h b/erts/emulator/beam/atom.h
index 5904ae0f7e..be998a46bd 100644
--- a/erts/emulator/beam/atom.h
+++ b/erts/emulator/beam/atom.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -20,10 +21,7 @@
#ifndef __ATOM_H__
#define __ATOM_H__
-#ifndef __INDEX_H__
#include "index.h"
-#endif
-
#include "erl_atom_table.h"
#define MAX_ATOM_CHARACTERS 255
@@ -31,6 +29,8 @@
#define MAX_ATOM_SZ_LIMIT (4*MAX_ATOM_CHARACTERS) /* theoretical byte limit */
#define ATOM_LIMIT (1024*1024)
#define MIN_ATOM_TABLE_SIZE 8192
+#define ATOM_BAD_ENCODING_ERROR -1
+#define ATOM_MAX_CHARS_ERROR -2
#ifndef ARCH_32
/* Internal atom cache needs MAX_ATOM_TABLE_SIZE to be less than an
@@ -128,17 +128,18 @@ 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 */
Eterm am_atom_put(const char*, int); /* ONLY 7-bit ascii! */
Eterm erts_atom_put(const byte *name, int len, ErtsAtomEncoding enc, int trunc);
-int atom_erase(byte*, int);
-int atom_static_put(byte*, int);
+int erts_atom_put_index(const byte *name, int len, ErtsAtomEncoding enc, int trunc);
void init_atom_table(void);
-void atom_info(int, void *);
-void dump_atoms(int, void *);
+void atom_info(fmtfn_t, void *);
+void dump_atoms(fmtfn_t, void *);
+Uint erts_get_atom_limit(void);
int erts_atom_get(const char* name, int len, Eterm* ap, ErtsAtomEncoding enc);
void erts_atom_get_text_space_sizes(Uint *reserved, Uint *used);
#endif
diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index d28e519ae1..a44d23b181 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -1,18 +1,19 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1996-2013. All Rights Reserved.
+# Copyright Ericsson AB 1996-2017. 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/.
+# 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
#
-# 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.
+# 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%
#
@@ -42,7 +43,7 @@ atom false true
atom Underscore='_'
atom Noname='nonode@nohost'
atom EOT='$end_of_table'
-atom Cookie=''
+atom Empty=''
#
# Used in the Beam emulator loop. (Smaller literals usually means tighter code.)
@@ -58,17 +59,25 @@ atom nocatch
atom undefined_function
atom undefined_lambda
+# Secret internal atom that can never be found by string lookup
+# and should never leak out to be seen by the user.
+atom ErtsSecretAtom='3RT$'
# All other atoms. Try to keep the order alphabetic.
#
atom DOWN='DOWN'
atom UP='UP'
atom EXIT='EXIT'
+atom abort
atom aborted
atom abs_path
atom absoluteURI
atom ac
+atom accessor
atom active
+atom active_tasks
+atom active_tasks_all
+atom alive
atom all
atom all_but_first
atom all_names
@@ -94,31 +103,37 @@ atom args
atom arg0
atom arity
atom asn1
+atom async
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
atom await_sched_wall_time_modifications
atom awaiting_load
atom awaiting_unload
atom backtrace backtrace_depth
-atom badarg badarith badarity badfile badmatch badsig badfun
+atom badarg badarith badarity badfile badfun badkey badmap badmatch badsig
atom bag
atom band
atom big
atom bif_return_trap
+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
@@ -143,18 +158,23 @@ atom catchlevel
atom cd
atom cdr
atom cflags
+atom CHANGE='CHANGE'
atom characters_to_binary_int
atom characters_to_list_int
atom clear
+atom clock_service
atom close
atom closed
atom code
atom command
+atom commandv
atom compact
atom compat_rel
atom compile
+atom complete
atom compressed
atom config_h
+atom convert_time_unit
atom connect
atom connected
atom connection_closed
@@ -163,6 +183,8 @@ atom const
atom context_switches
atom control
atom copy
+atom copy_literals
+atom counters
atom cpu
atom cpu_timestamp
atom cr
@@ -174,14 +196,24 @@ atom current_stacktrace
atom data
atom debug_flags
atom decimals
+atom default
atom delay_trap
atom dexit
atom depth
atom dgroup_leader
atom dictionary
+atom dirty_bif_exception
+atom dirty_bif_result
+atom dirty_bif_trap
+atom dirty_cpu
atom dirty_cpu_schedulers_online
+atom dirty_execution
+atom dirty_io
+atom dirty_nif_exception
+atom dirty_nif_finalizer
atom disable_trace
atom disabled
+atom discard
atom display_items
atom dist
atom dist_cmd
@@ -197,9 +229,12 @@ atom dotall
atom driver
atom driver_options
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
@@ -208,26 +243,34 @@ atom endian
atom env
atom eof
atom eol
-atom exception_from
-atom exception_trace
-atom extended
atom Eq='=:='
atom Eqeq='=='
+atom erl_tracer
atom erlang
+atom erl_signal_server
atom ERROR='ERROR'
atom error_handler
atom error_logger
+atom erts_code_purger
+atom erts_debug
atom erts_internal
atom ets
atom ETS_TRANSFER='ETS-TRANSFER'
atom event
atom exact_reductions
+atom exception_from
+atom exception_trace
atom exclusive
atom exit_status
atom existing
+atom existing_processes
+atom existing_ports
+atom existing
atom exiting
atom exports
+atom extended
atom external
+atom extra
atom false
atom fcgi
atom fd
@@ -235,7 +278,7 @@ atom first
atom firstline
atom flags
atom flush
-atom flush_monitor_message
+atom flush_monitor_messages
atom force
atom format_cpu_topology
atom free
@@ -247,7 +290,13 @@ atom functions
atom function_clause
atom garbage_collecting
atom garbage_collection
+atom garbage_collection_info
atom gc_end
+atom gc_major_end
+atom gc_major_start
+atom gc_max_heap_size
+atom gc_minor_end
+atom gc_minor_start
atom gc_start
atom Ge='>='
atom generational
@@ -256,13 +305,17 @@ atom get_seq_token
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
atom Gt='>'
atom grun
atom group_leader
+atom handle
atom have_dt_utag
atom heap_block_size
atom heap_size
@@ -278,7 +331,6 @@ atom http httph https http_response http_request http_header http_eoh http_error
atom id
atom if_clause
atom ignore
-atom imports
atom in
atom in_exiting
atom inactive
@@ -288,6 +340,7 @@ atom index
atom infinity
atom info
atom info_msg
+atom init
atom initial_call
atom input
atom internal
@@ -311,10 +364,12 @@ atom ldflags
atom Le='=<'
atom lf
atom line
+atom line_delimiter
atom line_length
atom linked_in_driver
atom links
atom list
+atom list_to_binary_continue
atom little
atom loaded
atom load_cancelled
@@ -325,25 +380,38 @@ atom long_schedule
atom low
atom Lt='<'
atom machine
+atom magic_ref
+atom major
atom match
atom match_limit
atom match_limit_recursion
atom match_spec
+atom match_spec_result
atom max
atom maximum
+atom max_heap_size
atom max_tables max_processes
atom mbuf_size
+atom md5
atom memory
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 microsecond
+atom microstate_accounting
+atom milli_seconds
+atom millisecond
atom min_heap_size
atom min_bin_vheap_size
+atom minor
atom minor_version
atom Minus='-'
atom module
@@ -352,13 +420,19 @@ atom monitored_by
atom monitor
atom monitor_nodes
atom monitors
+atom monotonic
+atom monotonic_timestamp
atom more
atom multi_scheduling
atom multiline
+atom nano_seconds
+atom nanosecond
atom name
atom named_table
atom namelist
+atom native
atom native_addresses
+atom need_gc
atom Neq='=/='
atom Neqeq='/='
atom net_kernel
@@ -366,6 +440,8 @@ atom net_kernel_terminated
atom never_utf
atom new
atom new_index
+atom new_processes
+atom new_ports
atom new_uniq
atom newline
atom next
@@ -405,10 +481,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
@@ -419,13 +497,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
@@ -440,6 +511,7 @@ atom pause
atom pending
atom pending_driver
atom pending_process
+atom pending_purge_lambda
atom pending_reload
atom permanent
atom pid
@@ -448,6 +520,9 @@ atom ports
atom port_count
atom port_limit
atom port_op
+atom positive
+atom prepare
+atom prepare_on_load
atom print
atom priority
atom private
@@ -492,6 +567,8 @@ atom return_from
atom return_to
atom return_trace
atom run_queue
+atom run_queue_lengths
+atom run_queue_lengths_all
atom runnable
atom runnable_ports
atom runnable_procs
@@ -501,12 +578,18 @@ atom running_procs
atom runtime
atom safe
atom save_calls
-atom scheduler
+atom scheduler
atom scheduler_id
+atom scheduler_wall_time
+atom scheduler_wall_time_all
atom schedulers_online
atom scheme
atom scientific
atom scope
+atom second
+atom seconds
+atom send
+atom send_to_non_existing_process
atom sensitive
atom sequential_tracer
atom sequential_trace_token
@@ -523,11 +606,25 @@ atom set_tcw
atom set_tcw_fake
atom separate
atom shared
+atom sighup
+atom sigterm
+atom sigusr1
+atom sigusr2
+atom sigill
+atom sigchld
+atom sigabrt
+atom sigalrm
+atom sigstop
+atom sigint
+atom sigsegv
+atom sigtstp
+atom sigquit
atom silent
atom size
atom sl_alloc
atom spawn_executable
atom spawn_driver
+atom spawned
atom ssl_tls
atom stack_size
atom start
@@ -536,6 +633,8 @@ atom static
atom stderr_to_stdout
atom stop
atom stream
+atom strict_monotonic
+atom strict_monotonic_timestamp
atom sunrm
atom suspend
atom suspended
@@ -552,17 +651,25 @@ atom term_to_binary_trap
atom this
atom thread_pool_size
atom threads
+atom time_offset
atom timeout
atom timeout_value
atom Times='*'
atom timestamp
atom total
+atom total_active_tasks
+atom total_active_tasks_all
atom total_heap_size
+atom total_run_queue_lengths
+atom total_run_queue_lengths_all
atom tpkt
-atom trace trace_ts traced
+atom trace trace_ts traced
atom trace_control_word
+atom trace_status
atom tracer
atom trap_exit
+atom trim
+atom trim_all
atom try_clause
atom true
atom tuple
@@ -578,6 +685,7 @@ atom use_stdio
atom used
atom utf8
atom unblock
+atom unblock_normal
atom uniq
atom unless_suspending
atom unloaded
@@ -588,11 +696,11 @@ atom value
atom values
atom version
atom visible
+atom wait
atom waiting
atom wall_clock
atom warning
atom warning_msg
-atom scheduler_wall_time
atom wordsize
atom write_concurrency
atom xor
diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c
index df1983a83d..023ee3ef4b 100644
--- a/erts/emulator/beam/beam_bif_load.c
+++ b/erts/emulator/beam/beam_bif_load.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1999-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1999-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -33,17 +34,101 @@
#include "beam_catches.h"
#include "erl_binary.h"
#include "erl_nif.h"
+#include "erl_bits.h"
#include "erl_thr_progress.h"
+#include "erl_nfunc_sched.h"
+#ifdef HIPE
+# include "hipe_bif0.h"
+# define IF_HIPE(X) (X)
+#else
+# define IF_HIPE(X) (0)
+#endif
+
+#ifdef HIPE
+# include "hipe_stack.h"
+#endif
+
+static struct {
+ Eterm module;
+ erts_smp_mtx_t mtx;
+ Export *pending_purge_lambda;
+ Eterm *sprocs;
+ Eterm def_sprocs[10];
+ Uint sp_size;
+ Uint sp_ix;
+ ErlFunEntry **funs;
+ ErlFunEntry *def_funs[10];
+ Uint fe_size;
+ Uint fe_ix;
+ struct erl_module_instance saved_old;
+} purge_state;
+
+Process *erts_code_purger = NULL;
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+Process *erts_dirty_process_code_checker;
+#endif
+erts_smp_atomic_t erts_copy_literal_area__;
+#define ERTS_SET_COPY_LITERAL_AREA(LA) \
+ erts_smp_atomic_set_nob(&erts_copy_literal_area__, \
+ (erts_aint_t) (LA))
+Process *erts_literal_area_collector = NULL;
+
+typedef struct ErtsLiteralAreaRef_ ErtsLiteralAreaRef;
+struct ErtsLiteralAreaRef_ {
+ ErtsLiteralAreaRef *next;
+ ErtsLiteralArea *literal_area;
+};
+
+struct {
+ erts_smp_mtx_t mtx;
+ ErtsLiteralAreaRef *first;
+ ErtsLiteralAreaRef *last;
+} release_literal_areas;
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, int *redsp, int fcalls);
static void delete_code(Module* modp);
-static void decrement_refc(BeamInstr* code);
-static int is_native(BeamInstr* code);
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);
+static void
+init_purge_state(void)
+{
+ purge_state.module = THE_NON_VALUE;
+
+ erts_smp_mtx_init(&purge_state.mtx, "purge_state", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
+
+ purge_state.pending_purge_lambda =
+ erts_export_put(am_erts_code_purger, am_pending_purge_lambda, 3);
+
+ purge_state.sprocs = &purge_state.def_sprocs[0];
+ purge_state.sp_size = sizeof(purge_state.def_sprocs);
+ purge_state.sp_size /= sizeof(purge_state.def_sprocs[0]);
+ purge_state.sp_ix = 0;
+ purge_state.funs = &purge_state.def_funs[0];
+ purge_state.fe_size = sizeof(purge_state.def_funs);
+ purge_state.fe_size /= sizeof(purge_state.def_funs[0]);
+ purge_state.fe_ix = 0;
+
+ purge_state.saved_old.code_hdr = 0;
+}
+
+void
+erts_beam_bif_load_init(void)
+{
+ erts_smp_mtx_init(&release_literal_areas.mtx, "release_literal_areas", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
+
+ release_literal_areas.first = NULL;
+ release_literal_areas.last = NULL;
+ erts_smp_atomic_init_nob(&erts_copy_literal_area__,
+ (erts_aint_t) NULL);
+
+ init_purge_state();
+}
BIF_RETTYPE code_is_module_native_1(BIF_ALIST_1)
{
@@ -59,8 +144,8 @@ BIF_RETTYPE code_is_module_native_1(BIF_ALIST_1)
return am_undefined;
}
erts_rlock_old_code(code_ix);
- res = ((modp->curr.code && is_native(modp->curr.code)) ||
- (modp->old.code != 0 && is_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;
@@ -68,8 +153,19 @@ BIF_RETTYPE code_is_module_native_1(BIF_ALIST_1)
BIF_RETTYPE code_make_stub_module_3(BIF_ALIST_3)
{
+#if !defined(HIPE)
+ BIF_ERROR(BIF_P, EXC_NOTSUP);
+#else
Module* modp;
- Eterm res;
+ Eterm res, mod;
+
+ if (!is_internal_magic_ref(BIF_ARG_1))
+ BIF_ERROR(BIF_P, BADARG);
+
+ mod = erts_module_for_prepared_code(erts_magic_ref2bin(BIF_ARG_1));
+
+ if (is_not_atom(mod))
+ BIF_ERROR(BIF_P, BADARG);
if (!erts_try_seize_code_write_permission(BIF_P)) {
ERTS_BIF_YIELD3(bif_export[BIF_code_make_stub_module_3],
@@ -79,21 +175,24 @@ BIF_RETTYPE code_make_stub_module_3(BIF_ALIST_3)
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
erts_smp_thr_progress_block();
- modp = erts_get_module(BIF_ARG_1, erts_active_code_ix());
+ modp = erts_get_module(mod, 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);
- if (res == BIF_ARG_1) {
+ if (res == mod) {
erts_end_staging_code_ix();
erts_commit_staging_code_ix();
+ if (!modp)
+ modp = erts_get_module(mod, erts_active_code_ix());
+ hipe_redirect_to_module(modp);
}
else {
erts_abort_staging_code_ix();
@@ -102,6 +201,7 @@ BIF_RETTYPE code_make_stub_module_3(BIF_ALIST_3)
erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
erts_release_code_write_permission();
return res;
+#endif
}
BIF_RETTYPE
@@ -134,9 +234,26 @@ prepare_loading_2(BIF_ALIST_2)
res = TUPLE2(hp, am_error, reason);
BIF_RET(res);
}
- hp = HAlloc(BIF_P, PROC_BIN_SIZE);
- res = erts_mk_magic_binary_term(&hp, &MSO(BIF_P), magic);
- erts_refc_dec(&magic->refc, 1);
+ hp = HAlloc(BIF_P, ERTS_MAGIC_REF_THING_SIZE);
+ res = erts_mk_magic_ref(&hp, &MSO(BIF_P), magic);
+ erts_refc_dec(&magic->intern.refc, 1);
+ BIF_RET(res);
+}
+
+BIF_RETTYPE
+has_prepared_code_on_load_1(BIF_ALIST_1)
+{
+ Eterm res;
+
+ if (!is_internal_magic_ref(BIF_ARG_1)) {
+ error:
+ BIF_ERROR(BIF_P, BADARG);
+ }
+
+ res = erts_has_code_on_load(erts_magic_ref2bin(BIF_ARG_1));
+ if (res == NIL) {
+ goto error;
+ }
BIF_RET(res);
}
@@ -144,10 +261,10 @@ struct m {
Binary* code;
Eterm module;
Module* modp;
- Uint exception;
+ Eterm exception;
};
-static Eterm staging_epilogue(Process* c_p, int, Eterm res, int, struct m*, int);
+static Eterm staging_epilogue(Process* c_p, int, Eterm res, int, struct m*, int, int);
#ifdef ERTS_SMP
static void smp_code_ix_commiter(void*);
@@ -155,7 +272,7 @@ static struct /* Protected by code_write_permission */
{
Process* stager;
ErtsThrPrgrLaterOp lop;
-}commiter_state;
+} committer_state;
#endif
static Eterm
@@ -164,14 +281,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) {
+ if (is_value(mp->exception)) {
res = CONS(hp, mp->module, res);
hp += 2;
exceptions--;
}
- mp--;
+ mp++;
}
return TUPLE2(hp, tag, res);
}
@@ -180,8 +296,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;
@@ -202,9 +318,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));
@@ -216,32 +336,33 @@ finish_loading_1(BIF_ALIST_1)
for (i = 0; i < n; i++) {
Eterm* cons = list_val(BIF_ARG_1);
Eterm term = CAR(cons);
- ProcBin* pb;
- if (!ERTS_TERM_IS_MAGIC_BINARY(term)) {
- ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG);
- goto done;
+ if (!is_internal_magic_ref(term)) {
+ goto badarg;
}
- pb = (ProcBin*) binary_val(term);
- p[i].code = pb->val;
+ p[i].code = erts_magic_ref2bin(term);
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);
+ }
+ }
}
/*
@@ -253,16 +374,33 @@ 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 = THE_NON_VALUE;
+ if (p[i].modp->seen) {
+ p[i].exception = am_duplicated;
+ 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 ||
- erts_is_default_trace_enabled()) {
- /* tracing involved, fallback with thread blocking */
+ erts_is_default_trace_enabled() ||
+ IF_HIPE(hipe_need_blocking(p[i].modp))) {
+ /* tracing or hipe need thread blocking */
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
erts_smp_thr_progress_block();
is_blocking = 1;
@@ -281,9 +419,9 @@ 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) {
- p[i].exception = 1;
+ p[i].exception = THE_NON_VALUE;
+ if (p[i].modp->curr.code_hdr && p[i].modp->old.code_hdr) {
+ p[i].exception = am_not_purged;
exceptions++;
}
}
@@ -300,11 +438,11 @@ finish_loading_1(BIF_ALIST_1)
Eterm mod;
Eterm retval;
- erts_refc_inc(&p[i].code->refc, 1);
+ erts_refc_inc(&p[i].code->intern.refc, 1);
retval = erts_finish_loading(p[i].code, BIF_P, 0, &mod);
ASSERT(retval == NIL || retval == am_on_load);
if (retval == am_on_load) {
- p[i].exception = 1;
+ p[i].exception = am_on_load;
exceptions++;
}
}
@@ -320,32 +458,37 @@ finish_loading_1(BIF_ALIST_1)
}
done:
- return staging_epilogue(BIF_P, do_commit, res, is_blocking, p, n);
+ return staging_epilogue(BIF_P, do_commit, res, is_blocking, p, n, 1);
}
static Eterm
staging_epilogue(Process* c_p, int commit, Eterm res, int is_blocking,
- struct m* loaded, int nloaded)
+ struct m* mods, int nmods, int free_mods)
{
#ifdef ERTS_SMP
if (is_blocking || !commit)
#endif
{
if (commit) {
+ int i;
erts_end_staging_code_ix();
erts_commit_staging_code_ix();
- if (loaded) {
- int i;
- for (i=0; i < nloaded; i++) {
- set_default_trace_pattern(loaded[i].module);
+
+ for (i=0; i < nmods; i++) {
+ if (mods[i].modp->curr.code_hdr
+ && mods[i].exception != am_on_load) {
+ set_default_trace_pattern(mods[i].module);
}
+ #ifdef HIPE
+ hipe_redirect_to_module(mods[i].modp);
+ #endif
}
}
else {
erts_abort_staging_code_ix();
}
- if (loaded) {
- erts_free(ERTS_ALC_T_LOADER_TMP, loaded);
+ if (free_mods) {
+ erts_free(ERTS_ALC_T_LOADER_TMP, mods);
}
if (is_blocking) {
erts_smp_thr_progress_unblock();
@@ -358,8 +501,8 @@ staging_epilogue(Process* c_p, int commit, Eterm res, int is_blocking,
else {
ASSERT(is_value(res));
- if (loaded) {
- erts_free(ERTS_ALC_T_LOADER_TMP, loaded);
+ if (free_mods) {
+ erts_free(ERTS_ALC_T_LOADER_TMP, mods);
}
erts_end_staging_code_ix();
/*
@@ -368,10 +511,10 @@ 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);
- erts_smp_proc_inc_refc(c_p);
+ 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);
/*
* smp_code_ix_commiter() will do the rest "later"
@@ -386,11 +529,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);
@@ -398,7 +541,7 @@ static void smp_code_ix_commiter(void* null)
erts_resume(p, ERTS_PROC_LOCK_STATUS);
}
erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
- erts_smp_proc_dec_refc(p);
+ erts_proc_dec_refc(p);
}
#endif /* ERTS_SMP */
@@ -418,7 +561,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);
@@ -427,7 +570,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, int *redsp, int fcalls)
{
Module* modp;
Eterm res;
@@ -442,58 +585,23 @@ 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, redsp, fcalls));
erts_runlock_old_code(code_ix);
return res;
}
-BIF_RETTYPE erts_internal_check_process_code_2(BIF_ALIST_2)
+BIF_RETTYPE erts_internal_check_process_code_1(BIF_ALIST_1)
{
int reds = 0;
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_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, &reds, BIF_P->fcalls);
ASSERT(is_value(res));
@@ -503,6 +611,43 @@ badarg:
BIF_ERROR(BIF_P, BADARG);
}
+BIF_RETTYPE erts_internal_check_dirty_process_code_2(BIF_ALIST_2)
+{
+#if !defined(ERTS_DIRTY_SCHEDULERS)
+ BIF_ERROR(BIF_P, EXC_NOTSUP);
+#else
+ Process *rp;
+ int reds = 0;
+ Eterm res;
+
+ if (BIF_P != erts_dirty_process_code_checker)
+ BIF_ERROR(BIF_P, EXC_NOTSUP);
+
+ if (is_not_internal_pid(BIF_ARG_1))
+ BIF_ERROR(BIF_P, BADARG);
+
+ if (is_not_atom(BIF_ARG_2))
+ BIF_ERROR(BIF_P, BADARG);
+
+ rp = erts_pid2proc_not_running(BIF_P, ERTS_PROC_LOCK_MAIN,
+ BIF_ARG_1, ERTS_PROC_LOCK_MAIN);
+ if (rp == ERTS_PROC_LOCK_BUSY)
+ ERTS_BIF_YIELD2(bif_export[BIF_erts_internal_check_dirty_process_code_2],
+ BIF_P, BIF_ARG_1, BIF_ARG_2);
+ if (!rp)
+ BIF_RET(am_false);
+
+ res = erts_check_process_code(rp, BIF_ARG_2, &reds, BIF_P->fcalls);
+
+ if (BIF_P != rp)
+ erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MAIN);
+
+ ASSERT(is_value(res));
+
+ BIF_RET2(res, reds);
+#endif
+}
+
BIF_RETTYPE delete_module_1(BIF_ALIST_1)
{
ErtsCodeIndex code_ix;
@@ -520,23 +665,24 @@ 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",
+ erts_dsprintf(dsbufp, "Module %T must be purged before deleting\n",
BIF_ARG_1);
erts_send_error_to_logger(BIF_P->group_leader, dsbufp);
ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG);
}
else {
if (modp->curr.num_breakpoints > 0 ||
- modp->curr.num_traced_exports > 0) {
- /* we have tracing, retry single threaded */
+ modp->curr.num_traced_exports > 0 ||
+ IF_HIPE(hipe_need_blocking(modp))) {
+ /* tracing or hipe need to go single threaded */
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
erts_smp_thr_progress_block();
is_blocking = 1;
@@ -550,7 +696,15 @@ BIF_RETTYPE delete_module_1(BIF_ALIST_1)
success = 1;
}
}
- return staging_epilogue(BIF_P, success, res, is_blocking, NULL, 0);
+ {
+ struct m mod;
+ Eterm retval;
+ mod.module = BIF_ARG_1;
+ mod.modp = modp;
+ mod.exception = THE_NON_VALUE;
+ retval = staging_epilogue(BIF_P, success, res, is_blocking, &mod, 1, 0);
+ return retval;
+ }
}
BIF_RETTYPE module_loaded_1(BIF_ALIST_1)
@@ -564,8 +718,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;
}
}
@@ -612,10 +766,13 @@ 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->on_load) {
+ BIF_ERROR(BIF_P, BADARG);
}
- else {
+ if (modp->on_load->code_hdr) {
+ BIF_TRAP_CODE_PTR_0(BIF_P,
+ modp->on_load->code_hdr->on_load_function_ptr);
+ } else {
BIF_ERROR(BIF_P, BADARG);
}
}
@@ -624,7 +781,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],
@@ -639,14 +795,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->on_load || !modp->on_load->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->on_load->code_hdr->on_load_function_ptr == NULL) {
goto error;
}
if (BIF_ARG_2 != am_false && BIF_ARG_2 != am_true) {
@@ -654,42 +810,64 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2)
}
if (BIF_ARG_2 == am_true) {
- int i;
+ int i, num_exps;
+
+ /*
+ * Make the code with the on_load function current.
+ */
+
+ if (modp->curr.code_hdr) {
+ modp->old = modp->curr;
+ }
+ modp->curr = *modp->on_load;
+ erts_free(ERTS_ALC_T_PREPARED_CODE, modp->on_load);
+ modp->on_load = 0;
/*
* The on_load function succeded. Fix up export entries.
*/
- for (i = 0; i < export_list_size(code_ix); i++) {
+ num_exps = export_list_size(code_ix);
+ for (i = 0; i < num_exps; i++) {
Export *ep = export_list(i,code_ix);
- if (ep != NULL &&
- ep->code[0] == BIF_ARG_1 &&
- ep->code[4] != 0) {
- ep->addressv[code_ix] = (void *) ep->code[4];
- ep->code[4] = 0;
+ if (ep == NULL || ep->info.mfa.module != BIF_ARG_1) {
+ continue;
+ }
+ if (ep->beam[1] != 0) {
+ ep->addressv[code_ix] = (void *) ep->beam[1];
+ ep->beam[1] = 0;
+ } else {
+ if (ep->addressv[code_ix] == ep->beam &&
+ ep->beam[0] == (BeamInstr) em_apply_bif) {
+ continue;
+ }
+ ep->addressv[code_ix] = ep->beam;
+ ep->beam[0] = (BeamInstr) em_call_error_handler;
}
}
- 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);
+ #ifdef HIPE
+ hipe_redirect_to_module(modp);
+ #endif
} else if (BIF_ARG_2 == am_false) {
- BeamInstr* code;
- BeamInstr* end;
+ int i, num_exps;
/*
- * The on_load function failed. Remove the loaded code.
- * This is an combination of delete and purge. We purge
- * the current code; the old code is not touched.
+ * The on_load function failed. Remove references to the
+ * code that is about to be purged from the export entries.
*/
- erts_total_code_size -= modp->curr.code_length;
- code = modp->curr.code;
- 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;
- modp->curr.code_length = 0;
- modp->curr.catches = BEAM_CATCHES_NIL;
- erts_remove_from_ranges(code);
+
+ num_exps = export_list_size(code_ix);
+ for (i = 0; i < num_exps; i++) {
+ Export *ep = export_list(i,code_ix);
+ if (ep == NULL || ep->info.mfa.module != BIF_ARG_1) {
+ continue;
+ }
+ if (ep->beam[0] == (BeamInstr) em_apply_bif) {
+ continue;
+ }
+ ep->beam[1] = 0;
+ }
}
erts_smp_thr_progress_unblock();
erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
@@ -704,61 +882,272 @@ set_default_trace_pattern(Eterm module)
Binary *match_spec;
Binary *meta_match_spec;
struct trace_pattern_flags trace_pattern_flags;
- Eterm meta_tracer_pid;
+ ErtsTracer meta_tracer;
erts_get_default_trace_pattern(&trace_pattern_is_on,
&match_spec,
&meta_match_spec,
&trace_pattern_flags,
- &meta_tracer_pid);
+ &meta_tracer);
if (trace_pattern_is_on) {
- Eterm mfa[1];
- mfa[0] = module;
- (void) erts_set_trace_pattern(0, mfa, 1,
+ ErtsCodeMFA mfa;
+ mfa.module = module;
+ (void) erts_set_trace_pattern(0, &mfa, 1,
match_spec,
meta_match_spec,
1, trace_pattern_flags,
- meta_tracer_pid, 1);
+ meta_tracer, 1);
+ }
+}
+
+static Uint hfrag_literal_size(Eterm* start, Eterm* end,
+ char* lit_start, Uint lit_size);
+static void hfrag_literal_copy(Eterm **hpp, ErlOffHeap *ohp,
+ Eterm *start, Eterm *end,
+ char *lit_start, Uint lit_size);
+
+Eterm
+erts_proc_copy_literal_area(Process *c_p, int *redsp, int fcalls, int gc_allowed)
+{
+ ErtsLiteralArea *la;
+ ErtsMessage *msgp;
+ struct erl_off_heap_header* oh;
+ char *literals;
+ Uint lit_bsize;
+ ErlHeapFragment *hfrag;
+
+ la = ERTS_COPY_LITERAL_AREA();
+ if (!la)
+ goto return_ok;
+
+ oh = la->off_heap;
+ literals = (char *) &la->start[0];
+ lit_bsize = (char *) la->end - literals;
+
+ /*
+ * If a literal is in the message queue we make an explicit copy of
+ * it and attach it to the heap fragment. Each message needs to be
+ * self contained, we cannot save the literal in the old_heap or
+ * any other heap than the message it self.
+ */
+
+ 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);
+
+ for (msgp = c_p->msg.first; msgp; msgp = msgp->next) {
+ ErlHeapFragment *hf;
+ Uint lit_sz = 0;
+
+ *redsp += 1;
+
+ 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; /* Content on heap or in external term format... */
+
+ for (hf = hfrag; hf; hf = hf->next) {
+ lit_sz += hfrag_literal_size(&hf->mem[0], &hf->mem[hf->used_size],
+ literals, lit_bsize);
+ *redsp += 1;
+ }
+
+ *redsp += lit_sz / 16; /* Better value needed... */
+ if (lit_sz > 0) {
+ ErlHeapFragment *bp = new_message_buffer(lit_sz);
+ Eterm *hp = bp->mem;
+
+ for (hf = hfrag; hf; hf = hf->next) {
+ hfrag_literal_copy(&hp, &bp->off_heap,
+ &hf->mem[0], &hf->mem[hf->used_size],
+ literals, lit_bsize);
+ hfrag = hf;
+ }
+
+ /* link new hfrag last */
+ ASSERT(hfrag->next == NULL);
+ hfrag->next = bp;
+ bp->next = NULL;
+ }
+ }
+
+ if (gc_allowed) {
+ /*
+ * Current implementation first tests without
+ * allowing GC, and then restarts the operation
+ * allowing GC if it is needed. It is therfore
+ * very likely that we will need the GC (although
+ * this is not completely certain). We go for
+ * the GC directly instead of scanning everything
+ * one more time...
+ *
+ * Also note that calling functions expect a
+ * major GC to be performed if gc_allowed is set
+ * to true. If you change this, you need to fix
+ * callers...
+ */
+ goto literal_gc;
+ }
+
+ *redsp += 2;
+ if (any_heap_ref_ptrs(&c_p->fvalue, &c_p->fvalue+1, literals, lit_bsize)) {
+ c_p->freason = EXC_NULL;
+ c_p->fvalue = NIL;
+ c_p->ftrace = NIL;
+ }
+
+ if (any_heap_ref_ptrs(c_p->stop, c_p->hend, literals, lit_bsize))
+ goto literal_gc;
+ *redsp += 1;
+#ifdef HIPE
+ if (nstack_any_heap_ref_ptrs(c_p, literals, lit_bsize))
+ goto literal_gc;
+ *redsp += 1;
+#endif
+ if (any_heap_refs(c_p->heap, c_p->htop, literals, lit_bsize))
+ goto literal_gc;
+ *redsp += 1;
+ if (c_p->abandoned_heap) {
+ if (any_heap_refs(c_p->abandoned_heap, c_p->abandoned_heap + c_p->heap_sz,
+ literals, lit_bsize))
+ goto literal_gc;
+ *redsp += 1;
+ }
+ if (any_heap_refs(c_p->old_heap, c_p->old_htop, literals, lit_bsize))
+ goto literal_gc;
+
+ /* Check dictionary */
+ *redsp += 1;
+ if (c_p->dictionary) {
+ Eterm* start = ERTS_PD_START(c_p->dictionary);
+ Eterm* end = start + ERTS_PD_SIZE(c_p->dictionary);
+
+ if (any_heap_ref_ptrs(start, end, literals, lit_bsize))
+ goto literal_gc;
+ }
+
+ /* Check heap fragments */
+ for (hfrag = c_p->mbuf; hfrag; hfrag = hfrag->next) {
+ Eterm *hp, *hp_end;
+
+ *redsp += 1;
+
+ hp = &hfrag->mem[0];
+ hp_end = &hfrag->mem[hfrag->used_size];
+ if (any_heap_refs(hp, hp_end, literals, lit_bsize))
+ goto literal_gc;
+ }
+
+ /*
+ * Message buffer fragments (matched messages)
+ * - off heap lists should already have been moved into
+ * process off heap structure.
+ * - Check for literals
+ */
+ for (msgp = c_p->msg_frag; msgp; msgp = msgp->next) {
+ hfrag = erts_message_to_heap_frag(msgp);
+ for (; hfrag; hfrag = hfrag->next) {
+ Eterm *hp, *hp_end;
+
+ *redsp += 1;
+
+ hp = &hfrag->mem[0];
+ hp_end = &hfrag->mem[hfrag->used_size];
+
+ if (any_heap_refs(hp, hp_end, literals, lit_bsize))
+ goto literal_gc;
+ }
}
+
+return_ok:
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(c_p)))
+ c_p->flags &= ~F_DIRTY_CLA;
+#endif
+
+ return am_ok;
+
+literal_gc:
+
+ if (!gc_allowed)
+ return am_need_gc;
+
+ if (c_p->flags & F_DISABLE_GC)
+ return THE_NON_VALUE;
+
+ *redsp += erts_garbage_collect_literals(c_p, (Eterm *) literals, lit_bsize,
+ oh, fcalls);
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (c_p->flags & F_DIRTY_CLA)
+ return THE_NON_VALUE;
+#endif
+
+ return am_ok;
}
static Eterm
-check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp)
+check_process_code(Process* rp, Module* modp, int *redsp, int fcalls)
{
BeamInstr* start;
char* mod_start;
Uint mod_size;
- BeamInstr* end;
Eterm* sp;
- struct erl_off_heap_header* oh;
- int done_gc = 0;
+#ifdef HIPE
+ void *nat_start = NULL;
+ Uint nat_size = 0;
+#endif
-#define INSIDE(a) (start <= (a) && (a) < end)
+ *redsp += 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;
}
+
+ *redsp += 1;
+
+ if (erts_check_nif_export_in_area(rp, mod_start, mod_size))
+ return am_true;
+
+ *redsp += (STACK_START(rp) - rp->stop) / 32;
/*
* 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;
}
}
+#ifdef HIPE
+ /*
+ * Check all continuation pointers stored on the native stack if the module
+ * has native code.
+ */
+ if (modp->old.hipe_code) {
+ nat_start = modp->old.hipe_code->text_segment;
+ nat_size = modp->old.hipe_code->text_segment_size;
+ if (nat_size && nstack_any_cps_in_segment(rp, nat_start, nat_size)) {
+ return am_true;
+ }
+ }
+#endif
+
/*
* Check all continuation pointers stored in stackdump
* and clear exception stackdump if there is a pointer
@@ -768,15 +1157,23 @@ 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;
+ char *area_start = mod_start;
+ Uint area_size = mod_size;
+#ifdef HIPE
+ if (rp->freason & EXF_NATIVE) {
+ area_start = nat_start;
+ area_size = nat_size;
+ }
+#endif
for (i = 0; i < s->depth; i++) {
- if (INSIDE(s->trace[i])) {
+ if (ErtsInArea(s->trace[i], area_start, area_size)) {
rp->freason = EXC_NULL;
rp->fvalue = NIL;
rp->ftrace = NIL;
@@ -786,123 +1183,9 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp)
}
}
- if (rp->flags & F_DISABLE_GC) {
- /*
- * Cannot proceed. Process has disabled gc in order to
- * safely leave inconsistent data on the heap and/or
- * off heap lists. Need to wait for gc to be enabled
- * again.
- */
- return THE_NON_VALUE;
- }
-
- /*
- * See if there are funs that refer to the old version of the module.
- */
-
- rescan:
- for (oh = MSO(rp).first; oh; oh = oh->next) {
- if (thing_subtag(oh->thing_word) == FUN_SUBTAG) {
- ErlFunThing* funp = (ErlFunThing*) oh;
-
- 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;
- }
- }
- }
- }
-
- /*
- * 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)) {
- 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 (rp->dictionary != NULL) {
- Eterm* start = rp->dictionary->data;
- Eterm* end = start + rp->dictionary->used;
-
- if (any_heap_ref_ptrs(start, end, mod_start, mod_size)) {
- goto need_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;
- }
- }
- break;
-
- need_gc:
- if (done_gc) {
- return am_true;
- } else {
- Eterm* literals;
- Uint lit_size;
- struct erl_off_heap_header* oh;
-
- if (!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;
- 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);
- }
- }
return am_false;
-#undef INSIDE
}
-#define in_area(ptr,start,nbytes) \
- ((UWord)((char*)(ptr) - (char*)(start)) < (nbytes))
-
static int
any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size)
{
@@ -914,7 +1197,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;
@@ -934,13 +1217,21 @@ 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;
case TAG_PRIMARY_HEADER:
if (!header_is_transparent(val)) {
- Eterm* new_p = p + thing_arityval(val);
+ Eterm* new_p;
+ if (header_is_bin_matchstate(val)) {
+ ErlBinMatchState *ms = (ErlBinMatchState*) p;
+ ErlBinMatchBuffer *mb = &(ms->mb);
+ if (ErtsInArea(mb->orig, mod_start, mod_size)) {
+ return 1;
+ }
+ }
+ new_p = p + thing_arityval(val);
ASSERT(start <= new_p && new_p < end);
p = new_p;
}
@@ -949,100 +1240,555 @@ any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size)
return 0;
}
-#undef in_area
+static Uint
+hfrag_literal_size(Eterm* start, Eterm* end, char* lit_start, Uint lit_size)
+{
+ Eterm* p;
+ Eterm val;
+ Uint sz = 0;
+
+ for (p = start; p < end; p++) {
+ val = *p;
+ switch (primary_tag(val)) {
+ case TAG_PRIMARY_BOXED:
+ case TAG_PRIMARY_LIST:
+ if (ErtsInArea(val, lit_start, lit_size)) {
+ sz += size_object(val);
+ }
+ break;
+ case TAG_PRIMARY_HEADER:
+ if (!header_is_transparent(val)) {
+ Eterm* new_p;
+ if (header_is_bin_matchstate(val)) {
+ ErlBinMatchState *ms = (ErlBinMatchState*) p;
+ ErlBinMatchBuffer *mb = &(ms->mb);
+ if (ErtsInArea(mb->orig, lit_start, lit_size)) {
+ sz += size_object(mb->orig);
+ }
+ }
+ new_p = p + thing_arityval(val);
+ ASSERT(start <= new_p && new_p < end);
+ p = new_p;
+ }
+ }
+ }
+ return sz;
+}
+
+static void
+hfrag_literal_copy(Eterm **hpp, ErlOffHeap *ohp,
+ Eterm *start, Eterm *end,
+ char *lit_start, Uint lit_size) {
+ Eterm* p;
+ Eterm val;
+ Uint sz;
+
+ for (p = start; p < end; p++) {
+ val = *p;
+ switch (primary_tag(val)) {
+ case TAG_PRIMARY_BOXED:
+ case TAG_PRIMARY_LIST:
+ if (ErtsInArea(val, lit_start, lit_size)) {
+ sz = size_object(val);
+ val = copy_struct(val, sz, hpp, ohp);
+ *p = val;
+ }
+ break;
+ case TAG_PRIMARY_HEADER:
+ if (!header_is_transparent(val)) {
+ Eterm* new_p;
+ /* matchstate in message, not possible. */
+ if (header_is_bin_matchstate(val)) {
+ ErlBinMatchState *ms = (ErlBinMatchState*) p;
+ ErlBinMatchBuffer *mb = &(ms->mb);
+ if (ErtsInArea(mb->orig, lit_start, lit_size)) {
+ sz = size_object(mb->orig);
+ mb->orig = copy_struct(mb->orig, sz, hpp, ohp);
+ }
+ }
+ new_p = p + thing_arityval(val);
+ ASSERT(start <= new_p && new_p < end);
+ p = new_p;
+ }
+ }
+ }
+}
+
+#ifdef ERTS_SMP
+
+ErtsThrPrgrLaterOp later_literal_area_switch;
-BIF_RETTYPE purge_module_1(BIF_ALIST_1)
+typedef struct {
+ ErtsThrPrgrLaterOp lop;
+ ErtsLiteralArea *la;
+} ErtsLaterReleasLiteralArea;
+
+static void
+later_release_literal_area(void *vlrlap)
{
- ErtsCodeIndex code_ix;
- BeamInstr* code;
- BeamInstr* end;
- Module* modp;
- int is_blocking = 0;
- Eterm ret;
+ ErtsLaterReleasLiteralArea *lrlap;
+ lrlap = (ErtsLaterReleasLiteralArea *) vlrlap;
+ erts_release_literal_area(lrlap->la);
+ erts_free(ERTS_ALC_T_RELEASE_LAREA, vlrlap);
+}
- if (is_not_atom(BIF_ARG_1)) {
- BIF_ERROR(BIF_P, BADARG);
+static void
+complete_literal_area_switch(void *literal_area)
+{
+ Process *p = erts_literal_area_collector;
+ erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+ erts_resume(p, ERTS_PROC_LOCK_STATUS);
+ erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+ if (literal_area)
+ erts_release_literal_area((ErtsLiteralArea *) literal_area);
+}
+#endif
+
+BIF_RETTYPE erts_internal_release_literal_area_switch_0(BIF_ALIST_0)
+{
+ ErtsLiteralArea *unused_la;
+ ErtsLiteralAreaRef *la_ref;
+
+ if (BIF_P != erts_literal_area_collector)
+ BIF_ERROR(BIF_P, EXC_NOTSUP);
+
+ erts_smp_mtx_lock(&release_literal_areas.mtx);
+
+ la_ref = release_literal_areas.first;
+ if (la_ref) {
+ release_literal_areas.first = la_ref->next;
+ if (!release_literal_areas.first)
+ release_literal_areas.last = NULL;
}
- if (!erts_try_seize_code_write_permission(BIF_P)) {
- ERTS_BIF_YIELD1(bif_export[BIF_purge_module_1], BIF_P, BIF_ARG_1);
+ erts_smp_mtx_unlock(&release_literal_areas.mtx);
+
+ unused_la = ERTS_COPY_LITERAL_AREA();
+
+ if (!la_ref) {
+ ERTS_SET_COPY_LITERAL_AREA(NULL);
+ if (unused_la) {
+#ifdef ERTS_SMP
+ ErtsLaterReleasLiteralArea *lrlap;
+ lrlap = erts_alloc(ERTS_ALC_T_RELEASE_LAREA,
+ sizeof(ErtsLaterReleasLiteralArea));
+ lrlap->la = unused_la;
+ erts_schedule_thr_prgr_later_cleanup_op(
+ later_release_literal_area,
+ (void *) lrlap,
+ &lrlap->lop,
+ (sizeof(ErtsLaterReleasLiteralArea)
+ + sizeof(ErtsLiteralArea)
+ + ((unused_la->end
+ - &unused_la->start[0])
+ - 1)*(sizeof(Eterm))));
+#else
+ erts_release_literal_area(unused_la);
+#endif
+ }
+ BIF_RET(am_false);
}
- code_ix = erts_active_code_ix();
+ ERTS_SET_COPY_LITERAL_AREA(la_ref->literal_area);
+
+ erts_free(ERTS_ALC_T_LITERAL_REF, la_ref);
+
+#ifdef ERTS_SMP
+ erts_schedule_thr_prgr_later_op(complete_literal_area_switch,
+ unused_la,
+ &later_literal_area_switch);
+ erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, NULL);
+ ERTS_BIF_YIELD_RETURN(BIF_P, am_true);
+#else
+ erts_release_literal_area(unused_la);
+ BIF_RET(am_true);
+#endif
+
+}
+
+void
+erts_purge_state_add_fun(ErlFunEntry *fe)
+{
+ ASSERT(is_value(purge_state.module));
+ if (purge_state.fe_ix >= purge_state.fe_size) {
+ ErlFunEntry **funs;
+ purge_state.fe_size += 100;
+ funs = erts_alloc(ERTS_ALC_T_PURGE_DATA,
+ sizeof(ErlFunEntry *)*purge_state.fe_size);
+ sys_memcpy((void *) funs,
+ (void *) purge_state.funs,
+ purge_state.fe_ix*sizeof(ErlFunEntry *));
+ if (purge_state.funs != &purge_state.def_funs[0])
+ erts_free(ERTS_ALC_T_PURGE_DATA, purge_state.funs);
+ purge_state.funs = funs;
+ }
+ purge_state.funs[purge_state.fe_ix++] = fe;
+}
+
+Export *
+erts_suspend_process_on_pending_purge_lambda(Process *c_p, ErlFunEntry* fe)
+{
+ erts_smp_mtx_lock(&purge_state.mtx);
+ if (purge_state.module == fe->module) {
+ /*
+ * The process c_p is about to call a fun in the code
+ * that we are trying to purge. Suspend it and call
+ * erts_code_purger:pending_purge_lambda/3. The process
+ * will be resumed when the purge completes or aborts,
+ * and will then try to do the call again.
+ */
+ if (purge_state.sp_ix >= purge_state.sp_size) {
+ Eterm *sprocs;
+ purge_state.sp_size += 100;
+ sprocs = erts_alloc(ERTS_ALC_T_PURGE_DATA,
+ (sizeof(ErlFunEntry *)
+ * purge_state.sp_size));
+ sys_memcpy((void *) sprocs,
+ (void *) purge_state.sprocs,
+ purge_state.sp_ix*sizeof(ErlFunEntry *));
+ if (purge_state.sprocs != &purge_state.def_sprocs[0])
+ erts_free(ERTS_ALC_T_PURGE_DATA, purge_state.sprocs);
+ purge_state.sprocs = sprocs;
+ }
+ purge_state.sprocs[purge_state.sp_ix++] = c_p->common.id;
+ erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL);
+ ERTS_VBUMP_ALL_REDS(c_p);
+ }
+ erts_smp_mtx_unlock(&purge_state.mtx);
+ return purge_state.pending_purge_lambda;
+}
+
+static void
+finalize_purge_operation(Process *c_p, int succeded)
+{
+ Uint ix;
+
+ if (c_p)
+ erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
+
+ erts_smp_mtx_lock(&purge_state.mtx);
+
+ ASSERT(purge_state.module != THE_NON_VALUE);
+
+ purge_state.module = THE_NON_VALUE;
/*
- * Correct module?
+ * Resume all processes that have tried to call
+ * funs in this code.
*/
+ for (ix = 0; ix < purge_state.sp_ix; ix++) {
+ Process *rp = erts_pid2proc(NULL, 0,
+ purge_state.sprocs[ix],
+ ERTS_PROC_LOCK_STATUS);
+ if (rp) {
+ erts_resume(rp, ERTS_PROC_LOCK_STATUS);
+ erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS);
+ }
+ }
- if ((modp = erts_get_module(BIF_ARG_1, code_ix)) == NULL) {
- ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG);
+ erts_smp_mtx_unlock(&purge_state.mtx);
+
+ if (c_p)
+ erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
+
+ if (purge_state.sprocs != &purge_state.def_sprocs[0]) {
+ erts_free(ERTS_ALC_T_PURGE_DATA, purge_state.sprocs);
+ purge_state.sprocs = &purge_state.def_sprocs[0];
+ purge_state.sp_size = sizeof(purge_state.def_sprocs);
+ purge_state.sp_size /= sizeof(purge_state.def_sprocs[0]);
}
- else {
- erts_rwlock_old_code(code_ix);
+ purge_state.sp_ix = 0;
+ if (purge_state.funs != &purge_state.def_funs[0]) {
+ erts_free(ERTS_ALC_T_PURGE_DATA, purge_state.funs);
+ purge_state.funs = &purge_state.def_funs[0];
+ purge_state.fe_size = sizeof(purge_state.def_funs);
+ purge_state.fe_size /= sizeof(purge_state.def_funs[0]);
+ }
+ purge_state.fe_ix = 0;
+}
+
+#ifdef ERTS_SMP
+
+static ErtsThrPrgrLaterOp purger_lop_data;
+
+static void
+resume_purger(void *unused)
+{
+ Process *p = erts_code_purger;
+ erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+ erts_resume(p, ERTS_PROC_LOCK_STATUS);
+ erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+}
+
+static void
+finalize_purge_abort(void *unused)
+{
+ erts_fun_purge_abort_finalize(purge_state.funs, purge_state.fe_ix);
+
+ finalize_purge_operation(NULL, 0);
+
+ resume_purger(NULL);
+}
+
+#endif /* ERTS_SMP */
+
+BIF_RETTYPE erts_internal_purge_module_2(BIF_ALIST_2)
+{
+ if (BIF_P != erts_code_purger)
+ BIF_ERROR(BIF_P, EXC_NOTSUP);
+
+ if (is_not_atom(BIF_ARG_1))
+ BIF_ERROR(BIF_P, BADARG);
+
+ switch (BIF_ARG_2) {
+
+ case am_prepare:
+ case am_prepare_on_load: {
/*
- * Any code to purge?
+ * Prepare for purge by marking all fun
+ * entries referring to the code to purge
+ * with "pending purge" markers.
*/
- if (modp->old.code == 0) {
- ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG);
- }
+ ErtsCodeIndex code_ix;
+ Module* modp;
+ Eterm res;
+
+ if (is_value(purge_state.module))
+ BIF_ERROR(BIF_P, BADARG);
+
+ code_ix = erts_active_code_ix();
+
+ /*
+ * Correct module?
+ */
+ modp = erts_get_module(BIF_ARG_1, code_ix);
+ if (!modp)
+ res = am_false;
else {
/*
- * Unload any NIF library
+ * Any code to purge?
*/
- if (modp->old.nif != NULL) {
- /* ToDo: Do unload nif without blocking */
- erts_rwunlock_old_code(code_ix);
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_thr_progress_block();
- is_blocking = 1;
- erts_rwlock_old_code(code_ix);
- erts_unload_nif(modp->old.nif);
- modp->old.nif = NULL;
+
+ if (BIF_ARG_2 == am_prepare_on_load) {
+ erts_rwlock_old_code(code_ix);
+ } else {
+ erts_rlock_old_code(code_ix);
}
+ if (BIF_ARG_2 == am_prepare_on_load) {
+ ASSERT(modp->on_load);
+ ASSERT(modp->on_load->code_hdr);
+ purge_state.saved_old = modp->old;
+ modp->old = *modp->on_load;
+ erts_free(ERTS_ALC_T_PREPARED_CODE, (void *) modp->on_load);
+ modp->on_load = 0;
+ }
+
+ if (!modp->old.code_hdr)
+ res = am_false;
+ else {
+ BeamInstr* code;
+ BeamInstr* end;
+ erts_smp_mtx_lock(&purge_state.mtx);
+ purge_state.module = BIF_ARG_1;
+ erts_smp_mtx_unlock(&purge_state.mtx);
+ res = am_true;
+ code = (BeamInstr*) modp->old.code_hdr;
+ end = (BeamInstr *)((char *)code + modp->old.code_length);
+ erts_fun_purge_prepare(code, end);
+ }
+
+ if (BIF_ARG_2 == am_prepare_on_load) {
+ erts_rwunlock_old_code(code_ix);
+ } else {
+ erts_runlock_old_code(code_ix);
+ }
+ }
+
+#ifndef ERTS_SMP
+ BIF_RET(res);
+#else
+ if (res != am_true)
+ BIF_RET(res);
+ else {
/*
- * Remove the old code.
+ * We'll be resumed when all schedulers are guaranteed
+ * to see the "pending purge" markers that we've made on
+ * all fun entries of the code that we are about to purge.
+ * Processes trying to call these funs will be suspended
+ * before calling the funs. That is we are guaranteed not
+ * to get any more direct references into the code while
+ * checking for such references...
*/
- ASSERT(erts_total_code_size >= modp->old.code_length);
- erts_total_code_size -= modp->old.code_length;
- code = modp->old.code;
- 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);
- erts_free(ERTS_ALC_T_CODE, (void *) code);
- modp->old.code = NULL;
- modp->old.code_length = 0;
- modp->old.catches = BEAM_CATCHES_NIL;
- erts_remove_from_ranges(code);
- ERTS_BIF_PREP_RET(ret, am_true);
+ erts_schedule_thr_prgr_later_op(resume_purger,
+ NULL,
+ &purger_lop_data);
+ erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, NULL);
+ ERTS_BIF_YIELD_RETURN(BIF_P, am_true);
}
- erts_rwunlock_old_code(code_ix);
+#endif
}
- if (is_blocking) {
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+
+ case am_abort: {
+ /*
+ * Soft purge that detected direct references into the code
+ * we set out to purge. Abort the purge.
+ */
+
+ if (purge_state.module != BIF_ARG_1)
+ BIF_ERROR(BIF_P, BADARG);
+
+ erts_fun_purge_abort_prepare(purge_state.funs, purge_state.fe_ix);
+
+#ifndef ERTS_SMP
+ erts_fun_purge_abort_finalize(purge_state.funs, purge_state.fe_ix);
+ finalize_purge_operation(BIF_P, 0);
+ BIF_RET(am_false);
+#else
+ /*
+ * We need to restore the code addresses of the funs in
+ * two stages in order to ensure that we do not get any
+ * stale suspended processes due to the purge abort.
+ * Restore address pointer (erts_fun_purge_abort_prepare);
+ * wait for thread progress; clear pending purge address
+ * pointer (erts_fun_purge_abort_finalize), and then
+ * resume processes that got suspended
+ * (finalize_purge_operation).
+ */
+ erts_schedule_thr_prgr_later_op(finalize_purge_abort,
+ NULL,
+ &purger_lop_data);
+ erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, NULL);
+ ERTS_BIF_YIELD_RETURN(BIF_P, am_false);
+#endif
}
- erts_release_code_write_permission();
- return ret;
-}
-static void
-decrement_refc(BeamInstr* code)
-{
- struct erl_off_heap_header* oh =
- (struct erl_off_heap_header *) code[MI_LITERALS_OFF_HEAP];
-
- while (oh) {
- Binary* bptr;
- ASSERT(thing_subtag(oh->thing_word) == REFC_BINARY_SUBTAG);
- bptr = ((ProcBin*)oh)->val;
- if (erts_refc_dectest(&bptr->refc, 0) == 0) {
- erts_bin_free(bptr);
+ case am_complete: {
+ ErtsCodeIndex code_ix;
+ BeamInstr* code;
+ Module* modp;
+ int is_blocking = 0;
+ Eterm ret;
+ ErtsLiteralArea *literals = NULL;
+
+
+ /*
+ * We have no direct references into the code.
+ * Complete to purge.
+ */
+
+ if (purge_state.module != BIF_ARG_1)
+ BIF_ERROR(BIF_P, BADARG);
+
+ if (!erts_try_seize_code_write_permission(BIF_P)) {
+ ERTS_BIF_YIELD2(bif_export[BIF_erts_internal_purge_module_2],
+ BIF_P, BIF_ARG_1, BIF_ARG_2);
+ }
+
+ code_ix = erts_active_code_ix();
+
+ /*
+ * Correct module?
+ */
+
+ if ((modp = erts_get_module(BIF_ARG_1, code_ix)) == NULL) {
+ ERTS_BIF_PREP_RET(ret, am_false);
}
- oh = oh->next;
+ else {
+
+ erts_rwlock_old_code(code_ix);
+
+ /*
+ * Any code to purge?
+ */
+ if (!modp->old.code_hdr) {
+ ERTS_BIF_PREP_RET(ret, am_false);
+ }
+ else {
+ /*
+ * Unload any NIF library
+ */
+ if (modp->old.nif != NULL
+ || IF_HIPE(hipe_purge_need_blocking(modp))) {
+ /* ToDo: Do unload nif without blocking */
+ erts_rwunlock_old_code(code_ix);
+ erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_smp_thr_progress_block();
+ is_blocking = 1;
+ erts_rwlock_old_code(code_ix);
+ if (modp->old.nif) {
+ erts_unload_nif(modp->old.nif);
+ modp->old.nif = NULL;
+ }
+ }
+
+ /*
+ * Remove the old code.
+ */
+ ASSERT(erts_total_code_size >= modp->old.code_length);
+ erts_total_code_size -= modp->old.code_length;
+ code = (BeamInstr*) modp->old.code_hdr;
+ erts_fun_purge_complete(purge_state.funs, purge_state.fe_ix);
+ beam_catches_delmod(modp->old.catches, code, modp->old.code_length,
+ code_ix);
+ literals = modp->old.code_hdr->literal_area;
+ modp->old.code_hdr->literal_area = NULL;
+ erts_free(ERTS_ALC_T_CODE, (void *) code);
+ modp->old.code_hdr = NULL;
+ modp->old.code_length = 0;
+ modp->old.catches = BEAM_CATCHES_NIL;
+ erts_remove_from_ranges(code);
+#ifdef HIPE
+ hipe_purge_module(modp, is_blocking);
+#endif
+ ERTS_BIF_PREP_RET(ret, am_true);
+ }
+
+ if (purge_state.saved_old.code_hdr) {
+ modp->old = purge_state.saved_old;
+ purge_state.saved_old.code_hdr = 0;
+ }
+ erts_rwunlock_old_code(code_ix);
+ }
+ if (is_blocking) {
+ erts_smp_thr_progress_unblock();
+ erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ }
+
+ erts_release_code_write_permission();
+
+ finalize_purge_operation(BIF_P, ret == am_true);
+
+ if (literals) {
+ ErtsLiteralAreaRef *ref;
+ ref = erts_alloc(ERTS_ALC_T_LITERAL_REF,
+ sizeof(ErtsLiteralAreaRef));
+ ref->literal_area = literals;
+ ref->next = NULL;
+ erts_smp_mtx_lock(&release_literal_areas.mtx);
+ if (release_literal_areas.last) {
+ release_literal_areas.last->next = ref;
+ release_literal_areas.last = ref;
+ }
+ else {
+ release_literal_areas.first = ref;
+ release_literal_areas.last = ref;
+ }
+ erts_smp_mtx_unlock(&release_literal_areas.mtx);
+ erts_queue_message(erts_literal_area_collector,
+ 0,
+ erts_alloc_message(0, NULL),
+ am_copy_literals,
+ BIF_P->common.id);
+ }
+
+ return ret;
+ }
+
+ default:
+ BIF_ERROR(BIF_P, BADARG);
+
}
}
@@ -1055,37 +1801,38 @@ delete_code(Module* modp)
{
ErtsCodeIndex code_ix = erts_staging_code_ix();
Eterm module = make_atom(modp->module);
- int i;
+ int i, num_exps = export_list_size(code_ix);
- for (i = 0; i < export_list_size(code_ix); i++) {
+ for (i = 0; i < num_exps; i++) {
Export *ep = export_list(i, code_ix);
- if (ep != NULL && (ep->code[0] == module)) {
- if (ep->addressv[code_ix] == ep->code+3) {
- if (ep->code[3] == (BeamInstr) em_apply_bif) {
+ if (ep != NULL && (ep->info.mfa.module == module)) {
+ if (ep->addressv[code_ix] == ep->beam) {
+ if (ep->beam[0] == (BeamInstr) em_apply_bif) {
continue;
}
- else if (ep->code[3] ==
+ else if (ep->beam[0] ==
(BeamInstr) BeamOp(op_i_generic_breakpoint)) {
ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
ASSERT(modp->curr.num_traced_exports > 0);
- erts_clear_export_break(modp, ep->code+3);
+ DBG_TRACE_MFA_P(&ep->info.mfa,
+ "export trace cleared, code_ix=%d", code_ix);
+ erts_clear_export_break(modp, &ep->info);
}
- else ASSERT(ep->code[3] == (BeamInstr) em_call_error_handler
+ else ASSERT(ep->beam[0] == (BeamInstr) em_call_error_handler
|| !erts_initialized);
}
- ep->addressv[code_ix] = ep->code+3;
- ep->code[3] = (BeamInstr) em_call_error_handler;
- ep->code[4] = 0;
+ ep->addressv[code_ix] = ep->beam;
+ ep->beam[0] = (BeamInstr) em_call_error_handler;
+ ep->beam[1] = 0;
+ DBG_TRACE_MFA_P(&ep->info.mfa,
+ "export invalidation, code_ix=%d", code_ix);
}
}
ASSERT(modp->curr.num_breakpoints == 0);
ASSERT(modp->curr.num_traced_exports == 0);
modp->old = modp->curr;
- modp->curr.code = NULL;
- modp->curr.code_length = 0;
- modp->curr.catches = BEAM_CATCHES_NIL;
- modp->curr.nif = NULL;
+ erts_module_instance_init(&modp->curr);
}
@@ -1099,32 +1846,12 @@ 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) {
- return am_not_purged;
- } else if (modp->old.code == NULL) { /* Make the current version old. */
+ if (modp->curr.code_hdr) {
+ if (modp->old.code_hdr) {
+ return am_not_purged;
+ }
+ /* Make the current version old. */
delete_code(modp);
}
return NIL;
}
-
-static int
-is_native(BeamInstr* code)
-{
- Uint i, num_functions = code[MI_NUM_FUNCTIONS];
-
- /* Check NativeAdress of first real function in module
- */
- for (i=0; i<num_functions; i++) {
- BeamInstr* func_info = (BeamInstr *) code[MI_FUNCTIONS+i];
- Eterm name = (Eterm) func_info[3];
-
- if (is_atom(name)) {
- return func_info[1] != 0;
- }
- else ASSERT(is_nil(name)); /* ignore BIF stubs */
- }
- /* Not a single non-BIF function? */
- return 0;
-}
-
-
diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c
index 4e711c89e0..069e7391fd 100644
--- a/erts/emulator/beam/beam_bp.c
+++ b/erts/emulator/beam/beam_bp.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2000-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2000-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -31,6 +32,7 @@
#include "erl_binary.h"
#include "beam_bp.h"
#include "erl_term.h"
+#include "erl_nfunc_sched.h"
/* *************************************************************************
** Macros
@@ -73,6 +75,44 @@ 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;
+#ifdef ERTS_DIRTY_SCHEDULERS
+erts_smp_mtx_t erts_dirty_bp_ix_mtx;
+#endif
+
+/*
+ * Inlined helpers
+ */
+
+static ERTS_INLINE ErtsMonotonicTime
+get_mtime(Process *c_p)
+{
+ return erts_get_monotonic_time(erts_proc_sched_data(c_p));
+}
+
+static ERTS_INLINE Uint32
+acquire_bp_sched_ix(Process *c_p)
+{
+ ErtsSchedulerData *esdp = erts_proc_sched_data(c_p);
+ ASSERT(esdp);
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (ERTS_SCHEDULER_IS_DIRTY(esdp)) {
+ erts_smp_mtx_lock(&erts_dirty_bp_ix_mtx);
+ return (Uint32) erts_no_schedulers;
+ }
+#endif
+ return (Uint32) esdp->no - 1;
+}
+
+static ERTS_INLINE void
+release_bp_sched_ix(Uint32 ix)
+{
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (ix == (Uint32) erts_no_schedulers)
+ erts_smp_mtx_unlock(&erts_dirty_bp_ix_mtx);
+#endif
+}
+
+
/* *************************************************************************
** Local prototypes
@@ -81,41 +121,33 @@ erts_smp_atomic32_t erts_staging_bp_index;
/*
** Helpers
*/
-static Eterm do_call_trace(Process* c_p, BeamInstr* I, Eterm* reg,
- int local, Binary* ms, Eterm tracer_pid);
+static ErtsTracer do_call_trace(Process* c_p, ErtsCodeInfo *info, Eterm* reg,
+ int local, Binary* ms, ErtsTracer tracer);
static void set_break(BpFunctions* f, Binary *match_spec, Uint break_flags,
- enum erts_break_op count_op, Eterm tracer_pid);
-static void set_function_break(BeamInstr *pc,
+ enum erts_break_op count_op, ErtsTracer tracer);
+static void set_function_break(ErtsCodeInfo *ci,
Binary *match_spec,
Uint break_flags,
enum erts_break_op count_op,
- Eterm tracer_pid);
+ ErtsTracer tracer);
static void clear_break(BpFunctions* f, Uint break_flags);
-static int clear_function_break(BeamInstr *pc, Uint break_flags);
+static int clear_function_break(ErtsCodeInfo *ci, 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 BpDataTime* get_time_break(ErtsCodeInfo *ci);
+static GenericBpData* check_break(ErtsCodeInfo *ci, Uint break_flags);
-static void bp_meta_unref(BpMetaPid* bmp);
-static void bp_count_unref(BpCount* bcp);
-static void bp_time_unref(BpDataTime* bdt);
-static void consolidate_bp_data(Module* modp, BeamInstr* pc, int local);
-static void uninstall_breakpoint(BeamInstr* pc);
+static void bp_meta_unref(BpMetaTracer *bmt);
+static void bp_count_unref(BpCount *bcp);
+static void bp_time_unref(BpDataTime *bdt);
+static void consolidate_bp_data(Module *modp, ErtsCodeInfo *ci, int local);
+static void uninstall_breakpoint(ErtsCodeInfo *ci);
/* 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);
@@ -132,11 +164,15 @@ void
erts_bp_init(void) {
erts_smp_atomic32_init_nob(&erts_active_bp_index, 0);
erts_smp_atomic32_init_nob(&erts_staging_bp_index, 1);
+#ifdef ERTS_DIRTY_SCHEDULERS
+ erts_smp_mtx_init(&erts_dirty_bp_ix_mtx, "dirty_break_point_index", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
+#endif
}
void
-erts_bp_match_functions(BpFunctions* f, Eterm mfa[3], int specified)
+erts_bp_match_functions(BpFunctions* f, ErtsCodeMFA *mfa, int specified)
{
ErtsCodeIndex code_ix = erts_active_code_ix();
Uint max_funcs = 0;
@@ -151,8 +187,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;
}
}
@@ -160,42 +196,45 @@ 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;
- BeamInstr* code;
- Uint num_functions = (Uint)(UWord) code_base[MI_NUM_FUNCTIONS];
+ BeamCodeHeader* code_hdr = module[current]->curr.code_hdr;
+ ErtsCodeInfo* ci;
+ Uint num_functions = (Uint)(UWord) code_hdr->num_functions;
Uint fi;
if (specified > 0) {
- if (mfa[0] != make_atom(module[current]->module)) {
+ if (mfa->module != make_atom(module[current]->module)) {
/* Wrong module name */
continue;
}
}
for (fi = 0; fi < num_functions; fi++) {
- BeamInstr* pc;
- int wi;
- code = code_base[MI_FUNCTIONS+fi];
- ASSERT(code[0] == (BeamInstr) BeamOp(op_i_func_info_IaaI));
- pc = code+5;
- if (erts_is_native_break(pc)) {
+ ci = code_hdr->functions[fi];
+ ASSERT(ci->op == (BeamInstr) BeamOp(op_i_func_info_IaaI));
+ if (erts_is_function_native(ci)) {
continue;
}
- if (is_nil(code[3])) { /* Ignore BIF stub */
+ if (is_nil(ci->mfa.module)) { /* Ignore BIF stub */
continue;
}
- for (wi = 0;
- wi < specified && (Eterm) code[2+wi] == mfa[wi];
- wi++) {
- /* Empty loop body */
- }
- if (wi == specified) {
- /* Store match */
- f->matching[i].pc = pc;
- f->matching[i].mod = module[current];
- i++;
- }
+ switch (specified) {
+ case 3:
+ if (ci->mfa.arity != mfa->arity)
+ continue;
+ case 2:
+ if (ci->mfa.function != mfa->function)
+ continue;
+ case 1:
+ if (ci->mfa.module != mfa->module)
+ continue;
+ case 0:
+ break;
+ }
+ /* Store match */
+ f->matching[i].ci = ci;
+ f->matching[i].mod = module[current];
+ i++;
}
}
f->matched = i;
@@ -203,7 +242,7 @@ erts_bp_match_functions(BpFunctions* f, Eterm mfa[3], int specified)
}
void
-erts_bp_match_export(BpFunctions* f, Eterm mfa[3], int specified)
+erts_bp_match_export(BpFunctions* f, ErtsCodeMFA *mfa, int specified)
{
ErtsCodeIndex code_ix = erts_active_code_ix();
int i;
@@ -215,27 +254,36 @@ erts_bp_match_export(BpFunctions* f, Eterm mfa[3], int specified)
for (i = 0; i < num_exps; i++) {
Export* ep = export_list(i, code_ix);
BeamInstr* pc;
- int j;
- for (j = 0; j < specified && mfa[j] == ep->code[j]; j++) {
- /* Empty loop body */
- }
- if (j < specified) {
- continue;
- }
- pc = ep->code+3;
+ switch (specified) {
+ case 3:
+ if (mfa->arity != ep->info.mfa.arity)
+ continue;
+ case 2:
+ if (mfa->function != ep->info.mfa.function)
+ continue;
+ case 1:
+ if (mfa->module != ep->info.mfa.module)
+ continue;
+ case 0:
+ break;
+ default:
+ ASSERT(0);
+ }
+
+ pc = ep->beam;
if (ep->addressv[code_ix] == pc) {
if ((*pc == (BeamInstr) em_apply_bif ||
*pc == (BeamInstr) em_call_error_handler)) {
continue;
}
ASSERT(*pc == (BeamInstr) BeamOp(op_i_generic_breakpoint));
- } else if (erts_is_native_break(ep->addressv[code_ix])) {
+ } else if (erts_is_function_native(erts_code_to_codeinfo(ep->addressv[code_ix]))) {
continue;
}
- f->matching[ne].pc = pc;
- f->matching[ne].mod = erts_get_module(ep->code[0], code_ix);
+ f->matching[ne].ci = &ep->info;
+ f->matching[ne].mod = erts_get_module(ep->info.mfa.module, code_ix);
ne++;
}
@@ -245,7 +293,10 @@ erts_bp_match_export(BpFunctions* f, Eterm mfa[3], int specified)
void
erts_bp_free_matched_functions(BpFunctions* f)
{
- Free(f->matching);
+ if (f->matching) {
+ Free(f->matching);
+ }
+ else ASSERT(f->matched == 0);
}
void
@@ -258,7 +309,7 @@ erts_consolidate_bp_data(BpFunctions* f, int local)
ERTS_SMP_LC_ASSERT(erts_has_code_write_permission());
for (i = 0; i < n; i++) {
- consolidate_bp_data(fs[i].mod, fs[i].pc, local);
+ consolidate_bp_data(fs[i].mod, fs[i].ci, local);
}
}
@@ -270,14 +321,14 @@ erts_consolidate_bif_bp_data(void)
ERTS_SMP_LC_ASSERT(erts_has_code_write_permission());
for (i = 0; i < BIF_SIZE; i++) {
Export *ep = bif_export[i];
- consolidate_bp_data(0, ep->code+3, 0);
+ consolidate_bp_data(0, &ep->info, 0);
}
}
static void
-consolidate_bp_data(Module* modp, BeamInstr* pc, int local)
+consolidate_bp_data(Module* modp, ErtsCodeInfo *ci, int local)
{
- GenericBp* g = (GenericBp *) pc[-4];
+ GenericBp* g = ci->u.gen_bp;
GenericBpData* src;
GenericBpData* dst;
Uint flags;
@@ -299,7 +350,7 @@ consolidate_bp_data(Module* modp, BeamInstr* pc, int local)
MatchSetUnref(dst->local_ms);
}
if (flags & ERTS_BPF_META_TRACE) {
- bp_meta_unref(dst->meta_pid);
+ bp_meta_unref(dst->meta_tracer);
MatchSetUnref(dst->meta_ms);
}
if (flags & ERTS_BPF_COUNT) {
@@ -323,9 +374,10 @@ consolidate_bp_data(Module* modp, BeamInstr* pc, int local)
}
ASSERT(modp->curr.num_breakpoints >= 0);
ASSERT(modp->curr.num_traced_exports >= 0);
- ASSERT(*pc != (BeamInstr) BeamOp(op_i_generic_breakpoint));
+ ASSERT(*erts_codeinfo_to_code(ci) !=
+ (BeamInstr) BeamOp(op_i_generic_breakpoint));
}
- pc[-4] = 0;
+ ci->u.gen_bp = NULL;
Free(g);
return;
}
@@ -340,18 +392,18 @@ consolidate_bp_data(Module* modp, BeamInstr* pc, int local)
MatchSetRef(dst->local_ms);
}
if (flags & ERTS_BPF_META_TRACE) {
- dst->meta_pid = src->meta_pid;
- erts_refc_inc(&dst->meta_pid->refc, 1);
+ dst->meta_tracer = src->meta_tracer;
+ erts_smp_refc_inc(&dst->meta_tracer->refc, 1);
dst->meta_ms = src->meta_ms;
MatchSetRef(dst->meta_ms);
}
if (flags & ERTS_BPF_COUNT) {
dst->count = src->count;
- erts_refc_inc(&dst->count->refc, 1);
+ erts_smp_refc_inc(&dst->count->refc, 1);
}
if (flags & ERTS_BPF_TIME_TRACE) {
dst->time = src->time;
- erts_refc_inc(&dst->time->refc, 1);
+ erts_smp_refc_inc(&dst->time->refc, 1);
ASSERT(dst->time->hash);
}
}
@@ -374,8 +426,9 @@ erts_install_breakpoints(BpFunctions* f)
BeamInstr br = (BeamInstr) BeamOp(op_i_generic_breakpoint);
for (i = 0; i < n; i++) {
- BeamInstr* pc = f->matching[i].pc;
- GenericBp* g = (GenericBp *) pc[-4];
+ ErtsCodeInfo* ci = f->matching[i].ci;
+ BeamInstr *pc = erts_codeinfo_to_code(ci);
+ GenericBp* g = ci->u.gen_bp;
if (*pc != br && g) {
Module* modp = f->matching[i].mod;
@@ -407,16 +460,16 @@ erts_uninstall_breakpoints(BpFunctions* f)
Uint n = f->matched;
for (i = 0; i < n; i++) {
- BeamInstr* pc = f->matching[i].pc;
- uninstall_breakpoint(pc);
+ uninstall_breakpoint(f->matching[i].ci);
}
}
static void
-uninstall_breakpoint(BeamInstr* pc)
+uninstall_breakpoint(ErtsCodeInfo *ci)
{
+ BeamInstr *pc = erts_codeinfo_to_code(ci);
if (*pc == (BeamInstr) BeamOp(op_i_generic_breakpoint)) {
- GenericBp* g = (GenericBp *) pc[-4];
+ GenericBp* g = ci->u.gen_bp;
if (g->data[erts_active_bp_ix()].flags == 0) {
/*
* The following write is not protected by any lock. We
@@ -433,59 +486,59 @@ uninstall_breakpoint(BeamInstr* pc)
void
erts_set_trace_break(BpFunctions* f, Binary *match_spec)
{
- set_break(f, match_spec, ERTS_BPF_LOCAL_TRACE, 0, am_true);
+ set_break(f, match_spec, ERTS_BPF_LOCAL_TRACE, 0, erts_tracer_true);
}
void
-erts_set_mtrace_break(BpFunctions* f, Binary *match_spec, Eterm tracer_pid)
+erts_set_mtrace_break(BpFunctions* f, Binary *match_spec, ErtsTracer tracer)
{
- set_break(f, match_spec, ERTS_BPF_META_TRACE, 0, tracer_pid);
+ set_break(f, match_spec, ERTS_BPF_META_TRACE, 0, tracer);
}
void
-erts_set_call_trace_bif(BeamInstr *pc, Binary *match_spec, int local)
+erts_set_call_trace_bif(ErtsCodeInfo *ci, Binary *match_spec, int local)
{
Uint flags = local ? ERTS_BPF_LOCAL_TRACE : ERTS_BPF_GLOBAL_TRACE;
- set_function_break(pc, match_spec, flags, 0, NIL);
+ set_function_break(ci, match_spec, flags, 0, erts_tracer_nil);
}
void
-erts_set_mtrace_bif(BeamInstr *pc, Binary *match_spec, Eterm tracer_pid)
+erts_set_mtrace_bif(ErtsCodeInfo *ci, Binary *match_spec, ErtsTracer tracer)
{
- set_function_break(pc, match_spec, ERTS_BPF_META_TRACE, 0, tracer_pid);
+ set_function_break(ci, match_spec, ERTS_BPF_META_TRACE, 0, tracer);
}
void
-erts_set_time_trace_bif(BeamInstr *pc, enum erts_break_op count_op)
+erts_set_time_trace_bif(ErtsCodeInfo *ci, enum erts_break_op count_op)
{
- set_function_break(pc, NULL,
+ set_function_break(ci, NULL,
ERTS_BPF_TIME_TRACE|ERTS_BPF_TIME_TRACE_ACTIVE,
- count_op, NIL);
+ count_op, erts_tracer_nil);
}
void
-erts_clear_time_trace_bif(BeamInstr *pc) {
- clear_function_break(pc, ERTS_BPF_TIME_TRACE|ERTS_BPF_TIME_TRACE_ACTIVE);
+erts_clear_time_trace_bif(ErtsCodeInfo *ci) {
+ clear_function_break(ci, ERTS_BPF_TIME_TRACE|ERTS_BPF_TIME_TRACE_ACTIVE);
}
void
erts_set_debug_break(BpFunctions* f) {
- set_break(f, NULL, ERTS_BPF_DEBUG, 0, NIL);
+ set_break(f, NULL, ERTS_BPF_DEBUG, 0, erts_tracer_nil);
}
void
erts_set_count_break(BpFunctions* f, enum erts_break_op count_op)
{
set_break(f, 0, ERTS_BPF_COUNT|ERTS_BPF_COUNT_ACTIVE,
- count_op, NIL);
+ count_op, erts_tracer_nil);
}
void
erts_set_time_break(BpFunctions* f, enum erts_break_op count_op)
{
set_break(f, 0, ERTS_BPF_TIME_TRACE|ERTS_BPF_TIME_TRACE_ACTIVE,
- count_op, NIL);
+ count_op, erts_tracer_nil);
}
void
@@ -495,14 +548,14 @@ erts_clear_trace_break(BpFunctions* f)
}
void
-erts_clear_call_trace_bif(BeamInstr *pc, int local)
+erts_clear_call_trace_bif(ErtsCodeInfo *ci, int local)
{
- GenericBp* g = (GenericBp *) pc[-4];
+ GenericBp* g = ci->u.gen_bp;
if (g) {
Uint flags = local ? ERTS_BPF_LOCAL_TRACE : ERTS_BPF_GLOBAL_TRACE;
if (g->data[erts_staging_bp_ix()].flags & flags) {
- clear_function_break(pc, flags);
+ clear_function_break(ci, flags);
}
}
}
@@ -514,9 +567,9 @@ erts_clear_mtrace_break(BpFunctions* f)
}
void
-erts_clear_mtrace_bif(BeamInstr *pc)
+erts_clear_mtrace_bif(ErtsCodeInfo *ci)
{
- clear_function_break(pc, ERTS_BPF_META_TRACE);
+ clear_function_break(ci, ERTS_BPF_META_TRACE);
}
void
@@ -546,64 +599,103 @@ 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;
- if (erts_is_native_break(pc)) {
+ ErtsCodeInfo *ci = code_hdr->functions[i];
+ if (erts_is_function_native(ci))
continue;
- }
- clear_function_break(pc, ERTS_BPF_ALL);
+ clear_function_break(ci, ERTS_BPF_ALL);
}
erts_commit_staged_bp();
for (i = 0; i < n; ++i) {
- BeamInstr* pc;
-
- pc = code_base[MI_FUNCTIONS+i] + 5;
- if (erts_is_native_break(pc)) {
+ ErtsCodeInfo *ci = code_hdr->functions[i];
+ if (erts_is_function_native(ci))
continue;
- }
- uninstall_breakpoint(pc);
- consolidate_bp_data(modp, pc, 1);
- ASSERT(pc[-4] == 0);
+ uninstall_breakpoint(ci);
+ consolidate_bp_data(modp, ci, 1);
+ ASSERT(ci->u.gen_bp == NULL);
}
return n;
}
void
-erts_clear_export_break(Module* modp, BeamInstr* pc)
+erts_clear_export_break(Module* modp, ErtsCodeInfo *ci)
{
ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
- clear_function_break(pc, ERTS_BPF_ALL);
+ clear_function_break(ci, ERTS_BPF_ALL);
erts_commit_staged_bp();
- *pc = (BeamInstr) 0;
- consolidate_bp_data(modp, pc, 0);
- ASSERT(pc[-4] == 0);
+ *erts_codeinfo_to_code(ci) = (BeamInstr) 0;
+ consolidate_bp_data(modp, ci, 0);
+ ASSERT(ci->u.gen_bp == NULL);
+}
+
+/*
+ * If c_p->cp is a trace return instruction, we set cp
+ * to be the place where we again start to execute code.
+ *
+ * cp is used by match spec {caller} to get the calling
+ * function, and if we don't do this fixup it will be
+ * 'undefined'. This has the odd side effect of {caller}
+ * not really being which function is the caller, but
+ * rather which function we are about to return to.
+ */
+static void fixup_cp_before_trace(Process *c_p, int *return_to_trace)
+{
+ Eterm *cpp, *E = c_p->stop;
+ BeamInstr w = *c_p->cp;
+ if (w == (BeamInstr) BeamOp(op_return_trace)) {
+ cpp = &E[2];
+ } else if (w == (BeamInstr) BeamOp(op_i_return_to_trace)) {
+ *return_to_trace = 1;
+ cpp = &E[0];
+ } else if (w == (BeamInstr) BeamOp(op_i_return_time_trace)) {
+ cpp = &E[0];
+ } else {
+ cpp = NULL;
+ }
+ if (cpp) {
+ for (;;) {
+ BeamInstr w = *cp_val(*cpp);
+ if (w == (BeamInstr) BeamOp(op_return_trace)) {
+ cpp += 3;
+ } else if (w == (BeamInstr) BeamOp(op_i_return_to_trace)) {
+ *return_to_trace = 1;
+ cpp += 1;
+ } else if (w == (BeamInstr) BeamOp(op_i_return_time_trace)) {
+ cpp += 2;
+ } else {
+ break;
+ }
+ }
+ c_p->cp = (BeamInstr *) cp_val(*cpp);
+ ASSERT(is_CP(*cpp));
+ }
}
BeamInstr
-erts_generic_breakpoint(Process* c_p, BeamInstr* I, Eterm* reg)
+erts_generic_breakpoint(Process* c_p, ErtsCodeInfo *info, Eterm* reg)
{
GenericBp* g;
GenericBpData* bp;
Uint bp_flags;
ErtsBpIndex ix = erts_active_bp_ix();
- g = (GenericBp *) I[-4];
+ ASSERT(info->op == (BeamInstr) BeamOp(op_i_func_info_IaaI));
+
+ g = info->u.gen_bp;
bp = &g->data[ix];
bp_flags = bp->flags;
ASSERT((bp_flags & ~ERTS_BPF_ALL) == 0);
@@ -622,19 +714,27 @@ erts_generic_breakpoint(Process* c_p, BeamInstr* I, Eterm* reg)
if (bp_flags & ERTS_BPF_LOCAL_TRACE) {
ASSERT((bp_flags & ERTS_BPF_GLOBAL_TRACE) == 0);
- (void) do_call_trace(c_p, I, reg, 1, bp->local_ms, am_true);
+ (void) do_call_trace(c_p, info, reg, 1, bp->local_ms, erts_tracer_true);
} else if (bp_flags & ERTS_BPF_GLOBAL_TRACE) {
- (void) do_call_trace(c_p, I, reg, 0, bp->local_ms, am_true);
+ (void) do_call_trace(c_p, info, reg, 0, bp->local_ms, erts_tracer_true);
}
if (bp_flags & ERTS_BPF_META_TRACE) {
- Eterm old_pid;
- Eterm new_pid;
+ ErtsTracer old_tracer, new_tracer;
+
+ old_tracer = erts_smp_atomic_read_nob(&bp->meta_tracer->tracer);
+
+ new_tracer = do_call_trace(c_p, info, reg, 1, bp->meta_ms, old_tracer);
- old_pid = (Eterm) erts_smp_atomic_read_nob(&bp->meta_pid->pid);
- new_pid = do_call_trace(c_p, I, reg, 1, bp->meta_ms, old_pid);
- if (new_pid != old_pid) {
- erts_smp_atomic_set_nob(&bp->meta_pid->pid, new_pid);
+ if (!ERTS_TRACER_COMPARE(new_tracer, old_tracer)) {
+ if (old_tracer == erts_smp_atomic_cmpxchg_acqb(
+ &bp->meta_tracer->tracer,
+ (erts_aint_t)new_tracer,
+ (erts_aint_t)old_tracer)) {
+ ERTS_TRACER_CLEAR(&old_tracer);
+ } else {
+ ERTS_TRACER_CLEAR(&new_tracer);
+ }
}
}
@@ -642,9 +742,9 @@ erts_generic_breakpoint(Process* c_p, BeamInstr* I, Eterm* reg)
erts_smp_atomic_inc_nob(&bp->count->acount);
}
- if (bp_flags & ERTS_BPF_TIME_TRACE_ACTIVE && erts_is_tracer_proc_valid(c_p)) {
+ if (bp_flags & ERTS_BPF_TIME_TRACE_ACTIVE) {
Eterm w;
- erts_trace_time_call(c_p, I, bp->time);
+ erts_trace_time_call(c_p, info, bp->time);
w = (BeamInstr) *c_p->cp;
if (! (w == (BeamInstr) BeamOp(op_i_return_time_trace) ||
w == (BeamInstr) BeamOp(op_return_trace) ||
@@ -652,7 +752,7 @@ erts_generic_breakpoint(Process* c_p, BeamInstr* I, Eterm* reg)
Eterm* E = c_p->stop;
ASSERT(c_p->htop <= E && E <= c_p->hend);
if (E - 2 < c_p->htop) {
- (void) erts_garbage_collect(c_p, 2, reg, I[-1]);
+ (void) erts_garbage_collect(c_p, 2, reg, info->mfa.arity);
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
}
E = c_p->stop;
@@ -660,7 +760,7 @@ erts_generic_breakpoint(Process* c_p, BeamInstr* I, Eterm* reg)
ASSERT(c_p->htop <= E && E <= c_p->hend);
E -= 2;
- E[0] = make_cp(I);
+ E[0] = make_cp(erts_codeinfo_to_code(info));
E[1] = make_cp(c_p->cp); /* original return address */
c_p->cp = beam_return_time_trace;
c_p->stop = E;
@@ -687,18 +787,19 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I)
Eterm (*func)(Process*, Eterm*, BeamInstr*);
Export* ep = bif_export[bif_index];
Uint32 flags = 0, flags_meta = 0;
- Eterm meta_tracer_pid = NIL;
- int applying = (I == &(ep->code[3])); /* Yup, the apply code for a bif
- * is actually in the
- * export entry */
+ ErtsTracer meta_tracer = erts_tracer_nil;
+ int applying = (I == ep->beam); /* Yup, the apply code for a bif
+ * is actually in the
+ * export entry */
BeamInstr *cp = p->cp;
GenericBp* g;
GenericBpData* bp = NULL;
Uint bp_flags = 0;
+ int return_to_trace = 0;
ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p);
- g = (GenericBp *) ep->fake_op_func_info_for_hipe[1];
+ g = ep->info.u.gen_bp;
if (g) {
bp = &g->data[erts_active_bp_ix()];
bp_flags = bp->flags;
@@ -710,30 +811,39 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I)
*/
if (!applying) {
p->cp = I;
+ } else {
+ fixup_cp_before_trace(p, &return_to_trace);
}
if (bp_flags & (ERTS_BPF_LOCAL_TRACE|ERTS_BPF_GLOBAL_TRACE) &&
IS_TRACED_FL(p, F_TRACE_CALLS)) {
int local = !!(bp_flags & ERTS_BPF_LOCAL_TRACE);
- flags = erts_call_trace(p, ep->code, bp->local_ms, args,
- local, &ERTS_TRACER_PROC(p));
+ flags = erts_call_trace(p, &ep->info, bp->local_ms, args,
+ local, &ERTS_TRACER(p));
}
if (bp_flags & ERTS_BPF_META_TRACE) {
- Eterm tpid1, tpid2;
-
- tpid1 = tpid2 =
- (Eterm) erts_smp_atomic_read_nob(&bp->meta_pid->pid);
- flags_meta = erts_call_trace(p, ep->code, bp->meta_ms, args,
- 0, &tpid2);
- meta_tracer_pid = tpid2;
- if (tpid1 != tpid2) {
- erts_smp_atomic_set_nob(&bp->meta_pid->pid, tpid2);
+ ErtsTracer old_tracer;
+
+ meta_tracer = erts_smp_atomic_read_nob(&bp->meta_tracer->tracer);
+ old_tracer = meta_tracer;
+ flags_meta = erts_call_trace(p, &ep->info, bp->meta_ms, args,
+ 0, &meta_tracer);
+
+ if (!ERTS_TRACER_COMPARE(old_tracer, meta_tracer)) {
+ ErtsTracer new_tracer = erts_tracer_nil;
+ erts_tracer_update(&new_tracer, meta_tracer);
+ if (old_tracer == erts_smp_atomic_cmpxchg_acqb(
+ &bp->meta_tracer->tracer,
+ (erts_aint_t)new_tracer,
+ (erts_aint_t)old_tracer)) {
+ ERTS_TRACER_CLEAR(&old_tracer);
+ } else {
+ ERTS_TRACER_CLEAR(&new_tracer);
+ }
}
}
if (bp_flags & ERTS_BPF_TIME_TRACE_ACTIVE &&
- IS_TRACED_FL(p, F_TRACE_CALLS) &&
- erts_is_tracer_proc_valid(p)) {
- BeamInstr *pc = (BeamInstr *)ep->code+3;
- erts_trace_time_call(p, pc, bp->time);
+ IS_TRACED_FL(p, F_TRACE_CALLS)) {
+ erts_trace_time_call(p, &ep->info, bp->time);
}
/* Restore original continuation pointer (if changed). */
@@ -743,6 +853,30 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I)
result = func(p, args, I);
+ if (erts_nif_export_check_save_trace(p, result,
+ applying, ep,
+ cp, flags,
+ flags_meta, I,
+ meta_tracer)) {
+ /*
+ * erts_bif_trace_epilogue() will be called
+ * later when appropriate via the NIF export
+ * scheduling functionality...
+ */
+ return result;
+ }
+
+ return erts_bif_trace_epilogue(p, result, applying, ep, cp,
+ flags, flags_meta, I,
+ meta_tracer);
+}
+
+Eterm
+erts_bif_trace_epilogue(Process *p, Eterm result, int applying,
+ Export* ep, BeamInstr *cp, Uint32 flags,
+ Uint32 flags_meta, BeamInstr* I,
+ ErtsTracer meta_tracer)
+{
if (applying && (flags & MATCH_SET_RETURN_TO_TRACE)) {
BeamInstr i_return_trace = beam_return_trace[0];
BeamInstr i_return_to_trace = beam_return_to_trace[0];
@@ -775,8 +909,6 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I)
if (reason != TRAP) {
Eterm class;
Eterm value = p->fvalue;
- DeclareTmpHeapNoproc(nocatch,3);
- UseTmpHeapNoproc(3);
/* Expand error value like in handle_error() */
if (reason & EXF_ARGLIST) {
Eterm *tp;
@@ -785,7 +917,8 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I)
value = tp[1];
}
if ((reason & EXF_THROWN) && (p->catches <= 0)) {
- value = TUPLE2(nocatch, am_nocatch, value);
+ Eterm *hp = HAlloc(p, 3);
+ value = TUPLE2(hp, am_nocatch, value);
reason = EXC_ERROR;
}
/* Note: expand_error_value() could theoretically
@@ -797,12 +930,12 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I)
class = exception_tag[GET_EXC_CLASS(reason)];
if (flags_meta & MATCH_SET_EXCEPTION_TRACE) {
- erts_trace_exception(p, ep->code, class, value,
- &meta_tracer_pid);
+ erts_trace_exception(p, &ep->info.mfa, class, value,
+ &meta_tracer);
}
if (flags & MATCH_SET_EXCEPTION_TRACE) {
- erts_trace_exception(p, ep->code, class, value,
- &ERTS_TRACER_PROC(p));
+ erts_trace_exception(p, &ep->info.mfa, class, value,
+ &ERTS_TRACER(p));
}
if ((flags & MATCH_SET_RETURN_TO_TRACE) && p->catches > 0) {
/* can only happen if(local)*/
@@ -824,7 +957,6 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I)
}
}
}
- UnUseTmpHeapNoproc(3);
if ((flags_meta|flags) & MATCH_SET_EXCEPTION_TRACE) {
erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR);
ERTS_TRACE_FLAGS(p) |= F_EXCEPTION_TRACE;
@@ -833,13 +965,14 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I)
}
} else {
if (flags_meta & MATCH_SET_RX_TRACE) {
- erts_trace_return(p, ep->code, result, &meta_tracer_pid);
+ erts_trace_return(p, &ep->info.mfa, result, &meta_tracer);
}
/* MATCH_SET_RETURN_TO_TRACE cannot occur if(meta) */
if (flags & MATCH_SET_RX_TRACE) {
- erts_trace_return(p, ep->code, result, &ERTS_TRACER_PROC(p));
+ erts_trace_return(p, &ep->info.mfa, result, &ERTS_TRACER(p));
}
- if (flags & MATCH_SET_RETURN_TO_TRACE) {
+ if (flags & MATCH_SET_RETURN_TO_TRACE &&
+ IS_TRACED_FL(p, F_TRACE_RETURN_TO)) {
/* can only happen if(local)*/
if (applying) {
/* Apply of BIF, cp is in calling function */
@@ -854,65 +987,36 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I)
return result;
}
-static Eterm
-do_call_trace(Process* c_p, BeamInstr* I, Eterm* reg,
- int local, Binary* ms, Eterm tracer_pid)
+static ErtsTracer
+do_call_trace(Process* c_p, ErtsCodeInfo* info, Eterm* reg,
+ int local, Binary* ms, ErtsTracer tracer)
{
- 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;
- w = *c_p->cp;
- if (w == (BeamInstr) BeamOp(op_return_trace)) {
- cpp = &E[2];
- } else if (w == (BeamInstr) BeamOp(op_i_return_to_trace)) {
- return_to_trace = 1;
- cpp = &E[0];
- } else if (w == (BeamInstr) BeamOp(op_i_return_time_trace)) {
- cpp = &E[0];
- } else {
- cpp = NULL;
- }
- if (cpp) {
- for (;;) {
- BeamInstr w = *cp_val(*cpp);
- if (w == (BeamInstr) BeamOp(op_return_trace)) {
- cpp += 3;
- } else if (w == (BeamInstr) BeamOp(op_i_return_to_trace)) {
- return_to_trace = 1;
- cpp += 1;
- } else if (w == (BeamInstr) BeamOp(op_i_return_time_trace)) {
- cpp += 2;
- } else {
- break;
- }
- }
- cp_save = c_p->cp;
- c_p->cp = (BeamInstr *) cp_val(*cpp);
- ASSERT(is_CP(*cpp));
- }
+ fixup_cp_before_trace(c_p, &return_to_trace);
+
ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
- flags = erts_call_trace(c_p, I-3, ms, reg, local, &tracer_pid);
+ flags = erts_call_trace(c_p, info, ms, reg, local, &tracer);
ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
- if (cpp) {
- c_p->cp = cp_save;
- }
+
+ /* restore cp after potential fixup */
+ c_p->cp = cp_save;
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
if ((flags & MATCH_SET_RETURN_TO_TRACE) && !return_to_trace) {
need += 1;
}
if (flags & MATCH_SET_RX_TRACE) {
- need += 3;
+ need += 3 + size_object(tracer);
}
if (need) {
ASSERT(c_p->htop <= E && E <= c_p->hend);
if (E - need < c_p->htop) {
- (void) erts_garbage_collect(c_p, need, reg, I[-1]);
+ (void) erts_garbage_collect(c_p, need, reg, info->mfa.arity);
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
E = c_p->stop;
}
@@ -923,44 +1027,47 @@ do_call_trace(Process* c_p, BeamInstr* I, Eterm* reg,
E[0] = make_cp(c_p->cp);
c_p->cp = beam_return_to_trace;
}
- if (flags & MATCH_SET_RX_TRACE) {
+ if (flags & MATCH_SET_RX_TRACE)
+ {
E -= 3;
+ c_p->stop = E;
ASSERT(c_p->htop <= E && E <= c_p->hend);
- ASSERT(is_CP((Eterm) (UWord) (I - 3)));
- ASSERT(am_true == tracer_pid ||
- is_internal_pid(tracer_pid) || is_internal_port(tracer_pid));
+ ASSERT(is_CP((Eterm) (UWord) (&info->mfa.module)));
+ ASSERT(IS_TRACER_VALID(tracer));
E[2] = make_cp(c_p->cp);
- E[1] = tracer_pid;
- E[0] = make_cp(I - 3); /* We ARE at the beginning of an
- instruction,
+ E[1] = copy_object(tracer, c_p);
+ E[0] = make_cp(&info->mfa.module);
+ /* We ARE at the beginning of an instruction,
the funcinfo is above i. */
c_p->cp = (flags & MATCH_SET_EXCEPTION_TRACE) ?
beam_exception_trace : beam_return_trace;
erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
ERTS_TRACE_FLAGS(c_p) |= F_EXCEPTION_TRACE;
erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
- }
- c_p->stop = E;
- return tracer_pid;
+ } else
+ c_p->stop = E;
+ return tracer;
}
void
-erts_trace_time_call(Process* c_p, BeamInstr* I, BpDataTime* bdt)
+erts_trace_time_call(Process* c_p, ErtsCodeInfo *info, 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;
BpDataTime *pbdt = NULL;
+ Uint32 six = acquire_bp_sched_ix(c_p);
ASSERT(c_p);
- ASSERT(erts_smp_atomic32_read_acqb(&c_p->state) & ERTS_PSFLG_RUNNING);
+ ASSERT(erts_smp_atomic32_read_acqb(&c_p->state) & (ERTS_PSFLG_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING));
/* get previous timestamp and breakpoint
* 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
@@ -971,20 +1078,20 @@ erts_trace_time_call(Process* c_p, BeamInstr* I, BpDataTime* bdt)
if (pbt == 0) {
/* First call of process to instrumented function */
pbt = Alloc(sizeof(process_breakpoint_time_t));
- (void) ERTS_PROC_SET_CALL_TIME(c_p, ERTS_PROC_LOCK_MAIN, pbt);
+ (void) ERTS_PROC_SET_CALL_TIME(c_p, pbt);
} else {
- ASSERT(pbt->pc);
+ ASSERT(pbt->ci);
/* 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;
/* previous breakpoint */
- pbdt = get_time_break(pbt->pc);
+ pbdt = get_time_break(pbt->ci);
/* if null then the breakpoint was removed */
if (pbdt) {
- h = &(pbdt->hash[bp_sched2ix_proc(c_p)]);
+ h = &(pbdt->hash[six]);
ASSERT(h);
ASSERT(h->item);
@@ -1001,12 +1108,11 @@ 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);
- h = &(bdt->hash[bp_sched2ix_proc(c_p)]);
+ h = &(bdt->hash[six]);
ASSERT(h);
ASSERT(h->item);
@@ -1018,29 +1124,31 @@ erts_trace_time_call(Process* c_p, BeamInstr* I, BpDataTime* bdt)
BP_TIME_ADD(item, &sitem);
}
- pbt->pc = I;
- pbt->ms = ms;
- pbt->s = s;
- pbt->us = us;
+ pbt->ci = info;
+ pbt->time = time;
+
+ release_bp_sched_ix(six);
}
void
-erts_trace_time_return(Process *p, BeamInstr *pc)
+erts_trace_time_return(Process *p, ErtsCodeInfo *ci)
{
- 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;
BpDataTime *pbdt = NULL;
+ Uint32 six = acquire_bp_sched_ix(p);
ASSERT(p);
- ASSERT(erts_smp_atomic32_read_acqb(&p->state) & ERTS_PSFLG_RUNNING);
+ ASSERT(erts_smp_atomic32_read_acqb(&p->state) & (ERTS_PSFLG_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING));
/* get previous timestamp and breakpoint
* 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
@@ -1051,21 +1159,23 @@ erts_trace_time_return(Process *p, BeamInstr *pc)
*/
if (pbt) {
+
/* might have been removed due to
* trace_pattern(false)
*/
- ASSERT(pbt->pc);
+ ASSERT(pbt->ci);
- bp_time_diff(&sitem, pbt, ms, s, us);
+ sitem.time = time - pbt->time;
sitem.pid = p->common.id;
sitem.count = 0;
/* previous breakpoint */
- pbdt = get_time_break(pbt->pc);
+ pbdt = get_time_break(pbt->ci);
/* beware, the trace_pattern might have been removed */
if (pbdt) {
- h = &(pbdt->hash[bp_sched2ix_proc(p)]);
+
+ h = &(pbdt->hash[six]);
ASSERT(h);
ASSERT(h->item);
@@ -1076,20 +1186,22 @@ erts_trace_time_return(Process *p, BeamInstr *pc)
} else {
BP_TIME_ADD(item, &sitem);
}
+
}
- pbt->pc = pc;
- pbt->ms = ms;
- pbt->s = s;
- pbt->us = us;
+ pbt->ci = ci;
+ pbt->time = time;
+
}
+
+ release_bp_sched_ix(six);
}
int
-erts_is_trace_break(BeamInstr *pc, Binary **match_spec_ret, int local)
+erts_is_trace_break(ErtsCodeInfo *ci, Binary **match_spec_ret, int local)
{
Uint flags = local ? ERTS_BPF_LOCAL_TRACE : ERTS_BPF_GLOBAL_TRACE;
- GenericBpData* bp = check_break(pc, flags);
+ GenericBpData* bp = check_break(ci, flags);
if (bp) {
if (match_spec_ret) {
@@ -1100,40 +1212,28 @@ erts_is_trace_break(BeamInstr *pc, Binary **match_spec_ret, int local)
return 0;
}
-int
-erts_is_mtrace_break(BeamInstr *pc, Binary **match_spec_ret,
- Eterm *tracer_pid_ret)
+int
+erts_is_mtrace_break(ErtsCodeInfo *ci, Binary **match_spec_ret,
+ ErtsTracer *tracer_ret)
{
- GenericBpData* bp = check_break(pc, ERTS_BPF_META_TRACE);
+ GenericBpData* bp = check_break(ci, ERTS_BPF_META_TRACE);
if (bp) {
if (match_spec_ret) {
*match_spec_ret = bp->meta_ms;
}
- if (tracer_pid_ret) {
- *tracer_pid_ret =
- (Eterm) erts_smp_atomic_read_nob(&bp->meta_pid->pid);
+ if (tracer_ret) {
+ *tracer_ret = erts_smp_atomic_read_nob(&bp->meta_tracer->tracer);
}
return 1;
}
return 0;
}
-int
-erts_is_native_break(BeamInstr *pc) {
-#ifdef HIPE
- ASSERT(pc[-5] == (BeamInstr) BeamOp(op_i_func_info_IaaI));
- return pc[0] == (BeamInstr) BeamOp(op_hipe_trap_call)
- || pc[0] == (BeamInstr) BeamOp(op_hipe_trap_call_closure);
-#else
- return 0;
-#endif
-}
-
int
-erts_is_count_break(BeamInstr *pc, Uint *count_ret)
+erts_is_count_break(ErtsCodeInfo *ci, Uint *count_ret)
{
- GenericBpData* bp = check_break(pc, ERTS_BPF_COUNT);
+ GenericBpData* bp = check_break(ci, ERTS_BPF_COUNT);
if (bp) {
if (count_ret) {
@@ -1144,13 +1244,13 @@ erts_is_count_break(BeamInstr *pc, Uint *count_ret)
return 0;
}
-int erts_is_time_break(Process *p, BeamInstr *pc, Eterm *retval) {
+int erts_is_time_break(Process *p, ErtsCodeInfo *ci, Eterm *retval) {
Uint i, ix;
bp_time_hash_t hash;
Uint size;
Eterm *hp, t;
bp_data_time_item_t *item = NULL;
- BpDataTime *bdt = get_time_break(pc);
+ BpDataTime *bdt = get_time_break(ci);
if (bdt) {
if (retval) {
@@ -1182,10 +1282,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;
}
@@ -1200,26 +1304,25 @@ int erts_is_time_break(Process *p, BeamInstr *pc, Eterm *retval) {
}
-BeamInstr *
-erts_find_local_func(Eterm mfa[3]) {
+ErtsCodeInfo *
+erts_find_local_func(ErtsCodeMFA *mfa) {
Module *modp;
- BeamInstr** code_base;
- BeamInstr* code_ptr;
+ BeamCodeHeader* code_hdr;
+ ErtsCodeInfo* ci;
Uint i,n;
- if ((modp = erts_get_module(mfa[0], erts_active_code_ix())) == NULL)
+ if ((modp = erts_get_module(mfa->module, 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];
- ASSERT(((BeamInstr) BeamOp(op_i_func_info_IaaI)) == code_ptr[0]);
- ASSERT(mfa[0] == ((Eterm) code_ptr[2]) ||
- is_nil((Eterm) code_ptr[2]));
- if (mfa[1] == ((Eterm) code_ptr[3]) &&
- ((BeamInstr) mfa[2]) == code_ptr[4]) {
- return code_ptr + 5;
+ ci = code_hdr->functions[i];
+ ASSERT(((BeamInstr) BeamOp(op_i_func_info_IaaI)) == ci->op);
+ ASSERT(mfa->module == ci->mfa.module || is_nil(ci->mfa.module));
+ if (mfa->function == ci->mfa.function &&
+ mfa->arity == ci->mfa.arity) {
+ return ci;
}
}
return NULL;
@@ -1265,8 +1368,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;
}
}
@@ -1314,8 +1416,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++;
@@ -1329,45 +1430,12 @@ 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;
BpDataTime *pbdt = NULL;
+ Uint32 six = acquire_bp_sched_ix(p);
ASSERT(p);
@@ -1384,14 +1452,13 @@ void erts_schedule_time_break(Process *p, Uint schedule) {
* the previous breakpoint.
*/
- pbdt = get_time_break(pbt->pc);
+ pbdt = get_time_break(pbt->ci);
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;
- h = &(pbdt->hash[bp_sched2ix_proc(p)]);
+ h = &(pbdt->hash[six]);
ASSERT(h);
ASSERT(h->item);
@@ -1409,10 +1476,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);
@@ -1420,6 +1484,8 @@ void erts_schedule_time_break(Process *p, Uint schedule) {
break;
}
} /* pbt */
+
+ release_bp_sched_ix(six);
}
/* *************************************************************************
@@ -1429,22 +1495,22 @@ void erts_schedule_time_break(Process *p, Uint schedule) {
static void
set_break(BpFunctions* f, Binary *match_spec, Uint break_flags,
- enum erts_break_op count_op, Eterm tracer_pid)
+ enum erts_break_op count_op, ErtsTracer tracer)
{
Uint i;
Uint n;
n = f->matched;
for (i = 0; i < n; i++) {
- BeamInstr* pc = f->matching[i].pc;
- set_function_break(pc, match_spec, break_flags,
- count_op, tracer_pid);
+ set_function_break(f->matching[i].ci,
+ match_spec, break_flags,
+ count_op, tracer);
}
}
static void
-set_function_break(BeamInstr *pc, Binary *match_spec, Uint break_flags,
- enum erts_break_op count_op, Eterm tracer_pid)
+set_function_break(ErtsCodeInfo *ci, Binary *match_spec, Uint break_flags,
+ enum erts_break_op count_op, ErtsTracer tracer)
{
GenericBp* g;
GenericBpData* bp;
@@ -1452,19 +1518,19 @@ set_function_break(BeamInstr *pc, Binary *match_spec, Uint break_flags,
ErtsBpIndex ix = erts_staging_bp_ix();
ERTS_SMP_LC_ASSERT(erts_has_code_write_permission());
- g = (GenericBp *) pc[-4];
+ g = ci->u.gen_bp;
if (g == 0) {
int i;
- if (count_op == erts_break_reset || count_op == erts_break_stop) {
+ if (count_op == ERTS_BREAK_RESTART || count_op == ERTS_BREAK_PAUSE) {
/* Do not insert a new breakpoint */
return;
}
g = Alloc(sizeof(GenericBp));
- g->orig_instr = *pc;
+ g->orig_instr = *erts_codeinfo_to_code(ci);
for (i = 0; i < ERTS_NUM_BP_IX; i++) {
g->data[i].flags = 0;
}
- pc[-4] = (BeamInstr) g;
+ ci->u.gen_bp = g;
}
bp = &g->data[ix];
@@ -1477,9 +1543,9 @@ set_function_break(BeamInstr *pc, Binary *match_spec, Uint break_flags,
MatchSetUnref(bp->local_ms);
} else if (common & ERTS_BPF_META_TRACE) {
MatchSetUnref(bp->meta_ms);
- bp_meta_unref(bp->meta_pid);
+ bp_meta_unref(bp->meta_tracer);
} else if (common & ERTS_BPF_COUNT) {
- if (count_op == erts_break_stop) {
+ if (count_op == ERTS_BREAK_PAUSE) {
bp->flags &= ~ERTS_BPF_COUNT_ACTIVE;
} else {
bp->flags |= ERTS_BPF_COUNT_ACTIVE;
@@ -1491,7 +1557,7 @@ set_function_break(BeamInstr *pc, Binary *match_spec, Uint break_flags,
BpDataTime* bdt = bp->time;
Uint i = 0;
- if (count_op == erts_break_stop) {
+ if (count_op == ERTS_BREAK_PAUSE) {
bp->flags &= ~ERTS_BPF_TIME_TRACE_ACTIVE;
} else {
bp->flags |= ERTS_BPF_TIME_TRACE_ACTIVE;
@@ -1512,19 +1578,21 @@ set_function_break(BeamInstr *pc, Binary *match_spec, Uint break_flags,
MatchSetRef(match_spec);
bp->local_ms = match_spec;
} else if (break_flags & ERTS_BPF_META_TRACE) {
- BpMetaPid* bmp;
+ BpMetaTracer* bmt;
+ ErtsTracer meta_tracer = erts_tracer_nil;
MatchSetRef(match_spec);
bp->meta_ms = match_spec;
- bmp = Alloc(sizeof(BpMetaPid));
- erts_refc_init(&bmp->refc, 1);
- erts_smp_atomic_init_nob(&bmp->pid, tracer_pid);
- bp->meta_pid = bmp;
+ bmt = Alloc(sizeof(BpMetaTracer));
+ erts_smp_refc_init(&bmt->refc, 1);
+ erts_tracer_update(&meta_tracer, tracer); /* copy tracer */
+ erts_smp_atomic_init_nob(&bmt->tracer, (erts_aint_t)meta_tracer);
+ bp->meta_tracer = bmt;
} else if (break_flags & ERTS_BPF_COUNT) {
BpCount* bcp;
ASSERT((bp->flags & ERTS_BPF_COUNT) == 0);
bcp = Alloc(sizeof(BpCount));
- erts_refc_init(&bcp->refc, 1);
+ erts_smp_refc_init(&bcp->refc, 1);
erts_smp_atomic_init_nob(&bcp->acount, 0);
bp->count = bcp;
} else if (break_flags & ERTS_BPF_TIME_TRACE) {
@@ -1533,8 +1601,12 @@ set_function_break(BeamInstr *pc, Binary *match_spec, Uint break_flags,
ASSERT((bp->flags & ERTS_BPF_TIME_TRACE) == 0);
bdt = Alloc(sizeof(BpDataTime));
- erts_refc_init(&bdt->refc, 1);
+ erts_smp_refc_init(&bdt->refc, 1);
+#ifdef ERTS_DIRTY_SCHEDULERS
+ bdt->n = erts_no_schedulers + 1;
+#else
bdt->n = erts_no_schedulers;
+#endif
bdt->hash = Alloc(sizeof(bp_time_hash_t)*(bdt->n));
for (i = 0; i < bdt->n; i++) {
bp_hash_init(&(bdt->hash[i]), 32);
@@ -1554,13 +1626,12 @@ clear_break(BpFunctions* f, Uint break_flags)
n = f->matched;
for (i = 0; i < n; i++) {
- BeamInstr* pc = f->matching[i].pc;
- clear_function_break(pc, break_flags);
+ clear_function_break(f->matching[i].ci, break_flags);
}
}
static int
-clear_function_break(BeamInstr *pc, Uint break_flags)
+clear_function_break(ErtsCodeInfo *ci, Uint break_flags)
{
GenericBp* g;
GenericBpData* bp;
@@ -1569,7 +1640,7 @@ clear_function_break(BeamInstr *pc, Uint break_flags)
ERTS_SMP_LC_ASSERT(erts_has_code_write_permission());
- if ((g = (GenericBp *) pc[-4]) == 0) {
+ if ((g = ci->u.gen_bp) == NULL) {
return 1;
}
@@ -1582,7 +1653,7 @@ clear_function_break(BeamInstr *pc, Uint break_flags)
}
if (common & ERTS_BPF_META_TRACE) {
MatchSetUnref(bp->meta_ms);
- bp_meta_unref(bp->meta_pid);
+ bp_meta_unref(bp->meta_tracer);
}
if (common & ERTS_BPF_COUNT) {
ASSERT((bp->flags & ERTS_BPF_COUNT_ACTIVE) == 0);
@@ -1598,17 +1669,19 @@ clear_function_break(BeamInstr *pc, Uint break_flags)
}
static void
-bp_meta_unref(BpMetaPid* bmp)
+bp_meta_unref(BpMetaTracer* bmt)
{
- if (erts_refc_dectest(&bmp->refc, 0) <= 0) {
- Free(bmp);
+ if (erts_smp_refc_dectest(&bmt->refc, 0) <= 0) {
+ ErtsTracer trc = erts_smp_atomic_read_nob(&bmt->tracer);
+ ERTS_TRACER_CLEAR(&trc);
+ Free(bmt);
}
}
static void
bp_count_unref(BpCount* bcp)
{
- if (erts_refc_dectest(&bcp->refc, 0) <= 0) {
+ if (erts_smp_refc_dectest(&bcp->refc, 0) <= 0) {
Free(bcp);
}
}
@@ -1616,7 +1689,7 @@ bp_count_unref(BpCount* bcp)
static void
bp_time_unref(BpDataTime* bdt)
{
- if (erts_refc_dectest(&bdt->refc, 0) <= 0) {
+ if (erts_smp_refc_dectest(&bdt->refc, 0) <= 0) {
Uint i = 0;
Uint j = 0;
Process *h_p = NULL;
@@ -1636,9 +1709,7 @@ bp_time_unref(BpDataTime* bdt)
h_p = erts_pid2proc(NULL, 0, item->pid,
ERTS_PROC_LOCK_MAIN);
if (h_p) {
- pbt = ERTS_PROC_SET_CALL_TIME(h_p,
- ERTS_PROC_LOCK_MAIN,
- NULL);
+ pbt = ERTS_PROC_SET_CALL_TIME(h_p, NULL);
if (pbt) {
Free(pbt);
}
@@ -1655,19 +1726,19 @@ bp_time_unref(BpDataTime* bdt)
}
static BpDataTime*
-get_time_break(BeamInstr *pc)
+get_time_break(ErtsCodeInfo *ci)
{
- GenericBpData* bp = check_break(pc, ERTS_BPF_TIME_TRACE);
+ GenericBpData* bp = check_break(ci, ERTS_BPF_TIME_TRACE);
return bp ? bp->time : 0;
}
static GenericBpData*
-check_break(BeamInstr *pc, Uint break_flags)
+check_break(ErtsCodeInfo *ci, Uint break_flags)
{
- GenericBp* g = (GenericBp *) pc[-4];
+ GenericBp* g = ci->u.gen_bp;
- ASSERT(pc[-5] == (BeamInstr) BeamOp(op_i_func_info_IaaI));
- if (erts_is_native_break(pc)) {
+ ASSERT(ci->op == (BeamInstr) BeamOp(op_i_func_info_IaaI));
+ if (erts_is_function_native(ci)) {
return 0;
}
if (g) {
diff --git a/erts/emulator/beam/beam_bp.h b/erts/emulator/beam/beam_bp.h
index b061401863..56fa82b912 100644
--- a/erts/emulator/beam/beam_bp.h
+++ b/erts/emulator/beam/beam_bp.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2000-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2000-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -28,8 +29,7 @@
typedef struct {
Eterm pid;
Sint count;
- Uint s_time;
- Uint us_time;
+ ErtsMonotonicTime time;
} bp_data_time_item_t;
typedef struct {
@@ -41,31 +41,29 @@ typedef struct {
typedef struct bp_data_time { /* Call time */
Uint n;
bp_time_hash_t *hash;
- erts_refc_t refc;
+ erts_smp_refc_t refc;
} BpDataTime;
typedef struct {
- Uint ms;
- Uint s;
- Uint us;
- BeamInstr *pc;
+ ErtsMonotonicTime time;
+ ErtsCodeInfo *ci;
} process_breakpoint_time_t; /* used within psd */
typedef struct {
erts_smp_atomic_t acount;
- erts_refc_t refc;
+ erts_smp_refc_t refc;
} BpCount;
typedef struct {
- erts_smp_atomic_t pid;
- erts_refc_t refc;
-} BpMetaPid;
+ erts_smp_atomic_t tracer;
+ erts_smp_refc_t refc;
+} BpMetaTracer;
typedef struct generic_bp_data {
Uint flags;
Binary* local_ms; /* Match spec for local call trace */
Binary* meta_ms; /* Match spec for meta trace */
- BpMetaPid* meta_pid; /* Meta trace pid */
+ BpMetaTracer* meta_tracer; /* Meta tracer */
BpCount* count; /* For call count */
BpDataTime* time; /* For time trace */
} GenericBpData;
@@ -81,23 +79,21 @@ typedef struct generic_bp {
#define ERTS_BP_CALL_TIME_SCHEDULE_OUT (1)
#define ERTS_BP_CALL_TIME_SCHEDULE_EXITING (2)
-#ifdef ERTS_SMP
-#define bp_sched2ix_proc(p) ((p)->scheduler_data->no - 1)
-#else
-#define bp_sched2ix_proc(p) (0)
+#ifdef ERTS_DIRTY_SCHEDULERS
+extern erts_smp_mtx_t erts_dirty_bp_ix_mtx;
#endif
enum erts_break_op{
- erts_break_nop = 0, /* Must be false */
- erts_break_set = !0, /* Must be true */
- erts_break_reset,
- erts_break_stop
+ ERTS_BREAK_NOP = 0, /* Must be false */
+ ERTS_BREAK_SET = !0, /* Must be true */
+ ERTS_BREAK_RESTART,
+ ERTS_BREAK_PAUSE
};
typedef Uint32 ErtsBpIndex;
typedef struct {
- BeamInstr* pc;
+ ErtsCodeInfo *ci;
Module* mod;
} BpFunction;
@@ -118,8 +114,8 @@ void erts_commit_staged_bp(void);
ERTS_GLB_INLINE ErtsBpIndex erts_active_bp_ix(void);
ERTS_GLB_INLINE ErtsBpIndex erts_staging_bp_ix(void);
-void erts_bp_match_functions(BpFunctions* f, Eterm mfa[3], int specified);
-void erts_bp_match_export(BpFunctions* f, Eterm mfa[3], int specified);
+void erts_bp_match_functions(BpFunctions* f, ErtsCodeMFA *mfa, int specified);
+void erts_bp_match_export(BpFunctions* f, ErtsCodeMFA *mfa, int specified);
void erts_bp_free_matched_functions(BpFunctions* f);
void erts_install_breakpoints(BpFunctions* f);
@@ -130,15 +126,15 @@ void erts_consolidate_bif_bp_data(void);
void erts_set_trace_break(BpFunctions *f, Binary *match_spec);
void erts_clear_trace_break(BpFunctions *f);
-void erts_set_call_trace_bif(BeamInstr *pc, Binary *match_spec, int local);
-void erts_clear_call_trace_bif(BeamInstr *pc, int local);
+void erts_set_call_trace_bif(ErtsCodeInfo *ci, Binary *match_spec, int local);
+void erts_clear_call_trace_bif(ErtsCodeInfo *ci, int local);
void erts_set_mtrace_break(BpFunctions *f, Binary *match_spec,
- Eterm tracer_pid);
+ ErtsTracer tracer);
void erts_clear_mtrace_break(BpFunctions *f);
-void erts_set_mtrace_bif(BeamInstr *pc, Binary *match_spec,
- Eterm tracer_pid);
-void erts_clear_mtrace_bif(BeamInstr *pc);
+void erts_set_mtrace_bif(ErtsCodeInfo *ci, Binary *match_spec,
+ ErtsTracer tracer);
+void erts_clear_mtrace_bif(ErtsCodeInfo *ci);
void erts_set_debug_break(BpFunctions *f);
void erts_clear_debug_break(BpFunctions *f);
@@ -148,46 +144,34 @@ void erts_clear_count_break(BpFunctions *f);
void erts_clear_all_breaks(BpFunctions* f);
int erts_clear_module_break(Module *modp);
-void erts_clear_export_break(Module *modp, BeamInstr* pc);
-
-BeamInstr erts_generic_breakpoint(Process* c_p, BeamInstr* I, Eterm* reg);
-BeamInstr erts_trace_break(Process *p, BeamInstr *pc, Eterm *args,
- Uint32 *ret_flags, Eterm *tracer_pid);
-
-int erts_is_trace_break(BeamInstr *pc, Binary **match_spec_ret, int local);
-int erts_is_mtrace_break(BeamInstr *pc, Binary **match_spec_ret,
- Eterm *tracer_pid_rte);
-int erts_is_mtrace_bif(BeamInstr *pc, Binary **match_spec_ret,
- Eterm *tracer_pid_ret);
-int erts_is_native_break(BeamInstr *pc);
-int erts_is_count_break(BeamInstr *pc, Uint *count_ret);
-int erts_is_time_break(Process *p, BeamInstr *pc, Eterm *call_time);
-
-void erts_trace_time_call(Process* c_p, BeamInstr* pc, BpDataTime* bdt);
-void erts_trace_time_return(Process* c_p, BeamInstr* pc);
+void erts_clear_export_break(Module *modp, ErtsCodeInfo* ci);
+
+BeamInstr erts_generic_breakpoint(Process* c_p, ErtsCodeInfo *ci, Eterm* reg);
+BeamInstr erts_trace_break(Process *p, ErtsCodeInfo *ci, Eterm *args,
+ Uint32 *ret_flags, ErtsTracer *tracer);
+
+int erts_is_trace_break(ErtsCodeInfo *ci, Binary **match_spec_ret, int local);
+int erts_is_mtrace_break(ErtsCodeInfo *ci, Binary **match_spec_ret,
+ ErtsTracer *tracer_ret);
+int erts_is_mtrace_bif(ErtsCodeInfo *ci, Binary **match_spec_ret,
+ ErtsTracer *tracer_ret);
+int erts_is_native_break(ErtsCodeInfo *ci);
+int erts_is_count_break(ErtsCodeInfo *ci, Uint *count_ret);
+int erts_is_time_break(Process *p, ErtsCodeInfo *ci, Eterm *call_time);
+
+void erts_trace_time_call(Process* c_p, ErtsCodeInfo *ci, BpDataTime* bdt);
+void erts_trace_time_return(Process* c_p, ErtsCodeInfo *ci);
void erts_schedule_time_break(Process *p, Uint out);
void erts_set_time_break(BpFunctions *f, enum erts_break_op);
void erts_clear_time_break(BpFunctions *f);
-int erts_is_time_trace_bif(Process *p, BeamInstr *pc, Eterm *call_time);
-void erts_set_time_trace_bif(BeamInstr *pc, enum erts_break_op);
-void erts_clear_time_trace_bif(BeamInstr *pc);
-
-BeamInstr *erts_find_local_func(Eterm mfa[3]);
+int erts_is_time_trace_bif(Process *p, ErtsCodeInfo *ci, Eterm *call_time);
+void erts_set_time_trace_bif(ErtsCodeInfo *ci, enum erts_break_op);
+void erts_clear_time_trace_bif(ErtsCodeInfo *ci);
-ERTS_GLB_INLINE Uint erts_bp_sched2ix(void);
+ErtsCodeInfo *erts_find_local_func(ErtsCodeMFA *mfa);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
-ERTS_GLB_INLINE Uint erts_bp_sched2ix(void)
-{
-#ifdef ERTS_SMP
- ErtsSchedulerData *esdp;
- esdp = erts_get_scheduler_data();
- return esdp->no - 1;
-#else
- return 0;
-#endif
-}
extern erts_smp_atomic32_t erts_active_bp_index;
extern erts_smp_atomic32_t erts_staging_bp_index;
diff --git a/erts/emulator/beam/beam_catches.c b/erts/emulator/beam/beam_catches.c
index d374d0469e..cd592c7e5e 100644
--- a/erts/emulator/beam/beam_catches.c
+++ b/erts/emulator/beam/beam_catches.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2000-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2000-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -142,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;
}
@@ -156,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_catches.h b/erts/emulator/beam/beam_catches.h
index 51ef463b2f..8eb2165ac9 100644
--- a/erts/emulator/beam/beam_catches.h
+++ b/erts/emulator/beam/beam_catches.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2000-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2000-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c
index a3cd08834f..a2060c80de 100644
--- a/erts/emulator/beam/beam_debug.c
+++ b/erts/emulator/beam/beam_debug.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1998-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1998-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -38,6 +39,7 @@
#include "beam_bp.h"
#include "erl_binary.h"
#include "erl_thr_progress.h"
+#include "erl_nfunc_sched.h"
#ifdef ARCH_64
# define HEXF "%016bpX"
@@ -49,7 +51,8 @@
void dbg_bt(Process* p, Eterm* sp);
void dbg_where(BeamInstr* addr, Eterm x0, Eterm* reg);
-static int print_op(int to, void *to_arg, int op, int size, BeamInstr* addr);
+static int print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr);
+static void print_bif_name(fmtfn_t to, void* to_arg, BifFunction bif);
BIF_RETTYPE
erts_debug_same_2(BIF_ALIST_2)
@@ -72,21 +75,55 @@ 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)
{
Process* p = BIF_P;
Eterm MFA = BIF_ARG_1;
- Eterm bool = BIF_ARG_2;
+ Eterm boolean = BIF_ARG_2;
Eterm* tp;
- Eterm mfa[3];
+ ErtsCodeMFA mfa;
int i;
int specified = 0;
Eterm res;
BpFunctions f;
- if (bool != am_true && bool != am_false)
+ if (boolean != am_true && boolean != am_false)
goto error;
if (is_not_tuple(MFA)) {
@@ -96,23 +133,24 @@ erts_debug_breakpoint_2(BIF_ALIST_2)
if (*tp != make_arityval(3)) {
goto error;
}
- mfa[0] = tp[1];
- mfa[1] = tp[2];
- mfa[2] = tp[3];
- if (!is_atom(mfa[0]) || !is_atom(mfa[1]) ||
- (!is_small(mfa[2]) && mfa[2] != am_Underscore)) {
+ if (!is_atom(tp[1]) || !is_atom(tp[2]) ||
+ (!is_small(tp[3]) && tp[3] != am_Underscore)) {
goto error;
}
- for (i = 0; i < 3 && mfa[i] != am_Underscore; i++, specified++) {
+ for (i = 0; i < 3 && tp[i+1] != am_Underscore; i++, specified++) {
/* Empty loop body */
}
for (i = specified; i < 3; i++) {
- if (mfa[i] != am_Underscore) {
+ if (tp[i+1] != am_Underscore) {
goto error;
}
}
- if (is_small(mfa[2])) {
- mfa[2] = signed_val(mfa[2]);
+
+ mfa.module = tp[1];
+ mfa.function = tp[2];
+
+ if (is_small(tp[3])) {
+ mfa.arity = signed_val(tp[3]);
}
if (!erts_try_seize_code_write_permission(BIF_P)) {
@@ -122,8 +160,8 @@ erts_debug_breakpoint_2(BIF_ALIST_2)
erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN);
erts_smp_thr_progress_block();
- erts_bp_match_functions(&f, mfa, specified);
- if (bool == am_true) {
+ erts_bp_match_functions(&f, &mfa, specified);
+ if (boolean == am_true) {
erts_set_debug_break(&f);
erts_install_breakpoints(&f);
erts_commit_staged_bp();
@@ -206,9 +244,9 @@ erts_debug_disassemble_1(BIF_ALIST_1)
Eterm* tp;
Eterm bin;
Eterm mfa;
- BeamInstr* funcinfo = NULL; /* Initialized to eliminate warning. */
- BeamInstr* code_base;
- BeamInstr* code_ptr = NULL; /* Initialized to eliminate warning. */
+ ErtsCodeMFA *cmfa = NULL;
+ BeamCodeHeader* code_hdr;
+ BeamInstr *code_ptr;
BeamInstr instr;
BeamInstr uaddr;
Uint hsz;
@@ -216,7 +254,7 @@ erts_debug_disassemble_1(BIF_ALIST_1)
if (term_to_UWord(addr, &uaddr)) {
code_ptr = (BeamInstr *) uaddr;
- if ((funcinfo = find_function_from_pc(code_ptr)) == NULL) {
+ if ((cmfa = find_function_from_pc(code_ptr)) == NULL) {
BIF_RET(am_false);
}
} else if (is_tuple(addr)) {
@@ -247,24 +285,22 @@ erts_debug_disassemble_1(BIF_ALIST_1)
* such as erts_debug:apply/4. Then search for it in the module.
*/
if ((ep = erts_find_function(mod, name, arity, code_ix)) != NULL) {
- /* XXX: add "&& ep->address != ep->code+3" condition?
+ /* XXX: add "&& ep->address != ep->code" condition?
* Consider a traced function.
- * Its ep will have ep->address == ep->code+3.
+ * Its ep will have ep->address == ep->code.
* erts_find_function() will return the non-NULL ep.
* Below we'll try to derive a code_ptr from ep->address.
* But this code_ptr will point to the start of the Export,
* not the function's func_info instruction. BOOM !?
*/
- code_ptr = ((BeamInstr *) ep->addressv[code_ix]) - 5;
- funcinfo = code_ptr+2;
- } else if (modp == NULL || (code_base = modp->curr.code) == NULL) {
+ cmfa = erts_code_to_codemfa(ep->addressv[code_ix]);
+ } 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];
- if (code_ptr[3] == name && code_ptr[4] == arity) {
- funcinfo = code_ptr+2;
+ cmfa = &code_hdr->functions[i]->mfa;
+ if (cmfa->function == name && cmfa->arity == arity) {
break;
}
}
@@ -272,6 +308,7 @@ erts_debug_disassemble_1(BIF_ALIST_1)
BIF_RET(am_undef);
}
}
+ code_ptr = (BeamInstr*)erts_code_to_codeinfo(erts_codemfa_to_code(cmfa));
} else {
goto error;
}
@@ -297,9 +334,10 @@ erts_debug_disassemble_1(BIF_ALIST_1)
(void) erts_bld_uword(NULL, &hsz, (BeamInstr) code_ptr);
hp = HAlloc(p, hsz);
addr = erts_bld_uword(&hp, NULL, (BeamInstr) code_ptr);
- ASSERT(is_atom(funcinfo[0]));
- ASSERT(is_atom(funcinfo[1]));
- mfa = TUPLE3(hp, (Eterm) funcinfo[0], (Eterm) funcinfo[1], make_small((Eterm) funcinfo[2]));
+ ASSERT(is_atom(cmfa->module) || is_nil(cmfa->module));
+ ASSERT(is_atom(cmfa->function) || is_nil(cmfa->function));
+ mfa = TUPLE3(hp, cmfa->module, cmfa->function,
+ make_small(cmfa->arity));
hp += 4;
return TUPLE3(hp, addr, bin, mfa);
}
@@ -311,11 +349,12 @@ dbg_bt(Process* p, Eterm* sp)
while (sp < stack) {
if (is_CP(*sp)) {
- BeamInstr* addr = find_function_from_pc(cp_val(*sp));
- if (addr)
+ ErtsCodeMFA* cmfa = find_function_from_pc(cp_val(*sp));
+ if (cmfa)
erts_fprintf(stderr,
HEXF ": %T:%T/%bpu\n",
- addr, (Eterm) addr[0], (Eterm) addr[1], addr[2]);
+ &cmfa->module, cmfa->module,
+ cmfa->function, cmfa->arity);
}
sp++;
}
@@ -324,17 +363,17 @@ dbg_bt(Process* p, Eterm* sp)
void
dbg_where(BeamInstr* addr, Eterm x0, Eterm* reg)
{
- BeamInstr* f = find_function_from_pc(addr);
+ ErtsCodeMFA* cmfa = find_function_from_pc(addr);
- if (f == NULL) {
+ if (cmfa == NULL) {
erts_fprintf(stderr, "???\n");
} else {
int arity;
int i;
- addr = f;
- arity = addr[2];
- erts_fprintf(stderr, HEXF ": %T:%T(", addr, (Eterm) addr[0], (Eterm) addr[1]);
+ arity = cmfa->arity;
+ erts_fprintf(stderr, HEXF ": %T:%T(", addr,
+ cmfa->module, cmfa->function);
for (i = 0; i < arity; i++)
erts_fprintf(stderr, i ? ", %T" : "%T", i ? reg[i] : x0);
erts_fprintf(stderr, ")\n");
@@ -342,7 +381,7 @@ dbg_where(BeamInstr* addr, Eterm x0, Eterm* reg)
}
static int
-print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
+print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr)
{
int i;
BeamInstr tag;
@@ -396,7 +435,7 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
packed >>= 10;
break;
case '0': /* Tight shift */
- *ap++ = packed & (BEAM_TIGHT_MASK / sizeof(Eterm));
+ *ap++ = packed & BEAM_TIGHT_MASK;
packed >>= BEAM_TIGHT_SHIFT;
break;
case '6': /* Shift 16 steps */
@@ -431,39 +470,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));
- }
+ 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 == Y_REG_DEF) {
- erts_print(to, to_arg, "y(%d)", reg_index(*ap) - CP_SIZE);
- 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;
}
@@ -480,46 +513,60 @@ 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;
case 'I': /* Untagged integer. */
case 't':
- erts_print(to, to_arg, "%d", *ap);
+ switch (op) {
+ case op_i_gc_bif1_jIsId:
+ case op_i_gc_bif2_jIIssd:
+ case op_i_gc_bif3_jIIssd:
+ {
+ const ErtsGcBif* p;
+ BifFunction gcf = (BifFunction) *ap;
+ for (p = erts_gc_bifs; p->bif != 0; p++) {
+ if (p->gc_bif == gcf) {
+ print_bif_name(to, to_arg, p->bif);
+ break;
+ }
+ }
+ if (p->bif == 0) {
+ erts_print(to, to_arg, "%d", (Uint)gcf);
+ }
+ break;
+ }
+ default:
+ erts_print(to, to_arg, "%d", *ap);
+ }
ap++;
break;
case 'f': /* Destination label */
{
- BeamInstr* f = find_function_from_pc((BeamInstr *)*ap);
- if (f+3 != (BeamInstr *) *ap) {
+ ErtsCodeMFA* cmfa = find_function_from_pc((BeamInstr *)*ap);
+ if (!cmfa || erts_codemfa_to_code(cmfa) != (BeamInstr *) *ap) {
erts_print(to, to_arg, "f(" HEXF ")", *ap);
} else {
- erts_print(to, to_arg, "%T:%T/%bpu", (Eterm) f[0], (Eterm) f[1], f[2]);
+ erts_print(to, to_arg, "%T:%T/%bpu", cmfa->module,
+ cmfa->function, cmfa->arity);
}
ap++;
}
break;
case 'p': /* Pointer (to label) */
{
- BeamInstr* f = find_function_from_pc((BeamInstr *)*ap);
- if (f+3 != (BeamInstr *) *ap) {
+ ErtsCodeMFA* cmfa = find_function_from_pc((BeamInstr *)*ap);
+ if (!cmfa || erts_codemfa_to_code(cmfa) != (BeamInstr *) *ap) {
erts_print(to, to_arg, "p(" HEXF ")", *ap);
} else {
- erts_print(to, to_arg, "%T:%T/%bpu", (Eterm) f[0], (Eterm) f[1], f[2]);
+ erts_print(to, to_arg, "%T:%T/%bpu", cmfa->module,
+ cmfa->function, cmfa->arity);
}
ap++;
}
@@ -532,26 +579,16 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
{
Export* ex = (Export *) *ap;
erts_print(to, to_arg,
- "%T:%T/%bpu", (Eterm) ex->code[0], (Eterm) ex->code[1], ex->code[2]);
+ "%T:%T/%bpu", (Eterm) ex->info.mfa.module,
+ (Eterm) ex->info.mfa.function,
+ ex->info.mfa.arity);
ap++;
}
break;
case 'F': /* Function definition */
break;
case 'b':
- for (i = 0; i < BIF_SIZE; i++) {
- BifFunction bif = (BifFunction) *ap;
- if (bif == bif_table[i].f) {
- break;
- }
- }
- if (i == BIF_SIZE) {
- erts_print(to, to_arg, "b(%d)", (Uint) *ap);
- } else {
- Eterm name = bif_table[i].name;
- unsigned arity = bif_table[i].arity;
- erts_print(to, to_arg, "%T/%u", name, arity);
- }
+ print_bif_name(to, to_arg, (BifFunction) *ap);
ap++;
break;
case 'P': /* Byte offset into tuple (see beam_load.c) */
@@ -560,7 +597,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:
@@ -579,36 +616,62 @@ 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_rfI:
- case op_i_select_val_xfI:
- case op_i_select_val_yfI:
+ case op_i_select_val_lins_xfI:
+ case op_i_select_val_lins_yfI:
{
int n = ap[-1];
+ int ix = n;
- while (n > 0) {
- erts_print(to, to_arg, "%T f(" HEXF ") ", (Eterm) ap[0], ap[1]);
- ap += 2;
- size += 2;
- n--;
+ while (ix--) {
+ erts_print(to, to_arg, "%T ", (Eterm) ap[0]);
+ ap++;
+ size++;
+ }
+ ix = n;
+ while (ix--) {
+ erts_print(to, to_arg, "f(" HEXF ") ", (Eterm) ap[0]);
+ ap++;
+ size++;
}
}
break;
- case op_i_select_tuple_arity_rfI:
- case op_i_select_tuple_arity_xfI:
- case op_i_select_tuple_arity_yfI:
+ case op_i_select_val_bins_xfI:
+ case op_i_select_val_bins_yfI:
{
int n = ap[-1];
while (n > 0) {
- Uint arity = arityval(ap[0]);
- erts_print(to, to_arg, " {%d} f(" HEXF ")", arity, ap[1]);
+ erts_print(to, to_arg, "%T f(" HEXF ") ", (Eterm) ap[0], ap[1]);
ap += 2;
size += 2;
n--;
}
}
break;
- case op_i_jump_on_val_rfII:
+ case op_i_select_tuple_arity_xfI:
+ case op_i_select_tuple_arity_yfI:
+ {
+ int n = ap[-1];
+ int ix = n - 1; /* without sentinel */
+
+ while (ix--) {
+ Uint arity = arityval(ap[0]);
+ erts_print(to, to_arg, "{%d} ", arity, ap[1]);
+ ap++;
+ size++;
+ }
+ /* print sentinel */
+ erts_print(to, to_arg, "{%T} ", ap[0], ap[1]);
+ ap++;
+ size++;
+ ix = n;
+ while (ix--) {
+ erts_print(to, to_arg, "f(" HEXF ") ", ap[0]);
+ ap++;
+ size++;
+ }
+ }
+ break;
case op_i_jump_on_val_xfII:
case op_i_jump_on_val_yfII:
{
@@ -620,7 +683,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:
{
@@ -632,30 +694,47 @@ 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_jdII:
+ case op_new_map_dII:
case op_update_map_assoc_jsdII:
case op_update_map_exact_jsdII:
- case op_i_has_map_fields_fsI:
- case op_i_get_map_elements_fsI:
{
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]);
+ break;
+ }
+ ap++, size++, n--;
+ }
+ }
+ break;
+ case op_i_get_map_elements_fsI:
+ {
+ int n = unpacked[-1];
+
+ while (n > 0) {
+ if (n % 3 == 1) {
+ erts_print(to, to_arg, " %X", 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;
}
}
@@ -668,3 +747,427 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
return size;
}
+
+static void print_bif_name(fmtfn_t to, void* to_arg, BifFunction bif)
+{
+ int i;
+
+ for (i = 0; i < BIF_SIZE; i++) {
+ if (bif == bif_table[i].f) {
+ break;
+ }
+ }
+ if (i == BIF_SIZE) {
+ erts_print(to, to_arg, "b(%d)", (Uint) bif);
+ } else {
+ Eterm name = bif_table[i].name;
+ unsigned arity = bif_table[i].arity;
+ erts_print(to, to_arg, "%T/%u", name, arity);
+ }
+}
+
+/*
+ * Dirty BIF testing.
+ *
+ * The erts_debug:dirty_cpu/2, erts_debug:dirty_io/1, and
+ * erts_debug:dirty/3 BIFs are used by the dirty_bif_SUITE
+ * test suite.
+ */
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+static int ms_wait(Process *c_p, Eterm etimeout, int busy);
+static int dirty_send_message(Process *c_p, Eterm to, Eterm tag);
+#endif
+static BIF_RETTYPE dirty_test(Process *c_p, Eterm type, Eterm arg1, Eterm arg2, UWord *I);
+
+/*
+ * erts_debug:dirty_cpu/2 is statically determined to execute on
+ * a dirty CPU scheduler (see erts_dirty_bif.tab).
+ */
+BIF_RETTYPE
+erts_debug_dirty_cpu_2(BIF_ALIST_2)
+{
+ return dirty_test(BIF_P, am_dirty_cpu, BIF_ARG_1, BIF_ARG_2, BIF_I);
+}
+
+/*
+ * erts_debug:dirty_io/2 is statically determined to execute on
+ * a dirty I/O scheduler (see erts_dirty_bif.tab).
+ */
+BIF_RETTYPE
+erts_debug_dirty_io_2(BIF_ALIST_2)
+{
+ return dirty_test(BIF_P, am_dirty_io, BIF_ARG_1, BIF_ARG_2, BIF_I);
+}
+
+/*
+ * erts_debug:dirty/3 executes on a normal scheduler.
+ */
+BIF_RETTYPE
+erts_debug_dirty_3(BIF_ALIST_3)
+{
+#ifdef ERTS_DIRTY_SCHEDULERS
+ Eterm argv[2];
+ switch (BIF_ARG_1) {
+ case am_normal:
+ return dirty_test(BIF_P, am_normal, BIF_ARG_2, BIF_ARG_3, BIF_I);
+ case am_dirty_cpu:
+ argv[0] = BIF_ARG_2;
+ argv[1] = BIF_ARG_3;
+ return erts_schedule_bif(BIF_P,
+ argv,
+ BIF_I,
+ erts_debug_dirty_cpu_2,
+ ERTS_SCHED_DIRTY_CPU,
+ am_erts_debug,
+ am_dirty_cpu,
+ 2);
+ case am_dirty_io:
+ argv[0] = BIF_ARG_2;
+ argv[1] = BIF_ARG_3;
+ return erts_schedule_bif(BIF_P,
+ argv,
+ BIF_I,
+ erts_debug_dirty_io_2,
+ ERTS_SCHED_DIRTY_IO,
+ am_erts_debug,
+ am_dirty_io,
+ 2);
+ default:
+ BIF_ERROR(BIF_P, EXC_BADARG);
+ }
+#else
+ BIF_ERROR(BIF_P, EXC_UNDEF);
+#endif
+}
+
+
+static BIF_RETTYPE
+dirty_test(Process *c_p, Eterm type, Eterm arg1, Eterm arg2, UWord *I)
+{
+ BIF_RETTYPE ret;
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (am_scheduler == arg1) {
+ ErtsSchedulerData *esdp;
+ if (arg2 != am_type)
+ goto badarg;
+ esdp = erts_proc_sched_data(c_p);
+ if (!esdp)
+ goto scheduler_type_error;
+
+ switch (esdp->type) {
+ case ERTS_SCHED_NORMAL:
+ ERTS_BIF_PREP_RET(ret, am_normal);
+ break;
+ case ERTS_SCHED_DIRTY_CPU:
+ ERTS_BIF_PREP_RET(ret, am_dirty_cpu);
+ break;
+ case ERTS_SCHED_DIRTY_IO:
+ ERTS_BIF_PREP_RET(ret, am_dirty_io);
+ break;
+ default:
+ scheduler_type_error:
+ ERTS_BIF_PREP_RET(ret, am_error);
+ break;
+ }
+ }
+ else if (am_error == arg1) {
+ switch (arg2) {
+ case am_notsup:
+ ERTS_BIF_PREP_ERROR(ret, c_p, EXC_NOTSUP);
+ break;
+ case am_undef:
+ ERTS_BIF_PREP_ERROR(ret, c_p, EXC_UNDEF);
+ break;
+ case am_badarith:
+ ERTS_BIF_PREP_ERROR(ret, c_p, EXC_BADARITH);
+ break;
+ case am_noproc:
+ ERTS_BIF_PREP_ERROR(ret, c_p, EXC_NOPROC);
+ break;
+ case am_system_limit:
+ ERTS_BIF_PREP_ERROR(ret, c_p, SYSTEM_LIMIT);
+ break;
+ case am_badarg:
+ default:
+ goto badarg;
+ }
+ }
+ else if (am_copy == arg1) {
+ int i;
+ Eterm res;
+
+ for (res = NIL, i = 0; i < 1000; i++) {
+ Eterm *hp, sz;
+ Eterm cpy;
+ /* We do not want this to be optimized,
+ but rather the oposite... */
+ sz = size_object(arg2);
+ hp = HAlloc(c_p, sz);
+ cpy = copy_struct(arg2, sz, &hp, &c_p->off_heap);
+ hp = HAlloc(c_p, 2);
+ res = CONS(hp, cpy, res);
+ }
+
+ ERTS_BIF_PREP_RET(ret, res);
+ }
+ else if (am_send == arg1) {
+ dirty_send_message(c_p, arg2, am_ok);
+ ERTS_BIF_PREP_RET(ret, am_ok);
+ }
+ else if (ERTS_IS_ATOM_STR("wait", arg1)) {
+ if (!ms_wait(c_p, arg2, type == am_dirty_cpu))
+ goto badarg;
+ ERTS_BIF_PREP_RET(ret, am_ok);
+ }
+ else if (ERTS_IS_ATOM_STR("reschedule", arg1)) {
+ /*
+ * Reschedule operation after decrement of two until we reach
+ * zero. Switch between dirty scheduler types when 'n' is
+ * evenly divided by 4. If the initial value wasn't evenly
+ * dividable by 2, throw badarg exception.
+ */
+ Eterm next_type;
+ Sint n;
+ if (!term_to_Sint(arg2, &n) || n < 0)
+ goto badarg;
+ if (n == 0)
+ ERTS_BIF_PREP_RET(ret, am_ok);
+ else {
+ Eterm argv[3];
+ Eterm eint = erts_make_integer((Uint) (n - 2), c_p);
+ if (n % 4 != 0)
+ next_type = type;
+ else {
+ switch (type) {
+ case am_dirty_cpu: next_type = am_dirty_io; break;
+ case am_dirty_io: next_type = am_normal; break;
+ case am_normal: next_type = am_dirty_cpu; break;
+ default: goto badarg;
+ }
+ }
+ switch (next_type) {
+ case am_dirty_io:
+ argv[0] = arg1;
+ argv[1] = eint;
+ ret = erts_schedule_bif(c_p,
+ argv,
+ I,
+ erts_debug_dirty_io_2,
+ ERTS_SCHED_DIRTY_IO,
+ am_erts_debug,
+ am_dirty_io,
+ 2);
+ break;
+ case am_dirty_cpu:
+ argv[0] = arg1;
+ argv[1] = eint;
+ ret = erts_schedule_bif(c_p,
+ argv,
+ I,
+ erts_debug_dirty_cpu_2,
+ ERTS_SCHED_DIRTY_CPU,
+ am_erts_debug,
+ am_dirty_cpu,
+ 2);
+ break;
+ case am_normal:
+ argv[0] = am_normal;
+ argv[1] = arg1;
+ argv[2] = eint;
+ ret = erts_schedule_bif(c_p,
+ argv,
+ I,
+ erts_debug_dirty_3,
+ ERTS_SCHED_NORMAL,
+ am_erts_debug,
+ am_dirty,
+ 3);
+ break;
+ default:
+ goto badarg;
+ }
+ }
+ }
+ else if (ERTS_IS_ATOM_STR("ready_wait6_done", arg1)) {
+ ERTS_DECL_AM(ready);
+ ERTS_DECL_AM(done);
+ dirty_send_message(c_p, arg2, AM_ready);
+ ms_wait(c_p, make_small(6000), 0);
+ dirty_send_message(c_p, arg2, AM_done);
+ ERTS_BIF_PREP_RET(ret, am_ok);
+ }
+ else if (ERTS_IS_ATOM_STR("alive_waitexiting", arg1)) {
+ Process *real_c_p = erts_proc_shadow2real(c_p);
+ Eterm *hp, *hp2;
+ Uint sz;
+ int i;
+ ErtsSchedulerData *esdp = erts_proc_sched_data(c_p);
+ int dirty_io = esdp->type == ERTS_SCHED_DIRTY_IO;
+
+ if (ERTS_PROC_IS_EXITING(real_c_p))
+ goto badarg;
+ dirty_send_message(c_p, arg2, am_alive);
+
+ /* Wait until dead */
+ while (!ERTS_PROC_IS_EXITING(real_c_p)) {
+ if (dirty_io)
+ ms_wait(c_p, make_small(100), 0);
+ else
+ erts_thr_yield();
+ }
+
+ ms_wait(c_p, make_small(1000), 0);
+
+ /* Should still be able to allocate memory */
+ hp = HAlloc(c_p, 3); /* Likely on heap */
+ sz = 10000;
+ hp2 = HAlloc(c_p, sz); /* Likely in heap fragment */
+ *hp2 = make_pos_bignum_header(sz);
+ for (i = 1; i < sz; i++)
+ hp2[i] = (Eterm) 4711;
+ ERTS_BIF_PREP_RET(ret, TUPLE2(hp, am_ok, make_big(hp2)));
+ }
+ else {
+ badarg:
+ ERTS_BIF_PREP_ERROR(ret, c_p, BADARG);
+ }
+#else
+ ERTS_BIF_PREP_ERROR(ret, c_p, EXC_UNDEF);
+#endif
+ return ret;
+}
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+
+static int
+dirty_send_message(Process *c_p, Eterm to, Eterm tag)
+{
+ ErtsProcLocks c_p_locks, rp_locks;
+ Process *rp, *real_c_p;
+ Eterm msg, *hp;
+ ErlOffHeap *ohp;
+ ErtsMessage *mp;
+
+ ASSERT(is_immed(tag));
+
+ real_c_p = erts_proc_shadow2real(c_p);
+ if (real_c_p != c_p)
+ c_p_locks = 0;
+ else
+ c_p_locks = ERTS_PROC_LOCK_MAIN;
+
+ ASSERT(real_c_p->common.id == c_p->common.id);
+
+ rp = erts_pid2proc_opt(real_c_p, c_p_locks,
+ to, 0,
+ ERTS_P2P_FLG_INC_REFC);
+
+ if (!rp)
+ return 0;
+
+ rp_locks = 0;
+ mp = erts_alloc_message_heap(rp, &rp_locks, 3, &hp, &ohp);
+
+ msg = TUPLE2(hp, tag, c_p->common.id);
+ erts_queue_message(rp, rp_locks, mp, msg, c_p->common.id);
+
+ if (rp == real_c_p)
+ rp_locks &= ~c_p_locks;
+ if (rp_locks)
+ erts_smp_proc_unlock(rp, rp_locks);
+
+ erts_proc_dec_refc(rp);
+
+ return 1;
+}
+
+static int
+ms_wait(Process *c_p, Eterm etimeout, int busy)
+{
+ ErtsSchedulerData *esdp = erts_proc_sched_data(c_p);
+ ErtsMonotonicTime time, timeout_time;
+ Sint64 ms;
+
+ if (!term_to_Sint64(etimeout, &ms))
+ return 0;
+
+ time = erts_get_monotonic_time(esdp);
+
+ if (ms < 0)
+ timeout_time = time;
+ else
+ timeout_time = time + ERTS_MSEC_TO_MONOTONIC(ms);
+
+ while (time < timeout_time) {
+ if (busy)
+ erts_thr_yield();
+ else {
+ ErtsMonotonicTime timeout = timeout_time - time;
+
+#ifdef __WIN32__
+ Sleep((DWORD) ERTS_MONOTONIC_TO_MSEC(timeout));
+#else
+ {
+ ErtsMonotonicTime to = ERTS_MONOTONIC_TO_USEC(timeout);
+ struct timeval tv;
+
+ tv.tv_sec = (long) to / (1000*1000);
+ tv.tv_usec = (long) to % (1000*1000);
+
+ select(0, NULL, NULL, NULL, &tv);
+ }
+#endif
+ }
+
+ time = erts_get_monotonic_time(esdp);
+ }
+ return 1;
+}
+
+#endif /* ERTS_DIRTY_SCHEDULERS */
+
+#ifdef ERTS_SMP
+# define ERTS_STACK_LIMIT ((char *) ethr_get_stacklimit())
+#else
+# define ERTS_STACK_LIMIT ((char *) erts_scheduler_stack_limit)
+#endif
+
+/*
+ * The below functions is for testing of the stack
+ * limit functionality. They are intentionally
+ * written body recursive in order to prevent
+ * last call optimization...
+ */
+
+UWord
+erts_check_stack_recursion_downwards(char *start_c)
+{
+ char *limit = ERTS_STACK_LIMIT;
+ char c;
+ UWord res;
+ if (erts_check_below_limit(&c, limit + 1024))
+ return (char *) erts_ptr_id(start_c) - (char *) erts_ptr_id(&c);
+ res = erts_check_stack_recursion_downwards(start_c);
+ erts_ptr_id(&c);
+ return res;
+}
+
+UWord
+erts_check_stack_recursion_upwards(char *start_c)
+{
+ char *limit = ERTS_STACK_LIMIT;
+ char c;
+ UWord res;
+ if (erts_check_above_limit(&c, limit - 1024))
+ return (char *) erts_ptr_id(&c) - (char *) erts_ptr_id(start_c);
+ res = erts_check_stack_recursion_upwards(start_c);
+ erts_ptr_id(&c);
+ return res;
+}
+
+int
+erts_is_above_stack_limit(char *ptr)
+{
+ return (char *) ptr > ERTS_STACK_LIMIT;
+}
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 1026e5f649..b4e6c35579 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2014. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -37,6 +38,7 @@
#include "beam_bp.h"
#include "beam_catches.h"
#include "erl_thr_progress.h"
+#include "erl_nfunc_sched.h"
#ifdef HIPE
#include "hipe_mode_switch.h"
#include "hipe_bif1.h"
@@ -63,18 +65,21 @@
# ifdef ERTS_SMP
# define PROCESS_MAIN_CHK_LOCKS(P) \
do { \
- if ((P)) { \
+ if ((P)) \
erts_proc_lc_chk_only_proc_main((P)); \
- } \
- else \
- erts_lc_check_exact(NULL, 0); \
- ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking()); \
+ ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking()); \
+} while (0)
+# define ERTS_SMP_REQ_PROC_MAIN_LOCK(P) \
+do { \
+ if ((P)) \
+ erts_proc_lc_require_lock((P), ERTS_PROC_LOCK_MAIN, \
+ __FILE__, __LINE__); \
+} while (0)
+# define ERTS_SMP_UNREQ_PROC_MAIN_LOCK(P) \
+do { \
+ if ((P)) \
+ erts_proc_lc_unrequire_lock((P), ERTS_PROC_LOCK_MAIN); \
} while (0)
-# define ERTS_SMP_REQ_PROC_MAIN_LOCK(P) \
- if ((P)) erts_proc_lc_require_lock((P), ERTS_PROC_LOCK_MAIN,\
- __FILE__, __LINE__)
-# define ERTS_SMP_UNREQ_PROC_MAIN_LOCK(P) \
- if ((P)) erts_proc_lc_unrequire_lock((P), ERTS_PROC_LOCK_MAIN)
# else
# define ERTS_SMP_REQ_PROC_MAIN_LOCK(P)
# define ERTS_SMP_UNREQ_PROC_MAIN_LOCK(P)
@@ -98,10 +103,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)
@@ -111,17 +113,16 @@ do { \
# define CHECK_ARGS(T)
#endif
-#ifndef MAX
-#define MAX(x, y) (((x) > (y)) ? (x) : (y))
-#endif
-
-#define GET_BIF_ADDRESS(p) ((BifFunction) (((Export *) p)->code[4]))
+#define GET_BIF_MODULE(p) (p->info.mfa.module)
+#define GET_BIF_FUNCTION(p) (p->info.mfa.function)
+#define GET_BIF_ARITY(p) (p->info.mfa.arity)
+#define GET_BIF_ADDRESS(p) ((BifFunction) (p->beam[1]))
#define TermWords(t) (((t) / (sizeof(BeamInstr)/sizeof(Eterm))) + !!((t) % (sizeof(BeamInstr)/sizeof(Eterm))))
/*
* We reuse some of fields in the save area in the process structure.
- * This is safe to do, since this space is only activly used when
+ * This is safe to do, since this space is only actively used when
* the process is switched out.
*/
#define REDS_IN(p) ((p)->def_arg_reg[5])
@@ -150,51 +151,41 @@ 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_PTR(Target) (((Target) & 1) ? &yb(Target-1) : &xb(Target))
+#define REG_TARGET(Target) (*REG_TARGET_PTR(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)
-
/*
* Store a result into a register and execute the next instruction.
* Dst points to the word with a destination descriptor, which MUST
* 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
@@ -220,11 +211,12 @@ BeamInstr beam_continue_exit[1];
BeamInstr* em_call_error_handler;
BeamInstr* em_apply_bif;
BeamInstr* em_call_nif;
+BeamInstr* em_call_bif_e;
/* NOTE These should be the only variables containing trace instructions.
** Sometimes tests are form the instruction value, and sometimes
-** for the refering variable (one of these), and rouge references
+** for the referring variable (one of these), and rouge references
** will most likely cause chaos.
*/
BeamInstr beam_return_to_trace[1]; /* OpCode(i_return_to_trace) */
@@ -241,10 +233,6 @@ BeamInstr beam_return_time_trace[1]; /* OpCode(i_return_time_trace) */
void** beam_ops;
#endif
-#ifndef ERTS_SMP /* Not supported with smp emulator */
-extern int count_instructions;
-#endif
-
#define SWAPIN \
HTOP = HEAP_TOP(c_p); \
E = c_p->stop
@@ -253,6 +241,14 @@ extern int count_instructions;
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()).
@@ -296,7 +292,7 @@ extern int count_instructions;
#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
@@ -312,12 +308,11 @@ extern int count_instructions;
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), FCALLS); \
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \
PROCESS_MAIN_CHK_LOCKS(c_p); \
- r(0) = reg[0]; \
SWAPIN; \
} \
E -= needed; \
@@ -366,12 +361,10 @@ extern int count_instructions;
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), FCALLS); \
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \
PROCESS_MAIN_CHK_LOCKS(c_p); \
- r(0) = reg[0]; \
SWAPIN; \
} \
HEAP_SPACE_VERIFIED(need); \
@@ -389,12 +382,10 @@ extern int count_instructions;
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), FCALLS); \
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \
PROCESS_MAIN_CHK_LOCKS(c_p); \
- r(0) = reg[0]; \
SWAPIN; \
} \
HEAP_SPACE_VERIFIED(need); \
@@ -411,15 +402,11 @@ extern int count_instructions;
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, FCALLS); \
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \
PROCESS_MAIN_CHK_LOCKS(c_p); \
- if (Live > 0) { \
- r(0) = reg[0]; \
- } \
Extra = reg[Live]; \
SWAPIN; \
} \
@@ -429,7 +416,7 @@ extern int count_instructions;
#define TestHeapPutList(Need, Reg) \
do { \
TestHeap((Need), 1); \
- PutList(Reg, r(0), r(0), StoreSimpleDest); \
+ PutList(Reg, r(0), r(0)); \
CHECK_TERM(r(0)); \
} while (0)
@@ -441,10 +428,9 @@ extern int count_instructions;
#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) \
@@ -534,15 +520,19 @@ extern int count_instructions;
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)
@@ -553,61 +543,140 @@ extern int count_instructions;
GetR((N)+1, Dst2); \
} while (0)
-#define PutList(H, T, Dst, Store) \
- do { \
- HTOP[0] = (H); HTOP[1] = (T); \
- Store(make_list(HTOP), Dst); \
- HTOP += 2; \
+#define PutList(H, T, Dst) \
+ do { \
+ HTOP[0] = (H); HTOP[1] = (T); \
+ Dst = make_list(HTOP); \
+ HTOP += 2; \
} while (0)
-#define Move(Src, Dst, Store) \
- do { \
- Eterm term = (Src); \
- Store(term, Dst); \
- } while (0)
+#define Swap(R1, R2) \
+ do { \
+ Eterm V = R1; \
+ R1 = R2; \
+ R2 = V; \
+ } while (0)
-#define Move2(src1, dst1, src2, dst2) dst1 = (src1); dst2 = (src2)
+#define SwapTemp(R1, R2, Tmp) \
+ do { \
+ Eterm V = R1; \
+ R1 = R2; \
+ R2 = Tmp = V; \
+ } while (0)
-#define MoveGenDest(src, dstp) \
- if ((dstp) == NULL) { r(0) = (src); } else { *(dstp) = src; }
+#define Move(Src, Dst) Dst = (Src)
-#define MoveReturn(Src, Dest) \
- (Dest) = (Src); \
- I = c_p->cp; \
- ASSERT(VALID_INSTR(*c_p->cp)); \
- c_p->cp = 0; \
- CHECK_TERM(r(0)); \
- Goto(*I)
+#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 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 DispatchReturn \
+do { \
+ if (FCALLS > 0 || FCALLS > neg_o_reds) { \
+ FCALLS--; \
+ Goto(*I); \
+ } \
+ else { \
+ c_p->current = NULL; \
+ c_p->arity = 1; \
+ goto context_switch3; \
+ } \
+} while (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)); \
+ DispatchReturn
#define DeallocateReturn(Deallocate) \
do { \
int words_to_pop = (Deallocate); \
- SET_I((BeamInstr *) cp_val(*E)); \
+ SET_I((BeamInstr *) cp_val(*E)); \
E = ADD_BYTE_OFFSET(E, words_to_pop); \
CHECK_TERM(r(0)); \
- Goto(*I); \
+ DispatchReturn; \
} 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) \
@@ -615,57 +684,69 @@ extern int count_instructions;
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)); \
+#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 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 GetTupleElement(Src, Element, Dest) \
+ do { \
+ Eterm* src; \
+ src = ADD_BYTE_OFFSET(tuple_val(Src), (Element)); \
+ (Dest) = *src; \
} 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 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 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 GetTupleElement2Y(Src, Element, D1, D2) \
+ do { \
+ Eterm* src; \
+ Eterm E1, E2; \
+ src = ADD_BYTE_OFFSET(tuple_val(Src), (Element)); \
+ E1 = src[0]; \
+ E2 = src[1]; \
+ D1 = E1; \
+ D2 = 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 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; }
@@ -689,23 +770,29 @@ extern int count_instructions;
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_not_map(Src)) { Fail; }
-
-#define HasMapField(Src, Key, Fail) if (has_not_map_field(Src, Key)) { Fail; }
+#define IsMap(Src, Fail) if (!is_map(Src)) { Fail; }
#define GetMapElement(Src, Key, Dst, Fail) \
do { \
@@ -716,6 +803,15 @@ extern int count_instructions;
Dst = _res; \
} while (0)
+#define GetMapElementHash(Src, Key, Hx, Dst, Fail) \
+ do { \
+ Eterm _res = get_map_element_hash(Src, Key, Hx); \
+ if (is_non_value(_res)) { \
+ Fail; \
+ } \
+ Dst = _res; \
+ } while (0)
+
#define IsFunction(X, Action) \
do { \
if ( !(is_any_fun(X)) ) { \
@@ -730,14 +826,29 @@ extern int count_instructions;
} \
} 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 IsTaggedTuple(Src,Arityval,Tag,Fail) \
+ do { \
+ if (!(is_tuple(Src) && \
+ (tuple_val(Src))[0] == Arityval && \
+ (tuple_val(Src))[1] == Tag)) { \
+ Fail; \
+ } \
} while (0)
#define IsBoolean(X, Fail) if ((X) != am_true && (X) != am_false) { Fail; }
@@ -748,7 +859,7 @@ extern int count_instructions;
#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; } \
@@ -765,6 +876,7 @@ extern int count_instructions;
#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; } \
@@ -779,6 +891,7 @@ extern int count_instructions;
#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; } \
@@ -790,7 +903,7 @@ extern int count_instructions;
Target = _uint_size * Unit; \
} while (0)
-#define BsGetFloat2(Ms, Live, Sz, Flags, Dst, Store, Fail) \
+#define BsGetFloat2(Ms, Live, Sz, Flags, Dst, Fail) \
do { \
ErlBinMatchBuffer *_mb; \
Eterm _result; Sint _size; \
@@ -801,12 +914,12 @@ extern int count_instructions;
LIGHT_SWAPOUT; \
_result = erts_bs_get_float_2(c_p, _size, (Flags), _mb); \
LIGHT_SWAPIN; \
- HEAP_SPACE_VERIFIED(0); \
+ HEAP_SPACE_VERIFIED(0); \
if (is_non_value(_result)) { Fail; } \
- else { Store(_result, Dst); } \
+ else { Dst = _result; } \
} while (0)
-#define BsGetBinaryImm_2(Ms, Live, Sz, Flags, Dst, Store, Fail) \
+#define BsGetBinaryImm_2(Ms, Live, Sz, Flags, Dst, Fail) \
do { \
ErlBinMatchBuffer *_mb; \
Eterm _result; \
@@ -815,12 +928,12 @@ extern int count_instructions;
LIGHT_SWAPOUT; \
_result = erts_bs_get_binary_2(c_p, (Sz), (Flags), _mb); \
LIGHT_SWAPIN; \
- HEAP_SPACE_VERIFIED(0); \
+ HEAP_SPACE_VERIFIED(0); \
if (is_non_value(_result)) { Fail; } \
- else { Store(_result, Dst); } \
+ else { Dst = _result; } \
} while (0)
-#define BsGetBinary_2(Ms, Live, Sz, Flags, Dst, Store, Fail) \
+#define BsGetBinary_2(Ms, Live, Sz, Flags, Dst, Fail) \
do { \
ErlBinMatchBuffer *_mb; \
Eterm _result; Uint _size; \
@@ -830,27 +943,27 @@ extern int count_instructions;
LIGHT_SWAPOUT; \
_result = erts_bs_get_binary_2(c_p, _size, (Flags), _mb); \
LIGHT_SWAPIN; \
- HEAP_SPACE_VERIFIED(0); \
+ HEAP_SPACE_VERIFIED(0); \
if (is_non_value(_result)) { Fail; } \
- else { Store(_result, Dst); } \
+ else { Dst = _result; } \
} while (0)
-#define BsGetBinaryAll_2(Ms, Live, Unit, Dst, Store, Fail) \
- do { \
- ErlBinMatchBuffer *_mb; \
- Eterm _result; \
- TestHeap(ERL_SUB_BIN_SIZE, Live); \
- _mb = ms_matchbuffer(Ms); \
- if (((_mb->size - _mb->offset) % Unit) == 0) { \
- LIGHT_SWAPOUT; \
- _result = erts_bs_get_binary_all_2(c_p, _mb); \
- LIGHT_SWAPIN; \
- HEAP_SPACE_VERIFIED(0); \
- ASSERT(is_value(_result)); \
- Store(_result, Dst); \
- } else { \
- HEAP_SPACE_VERIFIED(0); \
- Fail; } \
+#define BsGetBinaryAll_2(Ms, Live, Unit, Dst, Fail) \
+ do { \
+ ErlBinMatchBuffer *_mb; \
+ Eterm _result; \
+ TestHeap(ERL_SUB_BIN_SIZE, Live); \
+ _mb = ms_matchbuffer(Ms); \
+ if (((_mb->size - _mb->offset) % Unit) == 0) { \
+ LIGHT_SWAPOUT; \
+ _result = erts_bs_get_binary_all_2(c_p, _mb); \
+ LIGHT_SWAPIN; \
+ HEAP_SPACE_VERIFIED(0); \
+ ASSERT(is_value(_result)); \
+ Dst = _result; \
+ } else { \
+ HEAP_SPACE_VERIFIED(0); \
+ Fail; } \
} while (0)
#define BsSkipBits2(Ms, Bits, Unit, Fail) \
@@ -945,14 +1058,17 @@ extern int count_instructions;
* The following functions are called directly by process_main().
* Don't inline them.
*/
-static BifFunction translate_gc_bif(void* gcf) NOINLINE;
+static ErtsCodeMFA *ubif2mfa(void* uf) NOINLINE;
+static ErtsCodeMFA *gcbif2mfa(void* gcf) NOINLINE;
static BeamInstr* handle_error(Process* c_p, BeamInstr* pc,
- Eterm* reg, BifFunction bf) NOINLINE;
-static BeamInstr* call_error_handler(Process* p, BeamInstr* ip,
+ Eterm* reg, ErtsCodeMFA* bif_mfa) NOINLINE;
+static BeamInstr* call_error_handler(Process* p, ErtsCodeMFA* mfa,
Eterm* reg, Eterm func) NOINLINE;
-static BeamInstr* fixed_apply(Process* p, Eterm* reg, Uint arity) NOINLINE;
+static BeamInstr* fixed_apply(Process* p, Eterm* reg, Uint arity,
+ BeamInstr *I, Uint offs) NOINLINE;
static BeamInstr* apply(Process* p, Eterm module, Eterm function,
- Eterm args, Eterm* reg) NOINLINE;
+ Eterm args, Eterm* reg,
+ BeamInstr *I, Uint offs) NOINLINE;
static BeamInstr* call_fun(Process* p, int arity,
Eterm* reg, Eterm args) NOINLINE;
static BeamInstr* apply_fun(Process* p, Eterm fun,
@@ -964,8 +1080,8 @@ static Eterm update_map_assoc(Process* p, Eterm* reg,
Eterm map, BeamInstr* I) NOINLINE;
static Eterm update_map_exact(Process* p, Eterm* reg,
Eterm map, BeamInstr* I) NOINLINE;
-static int has_not_map_field(Eterm map, Eterm key);
static Eterm get_map_element(Eterm map, Eterm key);
+static Eterm get_map_element_hash(Eterm map, Eterm key, Uint32 hx);
/*
* Functions not directly called by process_main(). OK to inline.
@@ -974,14 +1090,14 @@ static BeamInstr* next_catch(Process* c_p, Eterm *reg);
static void terminate_proc(Process* c_p, Eterm Value);
static Eterm add_stacktrace(Process* c_p, Eterm Value, Eterm exc);
static void save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg,
- BifFunction bf, Eterm args);
+ ErtsCodeMFA *bif_mfa, Eterm args);
static struct StackTrace * get_trace_from_exc(Eterm exc);
static Eterm make_arglist(Process* c_p, Eterm* reg, int a);
void
init_emulator(void)
{
- process_main();
+ process_main(0, 0);
}
/*
@@ -990,23 +1106,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
@@ -1015,83 +1125,111 @@ init_emulator(void)
#ifdef USE_VM_CALL_PROBES
-#define DTRACE_LOCAL_CALL(p, m, f, a) \
+#define DTRACE_LOCAL_CALL(p, mfa) \
if (DTRACE_ENABLED(local_function_entry)) { \
DTRACE_CHARBUF(process_name, DTRACE_TERM_BUF_SIZE); \
- DTRACE_CHARBUF(mfa, DTRACE_TERM_BUF_SIZE); \
+ DTRACE_CHARBUF(mfa_buf, DTRACE_TERM_BUF_SIZE); \
int depth = STACK_START(p) - STACK_TOP(p); \
- dtrace_fun_decode(p, m, f, a, \
- process_name, mfa); \
- DTRACE3(local_function_entry, process_name, mfa, depth); \
+ dtrace_fun_decode(p, mfa, process_name, mfa_buf); \
+ DTRACE3(local_function_entry, process_name, mfa_buf, depth); \
}
-#define DTRACE_GLOBAL_CALL(p, m, f, a) \
+#define DTRACE_GLOBAL_CALL(p, mfa) \
if (DTRACE_ENABLED(global_function_entry)) { \
DTRACE_CHARBUF(process_name, DTRACE_TERM_BUF_SIZE); \
- DTRACE_CHARBUF(mfa, DTRACE_TERM_BUF_SIZE); \
+ DTRACE_CHARBUF(mfa_buf, DTRACE_TERM_BUF_SIZE); \
int depth = STACK_START(p) - STACK_TOP(p); \
- dtrace_fun_decode(p, m, f, a, \
- process_name, mfa); \
- DTRACE3(global_function_entry, process_name, mfa, depth); \
+ dtrace_fun_decode(p, mfa, process_name, mfa_buf); \
+ DTRACE3(global_function_entry, process_name, mfa_buf, depth); \
}
-#define DTRACE_RETURN(p, m, f, a) \
+#define DTRACE_RETURN(p, mfa) \
if (DTRACE_ENABLED(function_return)) { \
DTRACE_CHARBUF(process_name, DTRACE_TERM_BUF_SIZE); \
- DTRACE_CHARBUF(mfa, DTRACE_TERM_BUF_SIZE); \
+ DTRACE_CHARBUF(mfa_buf, DTRACE_TERM_BUF_SIZE); \
int depth = STACK_START(p) - STACK_TOP(p); \
- dtrace_fun_decode(p, m, f, a, \
- process_name, mfa); \
- DTRACE3(function_return, process_name, mfa, depth); \
+ dtrace_fun_decode(p, mfa, process_name, mfa_buf); \
+ DTRACE3(function_return, process_name, mfa_buf, depth); \
}
-#define DTRACE_BIF_ENTRY(p, m, f, a) \
- if (DTRACE_ENABLED(bif_entry)) { \
- DTRACE_CHARBUF(process_name, DTRACE_TERM_BUF_SIZE); \
- DTRACE_CHARBUF(mfa, DTRACE_TERM_BUF_SIZE); \
- dtrace_fun_decode(p, m, f, a, \
- process_name, mfa); \
- DTRACE2(bif_entry, process_name, mfa); \
+#define DTRACE_BIF_ENTRY(p, mfa) \
+ if (DTRACE_ENABLED(bif_entry)) { \
+ DTRACE_CHARBUF(process_name, DTRACE_TERM_BUF_SIZE); \
+ DTRACE_CHARBUF(mfa_buf, DTRACE_TERM_BUF_SIZE); \
+ dtrace_fun_decode(p, mfa, process_name, mfa_buf); \
+ DTRACE2(bif_entry, process_name, mfa_buf); \
}
-#define DTRACE_BIF_RETURN(p, m, f, a) \
- if (DTRACE_ENABLED(bif_return)) { \
- DTRACE_CHARBUF(process_name, DTRACE_TERM_BUF_SIZE); \
- DTRACE_CHARBUF(mfa, DTRACE_TERM_BUF_SIZE); \
- dtrace_fun_decode(p, m, f, a, \
- process_name, mfa); \
- DTRACE2(bif_return, process_name, mfa); \
+#define DTRACE_BIF_RETURN(p, mfa) \
+ if (DTRACE_ENABLED(bif_return)) { \
+ DTRACE_CHARBUF(process_name, DTRACE_TERM_BUF_SIZE); \
+ DTRACE_CHARBUF(mfa_buf, DTRACE_TERM_BUF_SIZE); \
+ dtrace_fun_decode(p, mfa, process_name, mfa_buf); \
+ DTRACE2(bif_return, process_name, mfa_buf); \
}
-#define DTRACE_NIF_ENTRY(p, m, f, a) \
- if (DTRACE_ENABLED(nif_entry)) { \
- DTRACE_CHARBUF(process_name, DTRACE_TERM_BUF_SIZE); \
- DTRACE_CHARBUF(mfa, DTRACE_TERM_BUF_SIZE); \
- dtrace_fun_decode(p, m, f, a, \
- process_name, mfa); \
- DTRACE2(nif_entry, process_name, mfa); \
+#define DTRACE_NIF_ENTRY(p, mfa) \
+ if (DTRACE_ENABLED(nif_entry)) { \
+ DTRACE_CHARBUF(process_name, DTRACE_TERM_BUF_SIZE); \
+ DTRACE_CHARBUF(mfa_buf, DTRACE_TERM_BUF_SIZE); \
+ dtrace_fun_decode(p, mfa, process_name, mfa_buf); \
+ DTRACE2(nif_entry, process_name, mfa_buf); \
}
-#define DTRACE_NIF_RETURN(p, m, f, a) \
- if (DTRACE_ENABLED(nif_return)) { \
- DTRACE_CHARBUF(process_name, DTRACE_TERM_BUF_SIZE); \
- DTRACE_CHARBUF(mfa, DTRACE_TERM_BUF_SIZE); \
- dtrace_fun_decode(p, m, f, a, \
- process_name, mfa); \
- DTRACE2(nif_return, process_name, mfa); \
+#define DTRACE_NIF_RETURN(p, mfa) \
+ if (DTRACE_ENABLED(nif_return)) { \
+ DTRACE_CHARBUF(process_name, DTRACE_TERM_BUF_SIZE); \
+ DTRACE_CHARBUF(mfa_buf, DTRACE_TERM_BUF_SIZE); \
+ dtrace_fun_decode(p, mfa, process_name, mfa_buf); \
+ DTRACE2(nif_return, process_name, mfa_buf); \
}
+#define DTRACE_GLOBAL_CALL_FROM_EXPORT(p,e) \
+ do { \
+ if (DTRACE_ENABLED(global_function_entry)) { \
+ BeamInstr* fp = (BeamInstr *) (((Export *) (e))->addressv[erts_active_code_ix()]); \
+ DTRACE_GLOBAL_CALL((p), erts_code_to_codemfa(fp)); \
+ } \
+ } while(0)
+
+#define DTRACE_RETURN_FROM_PC(p) \
+ do { \
+ ErtsCodeMFA* cmfa; \
+ if (DTRACE_ENABLED(function_return) && (cmfa = find_function_from_pc((p)->cp))) { \
+ DTRACE_RETURN((p), cmfa); \
+ } \
+ } while(0)
+
#else /* USE_VM_PROBES */
+#define DTRACE_LOCAL_CALL(p, mfa) do {} while (0)
+#define DTRACE_GLOBAL_CALL(p, mfa) do {} while (0)
+#define DTRACE_GLOBAL_CALL_FROM_EXPORT(p, e) do {} while (0)
+#define DTRACE_RETURN(p, mfa) do {} while (0)
+#define DTRACE_RETURN_FROM_PC(p) do {} while (0)
+#define DTRACE_BIF_ENTRY(p, mfa) do {} while (0)
+#define DTRACE_BIF_RETURN(p, mfa) do {} while (0)
+#define DTRACE_NIF_ENTRY(p, mfa) do {} while (0)
+#define DTRACE_NIF_RETURN(p, mfa) do {} while (0)
+#endif /* USE_VM_PROBES */
-#define DTRACE_LOCAL_CALL(p, m, f, a) do {} while (0)
-#define DTRACE_GLOBAL_CALL(p, m, f, a) do {} while (0)
-#define DTRACE_RETURN(p, m, f, a) do {} while (0)
-#define DTRACE_BIF_ENTRY(p, m, f, a) do {} while (0)
-#define DTRACE_BIF_RETURN(p, m, f, a) do {} while (0)
-#define DTRACE_NIF_ENTRY(p, m, f, a) do {} while (0)
-#define DTRACE_NIF_RETURN(p, m, f, a) do {} while (0)
+#ifdef DEBUG
+#define ERTS_DBG_CHK_REDS(P, FC) \
+ do { \
+ if (ERTS_PROC_GET_SAVED_CALLS_BUF((P))) { \
+ ASSERT(FC <= 0); \
+ ASSERT(erts_proc_sched_data(c_p)->virtual_reds \
+ <= 0 - (FC)); \
+ } \
+ else { \
+ ASSERT(FC <= CONTEXT_REDS); \
+ ASSERT(erts_proc_sched_data(c_p)->virtual_reds \
+ <= CONTEXT_REDS - (FC)); \
+ } \
+} while (0)
+#else
+#define ERTS_DBG_CHK_REDS(P, FC)
+#endif
-#endif /* USE_VM_PROBES */
/*
* process_main() is called twice:
@@ -1099,7 +1237,7 @@ init_emulator(void)
* the instructions' C labels to the loader.
* The second call starts execution of BEAM code. This call never returns.
*/
-void process_main(void)
+void process_main(Eterm * x_reg_array, FloatDef* f_reg_array)
{
static int init_done = 0;
Process* c_p = NULL;
@@ -1108,15 +1246,10 @@ 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.
*/
- register Eterm* reg REG_xregs = NULL;
+ register Eterm* reg REG_xregs = x_reg_array;
/*
* Top of heap (next free location); grows upwards.
@@ -1140,45 +1273,33 @@ 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.
*/
- register FloatDef *freg;
+ register FloatDef *freg = f_reg_array;
/*
* For keeping the negative old value of 'reds' when call saving is active.
*/
int neg_o_reds = 0;
- Eterm (*arith_func)(Process* p, Eterm* reg, Uint live);
-
-#ifndef NO_JUMP_TABLE
- static void* opcodes[] = { DEFINE_OPCODES };
#ifdef ERTS_OPCODE_COUNTER_SUPPORT
static void* counting_opcodes[] = { DEFINE_COUNTING_OPCODES };
-#endif
+#else
+#ifndef NO_JUMP_TABLE
+ static void* opcodes[] = { DEFINE_OPCODES };
#else
int Go;
#endif
-
- Uint temp_bits; /* Temporary used by BsSkipBits2 & BsGetInteger2 */
+#endif
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 */
@@ -1204,29 +1325,29 @@ void process_main(void)
goto do_schedule1;
do_schedule:
- reds_used = REDS_IN(c_p) - FCALLS;
+ ASSERT(c_p->arity < 6);
+ ASSERT(c_p->debug_reds_in == REDS_IN(c_p));
+ if (!ERTS_PROC_GET_SAVED_CALLS_BUF(c_p))
+ reds_used = REDS_IN(c_p) - FCALLS;
+ else
+ reds_used = REDS_IN(c_p) - (CONTEXT_REDS + FCALLS);
+ ASSERT(reds_used >= 0);
do_schedule1:
if (start_time != 0) {
Sint64 diff = erts_timestamp_millis() - start_time;
- if (diff > 0 && (Uint) diff > erts_system_monitor_long_schedule
-#ifdef ERTS_DIRTY_SCHEDULERS
- && !ERTS_SCHEDULER_IS_DIRTY(c_p->scheduler_data)
-#endif
- ) {
- BeamInstr *inptr = find_function_from_pc(start_time_i);
- BeamInstr *outptr = find_function_from_pc(c_p->i);
+ if (diff > 0 && (Uint) diff > erts_system_monitor_long_schedule) {
+ ErtsCodeMFA *inptr = find_function_from_pc(start_time_i);
+ ErtsCodeMFA *outptr = find_function_from_pc(c_p->i);
monitor_long_schedule_proc(c_p,inptr,outptr,(Uint) diff);
}
}
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);
+ c_p = erts_schedule(NULL, c_p, reds_used);
+ ASSERT(!(c_p->flags & F_HIPE_MODE));
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
start_time = 0;
#ifdef DEBUG
@@ -1235,16 +1356,13 @@ 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;
}
- 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;
@@ -1253,7 +1371,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]);
}
@@ -1266,23 +1384,22 @@ void process_main(void)
SET_I(c_p->i);
- reds = c_p->fcalls;
- if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)
- && (ERTS_TRACE_FLAGS(c_p) & F_SENSITIVE) == 0) {
- neg_o_reds = -reds;
- FCALLS = REDS_IN(c_p) = 0;
+ REDS_IN(c_p) = reds = c_p->fcalls;
+#ifdef DEBUG
+ c_p->debug_reds_in = reds;
+#endif
+
+ if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) {
+ neg_o_reds = -CONTEXT_REDS;
+ FCALLS = neg_o_reds + reds;
} else {
neg_o_reds = 0;
- FCALLS = REDS_IN(c_p) = reds;
+ FCALLS = reds;
}
+ ERTS_DBG_CHK_REDS(c_p, FCALLS);
+
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));
@@ -1295,10 +1412,9 @@ void process_main(void)
if (ERTS_PROC_IS_EXITING(c_p)) {
strcpy(fun_buf, "<exiting>");
} else {
- BeamInstr *fptr = find_function_from_pc(c_p->i);
- if (fptr) {
- dtrace_fun_decode(c_p, (Eterm)fptr[0],
- (Eterm)fptr[1], (Uint)fptr[2],
+ ErtsCodeMFA *cmfa = find_function_from_pc(c_p->i);
+ if (cmfa) {
+ dtrace_fun_decode(c_p, cmfa,
NULL, fun_buf);
} else {
erts_snprintf(fun_buf, sizeof(DTRACE_CHARBUF_NAME(fun_buf)),
@@ -1321,26 +1437,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);
@@ -1349,147 +1463,143 @@ 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;
}
-
- OpCase(i_plus_jId):
+
+#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)
+
{
+ Eterm PlusOp1, PlusOp2;
Eterm result;
- if (is_both_small(tmp_arg1, tmp_arg2)) {
- Sint i = signed_val(tmp_arg1) + signed_val(tmp_arg2);
+ 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);
- STORE_ARITH_RESULT(result);
+ StoreBifResult(4, result);
}
-
}
- arith_func = ARITH_FUNC(mixed_plus);
- goto do_big_arith2;
+ DO_OUTLINED_ARITH_2(mixed_plus, PlusOp1, PlusOp2);
}
- OpCase(i_minus_jId):
{
+ Eterm MinusOp1, MinusOp2;
Eterm result;
- if (is_both_small(tmp_arg1, tmp_arg2)) {
- Sint i = signed_val(tmp_arg1) - signed_val(tmp_arg2);
+ OpCase(i_minus_jIxxd):
+ MinusOp1 = xb(Arg(2));
+ MinusOp2 = xb(Arg(3));
+ goto do_minus;
+
+ OpCase(i_minus_jIssd):
+ GetArg2(2, MinusOp1, MinusOp2);
+ goto do_minus;
+
+ 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(i_move_call_only_fcr): {
+ OpCase(i_move_call_only_fc): {
r(0) = Arg(1);
}
/* FALL THROUGH */
OpCase(i_call_only_f): {
SET_I((BeamInstr *) Arg(0));
- DTRACE_LOCAL_CALL(c_p, (Eterm)I[-3], (Eterm)I[-2], I[-1]);
+ DTRACE_LOCAL_CALL(c_p, erts_code_to_codemfa(I));
Dispatch();
}
- OpCase(i_move_call_last_fPcr): {
+ OpCase(i_move_call_last_fPc): {
r(0) = Arg(2);
}
/* FALL THROUGH */
@@ -1497,11 +1607,11 @@ void process_main(void)
RESTORE_CP(E);
E = ADD_BYTE_OFFSET(E, Arg(1));
SET_I((BeamInstr *) Arg(0));
- DTRACE_LOCAL_CALL(c_p, (Eterm)I[-3], (Eterm)I[-2], I[-1]);
+ DTRACE_LOCAL_CALL(c_p, erts_code_to_codemfa(I));
Dispatch();
}
- OpCase(i_move_call_crf): {
+ OpCase(i_move_call_cf): {
r(0) = Arg(0);
I++;
}
@@ -1509,11 +1619,11 @@ void process_main(void)
OpCase(i_call_f): {
SET_CP(c_p, I+2);
SET_I((BeamInstr *) Arg(0));
- DTRACE_LOCAL_CALL(c_p, (Eterm)I[-3], (Eterm)I[-2], I[-1]);
+ DTRACE_LOCAL_CALL(c_p, erts_code_to_codemfa(I));
Dispatch();
}
- OpCase(i_move_call_ext_last_ePcr): {
+ OpCase(i_move_call_ext_last_ePc): {
r(0) = Arg(2);
}
/* FALL THROUGH */
@@ -1526,40 +1636,25 @@ void process_main(void)
* is not loaded, it points to code which will invoke the error handler
* (see lb_call_error_handler below).
*/
-#ifdef USE_VM_CALL_PROBES
- if (DTRACE_ENABLED(global_function_entry)) {
- BeamInstr* fp = (BeamInstr *) (((Export *) Arg(0))->addressv[erts_active_code_ix()]);
- DTRACE_GLOBAL_CALL(c_p, (Eterm)fp[-3], (Eterm)fp[-2], fp[-1]);
- }
-#endif
+ 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++;
}
/* FALL THROUGH */
OpCase(i_call_ext_e):
SET_CP(c_p, I+2);
-#ifdef USE_VM_CALL_PROBES
- if (DTRACE_ENABLED(global_function_entry)) {
- BeamInstr* fp = (BeamInstr *) (((Export *) Arg(0))->addressv[erts_active_code_ix()]);
- DTRACE_GLOBAL_CALL(c_p, (Eterm)fp[-3], (Eterm)fp[-2], fp[-1]);
- }
-#endif
+ 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 */
OpCase(i_call_ext_only_e):
-#ifdef USE_VM_CALL_PROBES
- if (DTRACE_ENABLED(global_function_entry)) {
- BeamInstr* fp = (BeamInstr *) (((Export *) Arg(0))->addressv[erts_active_code_ix()]);
- DTRACE_GLOBAL_CALL(c_p, (Eterm)fp[-3], (Eterm)fp[-2], fp[-1]);
- }
-#endif
+ DTRACE_GLOBAL_CALL_FROM_EXPORT(c_p, Arg(0));
Dispatchx();
OpCase(init_y): {
@@ -1593,18 +1688,9 @@ void process_main(void)
Next(1);
}
-
OpCase(return): {
-#ifdef USE_VM_CALL_PROBES
- BeamInstr* fptr;
-#endif
SET_I(c_p->cp);
-
-#ifdef USE_VM_CALL_PROBES
- if (DTRACE_ENABLED(function_return) && (fptr = find_function_from_pc(c_p->cp))) {
- DTRACE_RETURN(c_p, (Eterm)fptr[0], (Eterm)fptr[1], (Uint)fptr[2]);
- }
-#endif
+ DTRACE_RETURN_FROM_PC(c_p);
/*
* We must clear the CP to make sure that a stale value do not
* create a false module dependcy preventing code upgrading.
@@ -1613,7 +1699,7 @@ void process_main(void)
c_p->cp = 0;
CHECK_TERM(r(0));
HEAP_SPACE_VERIFIED(0);
- Goto(*I);
+ DispatchReturn;
}
/*
@@ -1627,19 +1713,21 @@ void process_main(void)
BeamInstr *next;
Eterm result;
+ if (!(FCALLS > 0 || FCALLS > neg_o_reds)) {
+ /* If we have run out of reductions, we do a context
+ switch before calling the bif */
+ c_p->arity = 2;
+ c_p->current = NULL;
+ goto context_switch3;
+ }
+
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)) {
@@ -1650,7 +1738,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;
@@ -1660,29 +1747,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);
}
}
}
@@ -1696,29 +1777,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):
@@ -1730,6 +1806,7 @@ void process_main(void)
c_p->catches--;
make_blank(yb(Arg(0)));
if (is_non_value(r(0))) {
+ c_p->fvalue = NIL;
if (x(1) == am_throw) {
r(0) = x(2);
} else {
@@ -1739,11 +1816,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, FCALLS);
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
SWAPIN;
@@ -1760,6 +1836,7 @@ void process_main(void)
c_p->catches--;
make_blank(yb(Arg(0)));
if (is_non_value(r(0))) {
+ c_p->fvalue = NIL;
r(0) = x(1);
x(1) = x(2);
x(2) = x(3);
@@ -1824,10 +1901,18 @@ 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;
+
+ /*
+ * 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__:
@@ -1842,6 +1927,8 @@ 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;
+ c_p->arity = 0;
goto do_schedule; /* Will be rescheduled for exit */
}
ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p);
@@ -1851,32 +1938,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);
@@ -1888,10 +1970,11 @@ void process_main(void)
*/
OpCase(remove_message): {
BeamInstr *next;
- ErlMessage* msgp;
-
+ ErtsMessage* msgp;
PROCESS_MAIN_CHK_LOCKS(c_p);
+ ERTS_CHK_MBUF_SZ(c_p);
+
PreFetch(0, next);
msgp = PEEK_MESSAGE(c_p);
@@ -1903,20 +1986,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;
}
@@ -1936,12 +2006,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)));
@@ -1971,7 +2035,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));
@@ -1984,11 +2048,24 @@ 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_DBG_CHK_REDS(c_p, FCALLS);
+ ERTS_CHK_MBUF_SZ(c_p);
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
-
NextPF(0, next);
}
@@ -1997,9 +2074,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.
@@ -2027,44 +2117,30 @@ void process_main(void)
}
GetArg1(1, timeout_value);
if (timeout_value != make_small(0)) {
-#if !defined(ARCH_64) || HALFWORD_HEAP
- Uint time_val;
-#endif
- if (is_small(timeout_value) && signed_val(timeout_value) > 0 &&
-#if defined(ARCH_64) && !HALFWORD_HEAP
- ((unsigned_val(timeout_value) >> 32) == 0)
-#else
- 1
-#endif
- ) {
- /*
- * The timer routiner will set c_p->i to the value in
- * 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;
- set_timer(c_p, unsigned_val(timeout_value));
- } else if (timeout_value == am_infinity) {
+ if (timeout_value == am_infinity)
c_p->flags |= F_TIMO;
-#if !defined(ARCH_64) || HALFWORD_HEAP
- } else if (term_to_Uint(timeout_value, &time_val)) {
- BeamInstr** pi = (BeamInstr**) c_p->def_arg_reg;
- *pi = I+3;
- set_timer(c_p, time_val);
-#endif
- } else { /* Wrong time */
- OpCase(i_wait_error_locked): {
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
- /* Fall through */
+ else {
+ int tres = erts_set_proc_timer_term(c_p, timeout_value);
+ if (tres == 0) {
+ /*
+ * The timer routiner will set c_p->i to the value in
+ * 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.
+ */
+ BeamInstr** pi = (BeamInstr**) c_p->def_arg_reg;
+ *pi = I+3;
}
+ else { /* Wrong time */
+ OpCase(i_wait_error_locked): {
+ erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
+ /* Fall through */
+ }
OpCase(i_wait_error): {
- c_p->freason = EXC_TIMEOUT_VALUE;
- goto find_func_info;
+ c_p->freason = EXC_TIMEOUT_VALUE;
+ goto find_func_info;
+ }
}
}
@@ -2082,10 +2158,30 @@ void process_main(void)
OpCase(wait_f):
wait2: {
+#ifndef ERTS_SMP
+ if (ERTS_PROC_IS_EXITING(c_p)) {
+ /*
+ * I non smp case:
+ *
+ * Currently executing process might be sent an exit
+ * signal if it is traced by a port that it also is
+ * linked to, and the port terminates during the
+ * trace. In this case we do *not* want to clear
+ * the active flag, which will make the process hang
+ * in limbo forever.
+ */
+ SWAPOUT;
+ c_p->arity = 0;
+ goto do_schedule;
+ }
+#endif
c_p->i = (BeamInstr *) Arg(0); /* L1 */
SWAPOUT;
c_p->arity = 0;
- erts_smp_atomic32_read_band_relb(&c_p->state, ~ERTS_PSFLG_ACTIVE);
+
+ if (!ERTS_PTMR_IS_TIMED_OUT(c_p))
+ erts_smp_atomic32_read_band_relb(&c_p->state,
+ ~ERTS_PSFLG_ACTIVE);
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
c_p->current = NULL;
@@ -2113,7 +2209,7 @@ void process_main(void)
if ((c_p->flags & (F_INSLPQUEUE | F_TIMO)) == 0) {
BeamInstr** p = (BeamInstr **) c_p->def_arg_reg;
*p = I+3;
- set_timer(c_p, Arg(1));
+ erts_set_proc_timer_uword(c_p, Arg(1));
}
goto wait2;
}
@@ -2131,7 +2227,7 @@ void process_main(void)
PreFetch(0, next);
if (IS_TRACED_FL(c_p, F_TRACE_RECEIVE)) {
- trace_receive(c_p, am_timeout);
+ trace_receive(c_p, am_clock_service, am_timeout, NULL);
}
if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) {
save_calls(c_p, &exp_timeout);
@@ -2141,22 +2237,17 @@ void process_main(void)
NextPF(0, next);
}
-
{
Eterm select_val2;
- OpCase(i_select_tuple_arity2_yfAfAf):
+ OpCase(i_select_tuple_arity2_yfAAff):
select_val2 = yb(Arg(0));
goto do_select_tuple_arity2;
- OpCase(i_select_tuple_arity2_xfAfAf):
+ OpCase(i_select_tuple_arity2_xfAAff):
select_val2 = xb(Arg(0));
goto do_select_tuple_arity2;
- OpCase(i_select_tuple_arity2_rfAfAf):
- select_val2 = r(0);
- I--;
-
do_select_tuple_arity2:
if (is_not_tuple(select_val2)) {
goto select_val2_fail;
@@ -2164,22 +2255,18 @@ void process_main(void)
select_val2 = *tuple_val(select_val2);
goto do_select_val2;
- OpCase(i_select_val2_yfcfcf):
+ OpCase(i_select_val2_yfccff):
select_val2 = yb(Arg(0));
goto do_select_val2;
- OpCase(i_select_val2_xfcfcf):
+ OpCase(i_select_val2_xfccff):
select_val2 = xb(Arg(0));
goto do_select_val2;
- OpCase(i_select_val2_rfcfcf):
- select_val2 = r(0);
- I--;
-
do_select_val2:
if (select_val2 == Arg(2)) {
- I += 2;
- } else if (select_val2 == Arg(4)) {
+ I += 3;
+ } else if (select_val2 == Arg(3)) {
I += 4;
}
@@ -2199,30 +2286,48 @@ 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);
- goto do_binary_search;
+ goto do_linear_search;
+ }
+ SET_I((BeamInstr *) Arg(1));
+ Goto(*I);
+
+ OpCase(i_select_val_lins_xfI):
+ select_val = xb(Arg(0));
+ goto do_linear_search;
+
+ OpCase(i_select_val_lins_yfI):
+ select_val = yb(Arg(0));
+ goto do_linear_search;
+
+ do_linear_search: {
+ BeamInstr *vs = &Arg(3);
+ int ix = 0;
+
+ for(;;) {
+ if (vs[ix+0] >= select_val) { ix += 0; break; }
+ if (vs[ix+1] >= select_val) { ix += 1; break; }
+ ix += 2;
}
+
+ if (vs[ix] == select_val) {
+ I += ix + Arg(2) + 2;
+ }
+
SET_I((BeamInstr *) Arg(1));
Goto(*I);
+ }
- OpCase(i_select_val_xfI):
+ OpCase(i_select_val_bins_xfI):
select_val = xb(Arg(0));
goto do_binary_search;
- OpCase(i_select_val_yfI):
+ OpCase(i_select_val_bins_yfI):
select_val = yb(Arg(0));
goto do_binary_search;
- OpCase(i_select_val_rfI):
- select_val = r(0);
- I--;
-
do_binary_search:
{
struct Pairs {
@@ -2283,10 +2388,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);
@@ -2311,10 +2412,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));
@@ -2334,15 +2431,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);
+ switch (loader_tag(term)) {
+ case LOADER_X_REG:
+ *hp++ = x(loader_x_reg_index(term));
break;
- case (X_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER:
- *hp++ = x(term >> _TAG_IMMED1_SIZE);
- 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;
@@ -2353,93 +2447,35 @@ void process_main(void)
Goto(*I);
}
- OpCase(new_map_jdII): {
+ OpCase(new_map_dII): {
Eterm res;
- x(0) = r(0);
- SWAPOUT;
- res = new_map(c_p, reg, I);
- SWAPIN;
- r(0) = x(0);
- StoreResult(res, Arg(1));
- Next(4+Arg(3));
- }
-
- OpCase(i_has_map_fields_fsI): {
- map_t* mp;
- Eterm map;
- Eterm field;
- Eterm *ks;
- BeamInstr* fs;
- Uint sz,n;
-
- GetArg1(1, map);
-
- /* this instruction assumes Arg1 is a map,
- * i.e. that it follows a test is_map if needed.
- */
-
- mp = (map_t *)map_val(map);
- sz = map_get_size(mp);
-
- if (sz == 0) {
- SET_I((BeamInstr *) Arg(0));
- goto has_map_fields_fail;
- }
-
- ks = map_get_keys(mp);
- n = (Uint)Arg(2);
- fs = &Arg(3); /* pattern fields */
-
- ASSERT(n>0);
-
- while(sz) {
- field = (Eterm)*fs;
- if (EQ(field,*ks)) {
- n--;
- fs++;
- if (n == 0) break;
- }
- ks++; sz--;
- }
-
- if (n) {
- SET_I((BeamInstr *) Arg(0));
- goto has_map_fields_fail;
- }
-
- I += 4 + Arg(2);
-has_map_fields_fail:
- ASSERT(VALID_INSTR(*I));
- Goto(*I);
- }
-
-#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; \
- } \
+ HEAVY_SWAPOUT;
+ res = new_map(c_p, reg, I-1);
+ HEAVY_SWAPIN;
+ StoreResult(res, Arg(0));
+ Next(3+Arg(2));
+ }
+
+#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): {
Eterm map;
- map_t *mp;
- Eterm field;
- Eterm *ks;
- Eterm *vs;
BeamInstr *fs;
- Uint sz,n;
+ Uint sz, n;
GetArg1(1, map);
@@ -2447,41 +2483,55 @@ do { \
* i.e. that it follows a test is_map if needed.
*/
- mp = (map_t *)map_val(map);
- sz = map_get_size(mp);
+ n = (Uint)Arg(2) / 3;
+ fs = &Arg(3); /* pattern fields and target registers */
- if (sz == 0) {
- SET_I((BeamInstr *) Arg(0));
- goto get_map_elements_fail;
- }
+ if (is_flatmap(map)) {
+ flatmap_t *mp;
+ Eterm *ks;
+ Eterm *vs;
- n = (Uint)Arg(2) / 2;
- fs = &Arg(3); /* pattern fields and target registers */
- ks = map_get_keys(mp);
- vs = map_get_values(mp);
+ mp = (flatmap_t *)flatmap_val(map);
+ sz = flatmap_get_size(mp);
- while(sz) {
- field = (Eterm)*fs;
- if (EQ(field,*ks)) {
- PUT_TERM_REG(*vs, fs[1]);
- n--;
- fs += 2;
- /* no more values to fetch, we are done */
- if (n == 0) break;
+ if (sz == 0) {
+ ClauseFail();
}
- ks++; sz--;
- vs++;
- }
- if (n) {
- SET_I((BeamInstr *) Arg(0));
- goto get_map_elements_fail;
- }
+ ks = flatmap_get_keys(mp);
+ vs = flatmap_get_values(mp);
+
+ while(sz) {
+ if (EQ((Eterm) fs[0], *ks)) {
+ PUT_TERM_REG(*vs, fs[1]);
+ n--;
+ fs += 3;
+ /* no more values to fetch, we are done */
+ if (n == 0) {
+ I = fs;
+ Next(-1);
+ }
+ }
+ ks++, sz--, vs++;
+ }
- I += 4 + Arg(2);
-get_map_elements_fail:
- ASSERT(VALID_INSTR(*I));
- Goto(*I);
+ ClauseFail();
+ } else {
+ const Eterm *v;
+ Uint32 hx;
+ ASSERT(is_hashmap(map));
+ while(n--) {
+ hx = fs[2];
+ ASSERT(hx == hashmap_make_hash((Eterm)fs[0]));
+ if ((v = erts_hashmap_get(hx, (Eterm)fs[0], map)) == NULL) {
+ ClauseFail();
+ }
+ PUT_TERM_REG(*v, fs[1]);
+ fs += 3;
+ }
+ I = fs;
+ Next(-1);
+ }
}
#undef PUT_TERM_REG
@@ -2490,16 +2540,20 @@ get_map_elements_fail:
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 {
- goto badarg;
+ /*
+ * This can only happen if the code was compiled
+ * with the compiler in OTP 17.
+ */
+ c_p->freason = BADMAP;
+ c_p->fvalue = map;
+ goto lb_Cl_error;
}
}
@@ -2508,16 +2562,14 @@ get_map_elements_fail:
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 {
- goto badarg;
+ goto lb_Cl_error;
}
}
@@ -2538,21 +2590,25 @@ get_map_elements_fail:
OpCase(bif1_fbsd):
{
- Eterm (*bf)(Process*, Eterm*);
+ ErtsBifFunc bf;
Eterm tmp_reg[1];
Eterm result;
GetArg1(2, tmp_reg[0]);
bf = (BifFunction) Arg(1);
+ ERTS_DBG_CHK_REDS(c_p, FCALLS);
c_p->fcalls = FCALLS;
PROCESS_MAIN_CHK_LOCKS(c_p);
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- result = (*bf)(c_p, tmp_reg);
+ ERTS_CHK_MBUF_SZ(c_p);
+ result = (*bf)(c_p, tmp_reg, I);
+ ERTS_CHK_MBUF_SZ(c_p);
ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
ERTS_HOLE_CHECK(c_p);
FCALLS = c_p->fcalls;
+ ERTS_DBG_CHK_REDS(c_p, FCALLS);
if (is_value(result)) {
StoreBifResult(3, result);
}
@@ -2566,28 +2622,32 @@ get_map_elements_fail:
OpCase(bif1_body_bsd):
{
- Eterm (*bf)(Process*, Eterm*);
+ ErtsBifFunc bf;
Eterm tmp_reg[1];
Eterm result;
GetArg1(1, tmp_reg[0]);
- bf = (BifFunction) Arg(0);
+ bf = (ErtsBifFunc) Arg(0);
+ ERTS_DBG_CHK_REDS(c_p, FCALLS);
c_p->fcalls = FCALLS;
PROCESS_MAIN_CHK_LOCKS(c_p);
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- result = (*bf)(c_p, tmp_reg);
+ ERTS_CHK_MBUF_SZ(c_p);
+ result = (*bf)(c_p, tmp_reg, I);
+ ERTS_CHK_MBUF_SZ(c_p);
ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
ERTS_HOLE_CHECK(c_p);
FCALLS = c_p->fcalls;
+ ERTS_DBG_CHK_REDS(c_p, FCALLS);
if (is_value(result)) {
StoreBifResult(2, result);
}
reg[0] = tmp_reg[0];
SWAPOUT;
- I = handle_error(c_p, I, reg, bf);
+ I = handle_error(c_p, I, reg, ubif2mfa((void *) bf));
goto post_error_handling;
}
@@ -2595,26 +2655,26 @@ get_map_elements_fail:
{
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);
+ ERTS_DBG_CHK_REDS(c_p, FCALLS);
c_p->fcalls = FCALLS;
SWAPOUT;
PROCESS_MAIN_CHK_LOCKS(c_p);
ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
+ ERTS_CHK_MBUF_SZ(c_p);
result = (*bf)(c_p, reg, live);
+ ERTS_CHK_MBUF_SZ(c_p);
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
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;
+ ERTS_DBG_CHK_REDS(c_p, FCALLS);
if (is_value(result)) {
StoreBifResult(4, result);
}
@@ -2622,12 +2682,12 @@ get_map_elements_fail:
SET_I((BeamInstr *) Arg(0));
Goto(*I);
}
- reg[0] = arg;
- I = handle_error(c_p, I, reg, translate_gc_bif((void *) bf));
+ x(0) = x(live);
+ I = handle_error(c_p, I, reg, gcbif2mfa((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);
@@ -2635,96 +2695,115 @@ get_map_elements_fail:
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);
+ ERTS_DBG_CHK_REDS(c_p, FCALLS);
c_p->fcalls = FCALLS;
SWAPOUT;
PROCESS_MAIN_CHK_LOCKS(c_p);
ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
+ ERTS_CHK_MBUF_SZ(c_p);
result = (*bf)(c_p, reg, live);
+ ERTS_CHK_MBUF_SZ(c_p);
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
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;
+ ERTS_DBG_CHK_REDS(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;
- I = handle_error(c_p, I, reg, translate_gc_bif((void *) bf));
+ live--;
+ x(0) = x(live);
+ x(1) = x(live+1);
+ I = handle_error(c_p, I, reg, gcbif2mfa((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);
+ ERTS_DBG_CHK_REDS(c_p, FCALLS);
c_p->fcalls = FCALLS;
SWAPOUT;
PROCESS_MAIN_CHK_LOCKS(c_p);
ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
+ ERTS_CHK_MBUF_SZ(c_p);
result = (*bf)(c_p, reg, live);
+ ERTS_CHK_MBUF_SZ(c_p);
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
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;
+ ERTS_DBG_CHK_REDS(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;
- I = handle_error(c_p, I, reg, translate_gc_bif((void *) bf));
+ live -= 2;
+ x(0) = x(live);
+ x(1) = x(live+1);
+ x(2) = x(live+2);
+ I = handle_error(c_p, I, reg, gcbif2mfa((void *) bf));
goto post_error_handling;
}
/*
* Guards bifs and, or, xor in guards.
*/
- OpCase(i_bif2_fbd):
+ OpCase(i_bif2_fbssd):
{
- Eterm tmp_reg[2] = {tmp_arg1, tmp_arg2};
- Eterm (*bf)(Process*, Eterm*);
+ Eterm tmp_reg[2];
+ ErtsBifFunc bf;
Eterm result;
- bf = (BifFunction) Arg(1);
+ GetArg2(2, tmp_reg[0], tmp_reg[1]);
+ bf = (ErtsBifFunc) Arg(1);
+ ERTS_DBG_CHK_REDS(c_p, FCALLS);
c_p->fcalls = FCALLS;
PROCESS_MAIN_CHK_LOCKS(c_p);
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- result = (*bf)(c_p, tmp_reg);
+ ERTS_CHK_MBUF_SZ(c_p);
+ result = (*bf)(c_p, tmp_reg, I);
+ ERTS_CHK_MBUF_SZ(c_p);
ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
ERTS_HOLE_CHECK(c_p);
FCALLS = c_p->fcalls;
+ ERTS_DBG_CHK_REDS(c_p, FCALLS);
if (is_value(result)) {
- StoreBifResult(2, result);
+ StoreBifResult(4, result);
}
SET_I((BeamInstr *) Arg(0));
Goto(*I);
@@ -2733,28 +2812,31 @@ get_map_elements_fail:
/*
* 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 (*bf)(Process*, Eterm*);
+ Eterm tmp_reg[2];
+ ErtsBifFunc bf;
Eterm result;
- bf = (BifFunction) Arg(0);
+ GetArg2(1, tmp_reg[0], tmp_reg[1]);
+ bf = (ErtsBifFunc) Arg(0);
PROCESS_MAIN_CHK_LOCKS(c_p);
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- result = (*bf)(c_p, tmp_reg);
+ ERTS_CHK_MBUF_SZ(c_p);
+ result = (*bf)(c_p, tmp_reg, I);
+ ERTS_CHK_MBUF_SZ(c_p);
ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
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);
+ I = handle_error(c_p, I, reg, ubif2mfa((void *) bf));
goto post_error_handling;
}
@@ -2764,31 +2846,58 @@ get_map_elements_fail:
*/
OpCase(call_bif_e):
{
- Eterm (*bf)(Process*, Eterm*, BeamInstr*) = GET_BIF_ADDRESS(Arg(0));
+ ErtsBifFunc bf;
Eterm result;
BeamInstr *next;
+ ErlHeapFragment *live_hf_end;
+ Export *export = (Export*)Arg(0);
+
+
+ if (!((FCALLS - 1) > 0 || (FCALLS-1) > neg_o_reds)) {
+ /* If we have run out of reductions, we do a context
+ switch before calling the bif */
+ c_p->arity = GET_BIF_ARITY(export);
+ c_p->current = &export->info.mfa;
+ goto context_switch3;
+ }
+
+ ERTS_MSACC_SET_BIF_STATE_CACHED_X(
+ GET_BIF_MODULE(export), GET_BIF_ADDRESS(export));
+
+ bf = GET_BIF_ADDRESS(export);
PRE_BIF_SWAPOUT(c_p);
+ ERTS_DBG_CHK_REDS(c_p, FCALLS);
c_p->fcalls = FCALLS - 1;
if (FCALLS <= 0) {
- save_calls(c_p, (Export *) Arg(0));
+ save_calls(c_p, export);
}
PreFetch(1, next);
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- reg[0] = r(0);
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
+ live_hf_end = c_p->mbuf;
+ ERTS_CHK_MBUF_SZ(c_p);
result = (*bf)(c_p, reg, I);
+ ERTS_CHK_MBUF_SZ(c_p);
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)) {
- Uint arity = ((Export *)Arg(0))->code[2];
- result = erts_gc_after_bif_call(c_p, result, reg, arity);
+ if (ERTS_IS_GC_DESIRED(c_p)) {
+ Uint arity = GET_BIF_ARITY(export);
+ 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;
+ ERTS_DBG_CHK_REDS(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));
@@ -2797,7 +2906,6 @@ get_map_elements_fail:
SET_CP(c_p, I+2);
SET_I(c_p->i);
SWAPIN;
- r(0) = reg[0];
Dispatch();
}
@@ -2805,7 +2913,7 @@ get_map_elements_fail:
* Error handling. SWAPOUT is not needed because it was done above.
*/
ASSERT(c_p->stop == E);
- I = handle_error(c_p, I, reg, bf);
+ I = handle_error(c_p, I, reg, &export->info.mfa);
goto post_error_handling;
}
@@ -2813,86 +2921,85 @@ get_map_elements_fail:
* 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_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);
+ Eterm RemOp1, RemOp2;
+
+ 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 {
- arith_func = ARITH_FUNC(int_rem);
- goto do_big_arith2;
+ DO_OUTLINED_ARITH_2(int_rem, RemOp1, RemOp2);
}
}
- 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;
- }
-
- 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);
+ Eterm BandOp1, BandOp2;
+
+ OpCase(i_band_jIxcd):
+ BandOp1 = xb(Arg(2));
+ BandOp2 = Arg(3);
+ goto do_band;
+
+ 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.
+ */
+ Eterm result = BandOp1 & BandOp2;
+ StoreBifResult(4, result);
}
- goto lb_Cl_error;
+ DO_OUTLINED_ARITH_2(band, BandOp1, BandOp2);
}
/*
- * An error occured in an arithmetic operation or test that could
+ * An error occurred in an arithmetic operation or test that could
* appear either in a head or in a body.
* In a head, execution should continue at failure address in Arg(0).
* In a body, Arg(0) == 0 and an exception should be raised.
@@ -2909,97 +3016,103 @@ get_map_elements_fail:
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.
+ * TAG ^ TAG == 0.
+ *
+ * Therefore, we perform the XOR operation on the tagged values,
+ * and OR in the tag bits.
*/
- result = make_small(signed_val(tmp_arg1) ^ signed_val(tmp_arg2));
- STORE_ARITH_RESULT(result);
+ Eterm result = (Op1 ^ Op2) | make_small(0);
+ 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);
}
+ ires = big_size(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);
+ ires = 1; /* big_size(small_to_big(Op1)) */
big_shift:
if (i > 0) { /* Left shift. */
- ires = big_size(tmp_arg1) + (i / D_EXP);
+ ires += (i / D_EXP);
} else { /* Right shift. */
- ires = big_size(tmp_arg1);
if (ires <= (-i / D_EXP))
ires = 3; /* ??? */
else
@@ -3017,14 +3130,17 @@ get_map_elements_fail:
c_p->freason = SYSTEM_LIMIT;
goto lb_Cl_error;
}
- TestHeapPreserve(ires+1, Arg(1), tmp_arg1);
+ TestHeapPreserve(ires+1, Arg(1), Op1);
+ if (is_small(Op1)) {
+ Op1 = small_to_big(signed_val(Op1), tmp_big);
+ }
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
@@ -3034,25 +3150,26 @@ get_map_elements_fail:
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);
}
+ ires = big_size(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.
*/
@@ -3076,12 +3193,10 @@ get_map_elements_fail:
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;
@@ -3096,92 +3211,84 @@ get_map_elements_fail:
OpCase(i_apply): {
BeamInstr *next;
- SWAPOUT;
- next = apply(c_p, r(0), x(1), x(2), reg);
- SWAPIN;
+ HEAVY_SWAPOUT;
+ next = apply(c_p, r(0), x(1), x(2), reg, NULL, 0);
+ HEAVY_SWAPIN;
if (next != NULL) {
- r(0) = reg[0];
SET_CP(c_p, I+1);
SET_I(next);
Dispatch();
}
- I = handle_error(c_p, I, reg, apply_3);
+ I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa);
goto post_error_handling;
}
OpCase(i_apply_last_P): {
BeamInstr *next;
- SWAPOUT;
- next = apply(c_p, r(0), x(1), x(2), reg);
- SWAPIN;
+ HEAVY_SWAPOUT;
+ next = apply(c_p, r(0), x(1), x(2), reg, I, Arg(0));
+ 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();
}
- I = handle_error(c_p, I, reg, apply_3);
+ I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa);
goto post_error_handling;
}
OpCase(i_apply_only): {
BeamInstr *next;
- SWAPOUT;
- next = apply(c_p, r(0), x(1), x(2), reg);
- SWAPIN;
+ HEAVY_SWAPOUT;
+ next = apply(c_p, r(0), x(1), x(2), reg, I, 0);
+ HEAVY_SWAPIN;
if (next != NULL) {
- r(0) = reg[0];
SET_I(next);
Dispatch();
}
- I = handle_error(c_p, I, reg, apply_3);
+ I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa);
goto post_error_handling;
}
OpCase(apply_I): {
BeamInstr *next;
- reg[0] = r(0);
- SWAPOUT;
- next = fixed_apply(c_p, reg, Arg(0));
- SWAPIN;
+ HEAVY_SWAPOUT;
+ next = fixed_apply(c_p, reg, Arg(0), NULL, 0);
+ HEAVY_SWAPIN;
if (next != NULL) {
- r(0) = reg[0];
SET_CP(c_p, I+2);
SET_I(next);
Dispatch();
}
- I = handle_error(c_p, I, reg, apply_3);
+ I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa);
goto post_error_handling;
}
OpCase(apply_last_IP): {
BeamInstr *next;
- reg[0] = r(0);
- SWAPOUT;
- next = fixed_apply(c_p, reg, Arg(0));
- SWAPIN;
+ HEAVY_SWAPOUT;
+ next = fixed_apply(c_p, reg, Arg(0), I, Arg(1));
+ 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();
}
- I = handle_error(c_p, I, reg, apply_3);
+ I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa);
goto post_error_handling;
}
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();
@@ -3192,12 +3299,11 @@ get_map_elements_fail:
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();
@@ -3208,11 +3314,10 @@ get_map_elements_fail:
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();
}
@@ -3222,13 +3327,10 @@ get_map_elements_fail:
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();
@@ -3239,13 +3341,11 @@ get_map_elements_fail:
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();
@@ -3279,19 +3379,29 @@ get_map_elements_fail:
* called from I[-3], I[-2], and I[-1] respectively.
*/
context_switch_fun:
- c_p->arity = I[-1] + 1;
+ /* Add one for the environment of the fun */
+ c_p->arity = erts_code_to_codemfa(I)->arity + 1;
goto context_switch2;
context_switch:
- c_p->arity = I[-1];
+ c_p->arity = erts_code_to_codemfa(I)->arity;
+
+ context_switch2: /* Entry for fun calls. */
+ c_p->current = erts_code_to_codemfa(I);
- context_switch2: /* Entry for fun calls. */
- c_p->current = I-3; /* Pointer to Mod, Func, Arity */
+ context_switch3:
{
Eterm* argp;
int i;
+ if (erts_smp_atomic32_read_nob(&c_p->state) & ERTS_PSFLG_EXITING) {
+ c_p->i = beam_exit;
+ c_p->arity = 0;
+ c_p->current = NULL;
+ goto do_schedule;
+ }
+
/*
* Make sure that there is enough room for the argument registers to be saved.
*/
@@ -3322,17 +3432,21 @@ get_map_elements_fail:
* (beacuse the code for the Dispatch() macro becomes shorter that way).
*/
- reds_used = REDS_IN(c_p) - FCALLS + 1;
-
+ ASSERT(c_p->debug_reds_in == REDS_IN(c_p));
+ if (!ERTS_PROC_GET_SAVED_CALLS_BUF(c_p))
+ reds_used = REDS_IN(c_p) - FCALLS;
+ else
+ reds_used = REDS_IN(c_p) - (CONTEXT_REDS + FCALLS);
+ ASSERT(reds_used >= 0);
+
/*
* Save the argument registers and everything else.
*/
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;
@@ -3345,23 +3459,18 @@ get_map_elements_fail:
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;
- c_p->arity = 0; /* In case this process will ever be garbed again. */
+ c_p->arity = 0; /* In case this process will never be garbed again. */
ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
erts_do_exit_process(c_p, am_normal);
ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
@@ -3375,48 +3484,18 @@ get_map_elements_fail:
goto do_schedule;
}
- OpCase(raise_ss): {
- /* This was not done very well in R10-0; then, we passed the tag in
- the first argument and hoped that the existing c_p->ftrace was
- still correct. But the ftrace-object already includes the tag
- (or rather, the freason). Now, we pass the original ftrace in
- the first argument. We also handle atom tags in the first
- argument for backwards compatibility.
- */
- Eterm raise_val1;
- Eterm raise_val2;
- GetArg2(0, raise_val1, raise_val2);
- c_p->fvalue = raise_val2;
- if (c_p->freason == EXC_NULL) {
- /* a safety check for the R10-0 case; should not happen */
- c_p->ftrace = NIL;
- c_p->freason = EXC_ERROR;
- }
- /* for R10-0 code, keep existing c_p->ftrace and hope it's correct */
- switch (raise_val1) {
- case am_throw:
- c_p->freason = EXC_THROWN & ~EXF_SAVETRACE;
- break;
- case am_error:
- c_p->freason = EXC_ERROR & ~EXF_SAVETRACE;
- break;
- case am_exit:
- c_p->freason = EXC_EXIT & ~EXF_SAVETRACE;
- break;
- default:
- {/* R10-1 and later
- XXX note: should do sanity check on given trace if it can be
- passed from a user! Currently only expecting generated calls.
- */
- struct StackTrace *s;
- c_p->ftrace = raise_val1;
- s = get_trace_from_exc(raise_val1);
- if (s == NULL) {
- c_p->freason = EXC_ERROR;
- } else {
- c_p->freason = PRIMARY_EXCEPTION(s->freason);
- }
- }
+ OpCase(i_raise): {
+ Eterm raise_trace = x(2);
+ Eterm raise_value = x(1);
+ struct StackTrace *s;
+
+ c_p->fvalue = raise_value;
+ c_p->ftrace = raise_trace;
+ s = get_trace_from_exc(raise_trace);
+ if (s == NULL) {
+ c_p->freason = EXC_ERROR;
+ } else {
+ c_p->freason = PRIMARY_EXCEPTION(s->freason);
}
goto find_func_info;
}
@@ -3424,25 +3503,14 @@ get_map_elements_fail:
{
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;
@@ -3459,11 +3527,10 @@ get_map_elements_fail:
* code[3]: &&call_error_handler
* code[4]: Not used
*/
- SWAPOUT;
- reg[0] = r(0);
- I = call_error_handler(c_p, I-3, reg, am_undefined_function);
- r(0) = reg[0];
- SWAPIN;
+ HEAVY_SWAPOUT;
+ I = call_error_handler(c_p, erts_code_to_codemfa(I),
+ reg, am_undefined_function);
+ HEAVY_SWAPIN;
if (I) {
Goto(*I);
}
@@ -3471,18 +3538,13 @@ get_map_elements_fail:
/* 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);
}
@@ -3503,15 +3565,26 @@ get_map_elements_fail:
* I[0]: &&call_nif
* I[1]: Function pointer to NIF function
* I[2]: Pointer to erl_module_nif
+ * I[3]: Function pointer to dirty NIF
+ *
+ * This layout is determined by the NifExport struct
*/
BifFunction vbf;
+ ErlHeapFragment *live_hf_end;
+ ErtsCodeMFA *codemfa;
+
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_NIF);
+
+ codemfa = erts_code_to_codemfa(I);
+
+ c_p->current = codemfa; /* current and vbf set to please handle_error */
+
+ DTRACE_NIF_ENTRY(c_p, codemfa);
+
+ HEAVY_SWAPOUT;
- 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 */
- SWAPOUT;
- c_p->fcalls = FCALLS - 1;
PROCESS_MAIN_CHK_LOCKS(c_p);
- bif_nif_arity = I[-1];
+ bif_nif_arity = codemfa->arity;
ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
@@ -3519,73 +3592,99 @@ get_map_elements_fail:
typedef Eterm NifF(struct enif_environment_t*, int argc, Eterm argv[]);
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);
+#ifdef ERTS_SMP
+ ASSERT(c_p->scheduler_data);
+#endif
+ live_hf_end = c_p->mbuf;
+ ERTS_CHK_MBUF_SZ(c_p);
+ erts_pre_nif(&env, c_p, (struct erl_module_nif*)I[2], NULL);
nif_bif_result = (*fp)(&env, bif_nif_arity, reg);
+ if (env.exception_thrown)
+ nif_bif_result = THE_NON_VALUE;
erts_post_nif(&env);
-#ifdef ERTS_DIRTY_SCHEDULERS
- if (is_non_value(nif_bif_result) && c_p->freason == TRAP) {
- Export* ep = ERTS_PROC_GET_DIRTY_SCHED_TRAP_EXPORT(c_p);
- ep->code[0] = I[-3];
- ep->code[1] = I[-2];
- }
-#endif
+ ERTS_CHK_MBUF_SZ(c_p);
+
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR);
+ ASSERT(!env.exiting);
+ ASSERT(!ERTS_PROC_IS_EXITING(c_p));
}
- ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(nif_bif_result));
- PROCESS_MAIN_CHK_LOCKS(c_p);
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- DTRACE_NIF_RETURN(c_p, (Eterm)I[-3], (Eterm)I[-2], (Uint)I[-1]);
+ DTRACE_NIF_RETURN(c_p, codemfa);
goto apply_bif_or_nif_epilogue;
OpCase(apply_bif):
/*
- * At this point, I points to the code[3] in the export entry for
+ * At this point, I points to the code[0] in the export entry for
* the BIF:
*
- * code[0]: Module
- * code[1]: Function
- * code[2]: Arity
- * code[3]: &&apply_bif
- * code[4]: Function pointer to BIF function
+ * code[-3]: Module
+ * code[-2]: Function
+ * code[-1]: Arity
+ * code[0]: &&apply_bif
+ * code[1]: Function pointer to BIF function
*/
- c_p->current = I-3; /* In case we apply process_info/1,2 or load_nif/1 */
+ if (!((FCALLS - 1) > 0 || (FCALLS - 1) > neg_o_reds)) {
+ /* If we have run out of reductions, we do a context
+ switch before calling the bif */
+ goto context_switch;
+ }
+
+ codemfa = erts_code_to_codemfa(I);
+
+ ERTS_MSACC_SET_BIF_STATE_CACHED_X(codemfa->module, (BifFunction)Arg(0));
+
+
+ /* In case we apply process_info/1,2 or load_nif/1 */
+ c_p->current = codemfa;
c_p->i = I; /* In case we apply check_process_code/2. */
c_p->arity = 0; /* To allow garbage collection on ourselves
* (check_process_code/2).
*/
- DTRACE_BIF_ENTRY(c_p, (Eterm)I[-3], (Eterm)I[-2], (Uint)I[-1]);
+ DTRACE_BIF_ENTRY(c_p, codemfa);
SWAPOUT;
+ ERTS_DBG_CHK_REDS(c_p, FCALLS - 1);
c_p->fcalls = FCALLS - 1;
vbf = (BifFunction) Arg(0);
PROCESS_MAIN_CHK_LOCKS(c_p);
- bif_nif_arity = I[-1];
- ASSERT(bif_nif_arity <= 3);
+ bif_nif_arity = codemfa->arity;
+ 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;
+ ErtsBifFunc bf = vbf;
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
+ live_hf_end = c_p->mbuf;
+ ERTS_CHK_MBUF_SZ(c_p);
nif_bif_result = (*bf)(c_p, reg, I);
+ ERTS_CHK_MBUF_SZ(c_p);
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);
}
-
- DTRACE_BIF_RETURN(c_p, (Eterm)I[-3], (Eterm)I[-2], (Uint)I[-1]);
+ /* 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, codemfa);
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;
+ ERTS_DBG_CHK_REDS(c_p, FCALLS);
if (is_value(nif_bif_result)) {
r(0) = nif_bif_result;
CHECK_TERM(r(0));
@@ -3594,14 +3693,13 @@ get_map_elements_fail:
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;
}
Dispatch();
}
- I = handle_error(c_p, c_p->cp, reg, vbf);
+ I = handle_error(c_p, c_p->cp, reg, c_p->current);
goto post_error_handling;
}
}
@@ -3616,21 +3714,21 @@ get_map_elements_fail:
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;
@@ -3641,8 +3739,9 @@ get_map_elements_fail:
goto find_func_info;
OpCase(i_func_info_IaaI): {
+ ErtsCodeInfo *ci = (ErtsCodeInfo*)I;
c_p->freason = EXC_FUNCTION_CLAUSE;
- c_p->current = I + 2;
+ c_p->current = &ci->mfa;
goto handle_error;
}
@@ -3678,19 +3777,13 @@ get_map_elements_fail:
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++;
@@ -3788,9 +3881,6 @@ get_map_elements_fail:
* Allocate the binary struct itself.
*/
bptr = erts_bin_nrml_alloc(num_bytes);
- bptr->flags = 0;
- bptr->orig_size = num_bytes;
- erts_refc_init(&bptr->refc, 1);
erts_current_bin = (byte *) bptr->orig_bytes;
/*
@@ -3812,52 +3902,48 @@ get_map_elements_fail:
}
{
- 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;
@@ -3865,15 +3951,15 @@ get_map_elements_fail:
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: {
@@ -3882,16 +3968,13 @@ get_map_elements_fail:
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->flags = 0;
- bptr->orig_size = tmp_arg1;
- erts_refc_init(&bptr->refc, 1);
+ bptr = erts_bin_nrml_alloc(BsOp1);
erts_current_bin = (byte *) bptr->orig_bytes;
/*
@@ -3900,28 +3983,28 @@ get_map_elements_fail:
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:
@@ -3929,33 +4012,36 @@ get_map_elements_fail:
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
@@ -3967,10 +4053,10 @@ get_map_elements_fail:
* 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 {
@@ -3993,16 +4079,16 @@ get_map_elements_fail:
* 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;
}
@@ -4012,8 +4098,8 @@ get_map_elements_fail:
*/
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.
@@ -4035,52 +4121,47 @@ get_map_elements_fail:
}
/*
- * 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);
}
@@ -4137,7 +4218,7 @@ get_map_elements_fail:
StoreBifResult(1, result);
}
- OpCase(i_bs_put_utf16_jIs): {
+ OpCase(bs_put_utf16_jIs): {
Eterm arg;
GetArg1(2, arg);
@@ -4171,26 +4252,29 @@ get_map_elements_fail:
/*
* 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.
@@ -4202,9 +4286,6 @@ get_map_elements_fail:
Uint slots;
Eterm context;
- OpCase(i_bs_start_match2_rfIId): {
- context = r(0);
-
do_start_match:
slots = Arg(2);
if (!is_boxed(context)) {
@@ -4251,7 +4332,7 @@ get_map_elements_fail:
ClauseFail();
}
NextPF(4, next);
- }
+
OpCase(i_bs_start_match2_xfIId): {
context = xb(Arg(0));
I++;
@@ -4264,18 +4345,6 @@ get_map_elements_fail:
}
}
- 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;
@@ -4288,16 +4357,6 @@ get_map_elements_fail:
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;
@@ -4309,16 +4368,6 @@ get_map_elements_fail:
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;
@@ -4330,16 +4379,6 @@ get_map_elements_fail:
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;
@@ -4354,19 +4393,11 @@ get_map_elements_fail:
{
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();
@@ -4384,15 +4415,10 @@ get_map_elements_fail:
{
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;
@@ -4413,17 +4439,10 @@ get_map_elements_fail:
{
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;
@@ -4436,11 +4455,11 @@ get_map_elements_fail:
_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);
@@ -4452,103 +4471,82 @@ get_map_elements_fail:
}
}
- /* 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;
@@ -4556,18 +4554,13 @@ get_map_elements_fail:
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++;
@@ -4578,7 +4571,7 @@ get_map_elements_fail:
* Operands: Fail Dst
*/
- do_bs_get_utf8: {
+ {
Eterm result = erts_bs_get_utf8(ms_matchbuffer(get_utf8_context));
if (is_non_value(result)) {
ClauseFail();
@@ -4591,12 +4584,7 @@ get_map_elements_fail:
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++;
}
@@ -4605,7 +4593,7 @@ get_map_elements_fail:
* 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)) {
@@ -4624,26 +4612,10 @@ get_map_elements_fail:
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;
@@ -4655,17 +4627,11 @@ get_map_elements_fail:
}
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) {
@@ -4693,16 +4659,11 @@ get_map_elements_fail:
{
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;
@@ -4730,14 +4691,6 @@ get_map_elements_fail:
}
}
- 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;
@@ -4747,14 +4700,6 @@ get_map_elements_fail:
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;
@@ -4785,11 +4730,11 @@ get_map_elements_fail:
*/
OpCase(return_trace): {
- BeamInstr* code = (BeamInstr *) (UWord) E[0];
+ ErtsCodeMFA* mfa = (ErtsCodeMFA *)(E[0]);
SWAPOUT; /* Needed for shared heap */
ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
- erts_trace_return(c_p, code, r(0), E+1/*Process tracer*/);
+ erts_trace_return(c_p, mfa, r(0), ERTS_TRACER_FROM_ETERM(E+1)/* tracer */);
ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
SWAPIN;
c_p->cp = NULL;
@@ -4800,12 +4745,9 @@ get_map_elements_fail:
OpCase(i_generic_breakpoint): {
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;
+ HEAVY_SWAPOUT;
+ real_I = erts_generic_breakpoint(c_p, erts_code_to_codeinfo(I), reg);
+ HEAVY_SWAPIN;
ASSERT(VALID_INSTR(real_I));
Goto(real_I);
}
@@ -4813,7 +4755,7 @@ get_map_elements_fail:
OpCase(i_return_time_trace): {
BeamInstr *pc = (BeamInstr *) (UWord) E[0];
SWAPOUT;
- erts_trace_time_return(c_p, pc);
+ erts_trace_time_return(c_p, erts_code_to_codeinfo(pc));
SWAPIN;
c_p->cp = NULL;
SET_I((BeamInstr *) cp_val(E[1]));
@@ -4864,7 +4806,7 @@ get_map_elements_fail:
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);
@@ -4884,7 +4826,7 @@ get_map_elements_fail:
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);
@@ -4903,7 +4845,7 @@ get_map_elements_fail:
#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
@@ -4980,7 +4922,13 @@ get_map_elements_fail:
#ifdef HIPE
{
- unsigned cmd;
+#define HIPE_MODE_SWITCH(Cmd) \
+ SWAPOUT; \
+ ERTS_DBG_CHK_REDS(c_p, FCALLS); \
+ 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): {
/*
@@ -4992,51 +4940,53 @@ get_map_elements_fail:
* I[ 0]: &&lb_hipe_trap_call
* ... remainder of original BEAM code
*/
- ASSERT(I[-5] == (Uint) OpCode(i_func_info_IaaI));
- c_p->hipe.ncallee = (void(*)(void)) I[-4];
- cmd = HIPE_MODE_SWITCH_CMD_CALL | (I[-1] << 8);
+ ErtsCodeInfo *ci = erts_code_to_codeinfo(I);
+ ASSERT(ci->op == (Uint) OpCode(i_func_info_IaaI));
+ c_p->hipe.u.ncallee = ci->u.ncallee;
++hipe_trap_count;
- goto L_hipe_mode_switch;
+ HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_CALL | (ci->mfa.arity << 8));
}
OpCase(hipe_trap_call_closure): {
- ASSERT(I[-5] == (Uint) OpCode(i_func_info_IaaI));
- c_p->hipe.ncallee = (void(*)(void)) I[-4];
- cmd = HIPE_MODE_SWITCH_CMD_CALL_CLOSURE | (I[-1] << 8);
+ ErtsCodeInfo *ci = erts_code_to_codeinfo(I);
+ ASSERT(ci->op == (Uint) OpCode(i_func_info_IaaI));
+ c_p->hipe.u.ncallee = ci->u.ncallee;
++hipe_trap_count;
- goto L_hipe_mode_switch;
+ HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_CALL_CLOSURE | (ci->mfa.arity << 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);
- reg = ERTS_PROC_GET_SCHDATA(c_p)->x_reg_array;
- freg = ERTS_PROC_GET_SCHDATA(c_p)->f_reg_array;
+#undef HIPE_MODE_SWITCH
+
+ L_post_hipe_mode_switch:
+#ifdef DEBUG
+ pid = c_p->common.id; /* may have switched process... */
+#endif
+ reg = erts_proc_sched_data(c_p)->x_reg_array;
+ freg = erts_proc_sched_data(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! */
+ ERTS_DBG_CHK_REDS(c_p, FCALLS);
+ switch( c_p->def_arg_reg[3] ) {
case HIPE_MODE_SWITCH_RES_RETURN:
ASSERT(is_value(reg[0]));
- MoveReturn(reg[0], r(0));
- case HIPE_MODE_SWITCH_RES_CALL:
+ 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
@@ -5045,9 +4995,8 @@ get_map_elements_fail:
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();
}
@@ -5058,7 +5007,7 @@ get_map_elements_fail:
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): {
@@ -5071,8 +5020,9 @@ get_map_elements_fail:
* I[ 0]: &&lb_hipe_call_count
* ... remainder of original BEAM code
*/
- struct hipe_call_count *hcc = (struct hipe_call_count*)I[-4];
- ASSERT(I[-5] == (Uint) OpCode(i_func_info_IaaI));
+ ErtsCodeInfo *ci = erts_code_to_codeinfo(I);
+ struct hipe_call_count *hcc = ci->u.hcc;
+ ASSERT(ci->op == (Uint) OpCode(i_func_info_IaaI));
ASSERT(hcc != NULL);
ASSERT(VALID_INSTR(hcc->opcode));
++(hcc->count);
@@ -5095,22 +5045,54 @@ get_map_elements_fail:
}
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 {
- I = handle_error(c_p, I, reg, hibernate_3);
+ HEAVY_SWAPIN;
+ I = handle_error(c_p, I, reg, &bif_export[BIF_hibernate_3]->info.mfa);
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)
+ 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);
- I = call_error_handler(c_p, I-3, reg, am_breakpoint);
- r(0) = reg[0];
- SWAPIN;
+ HEAVY_SWAPOUT;
+ I = call_error_handler(c_p, erts_code_to_codemfa(I), reg, am_breakpoint);
+ HEAVY_SWAPIN;
if (I) {
Goto(*I);
}
@@ -5138,7 +5120,7 @@ get_map_elements_fail:
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.
@@ -5151,27 +5133,20 @@ get_map_elements_fail:
#ifndef NO_JUMP_TABLE
#ifdef ERTS_OPCODE_COUNTER_SUPPORT
-
- /* Are tables correctly generated by beam_makeops? */
- ASSERT(sizeof(counting_opcodes) == sizeof(opcodes));
-
- if (count_instructions) {
#ifdef DEBUG
- counting_opcodes[op_catch_end_y] = LabelAddr(lb_catch_end_y);
+ counting_opcodes[op_catch_end_y] = LabelAddr(lb_catch_end_y);
#endif
- counting_opcodes[op_i_func_info_IaaI] = LabelAddr(lb_i_func_info_IaaI);
- beam_ops = counting_opcodes;
- }
- else
-#endif /* #ifndef ERTS_OPCODE_COUNTER_SUPPORT */
- {
- beam_ops = opcodes;
- }
+ counting_opcodes[op_i_func_info_IaaI] = LabelAddr(lb_i_func_info_IaaI);
+ beam_ops = counting_opcodes;
+#else /* #ifndef ERTS_OPCODE_COUNTER_SUPPORT */
+ beam_ops = opcodes;
+#endif /* ERTS_OPCODE_COUNTER_SUPPORT */
#endif /* NO_JUMP_TABLE */
em_call_error_handler = OpCode(call_error_handler);
em_apply_bif = OpCode(apply_bif);
em_call_nif = OpCode(call_nif);
+ em_call_bif_e = OpCode(call_bif_e);
beam_apply[0] = (BeamInstr) OpCode(i_apply);
beam_apply[1] = (BeamInstr) OpCode(normal_exit);
@@ -5190,17 +5165,17 @@ get_map_elements_fail:
bif_table[i].name,
bif_table[i].arity);
bif_export[i] = ep;
- ep->code[3] = (BeamInstr) OpCode(apply_bif);
- ep->code[4] = (BeamInstr) bif_table[i].f;
+ ep->beam[0] = (BeamInstr) OpCode(apply_bif);
+ ep->beam[1] = (BeamInstr) bif_table[i].f;
/* XXX: set func info for bifs */
- ep->fake_op_func_info_for_hipe[0] = (BeamInstr) BeamOp(op_i_func_info_IaaI);
+ ep->info.op = (BeamInstr) BeamOp(op_i_func_info_IaaI);
}
return;
}
#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 */
@@ -5219,34 +5194,277 @@ get_map_elements_fail:
}
}
-static BifFunction
-translate_gc_bif(void* gcf)
+/*
+ * erts_dirty_process_main() is what dirty schedulers execute. Since they handle
+ * only NIF calls they do not need to be able to execute all BEAM
+ * instructions.
+ */
+void erts_dirty_process_main(ErtsSchedulerData *esdp)
{
- if (gcf == erts_gc_length_1) {
- return length_1;
- } else if (gcf == erts_gc_size_1) {
- return size_1;
- } else if (gcf == erts_gc_bit_size_1) {
- return bit_size_1;
- } else if (gcf == erts_gc_byte_size_1) {
- return byte_size_1;
- } else if (gcf == erts_gc_map_size_1) {
- return map_size_1;
- } else if (gcf == erts_gc_abs_1) {
- return abs_1;
- } else if (gcf == erts_gc_float_1) {
- return float_1;
- } else if (gcf == erts_gc_round_1) {
- return round_1;
- } else if (gcf == erts_gc_trunc_1) {
- return round_1;
- } else if (gcf == erts_gc_binary_part_2) {
- return binary_part_2;
- } else if (gcf == erts_gc_binary_part_3) {
- return binary_part_3;
- } else {
- erl_exit(1, "bad gc bif");
+#ifdef ERTS_DIRTY_SCHEDULERS
+ Process* c_p = NULL;
+ ErtsMonotonicTime start_time;
+#ifdef DEBUG
+ ERTS_DECLARE_DUMMY(Eterm pid);
+#endif
+
+ /* Pointer to X registers: x(1)..x(N); reg[0] is used when doing GC,
+ * in all other cases x0 is used.
+ */
+ register Eterm* reg REG_xregs = NULL;
+
+ /*
+ * Top of heap (next free location); grows upwards.
+ */
+ register Eterm* HTOP REG_htop = NULL;
+
+ /* Stack pointer. Grows downwards; points
+ * to last item pushed (normally a saved
+ * continuation pointer).
+ */
+ register Eterm* E REG_stop = NULL;
+
+ /*
+ * Pointer to next threaded instruction.
+ */
+ register BeamInstr *I REG_I = NULL;
+
+ ERTS_MSACC_DECLARE_CACHE_X() /* a cached value of the tsd pointer for msacc */
+
+ /*
+ * start_time always positive for dirty CPU schedulers,
+ * and negative for dirty I/O schedulers.
+ */
+
+ if (ERTS_SCHEDULER_IS_DIRTY_CPU(esdp)) {
+ start_time = erts_get_monotonic_time(NULL);
+ ASSERT(start_time >= 0);
+ }
+ else {
+ start_time = ERTS_SINT64_MIN;
+ ASSERT(start_time < 0);
+ }
+
+ goto do_dirty_schedule;
+
+ context_switch:
+ c_p->current = erts_code_to_codemfa(I); /* Pointer to Mod, Func, Arity */
+ c_p->arity = c_p->current->arity;
+
+ {
+ int reds_used;
+ Eterm* argp;
+ int i;
+
+ /*
+ * Make sure that there is enough room for the argument registers to be saved.
+ */
+ if (c_p->arity > c_p->max_arg_reg) {
+ /*
+ * Yes, this is an expensive operation, but you only pay it the first
+ * time you call a function with more than 6 arguments which is
+ * scheduled out. This is better than paying for 26 words of wasted
+ * space for most processes which never call functions with more than
+ * 6 arguments.
+ */
+ Uint size = c_p->arity * sizeof(c_p->arg_reg[0]);
+ if (c_p->arg_reg != c_p->def_arg_reg) {
+ c_p->arg_reg = (Eterm *) erts_realloc(ERTS_ALC_T_ARG_REG,
+ (void *) c_p->arg_reg,
+ size);
+ } else {
+ c_p->arg_reg = (Eterm *) erts_alloc(ERTS_ALC_T_ARG_REG, size);
+ }
+ c_p->max_arg_reg = c_p->arity;
+ }
+
+ /*
+ * Save the argument registers and everything else.
+ */
+
+ argp = c_p->arg_reg;
+ for (i = c_p->arity - 1; i >= 0; i--) {
+ argp[i] = reg[i];
+ }
+ SWAPOUT;
+ c_p->i = I;
+
+ do_dirty_schedule:
+
+ if (start_time < 0) {
+ /*
+ * Dirty I/O scheduler:
+ * One reduction consumed regardless of
+ * time spent in the dirty NIF.
+ */
+ reds_used = esdp->virtual_reds + 1;
+ }
+ else {
+ /*
+ * Dirty CPU scheduler:
+ * Reductions based on time consumed by
+ * the dirty NIF.
+ */
+ Sint64 treds;
+ treds = erts_time2reds(start_time,
+ erts_get_monotonic_time(esdp));
+ treds += esdp->virtual_reds;
+ reds_used = treds > INT_MAX ? INT_MAX : (int) treds;
+ }
+
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
+ c_p = erts_schedule(esdp, c_p, reds_used);
+
+ if (start_time >= 0) {
+ start_time = erts_get_monotonic_time(esdp);
+ ASSERT(start_time >= 0);
+ }
+ }
+
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
+#ifdef DEBUG
+ pid = c_p->common.id; /* Save for debugging purposes */
+#endif
+ ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+
+ ASSERT(!(c_p->flags & F_HIPE_MODE));
+ ERTS_MSACC_UPDATE_CACHE_X();
+
+ /*
+ * Set fcalls even though we ignore it, so we don't
+ * confuse code accessing it...
+ */
+ if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p))
+ c_p->fcalls = 0;
+ else
+ c_p->fcalls = CONTEXT_REDS;
+
+ if (erts_smp_atomic32_read_nob(&c_p->state) & ERTS_PSFLG_DIRTY_RUNNING_SYS) {
+ erts_execute_dirty_system_task(c_p);
+ goto do_dirty_schedule;
+ }
+ else {
+ ErtsCodeMFA *codemfa;
+ Eterm* argp;
+ int i, exiting;
+
+ reg = esdp->x_reg_array;
+
+ argp = c_p->arg_reg;
+ for (i = c_p->arity - 1; i >= 0; i--) {
+ reg[i] = argp[i];
+ CHECK_TERM(reg[i]);
+ }
+
+ /*
+ * We put the original reduction count in the process structure, to reduce
+ * the code size (referencing a field in a struct through a pointer stored
+ * in a register gives smaller code than referencing a global variable).
+ */
+
+ I = c_p->i;
+
+ SWAPIN;
+
+#ifdef USE_VM_PROBES
+ if (DTRACE_ENABLED(process_scheduled)) {
+ DTRACE_CHARBUF(process_buf, DTRACE_TERM_BUF_SIZE);
+ DTRACE_CHARBUF(fun_buf, DTRACE_TERM_BUF_SIZE);
+ dtrace_proc_str(c_p, process_buf);
+
+ if (ERTS_PROC_IS_EXITING(c_p)) {
+ strcpy(fun_buf, "<exiting>");
+ } else {
+ ErtsCodeMFA *cmfa = find_function_from_pc(c_p->i);
+ if (cmfa) {
+ dtrace_fun_decode(c_p, cmfa, NULL, fun_buf);
+ } else {
+ erts_snprintf(fun_buf, sizeof(DTRACE_CHARBUF_NAME(fun_buf)),
+ "<unknown/%p>", *I);
+ }
+ }
+
+ DTRACE2(process_scheduled, process_buf, fun_buf);
+ }
+#endif
+
+ /*
+ * call_nif is always first instruction in function:
+ *
+ * I[-3]: Module
+ * I[-2]: Function
+ * I[-1]: Arity
+ * I[0]: &&call_nif
+ * I[1]: Function pointer to NIF function
+ * I[2]: Pointer to erl_module_nif
+ * I[3]: Function pointer to dirty NIF
+ *
+ * This layout is determined by the NifExport struct
+ */
+
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_NIF);
+
+ codemfa = erts_code_to_codemfa(I);
+
+ DTRACE_NIF_ENTRY(c_p, codemfa);
+ c_p->current = codemfa;
+ SWAPOUT;
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
+
+ ASSERT(!ERTS_PROC_IS_EXITING(c_p));
+ if (em_apply_bif == (BeamInstr *) *I) {
+ exiting = erts_call_dirty_bif(esdp, c_p, I, reg);
+ }
+ else {
+ ASSERT(em_call_nif == (BeamInstr *) *I);
+ exiting = erts_call_dirty_nif(esdp, c_p, I, reg);
+ }
+
+ ASSERT(!(c_p->flags & F_HIBERNATE_SCHED));
+
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR);
+ if (exiting)
+ goto do_dirty_schedule;
+ ASSERT(!ERTS_PROC_IS_EXITING(c_p));
+
+ DTRACE_NIF_RETURN(c_p, codemfa);
+ ERTS_HOLE_CHECK(c_p);
+ SWAPIN;
+ I = c_p->i;
+ goto context_switch;
+ }
+#endif /* ERTS_DIRTY_SCHEDULERS */
+}
+
+static ErtsCodeMFA *
+gcbif2mfa(void* gcf)
+{
+ int i;
+ for (i = 0; erts_gc_bifs[i].bif; i++) {
+ if (erts_gc_bifs[i].gc_bif == gcf)
+ return &bif_export[erts_gc_bifs[i].exp_ix]->info.mfa;
+ }
+ erts_exit(ERTS_ERROR_EXIT, "bad gc bif");
+ return NULL;
+}
+
+static ErtsCodeMFA *
+ubif2mfa(void* uf)
+{
+ int i;
+ for (i = 0; erts_u_bifs[i].bif; i++) {
+ if (erts_u_bifs[i].bif == uf)
+ return &bif_export[erts_u_bifs[i].exp_ix]->info.mfa;
}
+ erts_exit(ERTS_ERROR_EXIT, "bad u bif");
+ return NULL;
}
/*
@@ -5279,7 +5497,9 @@ Eterm error_atom[NUMBER_EXIT_CODES] = {
am_notalive, /* 14 */
am_system_limit, /* 15 */
am_try_clause, /* 16 */
- am_notsup /* 17 */
+ am_notsup, /* 17 */
+ am_badmap, /* 18 */
+ am_badkey, /* 19 */
};
/*
@@ -5303,15 +5523,27 @@ Eterm error_atom[NUMBER_EXIT_CODES] = {
*/
static BeamInstr*
-handle_error(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf)
+handle_error(Process* c_p, BeamInstr* pc, Eterm* reg, ErtsCodeMFA *bif_mfa)
{
Eterm* hp;
Eterm Value = c_p->fvalue;
Eterm Args = am_true;
- c_p->i = pc; /* In case we call erl_exit(). */
ASSERT(c_p->freason != TRAP); /* Should have been handled earlier. */
+ if (c_p->freason & EXF_RESTORE_NIF)
+ erts_nif_export_restore_error(c_p, &pc, reg, &bif_mfa);
+
+#ifdef DEBUG
+ if (bif_mfa) {
+ /* Verify that bif_mfa does not point into our nif export */
+ NifExport *nep = ERTS_PROC_GET_NIF_TRAP_EXPORT(c_p);
+ ASSERT(!nep || !ErtsInArea(bif_mfa, (char *)nep, sizeof(NifExport)));
+ }
+#endif
+
+ c_p->i = pc; /* In case we call erts_exit(). */
+
/*
* Check if we have an arglist for the top level call. If so, this
* is encoded in Value, so we have to dig out the real Value as well
@@ -5334,7 +5566,7 @@ handle_error(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf)
* more modular.
*/
if (c_p->freason & EXF_SAVETRACE) {
- save_stacktrace(c_p, pc, reg, bf, Args);
+ save_stacktrace(c_p, pc, reg, bif_mfa, Args);
}
/*
@@ -5372,7 +5604,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);
@@ -5404,8 +5636,10 @@ next_catch(Process* c_p, Eterm *reg) {
/* Can not follow cp here - code may be unloaded */
BeamInstr *cpp = c_p->cp;
if (cpp == beam_exception_trace) {
- erts_trace_exception(c_p, cp_val(ptr[0]),
- reg[1], reg[2], ptr+1);
+ ErtsCodeMFA *mfa = (ErtsCodeMFA*)cp_val(ptr[0]);
+ erts_trace_exception(c_p, mfa,
+ reg[1], reg[2],
+ ERTS_TRACER_FROM_ETERM(ptr+1));
/* Skip return_trace parameters */
ptr += 2;
} else if (cpp == beam_return_trace) {
@@ -5431,8 +5665,10 @@ next_catch(Process* c_p, Eterm *reg) {
if (is_catch(*ptr) && active_catches) goto found_catch;
}
if (cp_val(*prev) == beam_exception_trace) {
- erts_trace_exception(c_p, cp_val(ptr[0]),
- reg[1], reg[2], ptr+1);
+ ErtsCodeMFA *mfa = (ErtsCodeMFA*)cp_val(ptr[0]);
+ erts_trace_exception(c_p, mfa,
+ reg[1], reg[2],
+ ERTS_TRACER_FROM_ETERM(ptr+1));
}
/* Skip return_trace parameters */
ptr += 2;
@@ -5482,18 +5718,35 @@ next_catch(Process* c_p, Eterm *reg) {
static void
terminate_proc(Process* c_p, Eterm Value)
{
+ Eterm *hp;
+ Eterm Args = NIL;
+
/* Add a stacktrace if this is an error. */
if (GET_EXC_CLASS(c_p->freason) == EXTAG_ERROR) {
Value = add_stacktrace(c_p, Value, c_p->ftrace);
}
/* EXF_LOG is a primary exception flag */
if (c_p->freason & EXF_LOG) {
+ int alive = erts_is_alive;
erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
- erts_dsprintf(dsbufp, "Error in process %T ", c_p->common.id);
- if (erts_is_alive)
- erts_dsprintf(dsbufp, "on node %T ", erts_this_node->sysname);
- erts_dsprintf(dsbufp,"with exit value: %0.*T\n", display_items, Value);
- erts_send_error_to_logger(c_p->group_leader, dsbufp);
+
+ /* Build the format message */
+ erts_dsprintf(dsbufp, "Error in process ~p ");
+ if (alive)
+ erts_dsprintf(dsbufp, "on node ~p ");
+ erts_dsprintf(dsbufp, "with exit value:~n~p~n");
+
+ /* Build the args in reverse order */
+ hp = HAlloc(c_p, 2);
+ Args = CONS(hp, Value, Args);
+ if (alive) {
+ hp = HAlloc(c_p, 2);
+ Args = CONS(hp, erts_this_node->sysname, Args);
+ }
+ hp = HAlloc(c_p, 2);
+ Args = CONS(hp, c_p->common.id, Args);
+
+ erts_send_error_term_to_logger(c_p->group_leader, dsbufp, Args);
}
/*
* If we use a shared heap, the process will be garbage-collected.
@@ -5535,6 +5788,8 @@ expand_error_value(Process* c_p, Uint freason, Eterm Value) {
case (GET_EXC_INDEX(EXC_TRY_CLAUSE)):
case (GET_EXC_INDEX(EXC_BADFUN)):
case (GET_EXC_INDEX(EXC_BADARITY)):
+ case (GET_EXC_INDEX(EXC_BADMAP)):
+ case (GET_EXC_INDEX(EXC_BADKEY)):
/* Some common exceptions: value -> {atom, value} */
ASSERT(is_value(Value));
hp = HAlloc(c_p, 3);
@@ -5586,11 +5841,12 @@ expand_error_value(Process* c_p, Uint freason, Eterm Value) {
*/
static void
-save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf,
- Eterm args) {
+save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg,
+ ErtsCodeMFA *bif_mfa, Eterm args) {
struct StackTrace* s;
int sz;
int depth = erts_backtrace_depth; /* max depth (never negative) */
+
if (depth > 0) {
/* There will always be a current function */
depth --;
@@ -5606,33 +5862,30 @@ save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf,
s->depth = 0;
/*
- * If the failure was in a BIF other than 'error', 'exit' or
- * 'throw', find the bif-table index and save the argument
+ * If the failure was in a BIF other than 'error/1', 'error/2',
+ * 'exit/1' or 'throw/1', save BIF-MFA and save the argument
* registers by consing up an arglist.
*/
- if (bf != NULL && bf != error_1 && bf != error_2 &&
- bf != exit_1 && bf != throw_1) {
- int i;
- int a = 0;
- for (i = 0; i < BIF_SIZE; i++) {
- if (bf == bif_table[i].f || bf == bif_table[i].traced) {
- Export *ep = bif_export[i];
- s->current = ep->code;
- a = bif_table[i].arity;
+ if (bif_mfa) {
+ if (bif_mfa->module == am_erlang) {
+ switch (bif_mfa->function) {
+ case am_error:
+ if (bif_mfa->arity == 1 || bif_mfa->arity == 2)
+ goto non_bif_stacktrace;
+ break;
+ case am_exit:
+ if (bif_mfa->arity == 1)
+ goto non_bif_stacktrace;
+ break;
+ case am_throw:
+ if (bif_mfa->arity == 1)
+ goto non_bif_stacktrace;
+ break;
+ default:
break;
}
}
- if (i >= BIF_SIZE) {
- /*
- * The Bif does not really exist (no BIF entry). It is a
- * TRAP and traps are called through apply_bif, which also
- * sets c_p->current (luckily).
- * OR it is a NIF called by call_nif where current is also set.
- */
- ASSERT(c_p->current);
- s->current = c_p->current;
- a = s->current[2];
- }
+ s->current = bif_mfa;
/* Save first stack entry */
ASSERT(pc);
if (depth > 0) {
@@ -5645,8 +5898,11 @@ save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf,
depth--;
}
s->pc = NULL;
- args = make_arglist(c_p, reg, a); /* Overwrite CAR(c_p->ftrace) */
+ args = make_arglist(c_p, reg, bif_mfa->arity); /* Overwrite CAR(c_p->ftrace) */
} else {
+
+ non_bif_stacktrace:
+
s->current = c_p->current;
/*
* For a function_clause error, the arguments are in the beam
@@ -5656,7 +5912,7 @@ save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf,
(GET_EXC_INDEX(EXC_FUNCTION_CLAUSE)) ) {
int a;
ASSERT(s->current);
- a = s->current[2];
+ a = s->current->arity;
args = make_arglist(c_p, reg, a); /* Overwrite CAR(c_p->ftrace) */
/* Save first stack entry */
ASSERT(c_p->cp);
@@ -5707,12 +5963,30 @@ erts_save_stacktrace(Process* p, struct StackTrace* s, int depth)
p->cp) {
/* Cannot follow cp here - code may be unloaded */
BeamInstr *cpp = p->cp;
+ int trace_cp;
if (cpp == beam_exception_trace || cpp == beam_return_trace) {
/* Skip return_trace parameters */
ptr += 2;
+ trace_cp = 1;
} else if (cpp == beam_return_to_trace) {
/* Skip return_to_trace parameters */
ptr += 1;
+ trace_cp = 1;
+ }
+ else {
+ trace_cp = 0;
+ }
+ if (trace_cp && s->pc == cpp) {
+ /*
+ * If process 'cp' points to a return/exception trace
+ * instruction and 'cp' has been saved as 'pc' in
+ * stacktrace, we need to update 'pc' in stacktrace
+ * with the actual 'cp' located on the top of the
+ * stack; otherwise, we will lose the top stackframe
+ * when building the stack trace.
+ */
+ ASSERT(is_CP(p->stop[0]));
+ s->pc = cp_val(p->stop[0]);
}
}
while (ptr < STACK_START(p) && depth > 0) {
@@ -5827,17 +6101,20 @@ build_stacktrace(Process* c_p, Eterm exc) {
erts_lookup_function_info(&fi, s->pc, 1);
} else if (GET_EXC_INDEX(s->freason) ==
GET_EXC_INDEX(EXC_FUNCTION_CLAUSE)) {
- erts_lookup_function_info(&fi, s->current, 1);
+ erts_lookup_function_info(&fi, erts_codemfa_to_code(s->current), 1);
} else {
erts_set_current_function(&fi, s->current);
}
+ depth = s->depth;
/*
- * If fi.current is still NULL, default to the initial function
+ * If fi.current is still NULL, and we have no
+ * stack at all, default to the initial function
* (e.g. spawn_link(erlang, abs, [1])).
*/
- if (fi.current == NULL) {
- erts_set_current_function(&fi, c_p->initial);
+ if (fi.mfa == NULL) {
+ if (depth <= 0)
+ erts_set_current_function(&fi, &c_p->u.initial);
args = am_true; /* Just in case */
} else {
args = get_args_from_exc(exc);
@@ -5847,13 +6124,12 @@ build_stacktrace(Process* c_p, Eterm exc) {
* Look up all saved continuation pointers and calculate
* needed heap space.
*/
- depth = s->depth;
stk = stkp = (FunctionInfo *) erts_alloc(ERTS_ALC_T_TMP,
depth*sizeof(FunctionInfo));
- heap_size = fi.needed + 2;
+ heap_size = fi.mfa ? fi.needed + 2 : 0;
for (i = 0; i < depth; i++) {
erts_lookup_function_info(stkp, s->trace[i], 1);
- if (stkp->current) {
+ if (stkp->mfa) {
heap_size += stkp->needed + 2;
stkp++;
}
@@ -5869,15 +6145,17 @@ build_stacktrace(Process* c_p, Eterm exc) {
res = CONS(hp, mfa, res);
hp += 2;
}
- hp = erts_build_mfa_item(&fi, hp, args, &mfa);
- res = CONS(hp, mfa, res);
+ if (fi.mfa) {
+ hp = erts_build_mfa_item(&fi, hp, args, &mfa);
+ res = CONS(hp, mfa, res);
+ }
erts_free(ERTS_ALC_T_TMP, (void *) stk);
return res;
}
static BeamInstr*
-call_error_handler(Process* p, BeamInstr* fi, Eterm* reg, Eterm func)
+call_error_handler(Process* p, ErtsCodeMFA* mfa, Eterm* reg, Eterm func)
{
Eterm* hp;
Export* ep;
@@ -5886,13 +6164,14 @@ call_error_handler(Process* p, BeamInstr* fi, Eterm* reg, Eterm func)
Uint sz;
int i;
+ DBG_TRACE_MFA_P(mfa, "call_error_handler");
/*
* Search for the error_handler module.
*/
ep = erts_find_function(erts_proc_get_error_handler(p), func, 3,
erts_active_code_ix());
if (ep == NULL) { /* No error handler */
- p->current = fi;
+ p->current = mfa;
p->freason = EXC_UNDEF;
return 0;
}
@@ -5901,7 +6180,7 @@ call_error_handler(Process* p, BeamInstr* fi, Eterm* reg, Eterm func)
* Create a list with all arguments in the x registers.
*/
- arity = fi[2];
+ arity = mfa->arity;
sz = 2 * arity;
if (HeapWordsLeft(p) < sz) {
erts_garbage_collect(p, sz, reg, arity);
@@ -5917,8 +6196,8 @@ call_error_handler(Process* p, BeamInstr* fi, Eterm* reg, Eterm func)
/*
* Set up registers for call to error_handler:<func>/3.
*/
- reg[0] = fi[0];
- reg[1] = fi[1];
+ reg[0] = mfa->module;
+ reg[1] = mfa->function;
reg[2] = args;
return ep->addressv[erts_active_code_ix()];
}
@@ -5967,8 +6246,107 @@ apply_setup_error_handler(Process* p, Eterm module, Eterm function, Uint arity,
return ep;
}
+static ERTS_INLINE void
+apply_bif_error_adjustment(Process *p, Export *ep,
+ Eterm *reg, Uint arity,
+ BeamInstr *I, Uint stack_offset)
+{
+ /*
+ * I is only set when the apply is a tail call, i.e.,
+ * from the instructions i_apply_only, i_apply_last_P,
+ * and apply_last_IP.
+ */
+ if (I
+ && ep->beam[0] == (BeamInstr) em_apply_bif
+ && (ep == bif_export[BIF_error_1]
+ || ep == bif_export[BIF_error_2]
+ || ep == bif_export[BIF_exit_1]
+ || ep == bif_export[BIF_throw_1])) {
+ /*
+ * We are about to tail apply one of the BIFs
+ * erlang:error/1, erlang:error/2, erlang:exit/1,
+ * or erlang:throw/1. Error handling of these BIFs is
+ * special!
+ *
+ * We need 'p->cp' to point into the calling
+ * function when handling the error after the BIF has
+ * been applied. This in order to get the topmost
+ * stackframe correct. Without the following adjustment,
+ * 'p->cp' will point into the function that called
+ * current function when handling the error. We add a
+ * dummy stackframe in order to achieve this.
+ *
+ * Note that these BIFs unconditionally will cause
+ * an exception to be raised. That is, our modifications
+ * of 'p->cp' as well as the stack will be corrected by
+ * the error handling code.
+ *
+ * If we find an exception/return-to trace continuation
+ * pointer as the topmost continuation pointer, we do not
+ * need to do anything since the information already will
+ * be available for generation of the stacktrace.
+ */
+ int apply_only = stack_offset == 0;
+ BeamInstr *cpp;
+
+ if (apply_only) {
+ ASSERT(p->cp != NULL);
+ cpp = p->cp;
+ }
+ else {
+ ASSERT(is_CP(p->stop[0]));
+ cpp = cp_val(p->stop[0]);
+ }
+
+ if (cpp != beam_exception_trace
+ && cpp != beam_return_trace
+ && cpp != beam_return_to_trace) {
+ Uint need = stack_offset /* bytes */ / sizeof(Eterm);
+ if (need == 0)
+ need = 1; /* i_apply_only */
+ if (p->stop - p->htop < need)
+ erts_garbage_collect(p, (int) need, reg, arity+1);
+ p->stop -= need;
+
+ if (apply_only) {
+ /*
+ * Called from the i_apply_only instruction.
+ *
+ * 'p->cp' contains continuation pointer pointing
+ * into the function that called current function.
+ * We push that continuation pointer onto the stack,
+ * and set 'p->cp' to point into current function.
+ */
+
+ p->stop[0] = make_cp(p->cp);
+ p->cp = I;
+ }
+ else {
+ /*
+ * Called from an i_apply_last_p, or apply_last_IP,
+ * instruction.
+ *
+ * Calling instruction will after we return read
+ * a continuation pointer from the stack and write
+ * it to 'p->cp', and then remove the topmost
+ * stackframe of size 'stack_offset'.
+ *
+ * We have sized the dummy-stackframe so that it
+ * will be removed by the instruction we currently
+ * are executing, and leave the stackframe that
+ * normally would have been removed intact.
+ *
+ */
+ p->stop[0] = make_cp(I);
+ }
+ }
+ }
+}
+
static BeamInstr*
-apply(Process* p, Eterm module, Eterm function, Eterm args, Eterm* reg)
+apply(
+Process* p, Eterm module, Eterm function, Eterm args, Eterm* reg,
+BeamInstr *I, Uint stack_offset)
{
int arity;
Export* ep;
@@ -5993,21 +6371,54 @@ apply(Process* p, Eterm module, Eterm function, Eterm args, Eterm* reg)
return 0;
}
- /* The module argument may be either an atom or an abstract module
- * (currently implemented using tuples, but this might change).
- */
- this = THE_NON_VALUE;
- if (is_not_atom(module)) {
- Eterm* tp;
+ while (1) {
+ Eterm m, f, a;
+ /* The module argument may be either an atom or an abstract module
+ * (currently implemented using tuples, but this might change).
+ */
+ this = THE_NON_VALUE;
+ if (is_not_atom(module)) {
+ Eterm* tp;
+
+ if (is_not_tuple(module)) goto error;
+ tp = tuple_val(module);
+ if (arityval(tp[0]) < 1) goto error;
+ this = module;
+ module = tp[1];
+ if (is_not_atom(module)) goto error;
+ }
- if (is_not_tuple(module)) goto error;
- tp = tuple_val(module);
- if (arityval(tp[0]) < 1) goto error;
- this = module;
- module = tp[1];
- if (is_not_atom(module)) goto error;
+ if (module != am_erlang || function != am_apply)
+ break;
+
+ /* Adjust for multiple apply of apply/3... */
+
+ a = args;
+ if (is_list(a)) {
+ Eterm *consp = list_val(a);
+ m = CAR(consp);
+ a = CDR(consp);
+ if (is_list(a)) {
+ consp = list_val(a);
+ f = CAR(consp);
+ a = CDR(consp);
+ if (is_list(a)) {
+ consp = list_val(a);
+ a = CAR(consp);
+ if (is_nil(CDR(consp))) {
+ /* erlang:apply/3 */
+ module = m;
+ function = f;
+ args = a;
+ if (is_not_atom(f))
+ goto error;
+ continue;
+ }
+ }
+ }
+ }
+ break; /* != erlang:apply/3 */
}
-
/*
* Walk down the 3rd parameter of apply (the argument list) and copy
* the parameters to the x registers (reg[]). If the module argument
@@ -6045,18 +6456,14 @@ apply(Process* p, Eterm module, Eterm function, Eterm args, Eterm* reg)
} else if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) {
save_calls(p, ep);
}
-
-#ifdef USE_VM_CALL_PROBES
- if (DTRACE_ENABLED(global_function_entry)) {
- BeamInstr *fptr = (BeamInstr *) ep->addressv[erts_active_code_ix()];
- DTRACE_GLOBAL_CALL(p, (Eterm)fptr[-3], (Eterm)fptr[-2], (Uint)fptr[-1]);
- }
-#endif
+ apply_bif_error_adjustment(p, ep, reg, arity, I, stack_offset);
+ DTRACE_GLOBAL_CALL_FROM_EXPORT(p, ep);
return ep->addressv[erts_active_code_ix()];
}
static BeamInstr*
-fixed_apply(Process* p, Eterm* reg, Uint arity)
+fixed_apply(Process* p, Eterm* reg, Uint arity,
+ BeamInstr *I, Uint stack_offset)
{
Export* ep;
Eterm module;
@@ -6086,6 +6493,10 @@ fixed_apply(Process* p, Eterm* reg, Uint arity)
if (is_not_atom(module)) goto error;
++arity;
}
+
+ /* Handle apply of apply/3... */
+ if (module == am_erlang && function == am_apply && arity == 3)
+ return apply(p, reg[0], reg[1], reg[2], reg, I, stack_offset);
/*
* Get the index into the export table, or failing that the export
@@ -6100,13 +6511,8 @@ fixed_apply(Process* p, Eterm* reg, Uint arity)
} else if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) {
save_calls(p, ep);
}
-
-#ifdef USE_VM_CALL_PROBES
- if (DTRACE_ENABLED(global_function_entry)) {
- BeamInstr *fptr = (BeamInstr *) ep->addressv[erts_active_code_ix()];
- DTRACE_GLOBAL_CALL(p, (Eterm)fptr[-3], (Eterm)fptr[-2], (Uint)fptr[-1]);
- }
-#endif
+ apply_bif_error_adjustment(p, ep, reg, arity, I, stack_offset);
+ DTRACE_GLOBAL_CALL_FROM_EXPORT(p, ep);
return ep->addressv[erts_active_code_ix()];
}
@@ -6116,6 +6522,23 @@ erts_hibernate(Process* c_p, Eterm module, Eterm function, Eterm args, Eterm* re
int arity;
Eterm tmp;
+#ifndef ERTS_SMP
+ if (ERTS_PROC_IS_EXITING(c_p)) {
+ /*
+ * I non smp case:
+ *
+ * Currently executing process might be sent an exit
+ * signal if it is traced by a port that it also is
+ * linked to, and the port terminates during the
+ * trace. In this case we do *not* want to clear
+ * the active flag, which will make the process hang
+ * in limbo forever. Get out of here and terminate
+ * the process...
+ */
+ return -1;
+ }
+#endif
+
if (is_not_atom(module) || is_not_atom(function)) {
/*
* No need to test args here -- done below.
@@ -6158,11 +6581,11 @@ erts_hibernate(Process* c_p, Eterm module, Eterm function, Eterm args, Eterm* re
#ifdef USE_VM_PROBES
if (DTRACE_ENABLED(process_hibernate)) {
+ ErtsCodeMFA cmfa = { module, function, arity};
DTRACE_CHARBUF(process_name, DTRACE_TERM_BUF_SIZE);
- DTRACE_CHARBUF(mfa, DTRACE_TERM_BUF_SIZE);
- dtrace_fun_decode(c_p, module, function, arity,
- process_name, mfa);
- DTRACE2(process_hibernate, process_name, mfa);
+ DTRACE_CHARBUF(mfa_buf, DTRACE_TERM_BUF_SIZE);
+ dtrace_fun_decode(c_p, &cmfa, process_name, mfa_buf);
+ DTRACE2(process_hibernate, process_name, mfa_buf);
}
#endif
/*
@@ -6192,15 +6615,24 @@ erts_hibernate(Process* c_p, Eterm module, Eterm function, Eterm args, Eterm* re
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
-#ifdef ERTS_SMP
- ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p);
+#ifndef ERTS_SMP
+ if (ERTS_PROC_IS_EXITING(c_p)) {
+ /*
+ * See comment in the beginning of the function...
+ *
+ * This second test is needed since gc might be traced.
+ */
+ return -1;
+ }
+#else /* ERTS_SMP */
+ ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p);
if (!c_p->msg.len)
#endif
erts_smp_atomic32_read_band_relb(&c_p->state, ~ERTS_PSFLG_ACTIVE);
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
}
erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
- c_p->current = bif_export[BIF_hibernate_3]->code;
+ c_p->current = &bif_export[BIF_hibernate_3]->info.mfa;
c_p->flags |= F_HIBERNATE_SCHED; /* Needed also when woken! */
return 1;
}
@@ -6223,21 +6655,15 @@ call_fun(Process* p, /* Current process. */
if (is_fun_header(hdr)) {
ErlFunThing* funp = (ErlFunThing *) fun_val(fun);
- ErlFunEntry* fe;
- BeamInstr* code_ptr;
+ ErlFunEntry* fe = funp->fe;
+ BeamInstr* code_ptr = fe->address;
Eterm* var_ptr;
- int actual_arity;
- unsigned num_free;
-
- fe = funp->fe;
- num_free = funp->num_free;
- code_ptr = fe->address;
- actual_arity = (int) code_ptr[-1];
+ unsigned num_free = funp->num_free;
+ ErtsCodeMFA *mfa = erts_code_to_codemfa(code_ptr);
+ int actual_arity = mfa->arity;
if (actual_arity == arity+num_free) {
- DTRACE_LOCAL_CALL(p, (Eterm)code_ptr[-3],
- (Eterm)code_ptr[-2],
- code_ptr[-1]);
+ DTRACE_LOCAL_CALL(p, mfa);
if (num_free == 0) {
return code_ptr;
} else {
@@ -6292,34 +6718,49 @@ call_fun(Process* p, /* Current process. */
* representation (the module has never been loaded),
* or the module defining the fun has been unloaded.
*/
+
module = fe->module;
- if ((modp = erts_get_module(module, code_ix)) != NULL
- && modp->curr.code != NULL) {
+
+ ERTS_SMP_READ_MEMORY_BARRIER;
+ if (fe->pend_purge_address) {
/*
- * There is a module loaded, but obviously the fun is not
- * defined in it. We must not call the error_handler
- * (or we will get into an infinite loop).
+ * The system is currently trying to purge the
+ * module containing this fun. Suspend the process
+ * and let it try again when the purge operation is
+ * done (may succeed or not).
*/
- goto badfun;
+ ep = erts_suspend_process_on_pending_purge_lambda(p, fe);
+ ASSERT(ep);
}
+ else {
+ if ((modp = erts_get_module(module, code_ix)) != 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
+ * (or we will get into an infinite loop).
+ */
+ goto badfun;
+ }
- /*
- * No current code for this module. Call the error_handler module
- * to attempt loading the module.
- */
+ /*
+ * No current code for this module. Call the error_handler module
+ * to attempt loading the module.
+ */
- ep = erts_find_function(erts_proc_get_error_handler(p),
- am_undefined_lambda, 3, code_ix);
- if (ep == NULL) { /* No error handler */
- p->current = NULL;
- p->freason = EXC_UNDEF;
- return NULL;
+ ep = erts_find_function(erts_proc_get_error_handler(p),
+ am_undefined_lambda, 3, code_ix);
+ if (ep == NULL) { /* No error handler */
+ p->current = NULL;
+ p->freason = EXC_UNDEF;
+ return NULL;
+ }
}
reg[0] = module;
reg[1] = fun;
reg[2] = args;
reg[3] = NIL;
- return ep->addressv[erts_active_code_ix()];
+ return ep->addressv[code_ix];
}
}
} else if (is_export_header(hdr)) {
@@ -6327,10 +6768,10 @@ call_fun(Process* p, /* Current process. */
int actual_arity;
ep = *((Export **) (export_val(fun) + 1));
- actual_arity = (int) ep->code[2];
+ actual_arity = ep->info.mfa.arity;
if (arity == actual_arity) {
- DTRACE_GLOBAL_CALL(p, ep->code[0], ep->code[1], (Uint)ep->code[2]);
+ DTRACE_GLOBAL_CALL(p, &ep->info.mfa);
return ep->addressv[erts_active_code_ix()];
} else {
/*
@@ -6384,7 +6825,7 @@ apply_fun(Process* p, Eterm fun, Eterm args, Eterm* reg)
}
if (is_not_nil(tmp)) { /* Must be well-formed list */
- p->freason = EXC_UNDEF;
+ p->freason = EXC_BADARG;
return NULL;
}
reg[arity] = fun;
@@ -6411,16 +6852,13 @@ new_fun(Process* p, Eterm* reg, ErlFunEntry* fe, int num_free)
p->htop = hp + needed;
funp = (ErlFunThing *) hp;
hp = funp->env;
- erts_refc_inc(&fe->refc, 2);
+ erts_smp_refc_inc(&fe->refc, 2);
funp->thing_word = HEADER_FUN;
funp->next = MSO(p).first;
MSO(p).first = (struct erl_off_heap_header*) funp;
funp->fe = fe;
funp->num_free = num_free;
funp->creator = p->common.id;
-#ifdef HIPE
- funp->native_address = fe->native_address;
-#endif
funp->arity = (int)fe->address[-1] - num_free;
for (i = 0; i < num_free; i++) {
*hp++ = reg[i];
@@ -6428,76 +6866,91 @@ new_fun(Process* p, Eterm* reg, ErlFunEntry* fe, int num_free)
return make_fun(funp);
}
-static int has_not_map_field(Eterm map, Eterm key)
+static Eterm get_map_element(Eterm map, Eterm key)
{
- map_t* mp;
- Eterm* keys;
- Uint i;
- Uint n;
-
- mp = (map_t *)map_val(map);
- keys = map_get_keys(mp);
- n = map_get_size(mp);
- if (is_immed(key)) {
- for (i = 0; i < n; i++) {
- if (keys[i] == key) {
- return 0;
+ Uint32 hx;
+ const Eterm *vs;
+ if (is_flatmap(map)) {
+ flatmap_t *mp;
+ Eterm *ks;
+ Uint i;
+ Uint n;
+
+ mp = (flatmap_t *)flatmap_val(map);
+ ks = flatmap_get_keys(mp);
+ vs = flatmap_get_values(mp);
+ n = flatmap_get_size(mp);
+ if (is_immed(key)) {
+ for (i = 0; i < n; i++) {
+ if (ks[i] == key) {
+ return vs[i];
+ }
}
- }
- } else {
- for (i = 0; i < n; i++) {
- if (EQ(keys[i], key)) {
- return 0;
+ } else {
+ for (i = 0; i < n; i++) {
+ if (EQ(ks[i], key)) {
+ return vs[i];
+ }
}
}
+ return THE_NON_VALUE;
}
- return 1;
+ ASSERT(is_hashmap(map));
+ hx = hashmap_make_hash(key);
+ vs = erts_hashmap_get(hx,key,map);
+ return vs ? *vs : THE_NON_VALUE;
}
-static Eterm get_map_element(Eterm map, Eterm key)
+static Eterm get_map_element_hash(Eterm map, Eterm key, Uint32 hx)
{
- map_t *mp;
- Eterm* ks, *vs;
- Uint i;
- Uint n;
-
- mp = (map_t *)map_val(map);
- ks = map_get_keys(mp);
- vs = map_get_values(mp);
- n = map_get_size(mp);
- if (is_immed(key)) {
- for (i = 0; i < n; i++) {
- if (ks[i] == key) {
- return vs[i];
+ const Eterm *vs;
+
+ if (is_flatmap(map)) {
+ flatmap_t *mp;
+ Eterm *ks;
+ Uint i;
+ Uint n;
+
+ mp = (flatmap_t *)flatmap_val(map);
+ ks = flatmap_get_keys(mp);
+ vs = flatmap_get_values(mp);
+ n = flatmap_get_size(mp);
+ if (is_immed(key)) {
+ for (i = 0; i < n; i++) {
+ if (ks[i] == key) {
+ return vs[i];
+ }
}
- }
- } else {
- for (i = 0; i < n; i++) {
- if (EQ(ks[i], key)) {
- return vs[i];
+ } else {
+ for (i = 0; i < n; i++) {
+ if (EQ(ks[i], key)) {
+ return vs[i];
+ }
}
}
+ return THE_NON_VALUE;
}
- return THE_NON_VALUE;
+
+ ASSERT(is_hashmap(map));
+ ASSERT(hx == hashmap_make_hash(key));
+ vs = erts_hashmap_get(hx, key, map);
+ 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)
@@ -6511,7 +6964,33 @@ new_map(Process* p, Eterm* reg, BeamInstr* I)
Eterm *mhp,*thp;
Eterm *E;
BeamInstr *ptr;
- map_t *mp;
+ flatmap_t *mp;
+ ErtsHeapFactory factory;
+
+ ptr = &Arg(4);
+
+ if (n > 2*MAP_SMALL_MAP_LIMIT) {
+ Eterm res;
+ if (HeapWordsLeft(p) < n) {
+ erts_garbage_collect(p, n, reg, Arg(2));
+ }
+
+ mhp = p->htop;
+ thp = p->htop;
+ E = p->stop;
+
+ for (i = 0; i < n/2; i++) {
+ GET_TERM(*ptr++, *mhp++);
+ GET_TERM(*ptr++, *mhp++);
+ }
+
+ p->htop = mhp;
+
+ erts_factory_proc_init(&factory, p);
+ res = erts_hashmap_from_array(&factory, thp, n/2, 0);
+ erts_factory_close(&factory);
+ return res;
+ }
if (HeapWordsLeft(p) < need) {
erts_garbage_collect(p, need, reg, Arg(2));
@@ -6520,12 +6999,11 @@ new_map(Process* p, Eterm* reg, BeamInstr* I)
thp = p->htop;
mhp = thp + 1 + n/2;
E = p->stop;
- ptr = &Arg(4);
keys = make_tuple(thp);
*thp++ = make_arityval(n/2);
- mp = (map_t *)mhp; mhp += MAP_HEADER_SIZE;
- mp->thing_word = MAP_HEADER;
+ mp = (flatmap_t *)mhp; mhp += MAP_HEADER_FLATMAP_SZ;
+ mp->thing_word = MAP_HEADER_FLATMAP;
mp->size = n/2;
mp->keys = keys;
@@ -6534,7 +7012,7 @@ new_map(Process* p, Eterm* reg, BeamInstr* I)
GET_TERM(*ptr++, *mhp++);
}
p->htop = mhp;
- return make_map(mp);
+ return make_flatmap(mp);
}
static Eterm
@@ -6544,7 +7022,7 @@ update_map_assoc(Process* p, Eterm* reg, Eterm map, BeamInstr* I)
Uint num_old;
Uint num_updates;
Uint need;
- map_t *old_mp, *mp;
+ flatmap_t *old_mp, *mp;
Eterm res;
Eterm* hp;
Eterm* E;
@@ -6554,12 +7032,36 @@ update_map_assoc(Process* p, Eterm* reg, Eterm map, BeamInstr* I)
Eterm new_key;
Eterm* kp;
- if (is_not_map(map)) {
- return THE_NON_VALUE;
+ new_p = &Arg(5);
+ num_updates = Arg(4) / 2;
+
+ if (is_not_flatmap(map)) {
+ Uint32 hx;
+ Eterm val;
+
+ /* apparently the compiler does not emit is_map instructions,
+ * bad compiler */
+
+ if (is_not_hashmap(map))
+ return THE_NON_VALUE;
+
+ res = map;
+ E = p->stop;
+ while(num_updates--) {
+ /* assoc can't fail */
+ GET_TERM(new_p[0], new_key);
+ GET_TERM(new_p[1], val);
+ hx = hashmap_make_hash(new_key);
+
+ res = erts_hashmap_insert(p, hx, new_key, val, res, 0);
+
+ new_p += 2;
+ }
+ return res;
}
- old_mp = (map_t *) map_val(map);
- num_old = map_get_size(old_mp);
+ old_mp = (flatmap_t *) flatmap_val(map);
+ num_old = flatmap_get_size(old_mp);
/*
* If the old map is empty, create a new map.
@@ -6574,14 +7076,13 @@ update_map_assoc(Process* p, Eterm* reg, Eterm map, BeamInstr* I)
* update list are new).
*/
- num_updates = Arg(4) / 2;
- need = 2*(num_old+num_updates) + 1 + MAP_HEADER_SIZE;
+ need = 2*(num_old+num_updates) + 1 + MAP_HEADER_FLATMAP_SZ;
if (HeapWordsLeft(p) < need) {
Uint live = Arg(3);
reg[live] = map;
erts_garbage_collect(p, need, reg, live+1);
map = reg[live];
- old_mp = (map_t *)map_val(map);
+ old_mp = (flatmap_t *)flatmap_val(map);
}
/*
@@ -6612,16 +7113,15 @@ update_map_assoc(Process* p, Eterm* reg, Eterm map, BeamInstr* I)
kp = p->htop + 1; /* Point to first key */
hp = kp + num_old + num_updates;
- res = make_map(hp);
- mp = (map_t *)hp;
- hp += MAP_HEADER_SIZE;
- mp->thing_word = MAP_HEADER;
+ res = make_flatmap(hp);
+ mp = (flatmap_t *)hp;
+ hp += MAP_HEADER_FLATMAP_SZ;
+ mp->thing_word = MAP_HEADER_FLATMAP;
mp->keys = make_tuple(kp-1);
- old_vals = map_get_values(old_mp);
- old_keys = map_get_keys(old_mp);
+ old_vals = flatmap_get_values(old_mp);
+ old_keys = flatmap_get_keys(old_mp);
- new_p = &Arg(5);
GET_TERM(*new_p, new_key);
n = num_updates;
@@ -6707,8 +7207,17 @@ update_map_assoc(Process* p, Eterm* reg, Eterm map, BeamInstr* I)
n = kp - p->htop - 1; /* Actual number of keys/values */
*p->htop = make_arityval(n);
+ p->htop = hp;
mp->size = n;
- p->htop = hp;
+
+ /* The expensive case, need to build a hashmap */
+ if (n > MAP_SMALL_MAP_LIMIT) {
+ ErtsHeapFactory factory;
+ erts_factory_proc_init(&factory, p);
+ res = erts_hashmap_from_ks_and_vs(&factory,flatmap_get_keys(mp),
+ flatmap_get_values(mp),n);
+ erts_factory_close(&factory);
+ }
return res;
}
@@ -6723,7 +7232,7 @@ update_map_exact(Process* p, Eterm* reg, Eterm map, BeamInstr* I)
Uint i;
Uint num_old;
Uint need;
- map_t *old_mp, *mp;
+ flatmap_t *old_mp, *mp;
Eterm res;
Eterm* hp;
Eterm* E;
@@ -6732,18 +7241,53 @@ update_map_exact(Process* p, Eterm* reg, Eterm map, BeamInstr* I)
BeamInstr* new_p;
Eterm new_key;
- if (is_not_map(map)) {
- return THE_NON_VALUE;
+ new_p = &Arg(5);
+ n = Arg(4) / 2; /* Number of values to be updated */
+ ASSERT(n > 0);
+
+ if (is_not_flatmap(map)) {
+ Uint32 hx;
+ Eterm val;
+
+ /* apparently the compiler does not emit is_map instructions,
+ * bad compiler */
+
+ if (is_not_hashmap(map)) {
+ p->freason = BADMAP;
+ p->fvalue = map;
+ return THE_NON_VALUE;
+ }
+
+ res = map;
+ E = p->stop;
+ while(n--) {
+ GET_TERM(new_p[0], new_key);
+ GET_TERM(new_p[1], val);
+ hx = hashmap_make_hash(new_key);
+
+ res = erts_hashmap_insert(p, hx, new_key, val, res, 1);
+ if (is_non_value(res)) {
+ p->fvalue = new_key;
+ p->freason = BADKEY;
+ return res;
+ }
+
+ new_p += 2;
+ }
+ return res;
}
- old_mp = (map_t *) map_val(map);
- num_old = map_get_size(old_mp);
+ old_mp = (flatmap_t *) flatmap_val(map);
+ num_old = flatmap_get_size(old_mp);
/*
- * If the old map is empty, create a new map.
+ * If the old map is empty, fail.
*/
if (num_old == 0) {
+ E = p->stop;
+ p->freason = BADKEY;
+ GET_TERM(new_p[0], p->fvalue);
return THE_NON_VALUE;
}
@@ -6751,13 +7295,13 @@ update_map_exact(Process* p, Eterm* reg, Eterm map, BeamInstr* I)
* Allocate the exact heap space needed.
*/
- need = num_old + MAP_HEADER_SIZE;
+ need = num_old + MAP_HEADER_FLATMAP_SZ;
if (HeapWordsLeft(p) < need) {
Uint live = Arg(3);
reg[live] = map;
erts_garbage_collect(p, need, reg, live+1);
map = reg[live];
- old_mp = (map_t *)map_val(map);
+ old_mp = (flatmap_t *)flatmap_val(map);
}
/*
@@ -6767,23 +7311,20 @@ update_map_exact(Process* p, Eterm* reg, Eterm map, BeamInstr* I)
hp = p->htop;
E = p->stop;
- old_vals = map_get_values(old_mp);
- old_keys = map_get_keys(old_mp);
+ old_vals = flatmap_get_values(old_mp);
+ old_keys = flatmap_get_keys(old_mp);
- res = make_map(hp);
- mp = (map_t *)hp;
- hp += MAP_HEADER_SIZE;
- mp->thing_word = MAP_HEADER;
+ res = make_flatmap(hp);
+ mp = (flatmap_t *)hp;
+ hp += MAP_HEADER_FLATMAP_SZ;
+ mp->thing_word = MAP_HEADER_FLATMAP;
mp->size = num_old;
mp->keys = old_mp->keys;
/* Get array of key/value pairs to be updated */
- new_p = &Arg(5);
GET_TERM(*new_p, new_key);
/* Update all values */
- n = Arg(4) / 2; /* Number of values to be updated */
- ASSERT(n > 0);
for (i = 0; i < num_old; i++) {
if (!EQ(*old_keys, new_key)) {
/* Not same keys */
@@ -6816,6 +7357,8 @@ update_map_exact(Process* p, Eterm* reg, Eterm map, BeamInstr* I)
* update list did not previously exist.
*/
ASSERT(hp == p->htop + need);
+ p->freason = BADKEY;
+ p->fvalue = new_key;
return THE_NON_VALUE;
}
#undef GET_TERM
@@ -6837,15 +7380,24 @@ erts_is_builtin(Eterm Mod, Eterm Name, int arity)
Export e;
Export* ep;
- e.code[0] = Mod;
- e.code[1] = Name;
- e.code[2] = arity;
+ 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.info.mfa.module = Mod;
+ e.info.mfa.function = Name;
+ e.info.mfa.arity = arity;
if ((ep = export_get(&e)) == NULL) {
return 0;
}
- return ep->addressv[erts_active_code_ix()] == ep->code+3
- && (ep->code[3] == (BeamInstr) em_apply_bif);
+ return ep->addressv[erts_active_code_ix()] == ep->beam
+ && (ep->beam[0] == (BeamInstr) em_apply_bif);
}
@@ -6860,7 +7412,7 @@ erts_current_reductions(Process *current, Process *p)
if (current != p) {
return 0;
} else if (current->fcalls < 0 && ERTS_PROC_GET_SAVED_CALLS_BUF(current)) {
- return -current->fcalls;
+ return current->fcalls + CONTEXT_REDS;
} else {
return REDS_IN(current) - current->fcalls;
}
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index e96177cfd9..23258dbe9c 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2014. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -31,16 +32,20 @@
#include "bif.h"
#include "external.h"
#include "beam_load.h"
+#include "beam_bp.h"
#include "big.h"
#include "erl_bits.h"
#include "beam_catches.h"
#include "erl_binary.h"
#include "erl_zlib.h"
+#include "erl_map.h"
+#include "erl_process_dict.h"
#ifdef HIPE
#include "hipe_bif0.h"
#include "hipe_mode_switch.h"
#include "hipe_arch.h"
+#include "hipe_load.h"
#endif
ErlDrvBinary* erts_gzinflate_buffer(char*, int);
@@ -78,7 +83,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
@@ -102,7 +107,7 @@ typedef struct {
*/
typedef struct genop {
- int op; /* Opcode. */
+ unsigned int op; /* Opcode. */
int arity; /* Number of arguments. */
GenOpArg def_args[MAX_OPARGS]; /* Default buffer for arguments. */
GenOpArg* a; /* The arguments. */
@@ -152,13 +157,15 @@ typedef struct {
#define STR_CHUNK 2
#define IMP_CHUNK 3
#define EXP_CHUNK 4
-#define NUM_MANDATORY 5
+#define MIN_MANDATORY 1
+#define MAX_MANDATORY 5
#define LAMBDA_CHUNK 5
#define LITERAL_CHUNK 6
#define ATTR_CHUNK 7
#define COMPILE_CHUNK 8
#define LINE_CHUNK 9
+#define UTF8_ATOM_CHUNK 10
#define NUM_CHUNK_TYPES (sizeof(chunk_types)/sizeof(chunk_types[0]))
@@ -168,9 +175,13 @@ typedef struct {
static Uint chunk_types[] = {
/*
- * Mandatory chunk types -- these MUST be present.
+ * Atom chunk types -- Atom or AtU8 MUST be present.
*/
MakeIffId('A', 't', 'o', 'm'), /* 0 */
+
+ /*
+ * Mandatory chunk types -- these MUST be present.
+ */
MakeIffId('C', 'o', 'd', 'e'), /* 1 */
MakeIffId('S', 't', 'r', 'T'), /* 2 */
MakeIffId('I', 'm', 'p', 'T'), /* 3 */
@@ -184,6 +195,7 @@ static Uint chunk_types[] = {
MakeIffId('A', 't', 't', 'r'), /* 7 */
MakeIffId('C', 'I', 'n', 'f'), /* 8 */
MakeIffId('L', 'i', 'n', 'e'), /* 9 */
+ MakeIffId('A', 't', 'U', '8'), /* 10 */
};
/*
@@ -204,10 +216,7 @@ typedef struct {
typedef struct {
Eterm term; /* The tagged term (in the heap). */
- Uint heap_size; /* (Exact) size on the heap. */
- SWord offset; /* Offset from temporary location to final. */
- ErlOffHeap off_heap; /* Start of linked list of ProcBins. */
- Eterm* heap; /* Heap for term. */
+ ErlHeapFragment* heap_frags;
} Literal;
/*
@@ -245,7 +254,7 @@ typedef struct {
/*
* This structure contains all information about the module being loaded.
*/
-
+#define MD5_SIZE 16
typedef struct LoaderState {
/*
* The current logical file within the binary.
@@ -283,16 +292,17 @@ typedef struct LoaderState {
byte* code_start; /* Start of code file. */
unsigned code_size; /* Size of code file. */
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. */
+ unsigned int num_functions; /* Number of functions in module. */
+ unsigned int num_labels; /* Number of labels. */
+ 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. */
unsigned loaded_size; /* Final size of code when loaded. */
- byte mod_md5[16]; /* MD5 for module code. */
+ byte mod_md5[MD5_SIZE]; /* MD5 for module code. */
int may_load_nif; /* true if NIFs may later be loaded for this module */
int on_load; /* Index in the code for the on_load function
* (or 0 if there is no on_load function)
@@ -302,13 +312,13 @@ typedef struct LoaderState {
* Atom table.
*/
- int num_atoms; /* Number of atoms in atom table. */
+ unsigned int num_atoms; /* Number of atoms in atom table. */
Eterm* atom; /* Atom table. */
- int num_exps; /* Number of exports. */
+ unsigned int num_exps; /* Number of exports. */
ExportEntry* export; /* Pointer to export table. */
- int num_imports; /* Number of imports. */
+ unsigned int num_imports; /* Number of imports. */
ImportEntry* import; /* Import entry (translated information). */
/*
@@ -322,8 +332,8 @@ typedef struct LoaderState {
* Lambda table.
*/
- int num_lambdas; /* Number of lambdas in table. */
- int lambdas_allocated; /* Size of allocated lambda table. */
+ unsigned int num_lambdas; /* Number of lambdas in table. */
+ unsigned int lambdas_allocated; /* Size of allocated lambda table. */
Lambda* lambdas; /* Pointer to lambdas. */
Lambda def_lambdas[16]; /* Default storage for lambda table. */
char* lambda_error; /* Delayed missing 'FunT' error. */
@@ -332,8 +342,8 @@ typedef struct LoaderState {
* Literals (constant pool).
*/
- int num_literals; /* Number of literals in table. */
- int allocated_literals; /* Number of literal entries allocated. */
+ unsigned int num_literals; /* Number of literals in table. */
+ unsigned int allocated_literals; /* Number of literal entries allocated. */
Literal* literals; /* Array of literals. */
LiteralPatch* literal_patches; /* Operands that need to be patched. */
Uint total_literal_size; /* Total heap size for all literals. */
@@ -342,13 +352,13 @@ typedef struct LoaderState {
* Line table.
*/
BeamInstr* line_item; /* Line items from the BEAM file. */
- int num_line_items; /* Number of line items. */
+ unsigned int num_line_items;/* Number of line items. */
LineInstr* line_instr; /* Line instructions */
- int num_line_instrs; /* Maximum number of line instructions */
- int current_li; /* Current line instruction */
- int* func_line; /* Mapping from function to first line instr */
+ unsigned int num_line_instrs; /* Maximum number of line instructions */
+ unsigned int current_li; /* Current line instruction */
+ unsigned int* func_line; /* Mapping from function to first line instr */
Eterm* fname; /* List of file names */
- int num_fnames; /* Number of filenames in fname table */
+ unsigned int num_fnames; /* Number of filenames in fname table */
int loc_size; /* Size of location info in bytes (2/4) */
} LoaderState;
@@ -476,15 +486,20 @@ typedef struct LoaderState {
static void free_loader_state(Binary* magic);
-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);
+static ErlHeapFragment* new_literal_fragment(Uint size);
+static void free_literal_fragment(ErlHeapFragment*);
+static int loader_state_dtor(Binary* magic);
+#ifdef HIPE
+static Eterm stub_insert_new_code(Process *c_p, ErtsProcLocks c_p_locks,
+ Eterm group_leader, Eterm module,
+ BeamCodeHeader* code_hdr, Uint size,
+ HipeModule *hipe_code);
+#endif
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);
+ Uint num_types);
static int verify_chunks(LoaderState* stp);
-static int load_atom_table(LoaderState* stp);
+static int load_atom_table(LoaderState* stp, ErtsAtomEncoding enc);
static int load_import_table(LoaderState* stp);
static int read_export_table(LoaderState* stp);
static int is_bif(Eterm mod, Eterm func, unsigned arity);
@@ -511,7 +526,7 @@ static GenOp* gen_get_map_element(LoaderState* stp, GenOpArg Fail, GenOpArg Src,
static int freeze_code(LoaderState* stp);
-static void final_touch(LoaderState* stp);
+static void final_touch(LoaderState* stp, struct erl_module_instance* inst_p);
static void short_file(int line, LoaderState* stp, unsigned needed);
static void load_printf(int line, LoaderState* context, char *fmt, ...);
static int transform_engine(LoaderState* st);
@@ -524,13 +539,16 @@ static void new_literal_patch(LoaderState* stp, int pos);
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 exported_from_module(Process* p, Eterm mod);
-static Eterm functions_in_module(Process* p, Eterm mod);
-static Eterm attributes_for_module(Process* p, Eterm mod);
-static Eterm compilation_info_for_module(Process* p, Eterm mod);
-static Eterm native_addresses(Process* p, Eterm mod);
-int patch_funentries(Eterm Patchlist);
-int patch(Eterm Addresses, Uint fe);
+static Eterm get_module_info(Process* p, ErtsCodeIndex code_ix,
+ BeamCodeHeader*, Eterm module, Eterm what);
+static Eterm exported_from_module(Process* p, ErtsCodeIndex code_ix,
+ Eterm mod);
+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*);
static int safe_mul(UWord a, UWord b, UWord* resp);
static int must_swap_floats;
@@ -595,6 +613,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)
@@ -617,7 +636,7 @@ erts_prepare_loading(Binary* magic, Process *c_p, Eterm group_leader,
CHKALLOC();
CHKBLK(ERTS_ALC_T_CODE,stp->code);
if (!init_iff_file(stp, code, unloaded_size) ||
- !scan_iff_file(stp, chunk_types, NUM_CHUNK_TYPES, NUM_MANDATORY) ||
+ !scan_iff_file(stp, chunk_types, NUM_CHUNK_TYPES) ||
!verify_chunks(stp)) {
goto load_error;
}
@@ -635,28 +654,43 @@ 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;
+ /* 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->literal_area = NULL;
+ stp->hdr->md5_ptr = NULL;
/*
* Read the atom table.
*/
CHKBLK(ERTS_ALC_T_CODE,stp->code);
- define_file(stp, "atom table", ATOM_CHUNK);
- if (!load_atom_table(stp)) {
- goto load_error;
+ if (stp->chunks[UTF8_ATOM_CHUNK].size > 0) {
+ define_file(stp, "utf8 atom table", UTF8_ATOM_CHUNK);
+ if (!load_atom_table(stp, ERTS_ATOM_ENC_UTF8)) {
+ goto load_error;
+ }
+ } else {
+ define_file(stp, "atom table", ATOM_CHUNK);
+ if (!load_atom_table(stp, ERTS_ATOM_ENC_LATIN1)) {
+ goto load_error;
+ }
}
/*
@@ -750,8 +784,11 @@ Eterm
erts_finish_loading(Binary* magic, Process* c_p,
ErtsProcLocks c_p_locks, Eterm* modp)
{
- Eterm retval;
+ Eterm retval = NIL;
LoaderState* stp = ERTS_MAGIC_BIN_DATA(magic);
+ Module* mod_tab_p;
+ struct erl_module_instance* inst_p;
+ Uint size;
/*
* No other process may run since we will update the export
@@ -760,27 +797,87 @@ erts_finish_loading(Binary* magic, Process* c_p,
ERTS_SMP_LC_ASSERT(erts_initialized == 0 || erts_has_code_write_permission() ||
erts_smp_thr_progress_is_blocking());
-
/*
* Make current code for the module old and insert the new code
* as current. This will fail if there already exists old code
* for the module.
*/
+ mod_tab_p = erts_put_module(stp->module);
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);
- if (retval != NIL) {
- goto load_error;
+ if (!stp->on_load) {
+ /*
+ * Normal case -- no -on_load() function.
+ */
+ retval = beam_make_current_old(c_p, c_p_locks, stp->module);
+ ASSERT(retval == NIL);
+ } else {
+ ErtsCodeIndex code_ix = erts_staging_code_ix();
+ Eterm module = stp->module;
+ int i, num_exps;
+
+ /*
+ * There is an -on_load() function. We will keep the current
+ * code, but we must turn off any tracing.
+ */
+ num_exps = export_list_size(code_ix);
+ for (i = 0; i < num_exps; i++) {
+ Export *ep = export_list(i, code_ix);
+ if (ep == NULL || ep->info.mfa.module != module) {
+ continue;
+ }
+ if (ep->addressv[code_ix] == ep->beam) {
+ if (ep->beam[0] == (BeamInstr) em_apply_bif) {
+ continue;
+ } else if (ep->beam[0] ==
+ (BeamInstr) BeamOp(op_i_generic_breakpoint)) {
+ ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
+ ASSERT(mod_tab_p->curr.num_traced_exports > 0);
+ erts_clear_export_break(mod_tab_p, &ep->info);
+ ep->addressv[code_ix] = (BeamInstr *) ep->beam[1];
+ ep->beam[1] = 0;
+ }
+ ASSERT(ep->beam[1] == 0);
+ }
+ }
+ ASSERT(mod_tab_p->curr.num_breakpoints == 0);
+ ASSERT(mod_tab_p->curr.num_traced_exports == 0);
}
/*
+ * Update module table.
+ */
+
+ size = stp->loaded_size;
+ erts_total_code_size += size;
+
+ if (!stp->on_load) {
+ inst_p = &mod_tab_p->curr;
+ } else {
+ mod_tab_p->on_load =
+ (struct erl_module_instance *)
+ erts_alloc(ERTS_ALC_T_PREPARED_CODE,
+ sizeof(struct erl_module_instance));
+ inst_p = mod_tab_p->on_load;
+ erts_module_instance_init(inst_p);
+ }
+
+ inst_p->code_hdr = stp->hdr;
+ inst_p->code_length = size;
+
+ /*
+ * Update ranges (used for finding a function from a PC value).
+ */
+
+ erts_update_ranges((BeamInstr*)inst_p->code_hdr, size);
+
+ /*
* Ready for the final touch: fixing the export table entries for
* exported and imported functions. This can't fail.
*/
CHKBLK(ERTS_ALC_T_CODE,stp->code);
- final_touch(stp);
+ final_touch(stp, inst_p);
/*
* Loading succeded.
@@ -792,7 +889,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;
/*
@@ -803,7 +901,6 @@ erts_finish_loading(Binary* magic, Process* c_p,
retval = am_on_load;
}
- load_error:
free_loader_state(magic);
return retval;
}
@@ -816,7 +913,7 @@ erts_alloc_loader_state(void)
magic = erts_create_magic_binary(sizeof(LoaderState),
loader_state_dtor);
- erts_refc_inc(&magic->refc, 1);
+ erts_refc_inc(&magic->intern.refc, 1);
stp = ERTS_MAGIC_BIN_DATA(magic);
stp->bin = NULL;
stp->function = THE_NON_VALUE; /* Function not known yet */
@@ -824,7 +921,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;
@@ -860,29 +958,73 @@ erts_module_for_prepared_code(Binary* magic)
LoaderState* stp;
if (ERTS_MAGIC_BIN_DESTRUCTOR(magic) != loader_state_dtor) {
+#ifdef HIPE
+ HipeLoaderState *hipe_stp;
+ if ((hipe_stp = hipe_get_loader_state(magic))
+ && hipe_stp->text_segment != 0) {
+ return hipe_stp->module;
+ }
+#endif
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)
{
loader_state_dtor(magic);
- if (erts_refc_dectest(&magic->refc, 0) == 0) {
- erts_bin_free(magic);
- }
+ erts_bin_release(magic);
+}
+
+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, size);
+ return bp;
+}
+
+static void free_literal_fragment(ErlHeapFragment* bp)
+{
+ ASSERT(bp != NULL);
+ do {
+ ErlHeapFragment* next_bp = bp->next;
+
+ erts_cleanup_offheap(&bp->off_heap);
+ ERTS_HEAP_FREE(ERTS_ALC_T_PREPARED_CODE, (void *) bp,
+ ERTS_HEAP_FRAG_SIZE(bp->size));
+ bp = next_bp;
+ }while (bp != NULL);
}
/*
* This destructor function can safely be called multiple times.
*/
-static void
+static int
loader_state_dtor(Binary* magic)
{
LoaderState* stp = ERTS_MAGIC_BIN_DATA(magic);
@@ -891,9 +1033,14 @@ 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->literal_area) {
+ erts_release_literal_area(stp->hdr->literal_area);
+ stp->hdr->literal_area = NULL;
+ }
+ 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);
@@ -918,10 +1065,9 @@ loader_state_dtor(Binary* magic)
if (stp->literals != 0) {
int i;
for (i = 0; i < stp->num_literals; i++) {
- if (stp->literals[i].heap != 0) {
- erts_free(ERTS_ALC_T_PREPARED_CODE,
- (void *) stp->literals[i].heap);
- stp->literals[i].heap = 0;
+ if (stp->literals[i].heap_frags != 0) {
+ free_literal_fragment(stp->literals[i].heap_frags);
+ stp->literals[i].heap_frags = 0;
}
}
erts_free(ERTS_ALC_T_PREPARED_CODE, (void *) stp->literals);
@@ -963,12 +1109,15 @@ loader_state_dtor(Binary* magic)
*/
ASSERT(stp->genop_blocks == 0);
+ return 1;
}
+#ifdef HIPE
static Eterm
-insert_new_code(Process *c_p, ErtsProcLocks c_p_locks,
- Eterm group_leader, Eterm module, BeamInstr* code,
- Uint size)
+stub_insert_new_code(Process *c_p, ErtsProcLocks c_p_locks,
+ Eterm group_leader, Eterm module,
+ BeamCodeHeader* code_hdr, Uint size,
+ HipeModule *hipe_code)
{
Module* modp;
Eterm retval;
@@ -988,17 +1137,21 @@ 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. */
+ DBG_TRACE_MFA(make_atom(modp->module), 0, 0, "insert_new_code "
+ "first_hipe_ref = %p", hipe_code->first_hipe_ref);
+ modp->curr.hipe_code = hipe_code;
/*
* 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;
}
+#endif
static int
init_iff_file(LoaderState* stp, byte* code, Uint size)
@@ -1072,7 +1225,7 @@ init_iff_file(LoaderState* stp, byte* code, Uint size)
* Scan the IFF file. The header should have been verified by init_iff_file().
*/
static int
-scan_iff_file(LoaderState* stp, Uint* chunk_types, Uint num_types, Uint num_mandatory)
+scan_iff_file(LoaderState* stp, Uint* chunk_types, Uint num_types)
{
Uint count;
Uint id;
@@ -1151,7 +1304,16 @@ verify_chunks(LoaderState* stp)
MD5_CTX context;
MD5Init(&context);
- for (i = 0; i < NUM_MANDATORY; i++) {
+
+ if (stp->chunks[UTF8_ATOM_CHUNK].start != NULL) {
+ MD5Update(&context, stp->chunks[UTF8_ATOM_CHUNK].start, stp->chunks[UTF8_ATOM_CHUNK].size);
+ } else if (stp->chunks[ATOM_CHUNK].start != NULL) {
+ MD5Update(&context, stp->chunks[ATOM_CHUNK].start, stp->chunks[ATOM_CHUNK].size);
+ } else {
+ LoadError0(stp, "mandatory chunk of type 'Atom' or 'AtU8' not found\n");
+ }
+
+ for (i = MIN_MANDATORY; i < MAX_MANDATORY; i++) {
if (stp->chunks[i].start != NULL) {
MD5Update(&context, stp->chunks[i].start, stp->chunks[i].size);
} else {
@@ -1212,9 +1374,9 @@ verify_chunks(LoaderState* stp)
}
static int
-load_atom_table(LoaderState* stp)
+load_atom_table(LoaderState* stp, ErtsAtomEncoding enc)
{
- int i;
+ unsigned int i;
GetInt(stp, 4, stp->num_atoms);
stp->num_atoms++;
@@ -1231,7 +1393,7 @@ load_atom_table(LoaderState* stp)
GetByte(stp, n);
GetString(stp, atom, n);
- stp->atom[i] = erts_atom_put(atom, n, ERTS_ATOM_ENC_LATIN1, 1);
+ stp->atom[i] = erts_atom_put(atom, n, enc, 1);
}
/*
@@ -1259,13 +1421,13 @@ load_atom_table(LoaderState* stp)
static int
load_import_table(LoaderState* stp)
{
- int i;
+ unsigned int i;
GetInt(stp, 4, stp->num_imports);
stp->import = erts_alloc(ERTS_ALC_T_PREPARED_CODE,
stp->num_imports * sizeof(ImportEntry));
for (i = 0; i < stp->num_imports; i++) {
- int n;
+ unsigned int n;
Eterm mod;
Eterm func;
Uint arity;
@@ -1273,17 +1435,17 @@ load_import_table(LoaderState* stp)
GetInt(stp, 4, n);
if (n >= stp->num_atoms) {
- LoadError2(stp, "import entry %d: invalid atom number %d", i, n);
+ LoadError2(stp, "import entry %u: invalid atom number %u", i, n);
}
mod = stp->import[i].module = stp->atom[n];
GetInt(stp, 4, n);
if (n >= stp->num_atoms) {
- LoadError2(stp, "import entry %d: invalid atom number %d", i, n);
+ LoadError2(stp, "import entry %u: invalid atom number %u", i, n);
}
func = stp->import[i].function = stp->atom[n];
GetInt(stp, 4, arity);
if (arity > MAX_REG) {
- LoadError2(stp, "import entry %d: invalid arity %d", i, arity);
+ LoadError2(stp, "import entry %u: invalid arity %d", i, arity);
}
stp->import[i].arity = arity;
stp->import[i].patches = 0;
@@ -1294,8 +1456,8 @@ load_import_table(LoaderState* stp)
* the BIF function.
*/
if ((e = erts_active_export_entry(mod, func, arity)) != NULL) {
- if (e->code[3] == (BeamInstr) em_apply_bif) {
- stp->import[i].bf = (BifFunction) e->code[4];
+ if (e->beam[0] == (BeamInstr) em_apply_bif) {
+ stp->import[i].bf = (BifFunction) e->beam[1];
if (func == am_load_nif && mod == am_erlang && arity == 2) {
stp->may_load_nif = 1;
}
@@ -1311,12 +1473,12 @@ load_import_table(LoaderState* stp)
static int
read_export_table(LoaderState* stp)
{
- int i;
+ unsigned int i;
BeamInstr* address;
GetInt(stp, 4, stp->num_exps);
if (stp->num_exps > stp->num_functions) {
- LoadError2(stp, "%d functions exported; only %d functions defined",
+ LoadError2(stp, "%u functions exported; only %u functions defined",
stp->num_exps, stp->num_functions);
}
stp->export
@@ -1334,18 +1496,18 @@ read_export_table(LoaderState* stp)
stp->export[i].function = func;
GetInt(stp, 4, arity);
if (arity > MAX_REG) {
- LoadError2(stp, "export table entry %d: absurdly high arity %d", i, arity);
+ LoadError2(stp, "export table entry %u: absurdly high arity %u", i, arity);
}
stp->export[i].arity = arity;
GetInt(stp, 4, n);
if (n >= stp->num_labels) {
- LoadError3(stp, "export table entry %d: invalid label %d (highest defined label is %d)", i, n, stp->num_labels);
+ LoadError3(stp, "export table entry %u: invalid label %u (highest defined label is %u)", i, n, stp->num_labels);
}
value = stp->labels[n].value;
if (value == 0) {
- LoadError2(stp, "export table entry %d: label %d not resolved", i, n);
+ LoadError2(stp, "export table entry %u: label %u 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.
@@ -1364,7 +1526,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);
@@ -1388,7 +1550,7 @@ is_bif(Eterm mod, Eterm func, unsigned arity)
if (e == NULL) {
return 0;
}
- if (e->code[3] != (BeamInstr) em_apply_bif) {
+ if (e->beam[0] != (BeamInstr) em_apply_bif) {
return 0;
}
if (mod == am_erlang && func == am_apply && arity == 3) {
@@ -1404,7 +1566,7 @@ is_bif(Eterm mod, Eterm func, unsigned arity)
static int
read_lambda_table(LoaderState* stp)
{
- int i;
+ unsigned int i;
GetInt(stp, 4, stp->num_lambdas);
if (stp->num_lambdas > stp->lambdas_allocated) {
@@ -1424,12 +1586,12 @@ read_lambda_table(LoaderState* stp)
GetAtom(stp, n, stp->lambdas[i].function);
GetInt(stp, 4, arity);
if (arity > MAX_REG) {
- LoadError2(stp, "lambda entry %d: absurdly high arity %d", i, arity);
+ LoadError2(stp, "lambda entry %u: absurdly high arity %u", i, arity);
}
stp->lambdas[i].arity = arity;
GetInt(stp, 4, n);
if (n >= stp->num_labels) {
- LoadError3(stp, "lambda entry %d: invalid label %d (highest defined label is %d)",
+ LoadError3(stp, "lambda entry %u: invalid label %u (highest defined label is %u)",
i, n, stp->num_labels);
}
stp->lambdas[i].label = n;
@@ -1446,10 +1608,11 @@ read_lambda_table(LoaderState* stp)
return 0;
}
+
static int
read_literal_table(LoaderState* stp)
{
- int i;
+ unsigned int i;
uLongf uncompressed_sz;
byte* uncompressed = 0;
@@ -1467,36 +1630,46 @@ read_literal_table(LoaderState* stp)
stp->allocated_literals = stp->num_literals;
for (i = 0; i < stp->num_literals; i++) {
- stp->literals[i].heap = 0;
+ stp->literals[i].heap_frags = 0;
}
for (i = 0; i < stp->num_literals; i++) {
- int sz;
+ Uint sz;
Sint heap_size;
byte* p;
Eterm val;
- Eterm* hp;
+ ErtsHeapFactory factory;
GetInt(stp, 4, sz); /* Size of external term format. */
GetString(stp, p, sz);
if ((heap_size = erts_decode_ext_size(p, sz)) < 0) {
- LoadError1(stp, "literal %d: bad external format", i);
- }
- hp = stp->literals[i].heap = erts_alloc(ERTS_ALC_T_PREPARED_CODE,
- heap_size*sizeof(Eterm));
- stp->literals[i].off_heap.first = 0;
- stp->literals[i].off_heap.overhead = 0;
- val = erts_decode_ext(&hp, &stp->literals[i].off_heap, &p);
- stp->literals[i].heap_size = hp - stp->literals[i].heap;
- if (stp->literals[i].heap_size > heap_size) {
- erl_exit(1, "overrun by %d word(s) for literal heap, term %d",
- stp->literals[i].heap_size - heap_size, i);
+ LoadError1(stp, "literal %u: bad external format", i);
}
- if (is_non_value(val)) {
- LoadError1(stp, "literal %d: bad external format", i);
- }
- stp->literals[i].term = val;
- stp->total_literal_size += stp->literals[i].heap_size;
+
+ if (heap_size > 0) {
+ 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, 0);
+
+ if (is_non_value(val)) {
+ LoadError1(stp, "literal %u: bad external format", i);
+ }
+ erts_factory_close(&factory);
+ stp->literals[i].heap_frags = factory.heap_frags;
+ stp->total_literal_size += erts_used_frag_sz(factory.heap_frags);
+ }
+ else {
+ erts_factory_dummy_init(&factory);
+ val = erts_decode_ext(&factory, &p, 0);
+ if (is_non_value(val)) {
+ LoadError1(stp, "literal %u: bad external format", i);
+ }
+ ASSERT(is_immed(val));
+ stp->literals[i].heap_frags = NULL;
+ }
+ stp->literals[i].term = val;
+
}
erts_free(ERTS_ALC_T_TMP, uncompressed);
return 1;
@@ -1513,9 +1686,9 @@ read_line_table(LoaderState* stp)
{
unsigned version;
ERTS_DECLARE_DUMMY(unsigned flags);
- int num_line_items;
+ unsigned int num_line_items;
BeamInstr* lp;
- int i;
+ unsigned int i;
BeamInstr fname_index;
BeamInstr tag;
@@ -1594,7 +1767,7 @@ read_line_table(LoaderState* stp)
}
} else if (tag == TAG_a) {
if (val > stp->num_fnames) {
- LoadError2(stp, "file index overflow (%d/%d)",
+ LoadError2(stp, "file index overflow (%u/%u)",
val, stp->num_fnames);
}
fname_index = val;
@@ -1630,9 +1803,9 @@ read_line_table(LoaderState* stp)
stp->num_line_instrs *
sizeof(LineInstr));
stp->current_li = 0;
- stp->func_line = (int *) erts_alloc(ERTS_ALC_T_PREPARED_CODE,
- stp->num_functions *
- sizeof(int));
+ stp->func_line = (unsigned int *) erts_alloc(ERTS_ALC_T_PREPARED_CODE,
+ stp->num_functions *
+ sizeof(int));
return 1;
@@ -1656,6 +1829,10 @@ read_code_header(LoaderState* stp)
*/
GetInt(stp, 4, head_size);
+ if (head_size > stp->file_left) {
+ LoadError2(stp, "invalid code header size %u; bytes left %u",
+ head_size, stp->file_left);
+ }
stp->code_start = stp->file_p + head_size;
stp->code_size = stp->file_left - head_size;
stp->file_left = head_size;
@@ -1696,7 +1873,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
@@ -1715,13 +1892,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)
@@ -1737,7 +1915,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;
@@ -1751,26 +1929,26 @@ load_code(LoaderState* stp)
* by both the nif functionality and line instructions.
*/
enum {
- FUNC_INFO_SZ = 5
+ FUNC_INFO_SZ = sizeof(ErtsCodeInfo) / sizeof(Eterm)
};
- 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;
+ unsigned int new_op;
GenOp* tmp_op;
- ASSERT(ci <= code_buffer_size);
+ ASSERT(ci <= codev_size);
get_next_instr:
GetByte(stp, new_op);
if (new_op >= NUM_GENERIC_OPS) {
- LoadError1(stp, "invalid opcode %d", new_op);
+ LoadError1(stp, "invalid opcode %u", new_op);
}
if (gen_opc[new_op].name[0] == '\0') {
- LoadError1(stp, "invalid opcode %d", new_op);
+ LoadError1(stp, "invalid opcode %u", new_op);
}
@@ -1808,9 +1986,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);
}
@@ -1855,15 +2031,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);
@@ -1959,42 +2134,47 @@ load_code(LoaderState* stp)
ASSERT(arity == last_op->arity);
do_transform:
- if (stp->genop == NULL) {
- last_op_next = NULL;
- goto get_next_instr;
- }
-
+ ASSERT(stp->genop != NULL);
if (gen_opc[stp->genop->op].transform != -1) {
- int need;
- tmp_op = stp->genop;
-
- for (need = gen_opc[stp->genop->op].min_window-1; need > 0; need--) {
- if (tmp_op == NULL) {
- goto get_next_instr;
- }
- tmp_op = tmp_op->next;
+ if (stp->genop->next == NULL) {
+ /*
+ * Simple heuristic: Most transformations requires
+ * at least two instructions, so make sure that
+ * there are. That will reduce the number of
+ * TE_SHORT_WINDOWs.
+ */
+ goto get_next_instr;
}
switch (transform_engine(stp)) {
case TE_FAIL:
- last_op_next = NULL;
- last_op = NULL;
+ /*
+ * No transformation found. stp->genop != NULL and
+ * last_op_next is still valid. Go ahead and load
+ * the instruction.
+ */
break;
case TE_OK:
+ /*
+ * Some transformation was applied. last_op_next is
+ * no longer valid and stp->genop may be NULL.
+ * Try to transform again.
+ */
+ if (stp->genop == NULL) {
+ last_op_next = &stp->genop;
+ goto get_next_instr;
+ }
last_op_next = NULL;
- last_op = NULL;
goto do_transform;
case TE_SHORT_WINDOW:
- last_op_next = NULL;
- last_op = NULL;
+ /*
+ * No transformation applied. stp->genop != NULL and
+ * last_op_next is still valid. Fetch a new instruction
+ * before trying the transformation again.
+ */
goto get_next_instr;
}
}
- if (stp->genop == NULL) {
- last_op_next = NULL;
- goto get_next_instr;
- }
-
/*
* From the collected generic instruction, find the specific
* instruction.
@@ -2017,7 +2197,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++;
}
@@ -2128,14 +2343,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);
@@ -2146,6 +2358,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);
@@ -2154,14 +2370,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",
@@ -2205,7 +2418,7 @@ load_code(LoaderState* stp)
VerifyTag(stp, tag, TAG_u);
last_label = tmp_op->a[arg].val;
if (!(0 < last_label && last_label < stp->num_labels)) {
- LoadError2(stp, "invalid label num %d (0 < label < %d)",
+ LoadError2(stp, "invalid label num %u (0 < label < %u)",
tmp_op->a[arg].val, stp->num_labels);
}
if (stp->labels[last_label].value != 0) {
@@ -2318,20 +2531,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);
@@ -2354,20 +2560,18 @@ 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)",
+ LoadError1(stp, "too many functions in module (header said %u)",
stp->num_functions);
}
if (stp->may_load_nif) {
const int finfo_ix = ci - FUNC_INFO_SZ;
- enum { MIN_FUNC_SZ = 3 };
- if (finfo_ix - last_func_start < MIN_FUNC_SZ && last_func_start) {
+ if (finfo_ix - last_func_start < BEAM_NIF_MIN_FUNC_SZ && last_func_start) {
/* Must make room for call_nif op */
- int pad = MIN_FUNC_SZ - (finfo_ix - last_func_start);
- ASSERT(pad > 0 && pad < MIN_FUNC_SZ);
+ int pad = BEAM_NIF_MIN_FUNC_SZ - (finfo_ix - last_func_start);
+ ASSERT(pad > 0 && pad < BEAM_NIF_MIN_FUNC_SZ);
CodeNeed(pad);
sys_memmove(&code[finfo_ix+pad], &code[finfo_ix],
FUNC_INFO_SZ*sizeof(BeamInstr));
@@ -2392,16 +2596,19 @@ load_code(LoaderState* stp)
stp->function = code[ci-2];
stp->arity = code[ci-1];
+ /* When this assert is triggered, it is normally a sign that
+ the size of the ops.tab i_func_info instruction is not
+ the same as FUNC_INFO_SZ */
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] = (ErtsCodeInfo*) 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);
}
@@ -2415,7 +2622,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;
@@ -2433,14 +2639,14 @@ load_code(LoaderState* stp)
if (stp->line_item) {
BeamInstr item = code[ci-1];
BeamInstr loc;
- int li;
+ unsigned int li;
if (item >= stp->num_line_items) {
- LoadError2(stp, "line instruction index overflow (%d/%d)",
+ LoadError2(stp, "line instruction index overflow (%u/%u)",
item, stp->num_line_items);
}
li = stp->current_li;
if (li >= stp->num_line_instrs) {
- LoadError2(stp, "line instruction table overflow (%d/%d)",
+ LoadError2(stp, "line instruction table overflow (%u/%u)",
li, stp->num_line_instrs);
}
loc = stp->line_item[item];
@@ -2472,7 +2678,11 @@ load_code(LoaderState* stp)
* End of code found.
*/
case op_int_code_end:
- stp->code_buffer_size = code_buffer_size;
+ if (function_number != stp->num_functions) {
+ LoadError2(stp, "too few functions (%u) in module (header said %u)",
+ function_number, stp->num_functions);
+ }
+ stp->codev_size = codev_size;
stp->ci = ci;
stp->function = THE_NON_VALUE;
stp->genop = NULL;
@@ -2487,7 +2697,10 @@ load_code(LoaderState* stp)
{
GenOp* next = stp->genop->next;
FREE_GENOP(stp, stp->genop);
- stp->genop = next;
+ if ((stp->genop = next) == NULL) {
+ last_op_next = &stp->genop;
+ goto get_next_instr;
+ }
goto do_transform;
}
}
@@ -2631,12 +2844,18 @@ mixed_types(LoaderState* stp, GenOpArg Size, GenOpArg* Rest)
}
static int
-same_label(LoaderState* stp, GenOpArg Target, GenOpArg Label)
+is_killed_apply(LoaderState* stp, GenOpArg Reg, GenOpArg Live)
{
- return Target.type = TAG_f && Label.type == TAG_u &&
- Target.val == Label.val;
+ return Reg.type == TAG_x && Live.type == TAG_u &&
+ Live.val+2 <= Reg.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.
@@ -2653,17 +2872,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;
}
@@ -2789,23 +3008,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;
@@ -3165,7 +3377,11 @@ gen_increment_from_minus(LoaderState* stp, GenOpArg Reg, GenOpArg Integer,
static int
negation_is_small(LoaderState* stp, GenOpArg Int)
{
- return Int.type == TAG_i && IS_SSMALL(-Int.val);
+ /* Check for the rare case of overflow in BeamInstr (UWord) -> Sint
+ * Cast to the correct type before using IS_SSMALL (Sint) */
+ return Int.type == TAG_i &&
+ !(Int.val & ~((((BeamInstr)1) << ((sizeof(Sint)*8)-1))-1)) &&
+ IS_SSMALL(-((Sint)Int.val));
}
@@ -3225,14 +3441,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;
@@ -3249,7 +3465,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;
@@ -3272,14 +3488,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;
@@ -3296,7 +3512,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;
@@ -3315,9 +3531,10 @@ gen_select_tuple_arity(LoaderState* stp, GenOpArg S, GenOpArg Fail,
{
GenOp* op;
+ GenOpArg *tmp;
int arity = Size.val + 3;
int size = Size.val / 2;
- int i;
+ int i, j, align = 0;
/*
* Verify the validity of the list.
@@ -3332,9 +3549,37 @@ gen_select_tuple_arity(LoaderState* stp, GenOpArg S, GenOpArg Fail,
}
/*
+ * Use a special-cased instruction if there are only two values.
+ */
+ if (size == 2) {
+ NEW_GENOP(stp, op);
+ op->next = NULL;
+ op->op = genop_i_select_tuple_arity2_6;
+ GENOP_ARITY(op, arity - 1);
+ op->a[0] = S;
+ op->a[1] = Fail;
+ op->a[2].type = TAG_u;
+ op->a[2].val = Rest[0].val;
+ op->a[3].type = TAG_u;
+ op->a[3].val = Rest[2].val;
+ op->a[4] = Rest[1];
+ op->a[5] = Rest[3];
+
+ return op;
+ }
+
+ /*
* Generate the generic instruction.
+ * Assumption:
+ * Few different tuple arities to select on (fewer than 20).
+ * Use linear scan approach.
*/
+ align = 1;
+
+ arity += 2*align;
+ size += align;
+
NEW_GENOP(stp, op);
op->next = NULL;
op->op = genop_i_select_tuple_arity_3;
@@ -3342,39 +3587,36 @@ gen_select_tuple_arity(LoaderState* stp, GenOpArg S, GenOpArg Fail,
op->a[0] = S;
op->a[1] = Fail;
op->a[2].type = TAG_u;
- op->a[2].val = Size.val / 2;
- for (i = 0; i < Size.val; i += 2) {
- op->a[i+3].type = TAG_v;
- op->a[i+3].val = make_arityval(Rest[i].val);
- op->a[i+4] = Rest[i+1];
- }
+ op->a[2].val = size;
- /*
- * Sort the values to make them useful for a binary search.
- */
+ tmp = (GenOpArg *) erts_alloc(ERTS_ALC_T_LOADER_TMP, sizeof(GenOpArg)*(arity-2*align));
- qsort(op->a+3, size, 2*sizeof(GenOpArg),
- (int (*)(const void *, const void *)) genopargcompare);
-#ifdef DEBUG
- for (i = 3; i < arity-2; i += 2) {
- ASSERT(op->a[i].val < op->a[i+2].val);
+ for (i = 3; i < arity - 2*align; i+=2) {
+ tmp[i-3].type = TAG_v;
+ tmp[i-3].val = make_arityval(Rest[i-3].val);
+ tmp[i-2] = Rest[i-2];
}
-#endif
/*
- * Use a special-cased instruction if there are only two values.
+ * Sort the values to make them useful for a sentinel search
*/
- if (size == 2) {
- op->op = genop_i_select_tuple_arity2_6;
- op->arity--;
- op->a[2].type = TAG_u;
- op->a[2].val = arityval(op->a[3].val);
- op->a[3] = op->a[4];
- op->a[4].type = TAG_u;
- op->a[4].val = arityval(op->a[5].val);
- op->a[5] = op->a[6];
+
+ qsort(tmp, size - align, 2*sizeof(GenOpArg),
+ (int (*)(const void *, const void *)) genopargcompare);
+
+ j = 3;
+ for (i = 3; i < arity - 2*align; i += 2) {
+ op->a[j] = tmp[i-3];
+ op->a[j + size] = tmp[i-2];
+ j++;
}
+ erts_free(ERTS_ALC_T_LOADER_TMP, (void *) tmp);
+
+ op->a[j].type = TAG_u;
+ op->a[j].val = ~((BeamInstr)0);
+ op->a[j+size] = Fail;
+
return op;
}
@@ -3596,45 +3838,109 @@ gen_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail,
GenOpArg Size, GenOpArg* Rest)
{
GenOp* op;
+ GenOpArg *tmp;
int arity = Size.val + 3;
int size = Size.val / 2;
- int i;
+ int i, j, align = 0;
+
+ if (size == 2) {
+
+ /*
+ * Use a special-cased instruction if there are only two values.
+ */
+
+ NEW_GENOP(stp, op);
+ op->next = NULL;
+ op->op = genop_i_select_val2_6;
+ GENOP_ARITY(op, arity - 1);
+ op->a[0] = S;
+ op->a[1] = Fail;
+ op->a[2] = Rest[0];
+ op->a[3] = Rest[2];
+ op->a[4] = Rest[1];
+ op->a[5] = Rest[3];
+
+ return op;
+
+ } else if (size > 10) {
+
+ /* binary search instruction */
+
+ NEW_GENOP(stp, op);
+ op->next = NULL;
+ op->op = genop_i_select_val_bins_3;
+ GENOP_ARITY(op, arity);
+ op->a[0] = S;
+ op->a[1] = Fail;
+ op->a[2].type = TAG_u;
+ op->a[2].val = size;
+ for (i = 3; i < arity; i++) {
+ op->a[i] = Rest[i-3];
+ }
+
+ /*
+ * Sort the values to make them useful for a binary search.
+ */
+
+ qsort(op->a+3, size, 2*sizeof(GenOpArg),
+ (int (*)(const void *, const void *)) genopargcompare);
+#ifdef DEBUG
+ for (i = 3; i < arity-2; i += 2) {
+ ASSERT(op->a[i].val < op->a[i+2].val);
+ }
+#endif
+ return op;
+ }
+
+ /* linear search instruction */
+
+ align = 1;
+
+ arity += 2*align;
+ size += align;
NEW_GENOP(stp, op);
op->next = NULL;
- op->op = genop_i_select_val_3;
+ op->op = genop_i_select_val_lins_3;
GENOP_ARITY(op, arity);
op->a[0] = S;
op->a[1] = Fail;
op->a[2].type = TAG_u;
op->a[2].val = size;
- for (i = 3; i < arity; i++) {
- op->a[i] = Rest[i-3];
+
+ tmp = (GenOpArg *) erts_alloc(ERTS_ALC_T_LOADER_TMP, sizeof(GenOpArg)*(arity-2*align));
+
+ for (i = 3; i < arity - 2*align; i++) {
+ tmp[i-3] = Rest[i-3];
}
/*
- * Sort the values to make them useful for a binary search.
+ * Sort the values to make them useful for a sentinel search
*/
- qsort(op->a+3, size, 2*sizeof(GenOpArg),
- (int (*)(const void *, const void *)) genopargcompare);
-#ifdef DEBUG
- for (i = 3; i < arity-2; i += 2) {
- ASSERT(op->a[i].val < op->a[i+2].val);
+ qsort(tmp, size - align, 2*sizeof(GenOpArg),
+ (int (*)(const void *, const void *)) genopargcompare);
+
+ j = 3;
+ for (i = 3; i < arity - 2*align; i += 2) {
+ op->a[j] = tmp[i-3];
+ op->a[j+size] = tmp[i-2];
+ j++;
}
-#endif
- /*
- * Use a special-cased instruction if there are only two values.
- */
- if (size == 2) {
- op->op = genop_i_select_val2_6;
- op->arity--;
- op->a[2] = op->a[3];
- op->a[3] = op->a[4];
- op->a[4] = op->a[5];
- op->a[5] = op->a[6];
+ erts_free(ERTS_ALC_T_LOADER_TMP, (void *) tmp);
+
+ /* add sentinel */
+
+ op->a[j].type = TAG_u;
+ op->a[j].val = ~((BeamInstr)0);
+ op->a[j+size] = Fail;
+
+#ifdef DEBUG
+ for (i = 0; i < size - 1; i++) {
+ ASSERT(op->a[i+3].val <= op->a[i+4].val);
}
+#endif
return op;
}
@@ -3759,150 +4065,97 @@ gen_make_fun2(LoaderState* stp, GenOpArg idx)
op->next = NULL;
return op;
}
+
+static GenOp*
+translate_gc_bif(LoaderState* stp, GenOp* op, GenOpArg Bif)
+{
+ const ErtsGcBif* p;
+ BifFunction bf;
+
+ bf = stp->import[Bif.val].bf;
+ for (p = erts_gc_bifs; p->bif != 0; p++) {
+ if (p->bif == bf) {
+ op->a[1].type = TAG_u;
+ op->a[1].val = (BeamInstr) p->gc_bif;
+ return op;
+ }
+ }
+
+ op->op = genop_unsupported_guard_bif_3;
+ op->arity = 3;
+ op->a[0].type = TAG_a;
+ op->a[0].val = stp->import[Bif.val].module;
+ op->a[1].type = TAG_a;
+ op->a[1].val = stp->import[Bif.val].function;
+ op->a[2].type = TAG_u;
+ op->a[2].val = stp->import[Bif.val].arity;
+ return op;
+}
+
/*
- * 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).
+ * Rewrite gc_bifs with one parameter (the common case).
*/
static GenOp*
gen_guard_bif1(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
GenOpArg Src, GenOpArg Dst)
{
GenOp* op;
- BifFunction bf;
NEW_GENOP(stp, op);
op->next = NULL;
- bf = stp->import[Bif.val].bf;
- /* The translations here need to have a reverse counterpart in
- beam_emu.c:translate_gc_bif for error handling to work properly. */
- if (bf == length_1) {
- op->a[1].val = (BeamInstr) (void *) erts_gc_length_1;
- } else if (bf == size_1) {
- op->a[1].val = (BeamInstr) (void *) erts_gc_size_1;
- } else if (bf == bit_size_1) {
- op->a[1].val = (BeamInstr) (void *) erts_gc_bit_size_1;
- } else if (bf == byte_size_1) {
- op->a[1].val = (BeamInstr) (void *) erts_gc_byte_size_1;
- } else if (bf == map_size_1) {
- op->a[1].val = (BeamInstr) (void *) erts_gc_map_size_1;
- } else if (bf == abs_1) {
- op->a[1].val = (BeamInstr) (void *) erts_gc_abs_1;
- } else if (bf == float_1) {
- op->a[1].val = (BeamInstr) (void *) erts_gc_float_1;
- } else if (bf == round_1) {
- op->a[1].val = (BeamInstr) (void *) erts_gc_round_1;
- } else if (bf == trunc_1) {
- op->a[1].val = (BeamInstr) (void *) erts_gc_trunc_1;
- } else {
- op->op = genop_unsupported_guard_bif_3;
- op->arity = 3;
- op->a[0].type = TAG_a;
- op->a[0].val = stp->import[Bif.val].module;
- op->a[1].type = TAG_a;
- op->a[1].val = stp->import[Bif.val].function;
- op->a[2].type = TAG_u;
- op->a[2].val = stp->import[Bif.val].arity;
- return op;
- }
op->op = genop_i_gc_bif1_5;
op->arity = 5;
op->a[0] = Fail;
- op->a[1].type = TAG_u;
+ /* op->a[1] is set by translate_gc_bif() */
op->a[2] = Src;
op->a[3] = Live;
op->a[4] = Dst;
- return op;
+ return translate_gc_bif(stp, op, 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,
GenOpArg S1, GenOpArg S2, GenOpArg Dst)
{
GenOp* op;
- BifFunction bf;
NEW_GENOP(stp, op);
op->next = NULL;
- bf = stp->import[Bif.val].bf;
- /* The translations here need to have a reverse counterpart in
- beam_emu.c:translate_gc_bif for error handling to work properly. */
- if (bf == binary_part_2) {
- op->a[1].val = (BeamInstr) (void *) erts_gc_binary_part_2;
- } else {
- op->op = genop_unsupported_guard_bif_3;
- op->arity = 3;
- op->a[0].type = TAG_a;
- op->a[0].val = stp->import[Bif.val].module;
- op->a[1].type = TAG_a;
- op->a[1].val = stp->import[Bif.val].function;
- op->a[2].type = TAG_u;
- 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[1] is set by translate_gc_bif() */
+ op->a[2] = Live;
+ op->a[3] = S1;
+ op->a[4] = S2;
op->a[5] = Dst;
- return op;
+ return translate_gc_bif(stp, op, Bif);
}
/*
* 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,
GenOpArg S1, GenOpArg S2, GenOpArg S3, GenOpArg Dst)
{
GenOp* op;
- BifFunction bf;
NEW_GENOP(stp, op);
op->next = NULL;
- bf = stp->import[Bif.val].bf;
- /* The translations here need to have a reverse counterpart in
- beam_emu.c:translate_gc_bif for error handling to work properly. */
- if (bf == binary_part_3) {
- op->a[1].val = (BeamInstr) (void *) erts_gc_binary_part_3;
- } else {
- op->op = genop_unsupported_guard_bif_3;
- op->arity = 3;
- op->a[0].type = TAG_a;
- op->a[0].val = stp->import[Bif.val].module;
- op->a[1].type = TAG_a;
- op->a[1].val = stp->import[Bif.val].function;
- op->a[2].type = TAG_u;
- op->a[2].val = stp->import[Bif.val].arity;
- return op;
- }
op->op = genop_ii_gc_bif3_7;
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[1] is set by translate_gc_bif() */
+ 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;
+ return translate_gc_bif(stp, op, Bif);
}
static GenOp*
@@ -3955,8 +4208,139 @@ tuple_append_put(LoaderState* stp, GenOpArg Arity, GenOpArg Dst,
}
/*
+ * Predicate to test whether the given literal is a map.
+ */
+
+static int
+literal_is_map(LoaderState* stp, GenOpArg Lit)
+{
+ Eterm term;
+
+ ASSERT(Lit.type == TAG_q);
+ term = stp->literals[Lit.val].term;
+ return is_map(term);
+}
+
+/*
+ * Predicate to test whether the given literal is an empty map.
+ */
+
+static int
+is_empty_map(LoaderState* stp, GenOpArg Lit)
+{
+ Eterm term;
+
+ if (Lit.type != TAG_q) {
+ return 0;
+ }
+ term = stp->literals[Lit.val].term;
+ return is_flatmap(term) && flatmap_get_size(flatmap_val(term)) == 0;
+}
+
+/*
+ * Pseudo predicate map_key_sort that will sort the Rest operand for
+ * map instructions as a side effect.
+ */
+
+typedef struct SortGenOpArg {
+ Eterm term; /* Term to use for comparing */
+ GenOpArg arg; /* Original data */
+} SortGenOpArg;
+
+static int
+genopargtermcompare(SortGenOpArg* a, SortGenOpArg* b)
+{
+ return CMP_TERM(a->term, b->term);
+}
+
+static int
+map_key_sort(LoaderState* stp, GenOpArg Size, GenOpArg* Rest)
+{
+ SortGenOpArg* t;
+ unsigned size = Size.val;
+ unsigned i;
+
+ if (size == 2) {
+ return 1; /* Already sorted. */
+ }
+
+
+ t = (SortGenOpArg *) erts_alloc(ERTS_ALC_T_TMP, size*sizeof(SortGenOpArg));
+
+ /*
+ * Copy original data and sort keys to a temporary array.
+ */
+ for (i = 0; i < size; i += 2) {
+ t[i].arg = Rest[i];
+ switch (Rest[i].type) {
+ case TAG_a:
+ t[i].term = Rest[i].val;
+ ASSERT(is_atom(t[i].term));
+ break;
+ case TAG_i:
+ t[i].term = make_small(Rest[i].val);
+ break;
+ case TAG_n:
+ t[i].term = NIL;
+ break;
+ case TAG_q:
+ t[i].term = stp->literals[Rest[i].val].term;
+ break;
+ default:
+ /*
+ * Not a literal key. Not allowed. Only a single
+ * variable key is allowed in each map instruction.
+ */
+ erts_free(ERTS_ALC_T_TMP, (void *) t);
+ return 0;
+ }
+#ifdef DEBUG
+ t[i+1].term = THE_NON_VALUE;
+#endif
+ t[i+1].arg = Rest[i+1];
+ }
+
+ /*
+ * Sort the temporary array.
+ */
+ qsort((void *) t, size / 2, 2 * sizeof(SortGenOpArg),
+ (int (*)(const void *, const void *)) genopargtermcompare);
+
+ /*
+ * Copy back the sorted, original data.
+ */
+ for (i = 0; i < size; i++) {
+ Rest[i] = t[i].arg;
+ }
+
+ erts_free(ERTS_ALC_T_TMP, (void *) t);
+ return 1;
+}
+
+static int
+hash_genop_arg(LoaderState* stp, GenOpArg Key, Uint32* hx)
+{
+ switch (Key.type) {
+ case TAG_a:
+ *hx = hashmap_make_hash(Key.val);
+ return 1;
+ case TAG_i:
+ *hx = hashmap_make_hash(make_small(Key.val));
+ return 1;
+ case TAG_n:
+ *hx = hashmap_make_hash(NIL);
+ return 1;
+ case TAG_q:
+ *hx = hashmap_make_hash(stp->literals[Key.val].term);
+ return 1;
+ default:
+ return 0;
+ }
+}
+
+/*
* Replace a get_map_elements with one key to an instruction with one
- * element
+ * element.
*/
static GenOp*
@@ -3964,37 +4348,150 @@ gen_get_map_element(LoaderState* stp, GenOpArg Fail, GenOpArg Src,
GenOpArg Size, GenOpArg* Rest)
{
GenOp* op;
+ GenOpArg Key;
+ Uint32 hx = 0;
ASSERT(Size.type == TAG_u);
NEW_GENOP(stp, op);
op->next = NULL;
- op->op = genop_get_map_element_4;
- op->arity = 4;
-
op->a[0] = Fail;
op->a[1] = Src;
op->a[2] = Rest[0];
- op->a[3] = Rest[1];
+
+ Key = Rest[0];
+ if (hash_genop_arg(stp, Key, &hx)) {
+ op->arity = 5;
+ op->op = genop_i_get_map_element_hash_5;
+ op->a[3].type = TAG_u;
+ op->a[3].val = (BeamInstr) hx;
+ op->a[4] = Rest[1];
+ } else {
+ op->arity = 4;
+ op->op = genop_i_get_map_element_4;
+ op->a[3] = Rest[1];
+ }
return op;
}
+static int
+hash_internal_genop_arg(LoaderState* stp, GenOpArg Key, Uint32* hx)
+{
+ Eterm key_term;
+ switch (Key.type) {
+ case TAG_a:
+ key_term = Key.val;
+ break;
+ case TAG_i:
+ key_term = make_small(Key.val);
+ break;
+ case TAG_n:
+ key_term = NIL;
+ break;
+ case TAG_q:
+ key_term = stp->literals[Key.val].term;
+ break;
+ default:
+ return 0;
+ }
+ *hx = erts_pd_make_hx(key_term);
+ return 1;
+}
+
+
static GenOp*
-gen_has_map_field(LoaderState* stp, GenOpArg Fail, GenOpArg Src,
- GenOpArg Size, GenOpArg* Rest)
+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)
{
GenOp* op;
+ Uint32 hx;
+ Uint i;
+ GenOpArg* dst;
+#ifdef DEBUG
+ int good_hash;
+#endif
+ ERTS_UNDEF(hx, 0);
ASSERT(Size.type == TAG_u);
NEW_GENOP(stp, op);
+ op->op = genop_i_get_map_elements_3;
+ GENOP_ARITY(op, 3 + 3*(Size.val/2));
op->next = NULL;
- op->op = genop_has_map_field_3;
- op->arity = 4;
+ op->a[0] = Fail;
+ op->a[1] = Src;
+ op->a[2].type = TAG_u;
+ op->a[2].val = 3*(Size.val/2);
+
+ dst = op->a+3;
+ for (i = 0; i < Size.val / 2; i++) {
+ dst[0] = Rest[2*i];
+ dst[1] = Rest[2*i+1];
+#ifdef DEBUG
+ good_hash =
+#endif
+ hash_genop_arg(stp, dst[0], &hx);
+#ifdef DEBUG
+ ASSERT(good_hash);
+#endif
+ dst[2].type = TAG_u;
+ dst[2].val = (BeamInstr) hx;
+ dst += 3;
+ }
+ return op;
+}
+
+static GenOp*
+gen_has_map_fields(LoaderState* stp, GenOpArg Fail, GenOpArg Src,
+ GenOpArg Size, GenOpArg* Rest)
+{
+ GenOp* op;
+ Uint i;
+ Uint n;
+
+ ASSERT(Size.type == TAG_u);
+ n = Size.val;
+
+ NEW_GENOP(stp, op);
+ GENOP_ARITY(op, 3 + 2*n);
+ op->next = NULL;
+ op->op = genop_get_map_elements_3;
op->a[0] = Fail;
op->a[1] = Src;
- op->a[2] = Rest[0];
+ op->a[2].type = TAG_u;
+ op->a[2].val = 2*n;
+
+ 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 = SCRATCH_X_REG; /* Ignore result */
+ }
return op;
}
@@ -4006,8 +4503,8 @@ gen_has_map_field(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;
@@ -4032,128 +4529,80 @@ 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)) +
- strtab_size + attr_size + compile_size + line_size;
+ 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] = (ErtsCodeInfo*)(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;
- struct erl_off_heap_header* off_heap = 0;
- struct erl_off_heap_header** off_heap_last = &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;
- for (i = 0; i < stp->num_literals; i++) {
- SWord offset;
- struct erl_off_heap_header* t_off_heap;
-
- sys_memcpy(ptr, stp->literals[i].heap,
- stp->literals[i].heap_size*sizeof(Eterm));
- offset = ptr - stp->literals[i].heap;
- stp->literals[i].offset = offset;
- high = ptr + stp->literals[i].heap_size;
- while (ptr < high) {
- Eterm val = *ptr;
- switch (primary_tag(val)) {
- case TAG_PRIMARY_LIST:
- case TAG_PRIMARY_BOXED:
- *ptr++ = offset_ptr(val, offset);
- break;
- case TAG_PRIMARY_HEADER:
- if (header_is_transparent(val)) {
- ptr++;
- } else {
- if (thing_subtag(val) == REFC_BINARY_SUBTAG) {
- struct erl_off_heap_header* oh;
-
- oh = (struct erl_off_heap_header*) ptr;
- if (oh->next) {
- Eterm** uptr = (Eterm **) (void *) &oh->next;
- *uptr += offset;
- }
- }
- ptr += 1 + thing_arityval(val);
- }
- break;
- default:
- ptr++;
- break;
- }
- }
- ASSERT(ptr == high);
+ ErlOffHeap code_off_heap;
+ ErtsLiteralArea *literal_area;
+ Uint lit_asize;
- /*
- * Re-link the off_heap list for this term onto the
- * off_heap list for the entire module.
- */
- t_off_heap = stp->literals[i].off_heap.first;
- if (t_off_heap) {
- t_off_heap = (struct erl_off_heap_header *)
- offset_ptr((UWord) t_off_heap, offset);
- while (t_off_heap) {
- *off_heap_last = t_off_heap;
- off_heap_last = &t_off_heap->next;
- t_off_heap = t_off_heap->next;
- }
- }
+ ERTS_INIT_OFF_HEAP(&code_off_heap);
+
+ lit_asize = ERTS_LITERAL_AREA_ALLOC_SIZE(stp->total_literal_size);
+ literal_area = erts_alloc(ERTS_ALC_T_LITERAL, lit_asize);
+ ptr = &literal_area->start[0];
+ literal_area->end = ptr + stp->total_literal_size;
+
+ for (i = 0; i < stp->num_literals; i++) {
+ 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)));
+ }
}
- code[MI_LITERALS_OFF_HEAP] = (BeamInstr) off_heap;
+ literal_area->off_heap = code_off_heap.first;
lp = stp->literal_patches;
while (lp != 0) {
BeamInstr* op_ptr;
- Uint literal;
Literal* lit;
- op_ptr = code + lp->pos;
+ op_ptr = codev + lp->pos;
lit = &stp->literals[op_ptr[0]];
- literal = lit->term;
- if (is_boxed(literal) || is_list(literal)) {
- literal = offset_ptr(literal, lit->offset);
- }
- op_ptr[0] = literal;
+ op_ptr[0] = lit->term;
lp = lp->next;
}
- literal_end += stp->total_literal_size;
+ code_hdr->literal_area = literal_area;
}
CHKBLK(ERTS_ALC_T_CODE,code);
@@ -4161,52 +4610,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 unsigned int ftab_size = stp->num_functions;
+ const unsigned 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);
}
@@ -4218,13 +4664,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) {
@@ -4234,9 +4680,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);
@@ -4244,15 +4690,24 @@ 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);
+ {
+ byte* md5_sum = str_table + strtab_size + attr_size + compile_size;
+ CHKBLK(ERTS_ALC_T_CODE,code);
+ sys_memcpy(md5_sum, stp->mod_md5, MD5_SIZE);
+ CHKBLK(ERTS_ALC_T_CODE,code);
+ code_hdr->md5_ptr = md5_sum;
+ CHKBLK(ERTS_ALC_T_CODE,code);
}
CHKBLK(ERTS_ALC_T_CODE,code);
/*
* Make sure that we have not overflowed the allocated code space.
*/
- ASSERT(str_table + strtab_size + attr_size + compile_size ==
- ((byte *) code) + size);
+ ASSERT(str_table + strtab_size + attr_size + compile_size + MD5_SIZE ==
+ ((byte *) code_hdr) + size);
/*
* Patch all instructions that refer to the string table.
@@ -4264,46 +4719,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:
@@ -4311,19 +4767,19 @@ 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;
}
static void
-final_touch(LoaderState* stp)
+final_touch(LoaderState* stp, struct erl_module_instance* inst_p)
{
- int i;
+ unsigned int i;
int on_load = stp->on_load;
unsigned catches;
Uint index;
- BeamInstr* code = stp->code;
- Module* modp;
+ BeamInstr* codev = stp->codev;
/*
* Allocate catch indices and fix up all catch_yf instructions.
@@ -4332,14 +4788,13 @@ 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);
- modp->curr.catches = catches;
+ inst_p->catches = catches;
/*
* Export functions.
@@ -4355,16 +4810,16 @@ final_touch(LoaderState* stp)
}
ep = erts_export_put(stp->module, stp->export[i].function,
stp->export[i].arity);
- if (!on_load) {
- ep->addressv[erts_staging_code_ix()] = address;
- } else {
+ if (on_load) {
/*
- * Don't make any of the exported functions
- * callable yet.
+ * on_load: Don't make any of the exported functions
+ * callable yet. Keep any function in the current
+ * code callable.
*/
- ep->addressv[erts_staging_code_ix()] = ep->code+3;
- ep->code[4] = (BeamInstr) address;
+ ep->beam[1] = (BeamInstr) address;
}
+ else
+ ep->addressv[erts_staging_code_ix()] = address;
}
/*
@@ -4386,8 +4841,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;
}
}
@@ -4400,17 +4855,17 @@ 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) {
/*
* We are hiding a pointer into older code.
*/
- erts_refc_dec(&fe->refc, 1);
+ erts_smp_refc_dec(&fe->refc, 1);
}
fe->address = code_ptr;
#ifdef HIPE
- hipe_set_closure_stub(fe, stp->lambdas[i].num_free);
+ hipe_set_closure_stub(fe);
#endif
}
}
@@ -4421,32 +4876,26 @@ transform_engine(LoaderState* st)
{
Uint op;
int ap; /* Current argument. */
- Uint* restart; /* Where to restart if current match fails. */
- GenOpArg def_vars[TE_MAX_VARS]; /* Default buffer for variables. */
- GenOpArg* var = def_vars;
- int num_vars = 0;
+ const Uint* restart; /* Where to restart if current match fails. */
+ GenOpArg var[TE_MAX_VARS]; /* Buffer for variables. */
+ GenOpArg* rest_args = NULL;
+ int num_rest_args = 0;
int i; /* General index. */
Uint mask;
GenOp* instr;
- Uint* pc;
- int rval;
+ GenOp* first = st->genop;
+ GenOp* keep = NULL;
+ const Uint* pc;
static Uint restart_fail[1] = {TOP_fail};
- ASSERT(gen_opc[st->genop->op].transform != -1);
- pc = op_transform + gen_opc[st->genop->op].transform;
- restart = pc;
+ ASSERT(gen_opc[first->op].transform != -1);
+ restart = op_transform + gen_opc[first->op].transform;
restart:
- if (var != def_vars) {
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) var);
- var = def_vars;
- }
ASSERT(restart != NULL);
pc = restart;
ASSERT(*pc < NUM_TOPS); /* Valid instruction? */
- instr = st->genop;
-
-#define RETURN(r) rval = (r); goto do_return;
+ instr = first;
#ifdef DEBUG
restart = NULL;
@@ -4464,7 +4913,7 @@ transform_engine(LoaderState* st)
* We'll need at least one more instruction to decide whether
* this combination matches or not.
*/
- RETURN(TE_SHORT_WINDOW);
+ return TE_SHORT_WINDOW;
}
if (*pc++ != instr->op)
goto restart;
@@ -4513,7 +4962,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;
@@ -4546,7 +4996,7 @@ transform_engine(LoaderState* st)
if (i >= st->num_imports || st->import[i].bf == NULL)
goto restart;
if (bif_number != -1 &&
- bif_export[bif_number]->code[4] != (BeamInstr) st->import[i].bf) {
+ bif_export[bif_number]->beam[1] != (BeamInstr) st->import[i].bf) {
goto restart;
}
}
@@ -4625,19 +5075,9 @@ transform_engine(LoaderState* st)
#if defined(TOP_rest_args)
case TOP_rest_args:
{
- int n = *pc++;
int formal_arity = gen_opc[instr->op].arity;
- int j = formal_arity;
-
- num_vars = n + (instr->arity - formal_arity);
- var = erts_alloc(ERTS_ALC_T_LOADER_TMP,
- num_vars * sizeof(GenOpArg));
- for (i = 0; i < n; i++) {
- var[i] = def_vars[i];
- }
- while (i < num_vars) {
- var[i++] = instr->a[j++];
- }
+ num_rest_args = instr->arity - formal_arity;
+ rest_args = instr->a + formal_arity;
}
break;
#endif
@@ -4646,21 +5086,22 @@ transform_engine(LoaderState* st)
break;
case TOP_commit:
instr = instr->next; /* The next_instr was optimized away. */
-
- /*
- * The left-hand side of this transformation matched.
- * Delete all matched instructions.
- */
- while (st->genop != instr) {
- GenOp* next = st->genop->next;
- FREE_GENOP(st, st->genop);
- st->genop = next;
- }
+ keep = instr;
+ st->genop = instr;
#ifdef DEBUG
instr = 0;
#endif
break;
-
+#if defined(TOP_keep)
+ case TOP_keep:
+ /* Keep the current instruction unchanged. */
+ keep = instr;
+ st->genop = instr;
+#ifdef DEBUG
+ instr = 0;
+#endif
+ break;
+#endif
#if defined(TOP_call_end)
case TOP_call_end:
{
@@ -4685,22 +5126,19 @@ transform_engine(LoaderState* st)
lastp = &((*lastp)->next);
}
- instr = instr->next; /* The next_instr was optimized away. */
-
- /*
- * The left-hand side of this transformation matched.
- * Delete all matched instructions.
- */
- while (st->genop != instr) {
- GenOp* next = st->genop->next;
- FREE_GENOP(st, st->genop);
- st->genop = next;
- }
- *lastp = st->genop;
+ keep = instr->next; /* The next_instr was optimized away. */
+ *lastp = keep;
st->genop = new_instr;
}
- RETURN(TE_OK);
+ /* FALLTHROUGH */
#endif
+ case TOP_end:
+ while (first != keep) {
+ GenOp* next = first->next;
+ FREE_GENOP(st, first);
+ first = next;
+ }
+ return TE_OK;
case TOP_new_instr:
/*
* Note that the instructions are generated in reverse order.
@@ -4712,6 +5150,12 @@ transform_engine(LoaderState* st)
instr->arity = gen_opc[op].arity;
ap = 0;
break;
+#ifdef TOP_rename
+ case TOP_rename:
+ instr->op = op = *pc++;
+ instr->arity = gen_opc[op].arity;
+ return TE_OK;
+#endif
case TOP_store_type:
i = *pc++;
instr->a[ap].type = i;
@@ -4731,14 +5175,10 @@ transform_engine(LoaderState* st)
#if defined(TOP_store_rest_args)
case TOP_store_rest_args:
{
- int n = *pc++;
- int num_extra = num_vars - n;
-
- ASSERT(n <= num_vars);
- GENOP_ARITY(instr, instr->arity+num_extra);
+ GENOP_ARITY(instr, instr->arity+num_rest_args);
memcpy(instr->a, instr->def_args, ap*sizeof(GenOpArg));
- memcpy(instr->a+ap, var+n, num_extra*sizeof(GenOpArg));
- ap += num_extra;
+ memcpy(instr->a+ap, rest_args, num_rest_args*sizeof(GenOpArg));
+ ap += num_rest_args;
}
break;
#endif
@@ -4750,21 +5190,12 @@ transform_engine(LoaderState* st)
case TOP_try_me_else_fail:
restart = restart_fail;
break;
- case TOP_end:
- RETURN(TE_OK);
case TOP_fail:
- RETURN(TE_FAIL);
+ return TE_FAIL;
default:
ASSERT(0);
}
}
-#undef RETURN
-
- do_return:
- if (var != def_vars) {
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) var);
- }
- return rval;
}
static void
@@ -4967,7 +5398,8 @@ get_tag_and_value(LoaderState* stp, Uint len_code,
arity = count/sizeof(Eterm);
*result = new_literal(stp, &hp, arity+1);
- (void) bytes_to_big(bigbuf, count, neg, hp);
+ if (is_nil(bytes_to_big(bigbuf, count, neg, hp)))
+ goto load_error;
if (bigbuf != default_buf) {
erts_free(ERTS_ALC_T_LOADER_TMP, (void *) bigbuf);
@@ -5015,14 +5447,14 @@ new_genop(LoaderState* stp)
static int
new_label(LoaderState* stp)
{
- int num = stp->num_labels;
+ unsigned int num = stp->num_labels;
stp->num_labels++;
stp->labels = (Label *) erts_realloc(ERTS_ALC_T_PREPARED_CODE,
(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;
}
@@ -5071,19 +5503,18 @@ new_literal(LoaderState* stp, Eterm** hpp, Uint heap_size)
stp->total_literal_size += heap_size;
lit = stp->literals + stp->num_literals;
- lit->offset = 0;
- lit->heap_size = heap_size;
- lit->heap = erts_alloc(ERTS_ALC_T_PREPARED_CODE, heap_size*sizeof(Eterm));
- lit->term = make_boxed(lit->heap);
- lit->off_heap.first = 0;
- lit->off_heap.overhead = 0;
- *hpp = lit->heap;
+ lit->heap_frags = new_literal_fragment(heap_size);
+ lit->term = make_boxed(lit->heap_frags->mem);
+ *hpp = lit->heap_frags->mem;
return stp->num_literals++;
}
Eterm
erts_module_info_0(Process* p, Eterm module)
{
+ Module* modp;
+ ErtsCodeIndex code_ix = erts_active_code_ix();
+ BeamCodeHeader* code_hdr;
Eterm *hp;
Eterm list = NIL;
Eterm tup;
@@ -5092,21 +5523,31 @@ erts_module_info_0(Process* p, Eterm module)
return THE_NON_VALUE;
}
- if (erts_get_module(module, erts_active_code_ix()) == NULL) {
+ modp = erts_get_module(module, code_ix);
+ if (modp == NULL) {
return THE_NON_VALUE;
}
+ code_hdr = modp->curr.code_hdr;
+ if (code_hdr == NULL) {
+ return THE_NON_VALUE;
+ }
+
#define BUILD_INFO(What) \
- tup = erts_module_info_1(p, module, What); \
+ tup = get_module_info(p, code_ix, code_hdr, module, What); \
hp = HAlloc(p, 5); \
tup = TUPLE2(hp, What, tup); \
hp += 3; \
list = CONS(hp, tup, list)
+ BUILD_INFO(am_md5);
+#ifdef HIPE
+ BUILD_INFO(am_native);
+#endif
BUILD_INFO(am_compile);
BUILD_INFO(am_attributes);
- BUILD_INFO(am_imports);
BUILD_INFO(am_exports);
+ BUILD_INFO(am_module);
#undef BUILD_INFO
return list;
}
@@ -5114,20 +5555,47 @@ erts_module_info_0(Process* p, Eterm module)
Eterm
erts_module_info_1(Process* p, Eterm module, Eterm what)
{
+ Module* modp;
+ ErtsCodeIndex code_ix = erts_active_code_ix();
+ BeamCodeHeader* code_hdr;
+
+ if (is_not_atom(module)) {
+ return THE_NON_VALUE;
+ }
+
+ modp = erts_get_module(module, code_ix);
+ if (modp == NULL) {
+ return THE_NON_VALUE;
+ }
+
+ code_hdr = modp->curr.code_hdr;
+ if (code_hdr == NULL) {
+ return THE_NON_VALUE;
+ }
+
+ return get_module_info(p, code_ix, code_hdr, module, what);
+}
+
+static Eterm
+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_imports) {
- return NIL;
+ } else if (what == am_md5) {
+ return md5_of_module(p, code_hdr);
} else if (what == am_exports) {
- return exported_from_module(p, module);
+ return exported_from_module(p, code_ix, module);
} else if (what == am_functions) {
- return functions_in_module(p, module);
+ return functions_in_module(p, code_hdr);
} else if (what == am_attributes) {
- return attributes_for_module(p, module);
+ return attributes_for_module(p, code_hdr);
} else if (what == am_compile) {
- return compilation_info_for_module(p, module);
+ return compilation_info_for_module(p, code_hdr);
} else if (what == am_native_addresses) {
- return native_addresses(p, module);
+ return native_addresses(p, code_hdr);
+ } else if (what == am_native) {
+ return has_native(code_hdr);
}
return THE_NON_VALUE;
}
@@ -5135,16 +5603,12 @@ erts_module_info_1(Process* p, Eterm module, Eterm what)
/*
* Builds a list of all functions in the given module:
* [{Name, Arity},...]
- *
- * Returns a tagged term, or 0 on error.
*/
Eterm
functions_in_module(Process* p, /* Process whose heap to use. */
- Eterm mod) /* Tagged atom for module. */
+ BeamCodeHeader* code_hdr)
{
- Module* modp;
- BeamInstr* code;
int i;
Uint num_functions;
Uint need;
@@ -5152,32 +5616,21 @@ functions_in_module(Process* p, /* Process whose heap to use. */
Eterm* hp_end;
Eterm result = NIL;
- if (is_not_atom(mod)) {
- return THE_NON_VALUE;
- }
-
- modp = erts_get_module(mod, erts_active_code_ix());
- if (modp == NULL) {
- return THE_NON_VALUE;
- }
- code = modp->curr.code;
- 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];
- Eterm name = (Eterm) func_info[3];
- int arity = (int) func_info[4];
+ ErtsCodeInfo* ci = code_hdr->functions[i];
Eterm tuple;
/*
* If the function name is [], this entry is a stub for
* a BIF that should be ignored.
*/
- ASSERT(is_atom(name) || is_nil(name));
- if (is_atom(name)) {
- tuple = TUPLE2(hp, name, make_small(arity));
+ ASSERT(is_atom(ci->mfa.function) || is_nil(ci->mfa.function));
+ if (is_atom(ci->mfa.function)) {
+ tuple = TUPLE2(hp, ci->mfa.function, make_small(ci->mfa.arity));
hp += 3;
result = CONS(hp, tuple, result);
hp += 2;
@@ -5188,87 +5641,136 @@ functions_in_module(Process* p, /* Process whose heap to use. */
}
/*
+ * Returns 'true' if mod has any native compiled functions, otherwise 'false'
+ */
+
+static Eterm
+has_native(BeamCodeHeader *code_hdr)
+{
+ Eterm result = am_false;
+#ifdef HIPE
+ if (erts_is_module_native(code_hdr)) {
+ result = am_true;
+ }
+#endif
+ return result;
+}
+
+void
+erts_release_literal_area(ErtsLiteralArea* literal_area)
+{
+ struct erl_off_heap_header* oh;
+
+ if (!literal_area)
+ return;
+
+ oh = literal_area->off_heap;
+
+ while (oh) {
+ Binary* bptr;
+ ASSERT(thing_subtag(oh->thing_word) == REFC_BINARY_SUBTAG);
+ bptr = ((ProcBin*)oh)->val;
+ erts_bin_release(bptr);
+ oh = oh->next;
+ }
+ erts_free(ERTS_ALC_T_LITERAL, literal_area);
+}
+
+int
+erts_is_module_native(BeamCodeHeader* code_hdr)
+{
+ Uint i, num_functions;
+
+ /* Check NativeAdress of first real function in module */
+ if (code_hdr != NULL) {
+ num_functions = code_hdr->num_functions;
+ for (i=0; i<num_functions; i++) {
+ ErtsCodeInfo* ci = code_hdr->functions[i];
+ if (is_atom(ci->mfa.function)) {
+ return erts_is_function_native(ci);
+ }
+ else ASSERT(is_nil(ci->mfa.function)); /* ignore BIF stubs */
+ }
+ }
+ return 0;
+}
+
+int
+erts_is_function_native(ErtsCodeInfo *ci)
+{
+#ifdef HIPE
+ ASSERT(ci->op == (BeamInstr) BeamOp(op_i_func_info_IaaI));
+ return erts_codeinfo_to_code(ci)[0] == (BeamInstr) BeamOp(op_hipe_trap_call)
+ || erts_codeinfo_to_code(ci)[0] == (BeamInstr) BeamOp(op_hipe_trap_call_closure);
+#else
+ return 0;
+#endif
+}
+
+/*
* Builds a list of all functions including native addresses.
* [{Name,Arity,NativeAddress},...]
- *
- * Returns a tagged term, or 0 on error.
*/
static Eterm
-native_addresses(Process* p, Eterm mod)
+native_addresses(Process* p, BeamCodeHeader* code_hdr)
{
- Module* modp;
- BeamInstr* code;
+ Eterm result = NIL;
+#ifdef HIPE
int i;
Eterm* hp;
Uint num_functions;
Uint need;
Eterm* hp_end;
- Eterm result = NIL;
-
- if (is_not_atom(mod)) {
- return THE_NON_VALUE;
- }
- modp = erts_get_module(mod, erts_active_code_ix());
- if (modp == NULL) {
- return THE_NON_VALUE;
- }
-
- code = modp->curr.code;
- 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];
- Eterm name = (Eterm) func_info[3];
- int arity = (int) func_info[4];
+ ErtsCodeInfo *ci = code_hdr->functions[i];
Eterm tuple;
- ASSERT(is_atom(name) || is_nil(name)); /* [] if BIF stub */
- if (func_info[1] != 0) {
- Eterm addr;
- ASSERT(is_atom(name));
- addr = erts_bld_uint(&hp, NULL, func_info[1]);
- tuple = erts_bld_tuple(&hp, NULL, 3, name, make_small(arity), addr);
+ ASSERT(is_atom(ci->mfa.function)
+ || is_nil(ci->mfa.function)); /* [] if BIF stub */
+ if (ci->u.ncallee != NULL) {
+ Eterm addr;
+ ASSERT(is_atom(ci->mfa.function));
+ addr = erts_bld_uint(&hp, NULL, (Uint)ci->u.ncallee);
+ tuple = erts_bld_tuple(&hp, NULL, 3, ci->mfa.function,
+ make_small(ci->mfa.arity), addr);
result = erts_bld_cons(&hp, NULL, tuple, result);
}
}
HRelease(p, hp_end, hp);
+#endif
return result;
}
/*
* Builds a list of all exported functions in the given module:
* [{Name, Arity},...]
- *
- * Returns a tagged term, or 0 on error.
*/
Eterm
exported_from_module(Process* p, /* Process whose heap to use. */
+ ErtsCodeIndex code_ix,
Eterm mod) /* Tagged atom for module. */
{
- int i;
+ int i, num_exps;
Eterm* hp = NULL;
Eterm* hend = NULL;
Eterm result = NIL;
- ErtsCodeIndex code_ix;
-
- if (is_not_atom(mod)) {
- return THE_NON_VALUE;
- }
- code_ix = erts_active_code_ix();
- for (i = 0; i < export_list_size(code_ix); i++) {
+ num_exps = export_list_size(code_ix);
+ for (i = 0; i < num_exps; i++) {
Export* ep = export_list(i,code_ix);
- if (ep->code[0] == mod) {
+ if (ep->info.mfa.module == mod) {
Eterm tuple;
- if (ep->addressv[code_ix] == ep->code+3 &&
- ep->code[3] == (BeamInstr) em_call_error_handler) {
+ if (ep->addressv[code_ix] == ep->beam &&
+ ep->beam[0] == (BeamInstr) em_call_error_handler) {
/* There is a call to the function, but it does not exist. */
continue;
}
@@ -5278,7 +5780,8 @@ exported_from_module(Process* p, /* Process whose heap to use. */
hp = HAlloc(p, need);
hend = hp + need;
}
- tuple = TUPLE2(hp, ep->code[1], make_small(ep->code[2]));
+ tuple = TUPLE2(hp, ep->info.mfa.function,
+ make_small(ep->info.mfa.arity));
hp += 3;
result = CONS(hp, tuple, result);
hp += 2;
@@ -5290,91 +5793,68 @@ exported_from_module(Process* p, /* Process whose heap to use. */
/*
* Returns a list of all attributes for the module.
- *
- * Returns a tagged term, or 0 on error.
*/
Eterm
attributes_for_module(Process* p, /* Process whose heap to use. */
- Eterm mod) /* Tagged atom for module. */
-
+ BeamCodeHeader* code_hdr)
{
- Module* modp;
- BeamInstr* code;
- Eterm* hp;
byte* ext;
Eterm result = NIL;
- Eterm* end;
- if (is_not_atom(mod) || (is_not_list(result) && is_not_nil(result))) {
- return THE_NON_VALUE;
- }
-
- modp = erts_get_module(mod, erts_active_code_ix());
- if (modp == NULL) {
- return THE_NON_VALUE;
- }
- code = modp->curr.code;
- ext = (byte *) code[MI_ATTR_PTR];
+ ext = code_hdr->attr_ptr;
if (ext != NULL) {
- hp = HAlloc(p, code[MI_ATTR_SIZE_ON_HEAP]);
- end = hp + code[MI_ATTR_SIZE_ON_HEAP];
- result = erts_decode_ext(&hp, &MSO(p), &ext);
+ ErtsHeapFactory factory;
+ erts_factory_proc_prealloc_init(&factory, p, code_hdr->attr_size_on_heap);
+ result = erts_decode_ext(&factory, &ext, 0);
if (is_value(result)) {
- ASSERT(hp <= end);
+ erts_factory_close(&factory);
}
- HRelease(p,end,hp);
}
return result;
}
/*
* Returns a list containing compilation information.
- *
- * Returns a tagged term, or 0 on error.
*/
Eterm
compilation_info_for_module(Process* p, /* Process whose heap to use. */
- Eterm mod) /* Tagged atom for module. */
+ BeamCodeHeader* code_hdr)
{
- Module* modp;
- BeamInstr* code;
- Eterm* hp;
byte* ext;
Eterm result = NIL;
- Eterm* end;
- if (is_not_atom(mod) || (is_not_list(result) && is_not_nil(result))) {
- return THE_NON_VALUE;
- }
-
- modp = erts_get_module(mod, erts_active_code_ix());
- if (modp == NULL) {
- return THE_NON_VALUE;
- }
- code = modp->curr.code;
- ext = (byte *) code[MI_COMPILE_PTR];
+ ext = code_hdr->compile_ptr;
if (ext != NULL) {
- hp = HAlloc(p, code[MI_COMPILE_SIZE_ON_HEAP]);
- end = hp + code[MI_COMPILE_SIZE_ON_HEAP];
- result = erts_decode_ext(&hp, &MSO(p), &ext);
+ ErtsHeapFactory factory;
+ erts_factory_proc_prealloc_init(&factory, p, code_hdr->compile_size_on_heap);
+ result = erts_decode_ext(&factory, &ext, 0);
if (is_value(result)) {
- ASSERT(hp <= end);
+ erts_factory_close(&factory);
}
- HRelease(p,end,hp);
}
return result;
}
/*
+ * Returns the MD5 checksum for a module
+ */
+
+Eterm
+md5_of_module(Process* p, /* Process whose heap to use. */
+ BeamCodeHeader* code_hdr)
+{
+ return new_binary(p, code_hdr->md5_ptr, MD5_SIZE);
+}
+
+/*
* Build a single {M,F,A,Loction} item to be part of
* a stack trace.
*/
Eterm*
erts_build_mfa_item(FunctionInfo* fi, Eterm* hp, Eterm args, Eterm* mfa_p)
{
- BeamInstr* current = fi->current;
Eterm loc = NIL;
if (fi->loc != LINE_INVALID_LOCATION) {
@@ -5384,7 +5864,7 @@ erts_build_mfa_item(FunctionInfo* fi, Eterm* hp, Eterm args, Eterm* mfa_p)
Eterm file_term = NIL;
if (file == 0) {
- Atom* ap = atom_tab(atom_val(fi->current[0]));
+ Atom* ap = atom_tab(atom_val(fi->mfa->module));
file_term = buf_to_intlist(&hp, ".erl", 4, NIL);
file_term = buf_to_intlist(&hp, (char*)ap->name, ap->len, file_term);
} else {
@@ -5403,10 +5883,12 @@ erts_build_mfa_item(FunctionInfo* fi, Eterm* hp, Eterm args, Eterm* mfa_p)
}
if (is_list(args) || is_nil(args)) {
- *mfa_p = TUPLE4(hp, current[0], current[1], args, loc);
+ *mfa_p = TUPLE4(hp, fi->mfa->module, fi->mfa->function,
+ args, loc);
} else {
- Eterm arity = make_small(current[2]);
- *mfa_p = TUPLE4(hp, current[0], current[1], arity, loc);
+ Eterm arity = make_small(fi->mfa->arity);
+ *mfa_p = TUPLE4(hp, fi->mfa->module, fi->mfa->function,
+ arity, loc);
}
return hp + 5;
}
@@ -5417,9 +5899,9 @@ erts_build_mfa_item(FunctionInfo* fi, Eterm* hp, Eterm args, Eterm* mfa_p)
* the function.
*/
void
-erts_set_current_function(FunctionInfo* fi, BeamInstr* current)
+erts_set_current_function(FunctionInfo* fi, ErtsCodeMFA* mfa)
{
- fi->current = current;
+ fi->mfa = mfa;
fi->needed = 5;
fi->loc = LINE_INVALID_LOCATION;
}
@@ -5428,13 +5910,13 @@ erts_set_current_function(FunctionInfo* fi, BeamInstr* current)
/*
* Returns a pointer to {module, function, arity}, or NULL if not found.
*/
-BeamInstr*
+ErtsCodeMFA*
find_function_from_pc(BeamInstr* pc)
{
FunctionInfo fi;
erts_lookup_function_info(&fi, pc, 0);
- return fi.current;
+ return fi.mfa;
}
/*
@@ -5489,7 +5971,7 @@ code_get_chunk_2(BIF_ALIST_2)
goto error;
}
if (!init_iff_file(stp, start, binary_size(Bin)) ||
- !scan_iff_file(stp, &chunk, 1, 1) ||
+ !scan_iff_file(stp, &chunk, 1) ||
stp->chunks[0].start == NULL) {
res = am_undefined;
goto done;
@@ -5538,12 +6020,12 @@ code_module_md5_1(BIF_ALIST_1)
}
stp->module = THE_NON_VALUE; /* Suppress diagnostiscs */
if (!init_iff_file(stp, bytes, binary_size(Bin)) ||
- !scan_iff_file(stp, chunk_types, NUM_CHUNK_TYPES, NUM_MANDATORY) ||
+ !scan_iff_file(stp, chunk_types, NUM_CHUNK_TYPES) ||
!verify_chunks(stp)) {
res = am_undefined;
goto done;
}
- res = new_binary(p, stp->mod_md5, sizeof(stp->mod_md5));
+ res = new_binary(p, stp->mod_md5, MD5_SIZE);
done:
erts_free_aligned_binary_bytes(temp_alloc);
@@ -5551,31 +6033,28 @@ code_module_md5_1(BIF_ALIST_1)
return res;
}
-#define WORDS_PER_FUNCTION 6
+#ifdef HIPE
+#define WORDS_PER_FUNCTION (sizeof(ErtsCodeInfo) / sizeof(UWord) + 1)
static BeamInstr*
-make_stub(BeamInstr* fp, Eterm mod, Eterm func, Uint arity, Uint native, BeamInstr OpCode)
+make_stub(ErtsCodeInfo* info, Eterm mod, Eterm func, Uint arity, Uint native, BeamInstr OpCode)
{
- fp[0] = (BeamInstr) BeamOp(op_i_func_info_IaaI);
- fp[1] = native;
- fp[2] = mod;
- fp[3] = func;
- fp[4] = arity;
-#ifdef HIPE
- if (native) {
- fp[5] = BeamOpCode(op_move_return_nr);
- hipe_mfa_save_orig_beam_op(mod, func, arity, fp+5);
- }
-#endif
- fp[5] = OpCode;
- return fp + WORDS_PER_FUNCTION;
+ DBG_TRACE_MFA(mod,func,arity,"make beam stub at %p", erts_codeinfo_to_code(info));
+ ASSERT(WORDS_PER_FUNCTION == 6);
+ info->op = (BeamInstr) BeamOp(op_i_func_info_IaaI);
+ info->u.ncallee = (void (*)(void)) native;
+ info->mfa.module = mod;
+ info->mfa.function = func;
+ info->mfa.arity = arity;
+ erts_codeinfo_to_code(info)[0] = OpCode;
+ return erts_codeinfo_to_code(info)+1;
}
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. */
{
@@ -5583,7 +6062,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;
@@ -5597,11 +6076,11 @@ stub_copy_info(LoaderState* stp,
static int
stub_read_export_table(LoaderState* stp)
{
- int i;
+ unsigned int i;
GetInt(stp, 4, stp->num_exps);
if (stp->num_exps > stp->num_functions) {
- LoadError2(stp, "%d functions exported; only %d functions defined",
+ LoadError2(stp, "%u functions exported; only %u functions defined",
stp->num_exps, stp->num_functions);
}
stp->export
@@ -5615,7 +6094,7 @@ stub_read_export_table(LoaderState* stp)
GetAtom(stp, n, stp->export[i].function);
GetInt(stp, 4, n);
if (n > MAX_REG) {
- LoadError2(stp, "export table entry %d: absurdly high arity %d", i, n);
+ LoadError2(stp, "export table entry %u: absurdly high arity %u", i, n);
}
stp->export[i].arity = n;
GetInt(stp, 4, n); /* Ignore label */
@@ -5627,22 +6106,17 @@ stub_read_export_table(LoaderState* stp)
}
static void
-stub_final_touch(LoaderState* stp, BeamInstr* fp)
+stub_final_touch(LoaderState* stp, ErtsCodeInfo* ci)
{
- int i;
- int n = stp->num_exps;
- Eterm mod = fp[2];
- Eterm function = fp[3];
- int arity = fp[4];
-#ifdef HIPE
+ unsigned int i;
+ unsigned int n = stp->num_exps;
Lambda* lp;
-#endif
- if (is_bif(mod, function, arity)) {
- fp[1] = 0;
- fp[2] = 0;
- fp[3] = 0;
- fp[4] = 0;
+ if (is_bif(ci->mfa.module, ci->mfa.function, ci->mfa.arity)) {
+ ci->u.ncallee = NULL;
+ ci->mfa.module = 0;
+ ci->mfa.function = 0;
+ ci->mfa.arity = 0;
return;
}
@@ -5651,9 +6125,14 @@ stub_final_touch(LoaderState* stp, BeamInstr* fp)
*/
for (i = 0; i < n; i++) {
- if (stp->export[i].function == function && stp->export[i].arity == arity) {
- Export* ep = erts_export_put(mod, function, arity);
- ep->addressv[erts_staging_code_ix()] = fp+5;
+ if (stp->export[i].function == ci->mfa.function &&
+ stp->export[i].arity == ci->mfa.arity) {
+ Export* ep = erts_export_put(ci->mfa.module,
+ ci->mfa.function,
+ ci->mfa.arity);
+ ep->addressv[erts_staging_code_ix()] = erts_codeinfo_to_code(ci);
+ DBG_TRACE_MFA_P(&ci->mfa,"set beam stub at %p in export at %p (code_ix=%d)",
+ erts_codeinfo_to_code(ci), ep, erts_staging_code_ix());
return;
}
}
@@ -5663,16 +6142,14 @@ stub_final_touch(LoaderState* stp, BeamInstr* fp)
* Search the lambda table to find out which.
*/
-#ifdef HIPE
n = stp->num_lambdas;
for (i = 0, lp = stp->lambdas; i < n; i++, lp++) {
ErlFunEntry* fe = stp->lambdas[i].fe;
- if (lp->function == function && lp->arity == arity) {
- fp[5] = (Eterm) BeamOpCode(op_hipe_trap_call_closure);
- fe->address = &(fp[5]);
+ if (lp->function == ci->mfa.function && lp->arity == ci->mfa.arity) {
+ *erts_codeinfo_to_code(ci) = (Eterm) BeamOpCode(op_hipe_trap_call_closure);
+ fe->address = erts_codeinfo_to_code(ci);
}
}
-#endif
return;
}
@@ -5681,10 +6158,9 @@ stub_final_touch(LoaderState* stp, BeamInstr* fp)
[{Adr, Patchtyppe} | Addresses]
and the address of a fun_entry.
*/
-int
+static int
patch(Eterm Addresses, Uint fe)
{
-#ifdef HIPE
Eterm* listp;
Eterm tuple;
Eterm* tp;
@@ -5720,15 +6196,13 @@ patch(Eterm Addresses, Uint fe)
}
-#endif
return 1;
}
-int
+static int
patch_funentries(Eterm Patchlist)
{
-#ifdef HIPE
while (!is_nil(Patchlist)) {
Eterm Info;
Eterm MFA;
@@ -5802,50 +6276,41 @@ patch_funentries(Eterm Patchlist)
fe = erts_get_fun_entry(Mod, uniq, index);
fe->native_address = (Uint *)native_address;
- /* Deliberate MEMORY LEAK of native fun entries!!!
- *
- * Uncomment line below when hipe code upgrade and purging works correctly.
- * Today we may get cases when old (leaked) native code of a purged module
- * gets called and tries to create instances of a deleted fun entry.
- *
- * Reproduced on a debug emulator with stdlib_test/qlc_SUITE:join_merge
- *
- * erts_refc_dec(&fe->refc, 1);
- */
+ erts_smp_refc_dec(&fe->refc, 1);
if (!patch(Addresses, (Uint) fe))
return 0;
}
-#endif
return 1; /* Signal that all went well */
}
-
/*
* Do a dummy load of a module. No threaded code will be loaded.
* Used for loading native code.
* Will also patch all references to fun_entries to point to
* the new fun_entries created.
*/
-
Eterm
-erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
+erts_make_stub_module(Process* p, Eterm hipe_magic_bin, Eterm Beam, Eterm Info)
{
Binary* magic;
+ Binary* hipe_magic;
LoaderState* stp;
+ HipeLoaderState* hipe_stp;
+ HipeModule *hipe_code;
BeamInstr Funcs;
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;
@@ -5856,20 +6321,27 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
*/
magic = erts_alloc_loader_state();
stp = ERTS_MAGIC_BIN_DATA(magic);
+ hipe_code = erts_alloc(ERTS_ALC_T_HIPE_LL, sizeof(*hipe_code));
- if (is_not_atom(Mod)) {
+ if (!is_internal_magic_ref(hipe_magic_bin) ||
+ !(hipe_magic = erts_magic_ref2bin(hipe_magic_bin),
+ hipe_stp = hipe_get_loader_state(hipe_magic)) ||
+ hipe_stp->module == NIL || hipe_stp->text_segment == 0) {
goto error;
}
if (is_not_tuple(Info)) {
goto error;
}
tp = tuple_val(Info);
- if (tp[0] != make_arityval(2)) {
+ if (tp[0] != make_arityval(3)) {
goto error;
}
Funcs = tp[1];
- Patchlist = tp[2];
-
+ Patchlist = tp[2];
+ MD5Bin = tp[3];
+ if (is_not_binary(MD5Bin) || (binary_size(MD5Bin) != MD5_SIZE)) {
+ goto error;
+ }
if ((n = erts_list_length(Funcs)) < 0) {
goto error;
}
@@ -5882,13 +6354,13 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
* Scan the Beam binary and read the interesting sections.
*/
- stp->module = Mod;
+ stp->module = hipe_stp->module;
stp->group_leader = p->group_leader;
stp->num_functions = n;
if (!init_iff_file(stp, bytes, size)) {
goto error;
}
- if (!scan_iff_file(stp, chunk_types, NUM_CHUNK_TYPES, NUM_MANDATORY) ||
+ if (!scan_iff_file(stp, chunk_types, NUM_CHUNK_TYPES) ||
!verify_chunks(stp)) {
goto error;
}
@@ -5896,9 +6368,16 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
if (!read_code_header(stp)) {
goto error;
}
- define_file(stp, "atom table", ATOM_CHUNK);
- if (!load_atom_table(stp)) {
- goto error;
+ if (stp->chunks[UTF8_ATOM_CHUNK].size > 0) {
+ define_file(stp, "utf8 atom table", UTF8_ATOM_CHUNK);
+ if (!load_atom_table(stp, ERTS_ATOM_ENC_UTF8)) {
+ goto error;
+ }
+ } else {
+ define_file(stp, "atom table", ATOM_CHUNK);
+ if (!load_atom_table(stp, ERTS_ATOM_ENC_LATIN1)) {
+ goto error;
+ }
}
define_file(stp, "export table", EXP_CHUNK);
if (!stub_read_export_table(stp)) {
@@ -5916,37 +6395,38 @@ 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 = 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;
- 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->literal_area = NULL;
+ 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;
@@ -5989,20 +6469,17 @@ 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;
-#ifdef HIPE
+ code_hdr->functions[i] = (ErtsCodeInfo*)fp;
op = (Eterm) BeamOpCode(op_hipe_trap_call); /* Might be changed later. */
-#else
- op = (Eterm) BeamOpCode(op_move_return_nr);
-#endif
- fp = make_stub(fp, Mod, func, arity, (Uint)native_address, op);
+ fp = make_stub((ErtsCodeInfo*)fp, hipe_stp->module, func, arity,
+ (Uint)native_address, op);
}
/*
* Insert the last pointer and the int_code_end instruction.
*/
- ptrs[i] = (BeamInstr) fp;
+ code_hdr->functions[i] = (ErtsCodeInfo*)fp;
*fp++ = (BeamInstr) BeamOp(op_int_code_end);
/*
@@ -6011,25 +6488,44 @@ 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;
}
+ {
+ byte *tmp = NULL;
+ byte *md5 = NULL;
+ if ((md5 = erts_get_aligned_binary_bytes(MD5Bin, &tmp)) != NULL) {
+ sys_memcpy(info, md5, MD5_SIZE);
+ code_hdr->md5_ptr = info;
+ }
+ erts_free_aligned_binary_bytes(tmp);
+ }
+
+ /*
+ * Initialise HiPE module
+ */
+ hipe_code->text_segment = hipe_stp->text_segment;
+ hipe_code->text_segment_size = hipe_stp->text_segment_size;
+ hipe_code->data_segment = hipe_stp->data_segment;
+ hipe_code->first_hipe_ref = hipe_stp->new_hipe_refs;
+ hipe_code->first_hipe_sdesc = hipe_stp->new_hipe_sdesc;
/*
* Insert the module in the module table.
*/
- rval = insert_new_code(p, 0, p->group_leader, Mod, code, code_size);
+ rval = stub_insert_new_code(p, 0, p->group_leader, hipe_stp->module,
+ code_hdr, code_size, hipe_code);
if (rval != NIL) {
goto error;
}
@@ -6038,25 +6534,76 @@ 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);
+ stub_final_touch(stp, (ErtsCodeInfo*)fp);
fp += WORDS_PER_FUNCTION;
}
if (patch_funentries(Patchlist)) {
+ Eterm mod = hipe_stp->module;
+ /* Prevent code from being freed */
+ hipe_stp->text_segment = 0;
+ hipe_stp->data_segment = 0;
+ hipe_stp->new_hipe_refs = NULL;
+ hipe_stp->new_hipe_sdesc = NULL;
+
erts_free_aligned_binary_bytes(temp_alloc);
free_loader_state(magic);
- return Mod;
+ hipe_free_loader_state(hipe_stp);
+
+ return mod;
}
error:
+ erts_free(ERTS_ALC_T_HIPE_LL, hipe_code);
erts_free_aligned_binary_bytes(temp_alloc);
free_loader_state(magic);
BIF_ERROR(p, BADARG);
}
+int erts_commit_hipe_patch_load(Eterm hipe_magic_bin)
+{
+ Binary* hipe_magic;
+ HipeLoaderState* hipe_stp;
+ HipeModule *hipe_code;
+ Module* modp;
+
+ if (!is_internal_magic_ref(hipe_magic_bin) ||
+ !(hipe_magic = erts_magic_ref2bin(hipe_magic_bin),
+ hipe_stp = hipe_get_loader_state(hipe_magic)) ||
+ hipe_stp->module == NIL || hipe_stp->text_segment == 0) {
+ return 0;
+ }
+
+ modp = erts_get_module(hipe_stp->module, erts_active_code_ix());
+ if (!modp)
+ return 0;
+
+ /*
+ * Initialise HiPE module
+ */
+ hipe_code = erts_alloc(ERTS_ALC_T_HIPE_LL, sizeof(*hipe_code));
+ hipe_code->text_segment = hipe_stp->text_segment;
+ hipe_code->text_segment_size = hipe_stp->text_segment_size;
+ hipe_code->data_segment = hipe_stp->data_segment;
+ hipe_code->first_hipe_ref = hipe_stp->new_hipe_refs;
+ hipe_code->first_hipe_sdesc = hipe_stp->new_hipe_sdesc;
+
+ modp->curr.hipe_code = hipe_code;
+
+ /* Prevent code from being freed */
+ hipe_stp->text_segment = 0;
+ hipe_stp->data_segment = 0;
+ hipe_stp->new_hipe_refs = NULL;
+ hipe_stp->new_hipe_sdesc = NULL;
+
+ return 1;
+}
+
#undef WORDS_PER_FUNCTION
+#endif /* HIPE */
+
static int safe_mul(UWord a, UWord b, UWord* resp)
{
@@ -6070,3 +6617,46 @@ static int safe_mul(UWord a, UWord b, UWord* resp)
}
}
+#ifdef ENABLE_DBG_TRACE_MFA
+
+#define MFA_MAX 10
+Eterm dbg_trace_m[MFA_MAX];
+Eterm dbg_trace_f[MFA_MAX];
+Uint dbg_trace_a[MFA_MAX];
+unsigned int dbg_trace_ix = 0;
+
+void dbg_set_traced_mfa(const char* m, const char* f, Uint a)
+{
+ unsigned i = dbg_trace_ix++;
+ ASSERT(i < MFA_MAX);
+ dbg_trace_m[i] = am_atom_put(m, strlen(m));
+ dbg_trace_f[i] = am_atom_put(f, strlen(f));
+ dbg_trace_a[i] = a;
+}
+
+int dbg_is_traced_mfa(Eterm m, Eterm f, Uint a)
+{
+ unsigned int i;
+ for (i = 0; i < dbg_trace_ix; ++i) {
+ if (m == dbg_trace_m[i] &&
+ (!f || (f == dbg_trace_f[i] && a == dbg_trace_a[i]))) {
+
+ return i+1;
+ }
+ }
+ return 0;
+}
+
+void dbg_vtrace_mfa(unsigned ix, const char* format, ...)
+{
+ va_list arglist;
+ va_start(arglist, format);
+ ASSERT(--ix < MFA_MAX);
+ erts_fprintf(stderr, "MFA TRACE %T:%T/%u: ",
+ dbg_trace_m[ix], dbg_trace_f[ix], (int)dbg_trace_a[ix]);
+
+ erts_vfprintf(stderr, format, arglist);
+ va_end(arglist);
+}
+
+#endif /* ENABLE_DBG_TRACE_MFA */
diff --git a/erts/emulator/beam/beam_load.h b/erts/emulator/beam/beam_load.h
index bd22b0c4de..c088bdb751 100644
--- a/erts/emulator/beam/beam_load.h
+++ b/erts/emulator/beam/beam_load.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1999-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1999-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -26,31 +27,23 @@
Eterm beam_make_current_old(Process *c_p, ErtsProcLocks c_p_locks,
Eterm module);
-
typedef struct gen_op_entry {
char* name;
int arity;
int specific;
int num_specific;
int transform;
- int min_window;
} GenOpEntry;
-extern GenOpEntry gen_opc[];
-
-#ifdef NO_JUMP_TABLE
-#define BeamOp(Op) (Op)
-#else
-extern void** beam_ops;
-#define BeamOp(Op) beam_ops[(Op)]
-#endif
-
+extern const GenOpEntry gen_opc[];
extern BeamInstr beam_debug_apply[];
extern BeamInstr* em_call_error_handler;
extern BeamInstr* em_apply_bif;
extern BeamInstr* em_call_nif;
+struct ErtsLiteralArea_;
+
/*
* The following variables keep a sorted list of address ranges for
* each module. It allows us to quickly find a function given an
@@ -59,68 +52,92 @@ 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
-
-/*
- * 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
+typedef struct BeamCodeLineTab_ BeamCodeLineTab;
/*
- * Pointer to the line table (or NULL if none).
- */
-#define MI_LINE_TABLE 11
-
-/*
- * 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.
*/
+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).
+ */
+ struct ErtsLiteralArea_ *literal_area;
+
+ /*
+ * 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.
+ */
+ ErtsCodeInfo* functions[1];
+
+}BeamCodeHeader;
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+# define BEAM_NIF_MIN_FUNC_SZ 4
+#else
+# define BEAM_NIF_MIN_FUNC_SZ 3
+#endif
-#define MI_FUNCTIONS 12
+void erts_release_literal_area(struct ErtsLiteralArea_* literal_area);
+int erts_is_module_native(BeamCodeHeader* code);
+int erts_is_function_native(ErtsCodeInfo*);
+void erts_beam_bif_load_init(void);
+struct erl_fun_entry;
+void erts_purge_state_add_fun(struct erl_fun_entry *fe);
+Export *erts_suspend_process_on_pending_purge_lambda(Process *c_p,
+ struct erl_fun_entry*);
/*
* 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)
@@ -134,4 +151,34 @@ extern Uint erts_total_code_size;
#define LOC_FILE(Loc) ((Loc) >> 24)
#define LOC_LINE(Loc) ((Loc) & ((1 << 24)-1))
+
+/*
+ * MFA event debug "tracing" usage:
+ *
+ * #define ENABLE_DBG_TRACE_MFA
+ * call dbg_set_traced_mfa("mymod","myfunc",arity)
+ * for the function(s) to trace, in some init function.
+ *
+ * Run and get stderr printouts when interesting things happen to your MFA.
+ */
+#ifdef ENABLE_DBG_TRACE_MFA
+
+void dbg_set_traced_mfa(const char* m, const char* f, Uint a);
+int dbg_is_traced_mfa(Eterm m, Eterm f, Uint a);
+void dbg_vtrace_mfa(unsigned ix, const char* format, ...);
+#define DBG_TRACE_MFA(M,F,A,FMT, ...) do {\
+ unsigned ix;\
+ if ((ix=dbg_is_traced_mfa(M,F,A))) \
+ dbg_vtrace_mfa(ix, FMT"\n", ##__VA_ARGS__);\
+ }while(0)
+
+#define DBG_TRACE_MFA_P(MFA, FMT, ...) \
+ DBG_TRACE_MFA((MFA)->module, (MFA)->function, (MFA)->arity, FMT, ##__VA_ARGS__)
+
+#else
+# define dbg_set_traced_mfa(M,F,A)
+# define DBG_TRACE_MFA(M,F,A,FMT, ...)
+# define DBG_TRACE_MFA_P(MFA,FMT, ...)
+#endif /* ENABLE_DBG_TRACE_MFA */
+
#endif /* _BEAM_LOAD_H */
diff --git a/erts/emulator/beam/beam_ranges.c b/erts/emulator/beam/beam_ranges.c
index 0f2d5d0c2a..fac4289271 100644
--- a/erts/emulator/beam/beam_ranges.c
+++ b/erts/emulator/beam/beam_ranges.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2012. All Rights Reserved.
+ * Copyright Ericsson AB 2012-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -31,13 +32,22 @@ typedef struct {
erts_smp_atomic_t end; /* (BeamInstr*) Points one word beyond last function in module. */
} Range;
+/*
+ * Used for crash dumping of literals. The size of erts_dump_lit_areas is
+ * always twice the number of active ranges (to allow for literals in both
+ * current and old code).
+ */
+
+ErtsLiteralArea** erts_dump_lit_areas;
+Uint erts_dump_num_lit_areas;
+
/* Range 'end' needs to be atomic as we purge module
by setting end=start in active code_ix */
#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
@@ -52,6 +62,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)
@@ -71,6 +82,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)
@@ -84,48 +106,86 @@ erts_init_ranges(void)
r[i].allocated = 0;
erts_smp_atomic_init_nob(&r[i].mid, 0);
}
+
+ erts_dump_num_lit_areas = 8;
+ erts_dump_lit_areas = (ErtsLiteralArea **)
+ erts_alloc(ERTS_ALC_T_CRASH_DUMP,
+ erts_dump_num_lit_areas * sizeof(ErtsLiteralArea*));
}
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));
+
+ if (r[dst].allocated * 2 > erts_dump_num_lit_areas) {
+ erts_dump_num_lit_areas *= 2;
+ erts_dump_lit_areas = (ErtsLiteralArea **)
+ erts_realloc(ERTS_ALC_T_CRASH_DUMP,
+ (void *) erts_dump_lit_areas,
+ erts_dump_num_lit_areas * sizeof(ErtsLiteralArea*));
+ }
}
}
@@ -134,82 +194,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
@@ -236,32 +243,33 @@ erts_ranges_sz(void)
void
erts_lookup_function_info(FunctionInfo* fi, BeamInstr* pc, int full_info)
{
- BeamInstr** low;
- BeamInstr** high;
- BeamInstr** mid;
+ ErtsCodeInfo** low;
+ ErtsCodeInfo** high;
+ ErtsCodeInfo** mid;
Range* rp;
+ BeamCodeHeader* hdr;
- fi->current = NULL;
+ fi->mfa = NULL;
fi->needed = 5;
fi->loc = LINE_INVALID_LOCATION;
rp = find_range(pc);
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]) {
+ if (pc < (BeamInstr*)(mid[0])) {
high = mid;
- } else if (pc < mid[1]) {
- fi->current = mid[0]+2;
+ } else if (pc < (BeamInstr*)(mid[1])) {
+ fi->mfa = &mid[0]->mfa;
if (full_info) {
- BeamInstr** fp = (BeamInstr **) (rp->start +
- MI_FUNCTIONS);
+ ErtsCodeInfo** fp = hdr->functions;
int idx = mid - fp;
- lookup_loc(fi, pc, rp->start, idx);
+ lookup_loc(fi, pc, hdr, idx);
}
return;
} else {
@@ -282,7 +290,7 @@ find_range(BeamInstr* pc)
while (low < high) {
if (pc < mid->start) {
high = mid;
- } else if (pc > RANGE_END(mid)) {
+ } else if (pc >= RANGE_END(mid)) {
low = mid + 1;
} else {
erts_smp_atomic_set_nob(&r[active].mid, (erts_aint_t) mid);
@@ -294,39 +302,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;
@@ -335,7 +338,7 @@ lookup_loc(FunctionInfo* fi, BeamInstr* orig_pc, BeamInstr* modp, int idx)
file = LOC_FILE(fi->loc);
if (file == 0) {
/* Special case: Module name with ".erl" appended */
- Atom* mod_atom = atom_tab(atom_val(fi->current[0]));
+ Atom* mod_atom = atom_tab(atom_val(fi->mfa->module));
fi->needed += 2*(mod_atom->len+4);
} else {
Atom* ap = atom_tab(atom_val((fi->fname_ptr)[file-1]));
diff --git a/erts/emulator/beam/benchmark.c b/erts/emulator/beam/benchmark.c
deleted file mode 100644
index 8613131176..0000000000
--- a/erts/emulator/beam/benchmark.c
+++ /dev/null
@@ -1,363 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2002-2012. 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%
- */
-
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include "sys.h"
-#include "global.h"
-#include "benchmark.h"
-
-#ifdef BM_COUNTERS
-unsigned long long processes_busy;
-unsigned long long processes_spawned;
-unsigned long long messages_sent;
-unsigned long long messages_copied;
-unsigned long long messages_ego;
-unsigned long long minor_gc;
-unsigned long long major_gc;
-#endif /* BM_COUNTERS */
-
-#ifdef BM_TIMERS
-
-#if (defined(__i386__) || defined(__x86_64__)) && USE_PERFCTR
-
-#include "libperfctr.h"
-struct vperfctr *system_clock;
-double cpu_khz;
-BM_NEW_TIMER(start);
-
-static double get_hrvtime(void)
-{
- unsigned long long ticks;
- double milli_seconds;
-
- ticks = vperfctr_read_tsc(system_clock);
- milli_seconds = (double)ticks / cpu_khz;
- return milli_seconds;
-}
-
-static void stop_hrvtime(void)
-{
- if(system_clock)
- {
- vperfctr_stop(system_clock);
- vperfctr_close(system_clock);
- system_clock = NULL;
- }
-}
-
-#else /* not perfctr, asuming Solaris */
-#include <time.h>
-BM_TIMER_T system_clock;
-#endif
-
-unsigned long local_pause_times[MAX_PAUSE_TIME];
-unsigned long pause_times[MAX_PAUSE_TIME];
-unsigned long pause_times_old[MAX_PAUSE_TIME];
-
-BM_TIMER_T mmu;
-BM_TIMER_T mmu_counter;
-
-BM_NEW_TIMER(timer);
-BM_NEW_TIMER(system);
-BM_NEW_TIMER(gc);
-BM_NEW_TIMER(minor_gc);
-BM_NEW_TIMER(major_gc);
-BM_NEW_TIMER(minor_global_gc);
-BM_NEW_TIMER(major_global_gc);
-BM_NEW_TIMER(send);
-BM_NEW_TIMER(copy);
-BM_NEW_TIMER(size);
-BM_NEW_TIMER(max_minor);
-BM_NEW_TIMER(max_major);
-BM_NEW_TIMER(max_global_minor);
-BM_NEW_TIMER(max_global_major);
-BM_NEW_TIMER(misc0);
-BM_NEW_TIMER(misc1);
-BM_NEW_TIMER(misc2);
-#endif /* BM_TIMERS */
-
-#ifdef BM_HEAP_SIZES
-unsigned long long max_used_heap;
-unsigned long long max_allocated_heap;
-unsigned long long max_used_global_heap;
-unsigned long long max_allocated_global_heap;
-#endif /* BM_HEAP_SIZES */
-
-#ifdef BM_MESSAGE_SIZES
-unsigned long long words_sent;
-unsigned long long words_copied;
-unsigned long long words_prealloc;
-unsigned long long message_sizes[1000];
-#endif /* BM_MESSAGE_SIZES */
-
-/*****
- * The following functions have to be defined, but they only have contents
- * if certain keywords are defined.
- */
-
-void init_benchmarking()
-{
-#ifdef BM_TIMERS
-#if (defined(__i386__) || defined(__x86_64__)) && USE_PERFCTR
- /* pass `--with-perfctr=/path/to/perfctr' when configuring */
- struct perfctr_info info;
- struct vperfctr_control control;
- int i;
-
- system_clock = vperfctr_open();
- if (system_clock != NULL)
- {
- if (vperfctr_info(system_clock,&info) >= 0)
- {
- cpu_khz = (double)info.cpu_khz;
- if (info.cpu_features & PERFCTR_FEATURE_RDTSC)
- {
- memset(&control,0,sizeof control);
- control.cpu_control.tsc_on = 1;
- }
- }
- if (vperfctr_control(system_clock,&control) < 0)
- {
- vperfctr_close(system_clock);
- system_clock = NULL;
- }
- }
-
- for (i = 0; i < 1000; i++)
- {
- BM_START_TIMER(system);
- BM_STOP_TIMER(system);
- }
-
- timer_time = system_time / 1000;
- start_time = 0;
-#else
- int i;
- for (i = 0; i < 1000; i++)
- {
- BM_START_TIMER(system);
- BM_STOP_TIMER(system);
- }
- timer_time = system_time / 1000;
-#endif
-
- for (i = 0; i < MAX_PAUSE_TIME; i++) {
- local_pause_times[i] = 0;
- pause_times[i] = 0;
- pause_times_old[i] = 0;
- }
-
- mmu = 0;
- mmu_counter = 0;
-
- BM_MMU_INIT();
-#endif /* BM_TIMERS */
-
-#ifdef BM_COUNTERS
- processes_busy = 0;
- processes_spawned = 0;
- messages_sent = 0;
- messages_copied = 0;
- messages_ego = 0;
- minor_gc = 0;
- major_gc = 0;
-#endif /* BM_COUNTERS */
-
-#ifdef BM_HEAP_SIZES
- max_used_heap = 0;
- max_allocated_heap = 0;
- max_used_global_heap = 0;
- max_allocated_global_heap = 0;
-#endif /* BM_HEAP_SIZES */
-
-#ifdef BM_MESSAGE_SIZES
- words_sent = 0;
- words_copied = 0;
- words_prealloc = 0;
- {
- int i;
- for (i = 0; i < 1000; i++)
- message_sizes[i] = 0;
- }
-#endif /* BM_MESSAGE_SIZES */
-}
-
-void save_statistics()
-{
-#ifdef BM_STATISTICS
- FILE *file = fopen(BM_STATISTICS_FILE,"a");
- long i = 0;
-
- if (file)
- {
- erts_fprintf(file,"-------------------------------------------------------------------------\n");
- erts_fprintf(file,"The counters are reset at system start and are sums over the entire node.\n");
- erts_fprintf(file,"You may reset them manually using the BIFs in the module hipe_bifs.\n");
- erts_fprintf(file,"All times are given in milliseconds.\n");
- erts_fprintf(file,"-------------------------------------------------------------------------\n");
-
- erts_fprintf(file,"Node: %T\n",erts_this_node->sysname);
-
-#ifdef BM_COUNTERS
- erts_fprintf(file,"Number of processes spawned: %lld\n",processes_spawned);
- erts_fprintf(file,"Number of local minor GCs: %lld\n",minor_gc);
- erts_fprintf(file,"Number of local major GCs: %lld\n",major_gc);
- erts_fprintf(file,"Number of messages sent: %lld\n",messages_sent);
- erts_fprintf(file,"Number of messages copied: %lld\n",messages_copied);
- erts_fprintf(file,"Number of messages sent to self: %lld\n",messages_ego);
-#endif /* BM_COUNTERS */
-
-#ifdef BM_MESSAGE_SIZES
- erts_fprintf(file,"Number of words sent: %lld\n",words_sent);
- erts_fprintf(file,"Number of words copied: %lld\n",words_copied);
- erts_fprintf(file,"Number of words preallocated: %lld\n",words_prealloc);
-#endif /* BM_MESSAGE_SIZES */
-
-#ifdef BM_HEAP_SIZES
- erts_fprintf(file,"Biggest local heap used (in words): %lld\n",max_used_heap);
- erts_fprintf(file,"Biggest local heap allocated (in words): %lld\n",max_allocated_heap);
- erts_fprintf(file,"Biggest global heap used (in words): %lld\n",max_used_global_heap);
- erts_fprintf(file,"Biggest global heap allocated (in words): %lld\n",max_allocated_global_heap);
-#endif /* BM_HEAP_SIZES */
-
-#ifdef BM_TIMERS
- erts_fprintf(file,"--- The total active system time is the sum of all times below ---\n");
- BM_TIME_PRINTER("Mutator time",system_time);
- BM_TIME_PRINTER("Time spent in send (excluding size & copy)",send_time);
- BM_TIME_PRINTER("Time spent in size",size_time);
- BM_TIME_PRINTER("Time spent in copy",copy_time);
- BM_TIME_PRINTER("Time spent in local minor GC",minor_gc_time);
- BM_TIME_PRINTER("Time spent in local major GC",major_gc_time);
- BM_TIME_PRINTER("Time spent in global minor GC",minor_global_gc_time);
- BM_TIME_PRINTER("Time spent in global major GC",major_global_gc_time);
- erts_fprintf(file,"---\n");
- BM_TIME_PRINTER("Maximum time spent in one separate local minor GC",max_minor_time);
- BM_TIME_PRINTER("Maximum time spent in one separate local major GC",max_major_time);
- BM_TIME_PRINTER("Maximum time spent in one separate global minor GC",max_global_minor_time);
- BM_TIME_PRINTER("Maximum time spent in one separate global major GC",max_global_major_time);
-#endif /* BM_TIMERS */
-
-#if 0
- /* Save a log file for import into excel */
-
- long long total_time, n;
- long left, right, mid;
-
-#ifdef BM_COUNTERS
- erts_fprintf(file,"Spawns\tLocalGC\tMAGC\tMessages\tMutator_t\tLocalGC_t\tMAGC_t\tLocMaxP\tLocMeanP\tLocGeoMP\tMAMaxP\tMAMeanP\tMAGeoMP\t\tCMAGC\tCMAGC_t\n");
- erts_fprintf(file,"%lld\t%lld\t%lld\t%lld\t",
- processes_spawned,
- minor_garbage_cols + major_garbage_cols,
- minor_global_garbage_cols + major_global_garbage_cols,
- messages_sent);
-#endif /* BM_COUNTERS */
-
-#ifdef BM_TIMERS
- erts_fprintf(file,"%lld\t%lld\t%lld\t",
- (long long)(system_time + send_time + size_time + copy_time),
- (long long)(minor_gc_time + major_gc_time),
- (long long)(minor_global_gc_time + major_global_gc_time));
-
- total_time = 0; n = 0;
- left = 0; right = 0; mid = 0;
- for (i = 0; i < MAX_PAUSE_TIME; i++) {
- total_time += local_pause_times[i] * i;
- n += local_pause_times[i];
- if (i > mid)
- right += local_pause_times[i];
- while(right > left) {
- left += local_pause_times[mid++];
- right -= local_pause_times[mid];
- }
- }
- erts_fprintf(file,"%lld\t%lld\t%ld\t",
- (long long)((max_minor_time > max_major_time ?
- max_minor_time :
- max_major_time)*1000),
- total_time / n,
- mid);
-
- total_time = 0; n = 0;
- left = 0; right = 0; mid = 0;
- for (i = 0; i < MAX_PAUSE_TIME; i++) {
- if (pause_times[i] > 0) {
- total_time += pause_times[i] * i;
- n += pause_times[i];
- if (i > mid)
- right += pause_times[i];
- while(right > left) {
- left += pause_times[mid++];
- right -= pause_times[mid];
- }
- }
- }
- erts_fprintf(file,"%lld\t%lld\t%ld\t",
- (long long)((max_global_minor_time > max_global_major_time ?
- max_global_minor_time :
- max_global_major_time)*1000),
- (n > 0 ? total_time / n : 0),
- mid);
-
- erts_fprintf(file,"\t%lld\t%lld\n",n,total_time);
-
- erts_fprintf(file,"\nMinor:\n");
- for (i = 0; i < MAX_PAUSE_TIME; i++) {
- if (i < 1000 || pause_times[i] > 0) {
- erts_fprintf(file,"%d\t%ld\n",i,pause_times[i]);
- }
- }
-
- fprintf(file,"Major:\n");
- for (i = 0; i < MAX_PAUSE_TIME; i++) {
- if (pause_times_old[i] > 0) {
- fprintf(file,"%d\t%ld\n",i,pause_times_old[i]);
- }
- }
-#endif /* BM_TIMERS */
-
-#ifdef BM_TIMERS
- total_time = 0; n = 0;
- left = 0; right = 0; mid = 0;
- fprintf(file,"\nLocal:\n");
- for (i = 0; i < MAX_PAUSE_TIME; i++) {
- if (local_pause_times[i] > 0) {
- erts_fprintf(file,"%d\t%ld\n",i,local_pause_times[i]);
- total_time += local_pause_times[i] * i;
- n += local_pause_times[i];
- if (i > mid)
- right += local_pause_times[i];
- while(right > left) {
- left += local_pause_times[mid++];
- right -= local_pause_times[mid];
- }
- }
- }
- erts_fprintf(file,"Mid: %ld Mean: %ld\n",(long)mid,
- (long)(n > 0 ? total_time / n : 0));
-#endif
-#endif /* 0 */
- fclose(file);
- }
- else
- fprintf(stderr,"Sorry... Can not write to %s!\n\r",BM_STATISTICS_FILE);
-#endif /* BM_STATISTICS */
-}
diff --git a/erts/emulator/beam/benchmark.h b/erts/emulator/beam/benchmark.h
deleted file mode 100644
index 766edaac42..0000000000
--- a/erts/emulator/beam/benchmark.h
+++ /dev/null
@@ -1,329 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2002-2012. 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%
- */
-
-#ifndef __BENCHMARK_H__
-#define __BENCHMARK_H__
-
-/* The define __BENCHMARK__ is the master switch to turn on and off
- * benchmarking. This will enable the benchmark-BIFs in hipe_bif1.c.
- * Documentation for the BIFs is in hipe_bif1.c, and that is where you
- * will find the information about how to accually get some data out
- * from these timers and counters.
- */
-/* #define __BENCHMARK__ */
-
-#ifdef __BENCHMARK__
-/*
- * The defines below enables different parts of the benchmaring.
- * Counters and timers that are disabled, always report zero in
- * the BIFs.
- */
-
-/* BM_TIMERS keeps track of the time spent in diferent parts of the
- * system. It only measures accual active time, not time spent in idle
- * mode. These timers requires hardware support. For Linux, use the
- * package perfctr from user.it.uu.se/~mikpe/linux/perfctr. If this
- * package is not specified when configuring the system
- * (--with-perfctr=PATH), the Solaris hrtime_t will be used.
- * To add new timers look below.
- */
-#define BM_TIMERS
-
-/* BM_COUNTERS count all kinds of events that occurs in the system.
- * Among other things it counts the number of messages, then number of
- * garbage collections, the number of processes spawned etc.
- * To add new counters look below.
- */
-#define BM_COUNTERS
-
-/* BM_MESSAGE_SIZES keeps a log of the size of all messages sent in
- * the system. This introduce an overhead in time for the shared heap
- * system since all message sizes have to be calculated at send.
- */
-/* #define BM_MESSAGE_SIZES */
-
-/* BM_HEAP_SIZES goes through all processes at garbage collection time
- * to sum their allocated and used heap sizes. In anything else than a
- * shared heap system, this will cost.
- */
-/* #define BM_HEAP_SIZES */
-
-/* BM_STATISTICS saves an entry in the file BM_STATISTICS_FILE. This
- * is done for each erlang node at exit time.
- */
-/* #define BM_STATISTICS */
-
-#endif /* __BENCHMARK__ */
-
-
-#ifdef BM_STATISTICS
-# define BM_STATISTICS_FILE "/tmp/erlang_statistics.joppe.log"
-#endif /* BM_STATISTICS */
-
-
-/************ There are no more settings below this line *************/
-
-/*
- * Maintenance and how to add new stuff is documented by the code
- * below ;-)
- */
-
-#ifdef BM_COUNTERS
-/*********************************************************************
- * To add new counters:
- *
- * Add the variable here AND in benchmark.c. Use the macro
- * BM_COUNT(var) in the code where you want to increase it.
- *
- */
-extern unsigned long long processes_busy;
-extern unsigned long long processes_spawned;
-extern unsigned long long messages_sent;
-extern unsigned long long messages_copied;
-extern unsigned long long messages_ego;
-extern unsigned long long minor_gc;
-extern unsigned long long major_gc;
-
-#define BM_COUNT(var) (var)++;
-
-#define BM_EGO_COUNT(send,rec) { \
- if ((send) == (rec)) \
- BM_COUNT(messages_ego); }
-
-#define BM_LAZY_COPY_START long long gcs = minor_global_gc + major_global_gc;
-#define BM_LAZY_COPY_STOP { gcs = (minor_global_gc + major_global_gc) - gcs; \
- if (gcs > gc_in_copy) gc_in_copy = gcs; }
-
-#else /* !BM_COUNTERS */
-# define BM_COUNT(var)
-# define BM_EGO_COUNT(send,rec)
-# define BM_LAZY_COPY_START
-# define BM_LAZY_COPY_STOP
-#endif /* BM_COUNTERS */
-
-
-#ifdef BM_TIMERS
-/*********************************************************************
- * To add new timers:
- *
- * Add the variable below using the form extern BM_TIMER_T blah_time.
- * Also add them in benchmark.c using the macro NEW_TIMER(blah). Use
- * the macro BM_SWAP_TIMER(from,blah) ... BM_SWAP_TIMER(blah,to) to
- * start and stop the new timer. Note, that you have to know what
- * timer is running at the place where you want to insert your new
- * timer to be able to stop and start (from,to) it.
- *
- * You can use the macros BM_STOP_TIMER(blah) and BM_START_TIMER(blah)
- * around code that should not be timed at all. As above, you have to
- * know what timer to start and stop. The system timer is running at
- * most places in the emulator. Only the garbage collector and the
- * message sending has its own timers at the moment.
- *
- * The timer_time used when stopping timers is the time it takes to
- * start and stop the timers, calculated in init_benchmarking(). If it
- * is not there, the time it takes to do this will accually be
- * substantial compared to some small times in the system we want to
- * meassure (send time in shared heap for instance).
- */
-
-#if (defined(__i386__) || defined(__x86_64__)) && USE_PERFCTR
-#include "libperfctr.h"
-
-#define BM_TIMER_T double
-
-extern struct vperfctr *system_clock;
-extern double cpu_khz;
-extern BM_TIMER_T start_time;
-
-#define BM_START_TIMER(t) start_time = \
- (BM_TIMER_T)vperfctr_read_tsc(system_clock) / \
- cpu_khz;
-
-#define BM_STOP_TIMER(t) do { \
- BM_TIMER_T tmp = ((BM_TIMER_T)vperfctr_read_tsc(system_clock) / cpu_khz); \
- tmp -= (start_time + timer_time); \
- t##_time += (tmp > 0 ? tmp : 0); \
-} while(0)
-
-#define BM_TIME_PRINTER(str,time) do { \
- int min,sec,milli,micro; \
- BM_TIMER_T tmp = (time) * 1000; \
- micro = (uint)(tmp - ((int)(tmp / 1000)) * 1000); \
- tmp /= 1000; \
- milli = (uint)(tmp - ((int)(tmp / 1000)) * 1000); \
- tmp /= 1000; \
- sec = (uint)(tmp - ((int)(tmp / 60)) * 60); \
- min = (uint)tmp / 60; \
- erts_fprintf(file,str": %d:%02d.%03d %03d\n",min,sec,milli,micro); \
-} while(0)
-
-#else /* !USE_PERFCTR (Assuming Solaris) */
-
-#define BM_TIMER_T hrtime_t
-#define BM_START_TIMER(t) system_clock = sys_gethrtime()
-#define BM_STOP_TIMER(t) do { \
- BM_TIMER_T tmp = (sys_gethrtime() - system_clock) - timer_time; \
- t##_time += (tmp > 0 ? tmp : 0); \
-} while(0)
-
-#define BM_TIME_PRINTER(str,time) do { \
- int min,sec,milli,micro; \
- BM_TIMER_T tmp; \
- tmp = (time) / 1000; \
- micro = tmp % 1000; \
- tmp /= 1000; \
- milli = tmp % 1000; \
- tmp /= 1000; \
- sec = tmp % 60; \
- min = tmp / 60; \
- erts_fprintf(file,str": %d:%02d.%03d %03d\n",min,sec,milli,micro); \
-} while(0)
-
-extern BM_TIMER_T system_clock;
-#endif /* USE_PERFCTR */
-
-extern BM_TIMER_T timer_time;
-extern BM_TIMER_T system_time;
-extern BM_TIMER_T gc_time;
-extern BM_TIMER_T minor_gc_time;
-extern BM_TIMER_T major_gc_time;
-extern BM_TIMER_T minor_global_gc_time;
-extern BM_TIMER_T major_global_gc_time;
-extern BM_TIMER_T send_time;
-extern BM_TIMER_T copy_time;
-extern BM_TIMER_T size_time;
-extern BM_TIMER_T max_minor_time;
-extern BM_TIMER_T max_major_time;
-extern BM_TIMER_T max_global_minor_time;
-extern BM_TIMER_T max_global_major_time;
-extern BM_TIMER_T misc0_time;
-extern BM_TIMER_T misc1_time;
-extern BM_TIMER_T misc2_time;
-
-#define MAX_PAUSE_TIME 500000
-extern unsigned long local_pause_times[MAX_PAUSE_TIME];
-extern unsigned long pause_times[MAX_PAUSE_TIME];
-extern unsigned long pause_times_old[MAX_PAUSE_TIME];
-
-#define MMU_INTERVAL 5 /* milli seconds */
-extern BM_TIMER_T mmu_counter;
-extern BM_TIMER_T mmu;
-
-#define BM_NEW_TIMER(t) BM_TIMER_T t##_time = 0;
-#define BM_RESET_TIMER(t) t##_time = 0;
-#define BM_SWAP_TIMER(t1,t2) do { BM_STOP_TIMER(t1); BM_START_TIMER(t2); } while(0)
-#define BM_MMU_INIT() do { \
- BM_TIMER_T gc = gc_time; \
- while (gc > 0) { \
- if (gc > MMU_INTERVAL) { \
- gc -= MMU_INTERVAL - mmu_counter; \
- erts_printf("%d\n",(int)((mmu / MMU_INTERVAL) * 100)); \
- mmu_counter = 0; mmu = 0; \
- } else { \
- mmu_counter += gc; \
- if (mmu_counter >= MMU_INTERVAL) { \
- mmu_counter -= MMU_INTERVAL; \
- erts_printf("%d\n",(int)((mmu / MMU_INTERVAL) * 100)); \
- mmu = 0; \
- } \
- gc = 0; \
- } \
- } \
- BM_RESET_TIMER(system); \
- BM_RESET_TIMER(send); \
- BM_RESET_TIMER(copy); \
- BM_RESET_TIMER(size); \
-} while(0)
-
-#define BM_MMU_READ() do { \
- BM_TIMER_T mut = system_time + send_time + copy_time + size_time; \
- while (mut > 0) { \
- if (mut > MMU_INTERVAL) { \
- BM_TIMER_T tmp = MMU_INTERVAL - mmu_counter; \
- mmu += tmp; mut -= tmp; \
- erts_printf("%d\n",(int)((mmu / MMU_INTERVAL) * 100)); \
- mmu_counter = 0; mmu = 0; \
- } else { \
- mmu_counter += mut; mmu += mut; \
- if (mmu_counter >= MMU_INTERVAL) { \
- mmu_counter -= MMU_INTERVAL; \
- mmu -= mmu_counter; \
- erts_printf("%d\n",(int)((mmu / MMU_INTERVAL) * 100)); \
- mmu = mmu_counter; \
- } \
- mut = 0; \
- } \
- } \
-} while(0)
-
-#else /* !BM_TIMERS */
-# define BM_NEW_TIMER(t)
-# define BM_START_TIMER(t)
-# define BM_STOP_TIMER(t)
-# define BM_RESET_TIMER(t)
-# define BM_SWAP_TIMER(t1,t2)
-# define BM_TIME_PRINTER(str,time)
-# define BM_MMU_INIT()
-# define BM_MMU_READ()
-#endif /* BM_TIMERS */
-
-#ifdef BM_HEAP_SIZES
-extern unsigned long long max_used_heap;
-extern unsigned long long max_allocated_heap;
-extern unsigned long long max_used_global_heap;
-extern unsigned long long max_allocated_global_heap;
-#endif /* BM_HEAP_SIZES */
-
-#ifdef BM_MESSAGE_SIZES
-extern unsigned long long words_sent;
-extern unsigned long long words_copied;
-extern unsigned long long words_prealloc;
-extern unsigned long long message_sizes[1000];
-
-#define BM_MESSAGE_COPIED(size) { \
- words_copied += size; \
- BM_COUNT(messages_copied); }
-
-#define BM_PREALLOC_DATA(size) { \
- words_prealloc += size; }
-
-#define BM_MESSAGE(mess,send,rec) { \
- Uint msize = size_object(mess); \
- words_sent += msize; \
- if (msize < 1000) \
- message_sizes[msize]++; \
- else \
- message_sizes[999]++; \
- BM_EGO_COUNT(send,rec); \
- BM_COUNT(messages_sent); }
-
-#else /* !BM_MESSAGE_SIZES */
-
-#define BM_MESSAGE_COPIED(size) BM_COUNT(messages_copied);
-#define BM_PREALLOC_DATA(size)
-#define BM_MESSAGE(mess,send,rec) { \
- BM_EGO_COUNT(send,rec); \
- BM_COUNT(messages_sent); }
-
-#endif /* BM_MESSAGE_SIZES */
-
-void init_benchmarking(void);
-void save_statistics(void);
-
-#endif /* _BENCHMARK_H_ */
diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c
index 06a1230ca0..b6595d2a5d 100644
--- a/erts/emulator/beam/bif.c
+++ b/erts/emulator/beam/bif.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -28,7 +29,9 @@
#include "global.h"
#include "erl_process.h"
#include "error.h"
+#define ERL_WANT_HIPE_BIF_WRAPPER__
#include "bif.h"
+#undef ERL_WANT_HIPE_BIF_WRAPPER__
#include "big.h"
#include "dist.h"
#include "erl_version.h"
@@ -40,12 +43,21 @@
#define ERTS_PTAB_WANT_BIF_IMPL__
#include "erl_ptab.h"
#include "erl_bits.h"
+#include "erl_bif_unique.h"
+#include "erl_map.h"
+#include "erl_msacc.h"
-static Export* flush_monitor_message_trap = NULL;
+Export *erts_await_result;
+static Export* flush_monitor_messages_trap = NULL;
static Export* set_cpu_topology_trap = NULL;
static Export* await_proc_exit_trap = NULL;
static Export* await_port_send_result_trap = NULL;
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;
@@ -62,7 +74,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);
@@ -109,15 +121,12 @@ static int insert_internal_link(Process* p, Eterm rpid)
erts_add_link(&ERTS_P_LINKS(p), LINK_PID, rp->common.id);
erts_add_link(&ERTS_P_LINKS(rp), LINK_PID, p->common.id);
- ASSERT(is_nil(ERTS_TRACER_PROC(p))
- || is_internal_pid(ERTS_TRACER_PROC(p))
- || is_internal_port(ERTS_TRACER_PROC(p)));
+ ASSERT(IS_TRACER_VALID(ERTS_TRACER(p)));
if (IS_TRACED(p)) {
if (ERTS_TRACE_FLAGS(p) & (F_TRACE_SOL|F_TRACE_SOL1)) {
ERTS_TRACE_FLAGS(rp) |= (ERTS_TRACE_FLAGS(p) & TRACEE_FLAGS);
- ERTS_TRACER_PROC(rp) = ERTS_TRACER_PROC(p); /* maybe steal */
-
+ erts_tracer_replace(&rp->common, ERTS_TRACER(p));
if (ERTS_TRACE_FLAGS(p) & F_TRACE_SOL1) { /* maybe override */
ERTS_TRACE_FLAGS(rp) &= ~(F_TRACE_SOL1 | F_TRACE_SOL);
ERTS_TRACE_FLAGS(p) &= ~(F_TRACE_SOL1 | F_TRACE_SOL);
@@ -126,7 +135,8 @@ static int insert_internal_link(Process* p, Eterm rpid)
}
}
if (IS_TRACED_FL(rp, F_TRACE_PROCS))
- trace_proc(p, rp, am_getting_linked, p->common.id);
+ trace_proc(p, p == rp ? rp_locks : ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_LINK,
+ rp, am_getting_linked, p->common.id);
if (p == rp)
erts_smp_proc_unlock(p, rp_locks & ~ERTS_PROC_LOCK_MAIN);
@@ -145,7 +155,7 @@ BIF_RETTYPE link_1(BIF_ALIST_1)
DistEntry *dep;
if (IS_TRACED_FL(BIF_P, F_TRACE_PROCS)) {
- trace_proc(BIF_P, BIF_P, am_link, BIF_ARG_1);
+ trace_proc(BIF_P, ERTS_PROC_LOCK_MAIN, BIF_P, am_link, BIF_ARG_1);
}
/* check that the pid or port which is our argument is OK */
@@ -186,7 +196,7 @@ BIF_RETTYPE link_1(BIF_ALIST_1)
goto res_no_proc;
case ERTS_PORT_OP_SCHEDULED:
if (refp) {
- ASSERT(is_internal_ref(ref));
+ ASSERT(is_internal_ordinary_ref(ref));
BIF_TRAP3(await_port_send_result_trap, BIF_P, ref, am_true, am_true);
}
default:
@@ -269,20 +279,17 @@ res_no_proc: {
}
}
-#define ERTS_DEMONITOR_FALSE 2
-#define ERTS_DEMONITOR_TRUE 1
-#define ERTS_DEMONITOR_BADARG 0
-#define ERTS_DEMONITOR_YIELD_TRUE -1
-#define ERTS_DEMONITOR_INTERNAL_ERROR -2
-
-static int
+/* This function is allowed to return range of values handled by demonitor/1-2
+ * Namely: atoms true, false, yield, internal_error, badarg or THE_NON_VALUE
+ */
+static Eterm
remote_demonitor(Process *c_p, DistEntry *dep, Eterm ref, Eterm to)
{
ErtsDSigData dsd;
ErtsMonitor *dmon;
ErtsMonitor *mon;
int code;
- int res;
+ Eterm res = am_false;
#ifndef ERTS_SMP
int stale_mon = 0;
#endif
@@ -315,7 +322,7 @@ remote_demonitor(Process *c_p, DistEntry *dep, Eterm ref, Eterm to)
mon = erts_remove_monitor(&ERTS_P_MONITORS(c_p), ref);
erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_LINK);
- res = ERTS_DEMONITOR_TRUE;
+ res = am_true;
break;
case ERTS_DSIG_PREP_CONNECTED:
@@ -339,7 +346,7 @@ remote_demonitor(Process *c_p, DistEntry *dep, Eterm ref, Eterm to)
* This is possible when smp support is enabled.
* 'DOWN' message just arrived.
*/
- res = ERTS_DEMONITOR_TRUE;
+ res = am_true;
}
else {
/*
@@ -351,19 +358,16 @@ remote_demonitor(Process *c_p, DistEntry *dep, Eterm ref, Eterm to)
c_p->common.id,
(mon->name != NIL
? mon->name
- : mon->pid),
+ : mon->u.pid),
ref,
0);
- res = (code == ERTS_DSIG_SEND_YIELD
- ? ERTS_DEMONITOR_YIELD_TRUE
- : ERTS_DEMONITOR_TRUE);
+ res = (code == ERTS_DSIG_SEND_YIELD ? am_yield : am_true);
erts_destroy_monitor(dmon);
-
}
break;
default:
ASSERT(! "Invalid dsig prepare result");
- return ERTS_DEMONITOR_INTERNAL_ERROR;
+ return am_internal_error;
}
#ifndef ERTS_SMP
@@ -391,90 +395,147 @@ remote_demonitor(Process *c_p, DistEntry *dep, Eterm ref, Eterm to)
return res;
}
-static int demonitor(Process *c_p, Eterm ref)
+static ERTS_INLINE void
+demonitor_local_process(Process *c_p, Eterm ref, Eterm to, Eterm *res)
{
- ErtsMonitor *mon = NULL; /* The monitor entry to delete */
- Process *rp; /* Local target process */
- Eterm to = NIL; /* Monitor link traget */
- DistEntry *dep = NULL; /* Target's distribution entry */
- int deref_de = 0;
- int res;
- int unlock_link = 1;
+ Process *rp = erts_pid2proc_opt(c_p,
+ ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_LINK,
+ to,
+ ERTS_PROC_LOCK_LINK,
+ ERTS_P2P_FLG_ALLOW_OTHER_X);
+ ErtsMonitor *mon = erts_remove_monitor(&ERTS_P_MONITORS(c_p), ref);
+#ifndef ERTS_SMP
+ ASSERT(mon);
+#else
+ if (!mon)
+ *res = am_false;
+ else
+#endif
+ {
+ *res = am_true;
+ erts_destroy_monitor(mon);
+ }
+ if (rp) {
+ ErtsMonitor *rmon;
+ rmon = erts_remove_monitor(&ERTS_P_MONITORS(rp), ref);
+ if (rp != c_p)
+ erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
+ if (rmon != NULL)
+ erts_destroy_monitor(rmon);
+ }
+ else {
+ ERTS_SMP_ASSERT_IS_NOT_EXITING(c_p);
+ }
+}
+
+static ERTS_INLINE BIF_RETTYPE
+demonitor_local_port(Process *origin, Eterm ref, Eterm target)
+{
+ BIF_RETTYPE res = am_false;
+ Port *port = erts_port_lookup_raw(target);
+
+ if (!port) {
+ BIF_ERROR(origin, BADARG);
+ }
+ erts_smp_proc_unlock(origin, ERTS_PROC_LOCK_LINK);
+
+ if (port) {
+ Eterm trap_ref;
+ switch (erts_port_demonitor(origin, ERTS_PORT_DEMONITOR_NORMAL,
+ port, ref, &trap_ref)) {
+ case ERTS_PORT_OP_DROPPED:
+ case ERTS_PORT_OP_BADARG:
+ break;
+ case ERTS_PORT_OP_SCHEDULED:
+ BIF_TRAP3(await_port_send_result_trap, origin, trap_ref,
+ am_busy_port, am_true);
+ /* the busy_port atom will never be returned, because it cannot be
+ * returned from erts_port_(de)monitor, but just in case if in future
+ * internal API changes - you may see this atom */
+ default:
+ break;
+ }
+ }
+ else {
+ ERTS_SMP_ASSERT_IS_NOT_EXITING(origin);
+ }
+ BIF_RET(res);
+}
+
+/* Can return atom true, false, yield, internal_error, badarg or
+ * THE_NON_VALUE if error occurred or trap has been set up
+ */
+static
+BIF_RETTYPE demonitor(Process *c_p, Eterm ref, Eterm *multip)
+{
+ ErtsMonitor *mon = NULL; /* The monitor entry to delete */
+ Eterm to = NIL; /* Monitor link traget */
+ DistEntry *dep = NULL; /* Target's distribution entry */
+ int deref_de = 0;
+ BIF_RETTYPE res = am_false;
+ int unlock_link = 1;
erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_LINK);
if (is_not_internal_ref(ref)) {
- res = ERTS_DEMONITOR_BADARG;
+ res = am_badarg;
goto done; /* Cannot be this monitor's ref */
}
mon = erts_lookup_monitor(ERTS_P_MONITORS(c_p), ref);
if (!mon) {
- res = ERTS_DEMONITOR_FALSE;
goto done;
}
- if (mon->type != MON_ORIGIN) {
- res = ERTS_DEMONITOR_BADARG;
- goto done;
- }
- to = mon->pid;
-
- if (is_atom(to)) {
- /* Monitoring a name at node to */
- ASSERT(is_node_name_atom(to));
- dep = erts_sysname_to_connected_dist_entry(to);
- ASSERT(dep != erts_this_dist_entry);
- if (dep)
- deref_de = 1;
- } else {
- ASSERT(is_pid(to));
- dep = pid_dist_entry(to);
- }
- if (dep != erts_this_dist_entry) {
- res = remote_demonitor(c_p, dep, ref, to);
- /* remote_demonitor() unlocks link lock on c_p */
- unlock_link = 0;
- }
- else { /* Local monitor */
- if (deref_de) {
- deref_de = 0;
- erts_deref_dist_entry(dep);
- }
- dep = NULL;
- rp = erts_pid2proc_opt(c_p,
- ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_LINK,
- to,
- ERTS_PROC_LOCK_LINK,
- ERTS_P2P_FLG_ALLOW_OTHER_X);
- mon = erts_remove_monitor(&ERTS_P_MONITORS(c_p), ref);
-#ifndef ERTS_SMP
- ASSERT(mon);
-#else
- if (!mon)
- res = ERTS_DEMONITOR_FALSE;
- else
-#endif
- {
- res = ERTS_DEMONITOR_TRUE;
- erts_destroy_monitor(mon);
+ switch (mon->type) {
+ case MON_TIME_OFFSET:
+ *multip = am_true;
+ erts_demonitor_time_offset(ref);
+ res = am_true;
+ break;
+ case MON_ORIGIN:
+ to = mon->u.pid;
+ *multip = am_false;
+ if (is_atom(to)) {
+ /* Monitoring a name at node to */
+ ASSERT(is_node_name_atom(to));
+ dep = erts_sysname_to_connected_dist_entry(to);
+ ASSERT(dep != erts_this_dist_entry);
+ if (dep)
+ deref_de = 1;
+ } else if (is_port(to)) {
+ if (port_dist_entry(to) != erts_this_dist_entry) {
+ goto badarg;
+ }
+ res = demonitor_local_port(c_p, ref, to);
+ unlock_link = 0;
+ goto done;
+ } else {
+ ASSERT(is_pid(to));
+ dep = pid_dist_entry(to);
}
- if (rp) {
- ErtsMonitor *rmon;
- rmon = erts_remove_monitor(&ERTS_P_MONITORS(rp), ref);
- if (rp != c_p)
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
- if (rmon != NULL)
- erts_destroy_monitor(rmon);
+ if (dep != erts_this_dist_entry) {
+ res = remote_demonitor(c_p, dep, ref, to);
+ /* remote_demonitor() unlocks link lock on c_p */
+ unlock_link = 0;
}
- else {
- ERTS_SMP_ASSERT_IS_NOT_EXITING(c_p);
+ else { /* Local monitor */
+ if (deref_de) {
+ deref_de = 0;
+ erts_deref_dist_entry(dep);
+ }
+ dep = NULL;
+ demonitor_local_process(c_p, ref, to, &res);
}
-
+ break;
+ default /* case */ :
+badarg:
+ res = am_badarg; /* will be converted to error by caller */
+ *multip = am_false;
+ break;
}
-
- done:
+done:
if (unlock_link)
erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_LINK);
@@ -485,20 +546,20 @@ static int demonitor(Process *c_p, Eterm ref)
}
ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN == erts_proc_lc_my_proc_locks(c_p));
- return res;
+ BIF_RET(res);
}
BIF_RETTYPE demonitor_1(BIF_ALIST_1)
{
- switch (demonitor(BIF_P, BIF_ARG_1)) {
- case ERTS_DEMONITOR_FALSE:
- case ERTS_DEMONITOR_TRUE:
- BIF_RET(am_true);
- case ERTS_DEMONITOR_YIELD_TRUE:
- ERTS_BIF_YIELD_RETURN(BIF_P, am_true);
- case ERTS_DEMONITOR_BADARG:
- BIF_ERROR(BIF_P, BADARG);
- case ERTS_DEMONITOR_INTERNAL_ERROR:
+ Eterm multi;
+ switch (demonitor(BIF_P, BIF_ARG_1, &multi)) {
+ case am_false:
+ case am_true: BIF_RET(am_true);
+ case THE_NON_VALUE: BIF_RET(THE_NON_VALUE);
+ case am_yield: ERTS_BIF_YIELD_RETURN(BIF_P, am_true);
+ case am_badarg: BIF_ERROR(BIF_P, BADARG);
+
+ case am_internal_error:
default:
ASSERT(! "demonitor(): internal error");
BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR);
@@ -507,10 +568,11 @@ BIF_RETTYPE demonitor_1(BIF_ALIST_1)
BIF_RETTYPE demonitor_2(BIF_ALIST_2)
{
- Eterm res = am_true;
- int info = 0;
- int flush = 0;
- Eterm list = BIF_ARG_2;
+ BIF_RETTYPE res = am_true;
+ Eterm multi = am_false;
+ int info = 0;
+ int flush = 0;
+ Eterm list = BIF_ARG_2;
while (is_list(list)) {
Eterm* consp = list_val(list);
@@ -530,20 +592,28 @@ BIF_RETTYPE demonitor_2(BIF_ALIST_2)
if (is_not_nil(list))
goto badarg;
- switch (demonitor(BIF_P, BIF_ARG_1)) {
- case ERTS_DEMONITOR_FALSE:
+ switch (demonitor(BIF_P, BIF_ARG_1, &multi)) {
+ case THE_NON_VALUE:
+ /* If other error occurred or trap has been set up - pass through */
+ BIF_RET(THE_NON_VALUE);
+ case am_false:
if (info)
res = am_false;
- if (flush)
- BIF_TRAP2(flush_monitor_message_trap, BIF_P, BIF_ARG_1, res);
- case ERTS_DEMONITOR_TRUE:
+ if (flush) {
+flush_messages:
+ BIF_TRAP3(flush_monitor_messages_trap, BIF_P,
+ BIF_ARG_1, multi, res);
+ }
+ case am_true:
+ if (multi == am_true && flush)
+ goto flush_messages;
BIF_RET(res);
- case ERTS_DEMONITOR_YIELD_TRUE:
+ case am_yield:
ERTS_BIF_YIELD_RETURN(BIF_P, am_true);
- case ERTS_DEMONITOR_BADARG:
- badarg:
+ case am_badarg:
+badarg:
BIF_ERROR(BIF_P, BADARG);
- case ERTS_DEMONITOR_INTERNAL_ERROR:
+ case am_internal_error:
default:
ASSERT(! "demonitor(): internal error");
BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR);
@@ -564,7 +634,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);
@@ -572,11 +642,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
@@ -587,23 +654,16 @@ 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
-#ifdef USE_VM_PROBES
- , NIL
-#endif
- );
+ erts_queue_message(p, *p_locksp, msgp, tup, am_system);
}
-static BIF_RETTYPE
-local_pid_monitor(Process *p, Eterm target)
+static Eterm
+local_pid_monitor(Process *p, Eterm target, Eterm mon_ref, int boolean)
{
- BIF_RETTYPE ret;
- Eterm mon_ref;
- Process *rp;
+ Eterm ret = mon_ref;
+ Process *rp;
ErtsProcLocks p_locks = ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_LINK;
- mon_ref = erts_make_ref(p);
- ERTS_BIF_PREP_RET(ret, mon_ref);
if (target == p->common.id) {
return ret;
}
@@ -615,12 +675,18 @@ local_pid_monitor(Process *p, Eterm target)
if (!rp) {
erts_smp_proc_unlock(p, ERTS_PROC_LOCK_LINK);
p_locks &= ~ERTS_PROC_LOCK_LINK;
- erts_queue_monitor_message(p, &p_locks,
- mon_ref, am_process, target, am_noproc);
+ if (boolean)
+ ret = am_false;
+ else
+ erts_queue_monitor_message(p, &p_locks,
+ mon_ref, am_process, target, am_noproc);
}
else {
ASSERT(rp != p);
+ if (boolean)
+ ret = am_true;
+
erts_add_monitor(&ERTS_P_MONITORS(p), MON_ORIGIN, mon_ref, target, NIL);
erts_add_monitor(&ERTS_P_MONITORS(rp), MON_TARGET, mon_ref, p->common.id, NIL);
@@ -633,40 +699,112 @@ local_pid_monitor(Process *p, Eterm target)
}
static BIF_RETTYPE
-local_name_monitor(Process *p, Eterm target_name)
+local_port_monitor(Process *origin, Eterm target)
{
- BIF_RETTYPE ret;
- Eterm mon_ref;
- ErtsProcLocks p_locks = ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_LINK;
- Process *rp;
+ BIF_RETTYPE ref = erts_make_ref(origin);
+ Port *port = erts_sig_lookup_port(origin, target);
+ ErtsProcLocks p_locks = ERTS_PROC_LOCK_MAIN;
- mon_ref = erts_make_ref(p);
- ERTS_BIF_PREP_RET(ret, mon_ref);
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_LINK);
- rp = erts_whereis_process(p, p_locks, target_name, ERTS_PROC_LOCK_LINK,
- ERTS_P2P_FLG_ALLOW_OTHER_X);
- if (!rp) {
- DeclareTmpHeap(lhp,3,p);
+ if (!port) {
+res_no_proc:
+ /* Send the DOWN message immediately. Ref is made on the fly because
+ * caller has never seen it yet. */
+ erts_queue_monitor_message(origin, &p_locks, ref,
+ am_port, target, am_noproc);
+ }
+ else {
+ switch (erts_port_monitor(origin, port, target, &ref)) {
+ case ERTS_PORT_OP_DROPPED:
+ case ERTS_PORT_OP_BADARG:
+ goto res_no_proc;
+ case ERTS_PORT_OP_SCHEDULED:
+ BIF_TRAP3(await_port_send_result_trap, origin, ref,
+ am_busy_port, ref);
+ /* the busy_port atom will never be returned, because it cannot be
+ * returned from erts_port_monitor, but just in case if in future
+ * internal API changes - you may see this atom */
+ default:
+ break;
+ }
+ }
+ erts_smp_proc_unlock(origin, p_locks & ~ERTS_PROC_LOCK_MAIN);
+ BIF_RET(ref);
+}
+
+/* Type = process | port :: atom(), 1st argument passed to erlang:monitor/2
+ */
+static BIF_RETTYPE
+local_name_monitor(Process *self, Eterm type, Eterm target_name)
+{
+ BIF_RETTYPE ret = erts_make_ref(self);
+
+ ErtsProcLocks p_locks = ERTS_PROC_LOCK_MAIN | ERTS_PROC_LOCK_LINK;
+ Process *proc = NULL;
+ Port *port = NULL;
+
+ erts_smp_proc_lock(self, ERTS_PROC_LOCK_LINK);
+
+ erts_whereis_name(self, p_locks, target_name,
+ &proc, ERTS_PROC_LOCK_LINK,
+ ERTS_P2P_FLG_ALLOW_OTHER_X,
+ &port, 0);
+
+ /* If the name is not registered,
+ * or if we asked for proc and got a port,
+ * or if we asked for port and got a proc,
+ * we just send the 'DOWN' message.
+ */
+ if ((!proc && !port) ||
+ (type == am_process && port) ||
+ (type == am_port && proc)) {
+ DeclareTmpHeap(lhp,3,self);
Eterm item;
- UseTmpHeap(3,p);
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_LINK);
+ UseTmpHeap(3,self);
+
+ erts_smp_proc_unlock(self, ERTS_PROC_LOCK_LINK);
p_locks &= ~ERTS_PROC_LOCK_LINK;
+
item = TUPLE2(lhp, target_name, erts_this_dist_entry->sysname);
- erts_queue_monitor_message(p, &p_locks,
- mon_ref, am_process, item, am_noproc);
- UnUseTmpHeap(3,p);
- }
- else if (rp != p) {
- erts_add_monitor(&ERTS_P_MONITORS(p), MON_ORIGIN, mon_ref, rp->common.id,
- target_name);
- erts_add_monitor(&ERTS_P_MONITORS(rp), MON_TARGET, mon_ref, p->common.id,
- target_name);
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
+ erts_queue_monitor_message(self, &p_locks,
+ ret,
+ type, /* = process|port :: atom() */
+ item, am_noproc);
+ UnUseTmpHeap(3,self);
+ }
+ else if (port) {
+ erts_smp_proc_unlock(self, p_locks & ~ERTS_PROC_LOCK_MAIN);
+ p_locks &= ~ERTS_PROC_LOCK_MAIN;
+
+ switch (erts_port_monitor(self, port, target_name, &ret)) {
+ case ERTS_PORT_OP_DONE:
+ return ret;
+ case ERTS_PORT_OP_SCHEDULED: { /* Scheduled a signal */
+ ASSERT(is_internal_ordinary_ref(ret));
+ BIF_TRAP3(await_port_send_result_trap, self,
+ ret, am_true, ret);
+ /* bif_trap returns */
+ } break;
+ default:
+ goto badarg;
+ }
+ }
+ else if (proc != self) {
+ erts_add_monitor(&ERTS_P_MONITORS(self), MON_ORIGIN, ret,
+ proc->common.id, target_name);
+ erts_add_monitor(&ERTS_P_MONITORS(proc), MON_TARGET, ret,
+ self->common.id, target_name);
+ erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_LINK);
}
- erts_smp_proc_unlock(p, p_locks & ~ERTS_PROC_LOCK_MAIN);
-
- return ret;
+ if (p_locks) {
+ erts_smp_proc_unlock(self, p_locks & ~ERTS_PROC_LOCK_MAIN);
+ }
+ BIF_RET(ret);
+badarg:
+ if (p_locks) {
+ erts_smp_proc_unlock(self, p_locks & ~ERTS_PROC_LOCK_MAIN);
+ }
+ BIF_ERROR(self, BADARG);
}
static BIF_RETTYPE
@@ -733,7 +871,7 @@ remote_monitor(Process *p, Eterm bifarg1, Eterm bifarg2,
break;
}
- return ret;
+ BIF_RET(ret);
}
BIF_RETTYPE monitor_2(BIF_ALIST_2)
@@ -744,45 +882,72 @@ BIF_RETTYPE monitor_2(BIF_ALIST_2)
int deref_de = 0;
/* Only process monitors are implemented */
- if (BIF_ARG_1 != am_process) {
- goto error;
+ switch (BIF_ARG_1) {
+ case am_time_offset: {
+ Eterm ref;
+ if (BIF_ARG_2 != am_clock_service) {
+ goto badarg;
+ }
+ ref = erts_make_ref(BIF_P);
+ erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK);
+ erts_add_monitor(&ERTS_P_MONITORS(BIF_P), MON_TIME_OFFSET,
+ ref, am_clock_service, NIL);
+ erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK);
+ erts_monitor_time_offset(BIF_P->common.id, ref);
+ BIF_RET(ref);
+ }
+ case am_process:
+ case am_port:
+ break;
+ default:
+ goto badarg;
}
- if (is_internal_pid(target)) {
- local_pid:
- ret = local_pid_monitor(BIF_P, target);
- } else if (is_external_pid(target)) {
+ if (is_internal_pid(target) && BIF_ARG_1 == am_process) {
+local_pid:
+ ret = local_pid_monitor(BIF_P, target, erts_make_ref(BIF_P), 0);
+ } else if (is_external_pid(target) && BIF_ARG_1 == am_process) {
dep = external_pid_dist_entry(target);
if (dep == erts_this_dist_entry)
goto local_pid;
ret = remote_monitor(BIF_P, BIF_ARG_1, BIF_ARG_2, dep, target, 0);
+ } else if (is_internal_port(target) && BIF_ARG_1 == am_port) {
+local_port:
+ ret = local_port_monitor(BIF_P, target);
+ } else if (is_external_port(target) && BIF_ARG_1 == am_port) {
+ dep = external_port_dist_entry(target);
+ if (dep == erts_this_dist_entry) {
+ goto local_port;
+ }
+ goto badarg; /* No want remote port */
} else if (is_atom(target)) {
- ret = local_name_monitor(BIF_P, target);
+ ret = local_name_monitor(BIF_P, BIF_ARG_1, target);
} else if (is_tuple(target)) {
Eterm *tp = tuple_val(target);
Eterm remote_node;
Eterm name;
- if (arityval(*tp) != 2)
- goto error;
+ if (arityval(*tp) != 2) {
+ goto badarg;
+ }
remote_node = tp[2];
name = tp[1];
if (!is_atom(remote_node) || !is_atom(name)) {
- goto error;
+ goto badarg;
}
if (!erts_is_alive && remote_node != am_Noname) {
- goto error; /* Remote monitor from (this) undistributed node */
+ goto badarg; /* Remote monitor from (this) undistributed node */
}
dep = erts_sysname_to_connected_dist_entry(remote_node);
if (dep == erts_this_dist_entry) {
deref_de = 1;
- ret = local_name_monitor(BIF_P, name);
+ ret = local_name_monitor(BIF_P, BIF_ARG_1, name);
} else {
if (dep)
deref_de = 1;
ret = remote_monitor(BIF_P, BIF_ARG_1, BIF_ARG_2, dep, name, 1);
}
} else {
- error:
+badarg:
ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG);
}
if (deref_de) {
@@ -793,7 +958,6 @@ BIF_RETTYPE monitor_2(BIF_ALIST_2)
return ret;
}
-
/**********************************************************************/
/* this is a combination of the spawn and link BIFs */
@@ -802,7 +966,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);
@@ -839,9 +1003,11 @@ 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.max_heap_size = H_MAX_SIZE;
+ so.max_heap_flags = H_MAX_FLAGS;
so.priority = PRIORITY_NORMAL;
so.max_gen_gcs = (Uint16) erts_smp_atomic32_read_nob(&erts_max_gen_gcs);
so.scheduler = 0;
@@ -874,6 +1040,19 @@ 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_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) {
@@ -883,6 +1062,9 @@ BIF_RETTYPE spawn_opt_1(BIF_ALIST_1)
} else {
so.min_heap_size = erts_next_heap_size(min_heap_size, 0);
}
+ } else if (arg == am_max_heap_size) {
+ if (!erts_max_heap_size(val, &so.max_heap_size, &so.max_heap_flags))
+ goto error;
} else if (arg == am_min_bin_vheap_size && is_small(val)) {
Sint min_vheap_size = signed_val(val);
if (min_vheap_size < 0) {
@@ -916,6 +1098,10 @@ BIF_RETTYPE spawn_opt_1(BIF_ALIST_1)
goto error;
}
+ if (so.max_heap_size != 0 && so.max_heap_size < so.min_heap_size) {
+ goto error;
+ }
+
/*
* Spawn the process.
*/
@@ -945,6 +1131,7 @@ BIF_RETTYPE unlink_1(BIF_ALIST_1)
Process *rp;
DistEntry *dep;
ErtsLink *l = NULL, *rl = NULL;
+ ErtsProcLocks cp_locks = ERTS_PROC_LOCK_MAIN;
/*
* SMP specific note concerning incoming exit signals:
@@ -959,7 +1146,7 @@ BIF_RETTYPE unlink_1(BIF_ALIST_1)
*/
if (IS_TRACED_FL(BIF_P, F_TRACE_PROCS)) {
- trace_proc(BIF_P, BIF_P, am_unlink, BIF_ARG_1);
+ trace_proc(BIF_P, cp_locks, BIF_P, am_unlink, BIF_ARG_1);
}
if (is_internal_port(BIF_ARG_1)) {
@@ -990,7 +1177,7 @@ BIF_RETTYPE unlink_1(BIF_ALIST_1)
res = erts_port_unlink(BIF_P, prt, BIF_P->common.id, refp);
if (refp && res == ERTS_PORT_OP_SCHEDULED) {
- ASSERT(is_internal_ref(ref));
+ ASSERT(is_internal_ordinary_ref(ref));
BIF_TRAP3(await_port_send_result_trap, BIF_P, ref, am_true, am_true);
}
}
@@ -1064,10 +1251,10 @@ BIF_RETTYPE unlink_1(BIF_ALIST_1)
erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS);
+ cp_locks |= ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS;
+
/* get process struct */
- rp = erts_pid2proc_opt(BIF_P, (ERTS_PROC_LOCK_MAIN
- | ERTS_PROC_LOCK_LINK
- | ERTS_PROC_LOCK_STATUS),
+ rp = erts_pid2proc_opt(BIF_P, cp_locks,
BIF_ARG_1, ERTS_PROC_LOCK_LINK,
ERTS_P2P_FLG_ALLOW_OTHER_X);
@@ -1093,14 +1280,17 @@ BIF_RETTYPE unlink_1(BIF_ALIST_1)
erts_destroy_link(rl);
if (IS_TRACED_FL(rp, F_TRACE_PROCS) && rl != NULL) {
- trace_proc(BIF_P, rp, am_getting_unlinked, BIF_P->common.id);
+ erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_STATUS);
+ cp_locks &= ~ERTS_PROC_LOCK_STATUS;
+ trace_proc(BIF_P, (ERTS_PROC_LOCK_MAIN | ERTS_PROC_LOCK_LINK),
+ rp, am_getting_unlinked, BIF_P->common.id);
}
if (rp != BIF_P)
erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
}
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS);
+ erts_smp_proc_unlock(BIF_P, cp_locks & ~ERTS_PROC_LOCK_MAIN);
BIF_RET(am_true);
@@ -1393,7 +1583,7 @@ BIF_RETTYPE exit_2(BIF_ALIST_2)
ERTS_BIF_CHK_EXITED(BIF_P);
if (refp && res == ERTS_PORT_OP_SCHEDULED) {
- ASSERT(is_internal_ref(ref));
+ ASSERT(is_internal_ordinary_ref(ref));
BIF_TRAP3(await_port_send_result_trap, BIF_P, ref, am_true, am_true);
}
@@ -1511,7 +1701,32 @@ static BIF_RETTYPE process_flag_aux(Process *BIF_P,
scb->n = 0;
}
- scb = ERTS_PROC_SET_SAVED_CALLS_BUF(rp, ERTS_PROC_LOCK_MAIN, scb);
+#ifdef HIPE
+ if (rp->flags & F_HIPE_MODE) {
+ ASSERT(!ERTS_PROC_GET_SAVED_CALLS_BUF(rp));
+ scb = ERTS_PROC_SET_SUSPENDED_SAVED_CALLS_BUF(rp, scb);
+ }
+ else
+#endif
+ {
+#ifdef HIPE
+ ASSERT(!ERTS_PROC_GET_SUSPENDED_SAVED_CALLS_BUF(rp));
+#endif
+ scb = ERTS_PROC_SET_SAVED_CALLS_BUF(rp, scb);
+ if (rp == BIF_P && ((scb && i == 0) || (!scb && i != 0))) {
+ /* Adjust fcalls to match save calls setting... */
+ if (i == 0)
+ BIF_P->fcalls += CONTEXT_REDS; /* disabled it */
+ else
+ BIF_P->fcalls -= CONTEXT_REDS; /* enabled it */
+
+ /*
+ * Make sure we reschedule immediately so the
+ * change take effect at once.
+ */
+ ERTS_VBUMP_ALL_REDS(BIF_P);
+ }
+ }
if (!scb)
old_value = make_small(0);
@@ -1520,12 +1735,7 @@ static BIF_RETTYPE process_flag_aux(Process *BIF_P,
erts_free(ERTS_ALC_T_CALLS_BUF, (void *) scb);
}
- /* Make sure the process in question is rescheduled
- immediately, if it's us, so the call saving takes effect. */
- if (rp == BIF_P)
- BIF_RET2(old_value, CONTEXT_REDS);
- else
- BIF_RET(old_value);
+ BIF_RET(old_value);
}
error:
@@ -1539,9 +1749,7 @@ BIF_RETTYPE process_flag_2(BIF_ALIST_2)
if (is_not_atom(BIF_ARG_2)) {
goto error;
}
- old_value = erts_proc_set_error_handler(BIF_P,
- ERTS_PROC_LOCK_MAIN,
- BIF_ARG_2);
+ old_value = erts_proc_set_error_handler(BIF_P, BIF_ARG_2);
BIF_RET(old_value);
}
else if (BIF_ARG_1 == am_priority) {
@@ -1566,14 +1774,17 @@ BIF_RETTYPE process_flag_2(BIF_ALIST_2)
* true. For more info, see implementation of
* erts_send_exit_signal().
*/
+ erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCKS_XSIG_SEND);
if (trap_exit)
state = erts_smp_atomic32_read_bor_mb(&BIF_P->state,
ERTS_PSFLG_TRAP_EXIT);
else
state = erts_smp_atomic32_read_band_mb(&BIF_P->state,
~ERTS_PSFLG_TRAP_EXIT);
+ erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCKS_XSIG_SEND);
+
#ifdef ERTS_SMP
- if (ERTS_PROC_PENDING_EXIT(BIF_P)) {
+ if (state & ERTS_PSFLG_PENDING_EXIT) {
erts_handle_pending_exit(BIF_P, ERTS_PROC_LOCK_MAIN);
ERTS_BIF_EXITED(BIF_P);
}
@@ -1607,7 +1818,7 @@ BIF_RETTYPE process_flag_2(BIF_ALIST_2)
ERTS_PSFLG_BOUND);
}
- curr = ERTS_GET_SCHEDULER_DATA_FROM_PROC(BIF_P)->run_queue;
+ curr = erts_proc_sched_data(BIF_P)->run_queue;
old = (ERTS_PSFLG_BOUND & state) ? curr : NULL;
ASSERT(!old || old == curr);
@@ -1652,6 +1863,29 @@ BIF_RETTYPE process_flag_2(BIF_ALIST_2)
}
BIF_RET(old_value);
}
+ else if (BIF_ARG_1 == am_max_heap_size) {
+ Eterm *hp;
+ Uint sz = 0, max_heap_size, max_heap_flags;
+
+ if (!erts_max_heap_size(BIF_ARG_2, &max_heap_size, &max_heap_flags))
+ goto error;
+
+ if ((max_heap_size < MIN_HEAP_SIZE(BIF_P) && max_heap_size != 0))
+ goto error;
+
+ erts_max_heap_size_map(MAX_HEAP_SIZE_GET(BIF_P), MAX_HEAP_SIZE_FLAGS_GET(BIF_P), NULL, &sz);
+ hp = HAlloc(BIF_P, sz);
+ old_value = erts_max_heap_size_map(MAX_HEAP_SIZE_GET(BIF_P), MAX_HEAP_SIZE_FLAGS_GET(BIF_P), &hp, NULL);
+ MAX_HEAP_SIZE_SET(BIF_P, max_heap_size);
+ MAX_HEAP_SIZE_FLAGS_SET(BIF_P, max_heap_flags);
+ 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) {
@@ -1671,7 +1905,9 @@ BIF_RETTYPE process_flag_2(BIF_ALIST_2)
ERTS_TRACE_FLAGS(BIF_P) &= ~F_SENSITIVE;
}
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCKS_ALL_MINOR);
- BIF_RET(old_value);
+ /* make sure to bump all reds so that we get
+ rescheduled immediately so setting takes effect */
+ BIF_RET2(old_value, CONTEXT_REDS);
}
else if (BIF_ARG_1 == am_monitor_nodes) {
/*
@@ -1710,10 +1946,18 @@ BIF_RETTYPE process_flag_3(BIF_ALIST_3)
Process *rp;
Eterm res;
- if ((rp = erts_pid2proc(BIF_P, ERTS_PROC_LOCK_MAIN,
- BIF_ARG_1, ERTS_PROC_LOCK_MAIN)) == NULL) {
+#ifdef ERTS_SMP
+ rp = erts_pid2proc_not_running(BIF_P, ERTS_PROC_LOCK_MAIN,
+ BIF_ARG_1, ERTS_PROC_LOCK_MAIN);
+ if (rp == ERTS_PROC_LOCK_BUSY)
+ ERTS_BIF_YIELD3(bif_export[BIF_process_flag_3], BIF_P,
+ BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+#else
+ rp = erts_proc_lookup(BIF_ARG_1);
+#endif
+
+ if (!rp)
BIF_ERROR(BIF_P, BADARG);
- }
res = process_flag_aux(BIF_P, rp, BIF_ARG_2, BIF_ARG_3);
@@ -1777,6 +2021,8 @@ BIF_RETTYPE whereis_1(BIF_ALIST_1)
* erlang:'!'/2
*/
+HIPE_WRAPPER_BIF_DISABLE_GC(ebif_bang, 2)
+
BIF_RETTYPE
ebif_bang_2(BIF_ALIST_2)
{
@@ -1795,34 +2041,34 @@ ebif_bang_2(BIF_ALIST_2)
#define SEND_USER_ERROR (-5)
#define SEND_INTERNAL_ERROR (-6)
#define SEND_AWAIT_RESULT (-7)
+#define SEND_YIELD_CONTINUE (-8)
-Sint do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp);
static Sint remote_send(Process *p, DistEntry *dep,
- Eterm to, Eterm full_to, Eterm msg, int suspend)
+ Eterm to, Eterm full_to, Eterm msg,
+ ErtsSendContext* ctx)
{
Sint res;
int code;
- ErtsDSigData dsd;
ASSERT(is_atom(to) || is_external_pid(to));
- code = erts_dsig_prepare(&dsd, dep, p, ERTS_DSP_NO_LOCK, !suspend);
+ code = erts_dsig_prepare(&ctx->dsd, dep, p, ERTS_DSP_NO_LOCK, !ctx->suspend);
switch (code) {
case ERTS_DSIG_PREP_NOT_ALIVE:
case ERTS_DSIG_PREP_NOT_CONNECTED:
res = SEND_TRAP;
break;
case ERTS_DSIG_PREP_WOULD_SUSPEND:
- ASSERT(!suspend);
+ ASSERT(!ctx->suspend);
res = SEND_YIELD;
break;
case ERTS_DSIG_PREP_CONNECTED: {
if (is_atom(to))
- code = erts_dsig_send_reg_msg(&dsd, to, msg);
+ code = erts_dsig_send_reg_msg(to, msg, ctx);
else
- code = erts_dsig_send_msg(&dsd, to, msg);
+ code = erts_dsig_send_msg(to, msg, ctx);
/*
* Note that reductions have been bumped on calling
* process by erts_dsig_send_reg_msg() or
@@ -1830,6 +2076,8 @@ static Sint remote_send(Process *p, DistEntry *dep,
*/
if (code == ERTS_DSIG_SEND_YIELD)
res = SEND_YIELD_RETURN;
+ else if (code == ERTS_DSIG_SEND_CONTINUE)
+ res = SEND_YIELD_CONTINUE;
else
res = 0;
break;
@@ -1840,7 +2088,7 @@ static Sint remote_send(Process *p, DistEntry *dep,
}
if (res >= 0) {
- if (IS_TRACED(p))
+ if (IS_TRACED_FL(p, F_TRACE_SEND))
trace_send(p, full_to, msg);
if (ERTS_PROC_GET_SAVED_CALLS_BUF(p))
save_calls(p, &exp_send);
@@ -1849,8 +2097,9 @@ static Sint remote_send(Process *p, DistEntry *dep,
return res;
}
-Sint
-do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) {
+static Sint
+do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext *ctx)
+{
Eterm portid;
Port *pt;
Process* rp;
@@ -1858,7 +2107,7 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) {
Eterm* tp;
if (is_internal_pid(to)) {
- if (IS_TRACED(p))
+ if (IS_TRACED_FL(p, F_TRACE_SEND))
trace_send(p, to, msg);
if (ERTS_PROC_GET_SAVED_CALLS_BUF(p))
save_calls(p, &exp_send);
@@ -1881,13 +2130,18 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) {
erts_send_error_to_logger(p->group_leader, dsbufp);
return 0;
}
- return remote_send(p, dep, to, to, msg, suspend);
+ return remote_send(p, dep, to, to, msg, ctx);
} else if (is_atom(to)) {
Eterm id = erts_whereis_name_to_id(p, to);
- rp = erts_proc_lookup(id);
- if (rp)
+ rp = erts_proc_lookup_raw(id);
+ if (rp) {
+ if (IS_TRACED_FL(p, F_TRACE_SEND))
+ trace_send(p, to, msg);
+ if (ERTS_PROC_GET_SAVED_CALLS_BUF(p))
+ save_calls(p, &exp_send);
goto send_message;
+ }
pt = erts_port_lookup(id,
(erts_port_synchronous_ops
@@ -1898,7 +2152,7 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) {
goto port_common;
}
- if (IS_TRACED(p))
+ if (IS_TRACED_FL(p, F_TRACE_SEND))
trace_send(p, to, msg);
if (ERTS_PROC_GET_SAVED_CALLS_BUF(p))
save_calls(p, &exp_send);
@@ -1929,23 +2183,32 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) {
port_common:
ret_val = 0;
-
+
if (pt) {
- int ps_flags = suspend ? 0 : ERTS_PORT_SIG_FLG_NOSUSPEND;
+ int ps_flags = ctx->suspend ? 0 : ERTS_PORT_SIG_FLG_NOSUSPEND;
*refp = NIL;
+ if (IS_TRACED_FL(p, F_TRACE_SEND)) /* trace once only !! */
+ trace_send(p, portid, msg);
+
+ 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);
+ }
+
switch (erts_port_command(p, ps_flags, pt, msg, refp)) {
case ERTS_PORT_OP_CALLER_EXIT:
/* We are exiting... */
return SEND_USER_ERROR;
case ERTS_PORT_OP_BUSY:
/* Nothing has been sent */
- if (suspend)
+ if (ctx->suspend)
erts_suspend(p, ERTS_PROC_LOCK_MAIN, pt);
return SEND_YIELD;
case ERTS_PORT_OP_BUSY_SCHEDULED:
/* Message was sent */
- if (suspend) {
+ if (ctx->suspend) {
erts_suspend(p, ERTS_PROC_LOCK_MAIN, pt);
ret_val = SEND_YIELD_RETURN;
break;
@@ -1953,7 +2216,7 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) {
/* Fall through */
case ERTS_PORT_OP_SCHEDULED:
if (is_not_nil(*refp)) {
- ASSERT(is_internal_ref(*refp));
+ ASSERT(is_internal_ordinary_ref(*refp));
ret_val = SEND_AWAIT_RESULT;
}
break;
@@ -1966,22 +2229,10 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) {
break;
}
}
-
- if (IS_TRACED(p)) /* trace once only !! */
- trace_send(p, portid, msg);
+
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
- ) {
- seq_trace_update_send(p);
- seq_trace_output(SEQ_TRACE_TOKEN(p), msg,
- SEQ_TRACE_SEND, portid, p);
- }
-
+
if (ERTS_PROC_IS_EXITING(p)) {
KILL_CATCHES(p); /* Must exit */
return SEND_USER_ERROR;
@@ -2004,7 +2255,7 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) {
if (dep == erts_this_dist_entry) {
Eterm id;
erts_deref_dist_entry(dep);
- if (IS_TRACED(p))
+ if (IS_TRACED_FL(p, F_TRACE_SEND))
trace_send(p, to, msg);
if (ERTS_PROC_GET_SAVED_CALLS_BUF(p))
save_calls(p, &exp_send);
@@ -2025,12 +2276,17 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) {
return 0;
}
- ret = remote_send(p, dep, tp[1], to, msg, suspend);
- if (dep)
- erts_deref_dist_entry(dep);
+ ret = remote_send(p, dep, tp[1], to, msg, ctx);
+ if (ret != SEND_YIELD_CONTINUE) {
+ if (dep) {
+ erts_deref_dist_entry(dep);
+ }
+ } else {
+ ctx->dep_to_deref = dep;
+ }
return ret;
} else {
- if (IS_TRACED(p)) /* XXX Is this really neccessary ??? */
+ if (IS_TRACED_FL(p, F_TRACE_SEND))
trace_send(p, to, msg);
if (ERTS_PROC_GET_SAVED_CALLS_BUF(p))
save_calls(p, &exp_send);
@@ -2058,9 +2314,11 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) {
}
}
+HIPE_WRAPPER_BIF_DISABLE_GC(send, 3)
BIF_RETTYPE send_3(BIF_ALIST_3)
{
+ BIF_RETTYPE retval;
Eterm ref;
Process *p = BIF_P;
Eterm to = BIF_ARG_1;
@@ -2068,34 +2326,51 @@ BIF_RETTYPE send_3(BIF_ALIST_3)
Eterm opts = BIF_ARG_3;
int connect = !0;
- int suspend = !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;
+ ctx->dep_to_deref = NULL;
+ ctx->return_term = am_ok;
+ ctx->dss.reds = (Sint) (ERTS_BIF_REDS_LEFT(p) * TERM_TO_BINARY_LOOP_FACTOR);
+ ctx->dss.phase = ERTS_DSIG_SEND_PHASE_INIT;
+
while (is_list(l)) {
if (CAR(list_val(l)) == am_noconnect) {
connect = 0;
} else if (CAR(list_val(l)) == am_nosuspend) {
- suspend = 0;
+ ctx->suspend = 0;
} else {
- BIF_ERROR(p, BADARG);
+ ERTS_BIF_PREP_ERROR(retval, p, BADARG);
+ goto done;
}
l = CDR(list_val(l));
}
if(!is_nil(l)) {
- BIF_ERROR(p, BADARG);
+ ERTS_BIF_PREP_ERROR(retval, p, BADARG);
+ goto done;
}
#ifdef DEBUG
ref = NIL;
#endif
- result = do_send(p, to, msg, suspend, &ref);
+ 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))
goto yield_return;
- BIF_RET(am_ok);
+ ERTS_BIF_PREP_RET(retval, am_ok);
+ goto done;
}
switch (result) {
@@ -2103,68 +2378,129 @@ BIF_RETTYPE send_3(BIF_ALIST_3)
/* May need to yield even though we do not bump reds here... */
if (ERTS_IS_PROC_OUT_OF_REDS(p))
goto yield_return;
- BIF_RET(am_ok);
+ ERTS_BIF_PREP_RET(retval, am_ok);
break;
case SEND_TRAP:
if (connect) {
- BIF_TRAP3(dsend3_trap, p, to, msg, opts);
+ ERTS_BIF_PREP_TRAP3(retval, dsend3_trap, p, to, msg, opts);
} else {
- BIF_RET(am_noconnect);
+ ERTS_BIF_PREP_RET(retval, am_noconnect);
}
break;
case SEND_YIELD:
- if (suspend) {
- ERTS_BIF_YIELD3(bif_export[BIF_send_3], p, to, msg, opts);
+ if (ctx->suspend) {
+ ERTS_BIF_PREP_YIELD3(retval,
+ bif_export[BIF_send_3], p, to, msg, opts);
} else {
- BIF_RET(am_nosuspend);
+ ERTS_BIF_PREP_RET(retval, am_nosuspend);
}
break;
case SEND_YIELD_RETURN:
- if (!suspend)
- BIF_RET(am_nosuspend);
+ if (!ctx->suspend) {
+ ERTS_BIF_PREP_RET(retval, am_nosuspend);
+ break;
+ }
yield_return:
- ERTS_BIF_YIELD_RETURN(p, am_ok);
+ ERTS_BIF_PREP_YIELD_RETURN(retval, p, am_ok);
+ break;
case SEND_AWAIT_RESULT:
- ASSERT(is_internal_ref(ref));
- BIF_TRAP3(await_port_send_result_trap, p, ref, am_nosuspend, am_ok);
+ ASSERT(is_internal_ordinary_ref(ref));
+ ERTS_BIF_PREP_TRAP3(retval, await_port_send_result_trap, p, ref, am_nosuspend, am_ok);
+ break;
case SEND_BADARG:
- BIF_ERROR(p, BADARG);
+ ERTS_BIF_PREP_ERROR(retval, p, BADARG);
break;
case SEND_USER_ERROR:
- BIF_ERROR(p, EXC_ERROR);
+ ERTS_BIF_PREP_ERROR(retval, p, EXC_ERROR);
break;
case SEND_INTERNAL_ERROR:
- BIF_ERROR(p, EXC_INTERNAL_ERROR);
+ ERTS_BIF_PREP_ERROR(retval, p, EXC_INTERNAL_ERROR);
+ break;
+ case SEND_YIELD_CONTINUE:
+ BUMP_ALL_REDS(p);
+ erts_set_gc_state(p, 0);
+ ERTS_BIF_PREP_TRAP1(retval, &dsend_continue_trap_export, p,
+ erts_dsend_export_trap_context(p, ctx));
break;
default:
- ASSERT(! "Illegal send result");
+ erts_exit(ERTS_ABORT_EXIT, "send_3 invalid result %d\n", (int)result);
break;
}
- ASSERT(! "Can not arrive here");
- BIF_ERROR(p, BADARG);
+
+done:
+ UnUseTmpHeap(sizeof(ErtsSendContext)/sizeof(Eterm), BIF_P);
+ return retval;
}
+HIPE_WRAPPER_BIF_DISABLE_GC(send, 2)
+
BIF_RETTYPE send_2(BIF_ALIST_2)
{
return erl_send(BIF_P, BIF_ARG_1, BIF_ARG_2);
}
+static BIF_RETTYPE dsend_continue_trap_1(BIF_ALIST_1)
+{
+ Binary* bin = erts_magic_ref2bin(BIF_ARG_1);
+ ErtsSendContext* ctx = (ErtsSendContext*) ERTS_MAGIC_BIN_DATA(bin);
+ Sint initial_reds = (Sint) (ERTS_BIF_REDS_LEFT(BIF_P) * TERM_TO_BINARY_LOOP_FACTOR);
+ int result;
+
+ ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(bin) == erts_dsend_context_dtor);
+
+ ctx->dss.reds = initial_reds;
+ result = erts_dsig_send(&ctx->dsd, &ctx->dss);
+
+ switch (result) {
+ case ERTS_DSIG_SEND_OK:
+ erts_set_gc_state(BIF_P, 1);
+ BIF_RET(ctx->return_term);
+ break;
+ case ERTS_DSIG_SEND_YIELD: /*SEND_YIELD_RETURN*/
+ erts_set_gc_state(BIF_P, 1);
+ if (!ctx->suspend)
+ BIF_RET(am_nosuspend);
+ ERTS_BIF_YIELD_RETURN(BIF_P, ctx->return_term);
+
+ case ERTS_DSIG_SEND_CONTINUE: { /*SEND_YIELD_CONTINUE*/
+ BUMP_ALL_REDS(BIF_P);
+ BIF_TRAP1(&dsend_continue_trap_export, BIF_P, BIF_ARG_1);
+ }
+ default:
+ erts_exit(ERTS_ABORT_EXIT, "dsend_continue_trap invalid result %d\n", (int)result);
+ break;
+ }
+ ASSERT(! "Can not arrive here");
+ BIF_ERROR(BIF_P, BADARG);
+}
+
Eterm erl_send(Process *p, Eterm to, Eterm msg)
{
+ Eterm retval;
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
+ ctx->suspend = !0;
+ ctx->dep_to_deref = NULL;
+ ctx->return_term = msg;
+ ctx->dss.reds = (Sint) (ERTS_BIF_REDS_LEFT(p) * TERM_TO_BINARY_LOOP_FACTOR);
+ ctx->dss.phase = ERTS_DSIG_SEND_PHASE_INIT;
+
+ result = do_send(p, to, msg, &ref, ctx);
+
+ ERTS_MSACC_POP_STATE_M_X();
- result = do_send(p, to, msg, !0, &ref);
-
if (result > 0) {
ERTS_VBUMP_REDS(p, result);
if (ERTS_IS_PROC_OUT_OF_REDS(p))
goto yield_return;
- BIF_RET(msg);
+ ERTS_BIF_PREP_RET(retval, msg);
+ goto done;
}
switch (result) {
@@ -2172,35 +2508,46 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg)
/* May need to yield even though we do not bump reds here... */
if (ERTS_IS_PROC_OUT_OF_REDS(p))
goto yield_return;
- BIF_RET(msg);
+ ERTS_BIF_PREP_RET(retval, msg);
break;
case SEND_TRAP:
- BIF_TRAP2(dsend2_trap, p, to, msg);
+ ERTS_BIF_PREP_TRAP2(retval, dsend2_trap, p, to, msg);
break;
case SEND_YIELD:
- ERTS_BIF_YIELD2(bif_export[BIF_send_2], p, to, msg);
+ ERTS_BIF_PREP_YIELD2(retval, bif_export[BIF_send_2], p, to, msg);
break;
case SEND_YIELD_RETURN:
yield_return:
- ERTS_BIF_YIELD_RETURN(p, msg);
+ ERTS_BIF_PREP_YIELD_RETURN(retval, p, msg);
+ break;
case SEND_AWAIT_RESULT:
- ASSERT(is_internal_ref(ref));
- BIF_TRAP3(await_port_send_result_trap, p, ref, msg, msg);
+ ASSERT(is_internal_ordinary_ref(ref));
+ ERTS_BIF_PREP_TRAP3(retval,
+ await_port_send_result_trap, p, ref, msg, msg);
+ break;
case SEND_BADARG:
- BIF_ERROR(p, BADARG);
+ ERTS_BIF_PREP_ERROR(retval, p, BADARG);
break;
case SEND_USER_ERROR:
- BIF_ERROR(p, EXC_ERROR);
+ ERTS_BIF_PREP_ERROR(retval, p, EXC_ERROR);
break;
case SEND_INTERNAL_ERROR:
- BIF_ERROR(p, EXC_INTERNAL_ERROR);
+ ERTS_BIF_PREP_ERROR(retval, p, EXC_INTERNAL_ERROR);
+ break;
+ case SEND_YIELD_CONTINUE:
+ BUMP_ALL_REDS(p);
+ erts_set_gc_state(p, 0);
+ ERTS_BIF_PREP_TRAP1(retval, &dsend_continue_trap_export, p,
+ erts_dsend_export_trap_context(p, ctx));
break;
default:
- ASSERT(! "Illegal send result");
+ erts_exit(ERTS_ABORT_EXIT, "invalid send result %d\n", (int)result);
break;
}
- ASSERT(! "Can not arrive here");
- BIF_ERROR(p, BADARG);
+
+done:
+ UnUseTmpHeap(sizeof(ErtsSendContext)/sizeof(Eterm), p);
+ return retval;
}
/**********************************************************************/
@@ -2670,18 +3017,18 @@ BIF_RETTYPE atom_to_list_1(BIF_ALIST_1)
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);
-
+ byte *buf = (byte *) erts_alloc(ERTS_ALC_T_TMP, MAX_ATOM_SZ_LIMIT);
+ Sint written;
+ int i = erts_unicode_list_to_buf(BIF_ARG_1, buf, MAX_ATOM_CHARACTERS,
+ &written);
if (i < 0) {
erts_free(ERTS_ALC_T_TMP, (void *) buf);
- i = erts_list_length(BIF_ARG_1);
- if (i > MAX_ATOM_CHARACTERS) {
+ if (i == -2) {
BIF_ERROR(BIF_P, SYSTEM_LIMIT);
}
BIF_ERROR(BIF_P, BADARG);
}
- res = erts_atom_put((byte *) buf, i, ERTS_ATOM_ENC_LATIN1, 1);
+ res = erts_atom_put(buf, written, ERTS_ATOM_ENC_UTF8, 1);
ASSERT(is_atom(res));
erts_free(ERTS_ALC_T_TMP, (void *) buf);
BIF_RET(res);
@@ -2691,17 +3038,18 @@ BIF_RETTYPE list_to_atom_1(BIF_ALIST_1)
BIF_RETTYPE list_to_existing_atom_1(BIF_ALIST_1)
{
- int 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) {
+ byte *buf = (byte *) erts_alloc(ERTS_ALC_T_TMP, MAX_ATOM_SZ_LIMIT);
+ Sint written;
+ int i = erts_unicode_list_to_buf(BIF_ARG_1, buf, MAX_ATOM_CHARACTERS,
+ &written);
+ if (i < 0) {
error:
erts_free(ERTS_ALC_T_TMP, (void *) buf);
BIF_ERROR(BIF_P, BADARG);
} else {
Eterm a;
- if (erts_atom_get(buf, i, &a, ERTS_ATOM_ENC_LATIN1)) {
+ if (erts_atom_get((char *) buf, written, &a, ERTS_ATOM_ENC_UTF8)) {
erts_free(ERTS_ALC_T_TMP, (void *) buf);
BIF_RET(a);
} else {
@@ -2751,170 +3099,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;
- int skip = 0;
- int neg = 0;
- int 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;
- }
- i = i * 10;
- i = i + 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 = -i;
- res = make_small(i);
- } else {
- lg2 = (n+1)*230/69+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 (is_big(res)) /* check if small */
- res = big_plus_small(res, 0, hp); /* includes conversion to small */
-
- 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);
- }
- }
+/*
+ * 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_big(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)
+BIF_RETTYPE string_list_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));
@@ -2929,13 +3127,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);
@@ -2943,14 +3142,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);
@@ -2958,31 +3155,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);
-
- }
+}
/**********************************************************************/
@@ -3109,7 +3291,7 @@ BIF_RETTYPE float_to_binary_2(BIF_ALIST_2)
#define LOAD_E(xi,xim,xl,xlm) ((xi)=(xim), (xl)=(xlm))
#define STRING_TO_FLOAT_BUF_INC_SZ (128)
-BIF_RETTYPE string_to_float_1(BIF_ALIST_1)
+BIF_RETTYPE string_list_to_float_1(BIF_ALIST_1)
{
Eterm orig = BIF_ARG_1;
Eterm list = orig;
@@ -3288,7 +3470,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;
@@ -3405,7 +3587,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);
@@ -3434,91 +3616,6 @@ BIF_RETTYPE self_0(BIF_ALIST_0)
/**********************************************************************/
-/*
- New representation of refs in R9, see erl_term.h
-
- In the first data word, only the usual 18 bits are used. Ordinarily,
- in "long refs" all words are used (in other words, practically never
- wrap around), but for compatibility with older nodes, "short refs"
- exist. Short refs come into being by being converted from the old
- external format for refs (tag REFERENCE_EXT). Short refs are
- converted back to the old external format.
-
- When converting a long ref to the external format in the case of
- preparing for sending to an older node, the ref is truncated by only
- using the first word (with 18 significant bits), and using the old tag
- REFERENCE_EXT.
-
- When comparing refs or different size, only the parts up to the length
- of the shorter operand are used. This has the desirable effect that a
- long ref sent to an old node and back will be treated as equal to
- the original, although some of the bits have been lost.
-
- The hash value for a ref always considers only the first word, since
- in the above scenario, the original and the copy should have the same
- hash value.
-*/
-
-static Uint32 reference0; /* Initialized in erts_init_bif */
-static Uint32 reference1;
-static Uint32 reference2;
-static erts_smp_spinlock_t make_ref_lock;
-static erts_smp_mtx_t ports_snapshot_mtx;
-erts_smp_atomic_t erts_dead_ports_ptr; /* To store dying ports during snapshot */
-
-void
-erts_make_ref_in_array(Uint32 ref[ERTS_MAX_REF_NUMBERS])
-{
- erts_smp_spin_lock(&make_ref_lock);
-
- reference0++;
- if (reference0 >= MAX_REFERENCE) {
- reference0 = 0;
- reference1++;
- if (reference1 == 0) {
- reference2++;
- }
- }
-
- ref[0] = reference0;
- ref[1] = reference1;
- ref[2] = reference2;
-
- erts_smp_spin_unlock(&make_ref_lock);
-}
-
-Eterm erts_make_ref_in_buffer(Eterm buffer[REF_THING_SIZE])
-{
- Eterm* hp = buffer;
- Uint32 ref[ERTS_MAX_REF_NUMBERS];
-
- erts_make_ref_in_array(ref);
- write_ref_thing(hp, ref[0], ref[1], ref[2]);
- return make_internal_ref(hp);
-}
-
-Eterm erts_make_ref(Process *p)
-{
- Eterm* hp;
- Uint32 ref[ERTS_MAX_REF_NUMBERS];
-
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p));
-
- hp = HAlloc(p, REF_THING_SIZE);
-
- erts_make_ref_in_array(ref);
- write_ref_thing(hp, ref[0], ref[1], ref[2]);
-
- return make_internal_ref(hp);
-}
-
-BIF_RETTYPE make_ref_0(BIF_ALIST_0)
-{
- return erts_make_ref(BIF_P);
-}
-
-/**********************************************************************/
-
/* return the time of day */
BIF_RETTYPE time_0(BIF_ALIST_0)
@@ -3764,13 +3861,21 @@ BIF_RETTYPE now_0(BIF_ALIST_0)
/**********************************************************************/
-BIF_RETTYPE garbage_collect_0(BIF_ALIST_0)
+/*
+ * Pass atom 'minor' for relaxed generational GC run. This is only
+ * recommendation, major run may still be chosen by VM.
+ * Pass atom 'major' for default behaviour - major GC run (fullsweep)
+ */
+BIF_RETTYPE
+erts_internal_garbage_collect_1(BIF_ALIST_1)
{
- int reds;
-
- FLAGS(BIF_P) |= F_NEED_FULLSWEEP;
- reds = erts_garbage_collect(BIF_P, 0, NULL, 0);
- BIF_RET2(am_true, reds);
+ switch (BIF_ARG_1) {
+ case am_minor: break;
+ case am_major: FLAGS(BIF_P) |= F_NEED_FULLSWEEP; break;
+ default: BIF_ERROR(BIF_P, BADARG);
+ }
+ erts_garbage_collect(BIF_P, 0, NULL, 0);
+ return am_true;
}
/**********************************************************************/
@@ -3825,7 +3930,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);
@@ -3839,15 +3944,18 @@ BIF_RETTYPE display_string_1(BIF_ALIST_1)
{
Process* p = BIF_P;
Eterm string = BIF_ARG_1;
- int len = is_string(string);
- char *str;
+ Sint len = erts_unicode_list_to_buf_len(string);
+ Sint written;
+ byte *str;
+ int res;
- if (len <= 0) {
+ if (len < 0) {
BIF_ERROR(p, BADARG);
}
- 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__);
+ str = (byte *) erts_alloc(ERTS_ALC_T_TMP, sizeof(char)*(len + 1));
+ res = erts_unicode_list_to_buf(string, str, len, &written);
+ if (res != 0 || written != len)
+ erts_exit(ERTS_ERROR_EXIT, "%s:%d: Internal error (%d)\n", __FILE__, __LINE__, res);
str[len] = '\0';
erts_fprintf(stderr, "%s", str);
erts_free(ERTS_ALC_T_TMP, (void *) str);
@@ -3862,61 +3970,11 @@ BIF_RETTYPE display_nl_0(BIF_ALIST_0)
/**********************************************************************/
-/* stop the system */
-/* ARGSUSED */
-BIF_RETTYPE halt_0(BIF_ALIST_0)
-{
- VERBOSE(DEBUG_SYSTEM,("System halted by BIF halt()\n"));
- erl_halt(0);
- ERTS_BIF_YIELD1(bif_export[BIF_halt_1], BIF_P, am_undefined);
-}
-
-/**********************************************************************/
-
-#define HALT_MSG_SIZE 200
-static char halt_msg[HALT_MSG_SIZE];
-
-/* stop the system with exit code */
-/* ARGSUSED */
-BIF_RETTYPE halt_1(BIF_ALIST_1)
-{
- Sint code;
-
- if (is_small(BIF_ARG_1) && (code = signed_val(BIF_ARG_1)) >= 0) {
- VERBOSE(DEBUG_SYSTEM,("System halted by BIF halt(%T)\n", BIF_ARG_1));
- erl_halt((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, "");
- }
- else if (is_string(BIF_ARG_1) || BIF_ARG_1 == NIL) {
- int i;
-
- if ((i = intlist_to_buf(BIF_ARG_1, halt_msg, HALT_MSG_SIZE-1)) < 0) {
- goto error;
- }
- 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);
- }
- else
- goto error;
- return NIL; /* Pedantic (lint does not know about erl_exit) */
- error:
- BIF_ERROR(BIF_P, BADARG);
-}
-
-/**********************************************************************/
/* stop the system with exit code and flags */
-/* ARGSUSED */
BIF_RETTYPE halt_2(BIF_ALIST_2)
{
- Sint code;
+ Uint code;
Eterm optlist = BIF_ARG_2;
int flush = 1;
@@ -3943,39 +4001,44 @@ 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_BIF_YIELD1(bif_export[BIF_halt_1], BIF_P, am_undefined);
+ erts_halt(pos_int_code);
+ ERTS_BIF_YIELD2(bif_export[BIF_halt_2], BIF_P, am_undefined, 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;
+ else if (is_list(BIF_ARG_1) || BIF_ARG_1 == NIL) {
+# define HALT_MSG_SIZE 200
+ static byte halt_msg[4*HALT_MSG_SIZE+1];
+ Sint written;
- if ((i = intlist_to_buf(BIF_ARG_1, halt_msg, HALT_MSG_SIZE-1)) < 0) {
- goto error;
- }
- halt_msg[i] = '\0';
+ if (erts_unicode_list_to_buf(BIF_ARG_1, halt_msg, HALT_MSG_SIZE,
+ &written) == -1 ) {
+ goto error;
+ }
+ ASSERT(written >= 0 && written < sizeof(halt_msg));
+ halt_msg[written] = '\0';
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);
}
@@ -3984,16 +4047,19 @@ BIF_RETTYPE halt_2(BIF_ALIST_2)
BIF_RETTYPE function_exported_3(BIF_ALIST_3)
{
+ int arity;
if (is_not_atom(BIF_ARG_1) ||
is_not_atom(BIF_ARG_2) ||
is_not_small(BIF_ARG_3)) {
BIF_ERROR(BIF_P, BADARG);
}
- if (erts_find_function(BIF_ARG_1, BIF_ARG_2, signed_val(BIF_ARG_3),
- erts_active_code_ix()) == NULL) {
- BIF_RET(am_false);
+ arity = signed_val(BIF_ARG_3);
+ if (erts_find_function(BIF_ARG_1, BIF_ARG_2, arity,
+ erts_active_code_ix()) != NULL ||
+ erts_is_builtin(BIF_ARG_1, BIF_ARG_2, arity)) {
+ BIF_RET(am_true);
}
- BIF_RET(am_true);
+ BIF_RET(am_false);
}
/**********************************************************************/
@@ -4028,7 +4094,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);
@@ -4040,6 +4106,7 @@ BIF_RETTYPE ref_to_list_1(BIF_ALIST_1)
{
if (is_not_ref(BIF_ARG_1))
BIF_ERROR(BIF_P, BADARG);
+ erts_magic_ref_save_bin(BIF_ARG_1);
BIF_RET(term2list_dsprintf(BIF_P, BIF_ARG_1));
}
@@ -4056,16 +4123,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));
}
@@ -4109,7 +4169,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);
/*
@@ -4170,6 +4230,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);
@@ -4190,6 +4251,201 @@ BIF_RETTYPE list_to_pid_1(BIF_ALIST_1)
BIF_ERROR(BIF_P, BADARG);
}
+BIF_RETTYPE list_to_port_1(BIF_ALIST_1)
+{
+ /*
+ * A valid port identifier is on the format
+ * "#Port<N.P>" where N is node and P is
+ * the port id. Both N and P are of type Uint32.
+ */
+ Uint32 n, p;
+ char* cp;
+ int i;
+ DistEntry *dep = NULL;
+ char buf[6 /* #Port< */
+ + (2)*(10 + 1) /* N.P> */
+ + 1 /* \0 */];
+
+ /* walk down the list and create a C string */
+ if ((i = intlist_to_buf(BIF_ARG_1, buf, sizeof(buf)-1)) < 0)
+ goto bad;
+
+ buf[i] = '\0'; /* null terminal */
+
+ cp = &buf[0];
+ if (strncmp("#Port<", cp, 6) != 0)
+ goto bad;
+
+ cp += 6; /* strlen("#Port<") */
+
+ if (sscanf(cp, "%u.%u>", &n, &p) < 2)
+ goto bad;
+
+ if (p > ERTS_MAX_PORT_NUMBER)
+ goto bad;
+
+ dep = erts_channel_no_to_dist_entry(n);
+
+ if (!dep)
+ goto bad;
+
+ if(dep == erts_this_dist_entry) {
+ erts_deref_dist_entry(dep);
+ BIF_RET(make_internal_port(p));
+ }
+ else {
+ ExternalThing *etp;
+ ErlNode *enp;
+
+ if (is_nil(dep->cid))
+ 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_port_header(1);
+ etp->next = MSO(BIF_P).first;
+ etp->node = enp;
+ etp->data.ui[0] = p;
+
+ MSO(BIF_P).first = (struct erl_off_heap_header*) etp;
+ erts_deref_dist_entry(dep);
+ BIF_RET(make_external_port(etp));
+ }
+
+ bad:
+ if (dep)
+ erts_deref_dist_entry(dep);
+ BIF_ERROR(BIF_P, BADARG);
+}
+
+BIF_RETTYPE list_to_ref_1(BIF_ALIST_1)
+{
+ /*
+ * A valid reference is on the format
+ * "#Ref<N.X.Y.Z>" where N, X, Y, and Z are
+ * 32-bit integers (i.e., max 10 characters).
+ */
+ Eterm *hp;
+ Eterm res;
+ Uint32 refn[ERTS_MAX_REF_NUMBERS];
+ int n = 0;
+ Uint ints[1 + ERTS_MAX_REF_NUMBERS] = {0};
+ char* cp;
+ Sint i;
+ DistEntry *dep = NULL;
+ char buf[5 /* #Ref< */
+ + (1 + ERTS_MAX_REF_NUMBERS)*(10 + 1) /* N.X.Y.Z> */
+ + 1 /* \0 */];
+
+ /* walk down the list and create a C string */
+ if ((i = intlist_to_buf(BIF_ARG_1, buf, sizeof(buf)-1)) < 0)
+ goto bad;
+
+ buf[i] = '\0'; /* null terminal */
+
+ cp = &buf[0];
+ if (*cp++ != '#') goto bad;
+ if (*cp++ != 'R') goto bad;
+ if (*cp++ != 'e') goto bad;
+ if (*cp++ != 'f') goto bad;
+ if (*cp++ != '<') goto bad;
+
+ for (i = 0; i < sizeof(ints)/sizeof(Uint); i++) {
+ if (*cp < '0' || *cp > '9') goto bad;
+
+ while (*cp >= '0' && *cp <= '9') {
+ ints[i] = 10*ints[i] + (*cp - '0');
+ cp++;
+ }
+
+ n++;
+ if (ints[i] > ~((Uint32) 0)) goto bad;
+ if (*cp == '>') break;
+ if (*cp++ != '.') goto bad;
+ }
+
+ if (*cp++ != '>') goto bad;
+ if (*cp != '\0') goto bad;
+
+ if (n < 2) goto bad;
+
+ for (n = 0; i > 0; i--)
+ refn[n++] = (Uint32) ints[i];
+
+ ASSERT(n <= ERTS_MAX_REF_NUMBERS);
+
+ dep = erts_channel_no_to_dist_entry(ints[0]);
+
+ if (!dep)
+ goto bad;
+
+ if(dep == erts_this_dist_entry) {
+ ErtsMagicBinary *mb;
+ Uint32 sid;
+ if (refn[0] > MAX_REFERENCE) goto bad;
+ if (n != ERTS_REF_NUMBERS) goto bad;
+ sid = erts_get_ref_numbers_thr_id(refn);
+ if (sid > erts_no_schedulers) goto bad;
+ mb = erts_magic_ref_lookup_bin(refn);
+ if (mb) {
+ hp = HAlloc(BIF_P, ERTS_MAGIC_REF_THING_SIZE);
+ res = erts_mk_magic_ref(&hp, &BIF_P->off_heap,
+ (Binary *) mb);
+ }
+ else {
+ hp = HAlloc(BIF_P, ERTS_REF_THING_SIZE);
+ write_ref_thing(hp, refn[0], refn[1], refn[2]);
+ res = make_internal_ref(hp);
+ }
+ }
+ else {
+ ExternalThing *etp;
+ ErlNode *enp;
+ Uint hsz;
+ int j;
+
+ if (is_nil(dep->cid))
+ goto bad;
+
+ enp = erts_find_or_insert_node(dep->sysname, dep->creation);
+ ASSERT(enp != erts_this_node);
+
+ hsz = EXTERNAL_THING_HEAD_SIZE;
+#if defined(ARCH_64)
+ hsz += n/2 + 1;
+#else
+ hsz += n;
+#endif
+
+ etp = (ExternalThing *) HAlloc(BIF_P, hsz);
+ etp->header = make_external_ref_header(n/2);
+ etp->next = BIF_P->off_heap.first;
+ etp->node = enp;
+ i = 0;
+#if defined(ARCH_64)
+ etp->data.ui32[i] = n;
+#endif
+ for (j = 0; j < n; j++) {
+ etp->data.ui32[i] = refn[j];
+ i++;
+ }
+
+ BIF_P->off_heap.first = (struct erl_off_heap_header*) etp;
+ res = make_external_ref(etp);
+ }
+
+ erts_deref_dist_entry(dep);
+ BIF_RET(res);
+
+ bad:
+ if (dep)
+ erts_deref_dist_entry(dep);
+ BIF_ERROR(BIF_P, BADARG);
+}
+
+
/**********************************************************************/
BIF_RETTYPE group_leader_0(BIF_ALIST_0)
@@ -4252,8 +4508,30 @@ BIF_RETTYPE group_leader_2(BIF_ALIST_2)
else {
locks &= ~ERTS_PROC_LOCK_STATUS;
erts_smp_proc_unlock(new_member, ERTS_PROC_LOCK_STATUS);
- new_member->group_leader = STORE_NC_IN_PROC(new_member,
- BIF_ARG_1);
+ if (new_member == BIF_P
+ || !(erts_smp_atomic32_read_nob(&new_member->state)
+ & ERTS_PSFLG_DIRTY_RUNNING)) {
+ new_member->group_leader = STORE_NC_IN_PROC(new_member,
+ BIF_ARG_1);
+ }
+ else {
+ ErlHeapFragment *bp;
+ Eterm *hp;
+ /*
+ * Other process executing on a dirty scheduler,
+ * so we are not allowed to write to its heap.
+ * Store in heap fragment.
+ */
+
+ bp = new_message_buffer(NC_HEAP_SIZE(BIF_ARG_1));
+ hp = bp->mem;
+ new_member->group_leader = STORE_NC(&hp,
+ &new_member->off_heap,
+ BIF_ARG_1);
+ bp->next = new_member->mbuf;
+ new_member->mbuf = bp;
+ new_member->mbuf_sz += bp->used_size;
+ }
}
}
@@ -4285,39 +4563,46 @@ 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
- 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,
- 0)) {
- case ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED:
- BIF_RET(am_blocked);
- case ERTS_SCHDLR_SSPND_YIELD_DONE_MSCHED_BLOCKED:
- ERTS_BIF_YIELD_RETURN_X(BIF_P, am_blocked,
- am_multi_scheduling);
- case ERTS_SCHDLR_SSPND_DONE:
- BIF_RET(am_enabled);
- case ERTS_SCHDLR_SSPND_YIELD_RESTART:
- ERTS_VBUMP_ALL_REDS(BIF_P);
- BIF_TRAP2(bif_export[BIF_system_flag_2],
- BIF_P, BIF_ARG_1, BIF_ARG_2);
- case ERTS_SCHDLR_SSPND_YIELD_DONE:
- ERTS_BIF_YIELD_RETURN_X(BIF_P, am_enabled,
- am_multi_scheduling);
- case ERTS_SCHDLR_SSPND_EINVAL:
- goto error;
- default:
- ASSERT(0);
- BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR);
- break;
- }
- }
+ 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);
+ switch (erts_block_multi_scheduling(BIF_P,
+ ERTS_PROC_LOCK_MAIN,
+ 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:
+ ERTS_VBUMP_ALL_REDS(BIF_P);
+ BIF_TRAP2(bif_export[BIF_system_flag_2],
+ BIF_P, BIF_ARG_1, BIF_ARG_2);
+ case ERTS_SCHDLR_SSPND_YIELD_DONE:
+ ERTS_BIF_YIELD_RETURN_X(BIF_P, am_enabled,
+ am_multi_scheduling);
+ case ERTS_SCHDLR_SSPND_EINVAL:
+ goto error;
+ default:
+ ASSERT(0);
+ BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR);
+ break;
+ }
#endif
}
} else if (BIF_ARG_1 == am_schedulers_online) {
@@ -4333,11 +4618,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:
@@ -4397,6 +4678,31 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
BIF_RET(make_small(oval));
+ } else if (BIF_ARG_1 == am_max_heap_size) {
+
+ Eterm *hp, old_value;
+ Uint sz = 0, max_heap_size, max_heap_flags;
+
+ if (!erts_max_heap_size(BIF_ARG_2, &max_heap_size, &max_heap_flags))
+ goto error;
+
+ if (max_heap_size < H_MIN_SIZE && max_heap_size != 0)
+ goto error;
+
+ erts_max_heap_size_map(H_MAX_SIZE, H_MAX_FLAGS, NULL, &sz);
+ hp = HAlloc(BIF_P, sz);
+ old_value = erts_max_heap_size_map(H_MAX_SIZE, H_MAX_FLAGS, &hp, NULL);
+
+ erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_smp_thr_progress_block();
+
+ H_MAX_SIZE = max_heap_size;
+ H_MAX_FLAGS = max_heap_flags;
+
+ erts_smp_thr_progress_unblock();
+ erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+
+ BIF_RET(old_value);
} else if (BIF_ARG_1 == am_display_items) {
int oval = display_items;
if (!is_small(BIF_ARG_2) || (n = signed_val(BIF_ARG_2)) < 0) {
@@ -4417,15 +4723,37 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
} else if (BIF_ARG_1 == am_trace_control_word) {
BIF_RET(db_set_trace_control_word(BIF_P, BIF_ARG_2));
} else if (BIF_ARG_1 == am_sequential_tracer) {
- Eterm old_value = erts_set_system_seq_tracer(BIF_P,
- ERTS_PROC_LOCK_MAIN,
- BIF_ARG_2);
- if (old_value != THE_NON_VALUE) {
- BIF_RET(old_value);
- }
+ ErtsTracer new_seq_tracer, old_seq_tracer;
+ Eterm ret;
+
+ if (BIF_ARG_2 == am_false)
+ new_seq_tracer = erts_tracer_nil;
+ else
+ new_seq_tracer = erts_term_to_tracer(THE_NON_VALUE, BIF_ARG_2);
+
+ if (new_seq_tracer == THE_NON_VALUE)
+ goto error;
+
+ old_seq_tracer = erts_set_system_seq_tracer(BIF_P,
+ ERTS_PROC_LOCK_MAIN,
+ new_seq_tracer);
+
+ ERTS_TRACER_CLEAR(&new_seq_tracer);
+
+ if (old_seq_tracer == THE_NON_VALUE)
+ goto error;
+
+ if (ERTS_TRACER_IS_NIL(old_seq_tracer))
+ BIF_RET(am_false);
+
+ ret = erts_tracer_to_term(BIF_P, old_seq_tracer);
+
+ ERTS_TRACER_CLEAR(&old_seq_tracer);
+
+ BIF_RET(ret);
} 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();
@@ -4462,7 +4790,7 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
erts_aint32_t new = BIF_ARG_2 == am_true ? 1 : 0;
erts_aint32_t old = erts_smp_atomic32_xchg_nob(&sched_wall_time,
new);
- Eterm ref = erts_sched_wall_time_request(BIF_P, 1, new);
+ Eterm ref = erts_sched_wall_time_request(BIF_P, 1, new, 0, 0);
ASSERT(is_value(ref));
BIF_TRAP2(await_sched_wall_time_mod_trap,
BIF_P,
@@ -4496,6 +4824,53 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
break;
}
#endif
+ } else if (BIF_ARG_1 == am_time_offset
+ && ERTS_IS_ATOM_STR("finalize", BIF_ARG_2)) {
+ ErtsTimeOffsetState res;
+ erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ res = erts_finalize_time_offset();
+ erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ switch (res) {
+ case ERTS_TIME_OFFSET_PRELIMINARY: {
+ DECL_AM(preliminary);
+ BIF_RET(AM_preliminary);
+ }
+ case ERTS_TIME_OFFSET_FINAL: {
+ DECL_AM(final);
+ BIF_RET(AM_final);
+ }
+ case ERTS_TIME_OFFSET_VOLATILE: {
+ DECL_AM(volatile);
+ BIF_RET(AM_volatile);
+ }
+ 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))
@@ -4537,25 +4912,6 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
/**********************************************************************/
-BIF_RETTYPE hash_2(BIF_ALIST_2)
-{
- Uint32 hash;
- Sint range;
-
- if (is_not_small(BIF_ARG_2)) {
- BIF_ERROR(BIF_P, BADARG);
- }
- if ((range = signed_val(BIF_ARG_2)) <= 0) { /* [1..MAX_SMALL] */
- BIF_ERROR(BIF_P, BADARG);
- }
-#if defined(ARCH_64) && !HALFWORD_HEAP
- if (range > ((1L << 27) - 1))
- BIF_ERROR(BIF_P, BADARG);
-#endif
- hash = make_broken_hash(BIF_ARG_1);
- BIF_RET(make_small(1 + (hash % range))); /* [1..range] */
-}
-
BIF_RETTYPE phash_2(BIF_ALIST_2)
{
Uint32 hash;
@@ -4620,7 +4976,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)) {
@@ -4647,7 +5003,7 @@ BIF_RETTYPE bump_reductions_1(BIF_ALIST_1)
}
BIF_RETTYPE erts_internal_cmp_term_2(BIF_ALIST_2) {
- int res = CMP_TERM(BIF_ARG_1,BIF_ARG_2);
+ Sint res = CMP_TERM(BIF_ARG_1,BIF_ARG_2);
/* ensure -1, 0, 1 result */
if (res < 0) {
@@ -4660,29 +5016,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);
}
/*
@@ -4714,7 +5068,7 @@ skip_current_msgq(Process *c_p)
res = 0;
}
else {
- ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p);
+ ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p);
c_p->msg.save = c_p->msg.last;
res = 1;
}
@@ -4767,46 +5121,45 @@ erts_bif_prep_await_proc_exit_apply_trap(Process *c_p,
Export bif_return_trap_export;
void erts_init_trap_export(Export* ep, Eterm m, Eterm f, Uint a,
- Eterm (*bif)(BIF_ALIST_0))
+ Eterm (*bif)(BIF_ALIST))
{
int i;
sys_memset((void *) ep, 0, sizeof(Export));
for (i=0; i<ERTS_NUM_CODE_IX; i++) {
- ep->addressv[i] = &ep->code[3];
+ ep->addressv[i] = ep->beam;
}
- ep->code[0] = m;
- ep->code[1] = f;
- ep->code[2] = a;
- ep->code[3] = (BeamInstr) em_apply_bif;
- ep->code[4] = (BeamInstr) bif;
+ ep->info.mfa.module = m;
+ ep->info.mfa.function = f;
+ ep->info.mfa.arity = a;
+ ep->beam[0] = (BeamInstr) em_apply_bif;
+ ep->beam[1] = (BeamInstr) bif;
}
void erts_init_bif(void)
{
- reference0 = 0;
- reference1 = 0;
- reference2 = 0;
-
- erts_smp_spinlock_init(&make_ref_lock, "make_ref");
- erts_smp_mtx_init(&ports_snapshot_mtx, "ports_snapshot");
- 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);
- flush_monitor_message_trap = erts_export_put(am_erlang,
- am_flush_monitor_message,
- 2);
+ erts_await_result = erts_export_put(am_erts_internal,
+ am_await_result,
+ 1);
+
+ erts_init_trap_export(&dsend_continue_trap_export,
+ am_erts_internal, am_dsend_continue_trap, 1,
+ dsend_continue_trap_1);
+
+ flush_monitor_messages_trap = erts_export_put(am_erts_internal,
+ am_flush_monitor_messages,
+ 3);
+
+ erts_convert_time_unit_trap = erts_export_put(am_erlang,
+ am_convert_time_unit,
+ 3);
set_cpu_topology_trap = erts_export_put(am_erlang,
am_set_cpu_topology,
@@ -4818,10 +5171,322 @@ 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());
+}
+
+/*
+ * Scheduling of BIFs via NifExport...
+ */
+#define ERTS_WANT_NFUNC_SCHED_INTERNALS__
+#include "erl_nfunc_sched.h"
+
+#define ERTS_SCHED_BIF_TRAP_MARKER ((void *) (UWord) 1)
+
+static ERTS_INLINE void
+schedule(Process *c_p, Process *dirty_shadow_proc,
+ ErtsCodeMFA *mfa, BeamInstr *pc,
+ ErtsBifFunc dfunc, void *ifunc,
+ Eterm module, Eterm function,
+ int argc, Eterm *argv)
+{
+ ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(c_p));
+ (void) erts_nif_export_schedule(c_p, dirty_shadow_proc,
+ mfa, pc, (BeamInstr) em_apply_bif,
+ dfunc, ifunc,
+ module, function,
+ argc, argv);
+}
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+
+static BIF_RETTYPE dirty_bif_result(BIF_ALIST_1)
+{
+ NifExport *nep = (NifExport *) ERTS_PROC_GET_NIF_TRAP_EXPORT(BIF_P);
+ erts_nif_export_restore(BIF_P, nep, BIF_ARG_1);
+ BIF_RET(BIF_ARG_1);
+}
+
+static BIF_RETTYPE dirty_bif_trap(BIF_ALIST)
+{
+ NifExport *nep = (NifExport *) ERTS_PROC_GET_NIF_TRAP_EXPORT(BIF_P);
+
+ /*
+ * Arity and argument registers already set
+ * correct by call to dirty_bif_trap()...
+ */
+
+ ASSERT(BIF_P->arity == nep->exp.info.mfa.arity);
+
+ erts_nif_export_restore(BIF_P, nep, THE_NON_VALUE);
+
+ BIF_P->i = (BeamInstr *) nep->func;
+ BIF_P->freason = TRAP;
+ return THE_NON_VALUE;
+}
+
+static BIF_RETTYPE dirty_bif_exception(BIF_ALIST_2)
+{
+ Eterm freason;
+
+ ASSERT(is_small(BIF_ARG_1));
+
+ freason = signed_val(BIF_ARG_1);
+
+ /* Restore orig info for error and clear nif export in handle_error() */
+ freason |= EXF_RESTORE_NIF;
+
+ BIF_P->fvalue = BIF_ARG_2;
+
+ BIF_ERROR(BIF_P, freason);
+}
+
+#endif /* ERTS_DIRTY_SCHEDULERS */
+
+extern BeamInstr* em_call_bif_e;
+static BIF_RETTYPE call_bif(Process *c_p, Eterm *reg, BeamInstr *I);
+
+BIF_RETTYPE
+erts_schedule_bif(Process *proc,
+ Eterm *argv,
+ BeamInstr *i,
+ ErtsBifFunc bif,
+ ErtsSchedType sched_type,
+ Eterm mod,
+ Eterm func,
+ int argc)
+{
+ Process *c_p, *dirty_shadow_proc;
+ ErtsCodeMFA *mfa;
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (proc->static_flags & ERTS_STC_FLG_SHADOW_PROC) {
+ dirty_shadow_proc = proc;
+ c_p = proc->next;
+ ASSERT(c_p->common.id == dirty_shadow_proc->common.id);
+ erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
+ }
+ else
+#endif
+ {
+ dirty_shadow_proc = NULL;
+ c_p = proc;
+ }
+
+ if (!ERTS_PROC_IS_EXITING(c_p)) {
+ Export *exp;
+ BifFunction dbif, ibif;
+ BeamInstr *pc;
+
+ /*
+ * dbif - direct bif
+ * ibif - indirect bif
+ */
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+ erts_aint32_t set, mask;
+ mask = (ERTS_PSFLG_DIRTY_CPU_PROC
+ | ERTS_PSFLG_DIRTY_IO_PROC);
+ switch (sched_type) {
+ case ERTS_SCHED_DIRTY_CPU:
+ set = ERTS_PSFLG_DIRTY_CPU_PROC;
+ dbif = bif;
+ ibif = NULL;
+ break;
+ case ERTS_SCHED_DIRTY_IO:
+ set = ERTS_PSFLG_DIRTY_IO_PROC;
+ dbif = bif;
+ ibif = NULL;
+ break;
+ case ERTS_SCHED_NORMAL:
+ default:
+ set = 0;
+ dbif = call_bif;
+ ibif = bif;
+ break;
+ }
+
+ (void) erts_smp_atomic32_read_bset_nob(&c_p->state, mask, set);
+#else
+ dbif = call_bif;
+ ibif = bif;
+#endif
+
+ if (i == NULL) {
+ ERTS_INTERNAL_ERROR("Missing instruction pointer");
+ }
+#ifdef HIPE
+ else if (proc->flags & F_HIPE_MODE) {
+ /* Pointer to bif export in i */
+ exp = (Export *) i;
+ pc = c_p->cp;
+ mfa = &exp->info.mfa;
+ }
+#endif
+ else if (em_call_bif_e == (BeamInstr *) *i) {
+ /* Pointer to bif export in i+1 */
+ exp = (Export *) i[1];
+ pc = i;
+ mfa = &exp->info.mfa;
+ }
+ else if (em_apply_bif == (BeamInstr *) *i) {
+ /* Pointer to bif in i+1, and mfa in i-3 */
+ pc = c_p->cp;
+ mfa = erts_code_to_codemfa(i);
+ }
+ else {
+ ERTS_INTERNAL_ERROR("erts_schedule_bif() called "
+ "from unexpected instruction");
+ }
+ ASSERT(bif);
+
+ if (argc < 0) { /* reschedule original call */
+ mod = mfa->module;
+ func = mfa->function;
+ argc = (int) mfa->arity;
+ }
+
+ schedule(c_p, dirty_shadow_proc, mfa, pc, dbif, ibif,
+ mod, func, argc, argv);
+ }
+
+ if (dirty_shadow_proc)
+ erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
+
+ return THE_NON_VALUE;
+}
+
+static BIF_RETTYPE
+call_bif(Process *c_p, Eterm *reg, BeamInstr *I)
+{
+ NifExport *nep = ERTS_I_BEAM_OP_TO_NIF_EXPORT(I);
+ ErtsBifFunc bif = (ErtsBifFunc) nep->func;
+ BIF_RETTYPE ret;
+
+ ASSERT(!ERTS_SCHEDULER_IS_DIRTY(erts_get_scheduler_data()));
+
+ nep->func = ERTS_SCHED_BIF_TRAP_MARKER;
+
+ ASSERT(bif);
+
+ ret = (*bif)(c_p, reg, I);
+
+ if (is_value(ret))
+ erts_nif_export_restore(c_p, nep, ret);
+ else if (c_p->freason != TRAP)
+ c_p->freason |= EXF_RESTORE_NIF; /* restore in handle_error() */
+ else if (nep->func == ERTS_SCHED_BIF_TRAP_MARKER) {
+ /* BIF did an ordinary trap... */
+ erts_nif_export_restore(c_p, nep, ret);
+ }
+ /* else:
+ * BIF rescheduled itself using erts_schedule_bif().
+ */
+
+ return ret;
+}
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+
+int
+erts_call_dirty_bif(ErtsSchedulerData *esdp, Process *c_p, BeamInstr *I, Eterm *reg)
+{
+ BIF_RETTYPE result;
+ int exiting;
+ Process *dirty_shadow_proc;
+ ErtsBifFunc bf;
+ NifExport *nep;
+#ifdef DEBUG
+ Eterm *c_p_htop;
+ erts_aint32_t state;
+
+ ASSERT(!c_p->scheduler_data);
+ state = erts_smp_atomic32_read_nob(&c_p->state);
+ ASSERT((state & ERTS_PSFLG_DIRTY_RUNNING)
+ && !(state & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS)));
+ ASSERT(esdp);
+
+#endif
+
+ nep = ERTS_I_BEAM_OP_TO_NIF_EXPORT(I);
+ ASSERT(nep == ERTS_PROC_GET_NIF_TRAP_EXPORT(c_p));
+
+ nep->func = ERTS_SCHED_BIF_TRAP_MARKER;
+
+ bf = (ErtsBifFunc) I[1];
+
+ erts_smp_atomic32_read_band_mb(&c_p->state, ~(ERTS_PSFLG_DIRTY_CPU_PROC
+ | ERTS_PSFLG_DIRTY_IO_PROC));
+
+ dirty_shadow_proc = erts_make_dirty_shadow_proc(esdp, c_p);
+
+ dirty_shadow_proc->freason = c_p->freason;
+ dirty_shadow_proc->fvalue = c_p->fvalue;
+ dirty_shadow_proc->ftrace = c_p->ftrace;
+ dirty_shadow_proc->cp = c_p->cp;
+ dirty_shadow_proc->i = c_p->i;
+
+#ifdef DEBUG
+ c_p_htop = c_p->htop;
+#endif
+
+ erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
+
+ result = (*bf)(dirty_shadow_proc, reg, I);
+
+ erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
+
+ ASSERT(c_p_htop == c_p->htop);
+ ASSERT(dirty_shadow_proc->static_flags & ERTS_STC_FLG_SHADOW_PROC);
+ ASSERT(dirty_shadow_proc->next == c_p);
+
+ exiting = ERTS_PROC_IS_EXITING(c_p);
+
+ if (!exiting) {
+ if (is_value(result))
+ schedule(c_p, dirty_shadow_proc, NULL, NULL, dirty_bif_result,
+ NULL, am_erts_internal, am_dirty_bif_result, 1, &result);
+ else if (dirty_shadow_proc->freason != TRAP) {
+ Eterm argv[2];
+ ASSERT(dirty_shadow_proc->freason <= MAX_SMALL);
+ argv[0] = make_small(dirty_shadow_proc->freason);
+ argv[1] = dirty_shadow_proc->fvalue;
+ schedule(c_p, dirty_shadow_proc, NULL, NULL,
+ dirty_bif_exception, NULL, am_erts_internal,
+ am_dirty_bif_exception, 2, argv);
+ }
+ else if (nep->func == ERTS_SCHED_BIF_TRAP_MARKER) {
+ /* Dirty BIF did an ordinary trap... */
+ ASSERT(!(erts_smp_atomic32_read_nob(&c_p->state)
+ & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC)));
+ schedule(c_p, dirty_shadow_proc, NULL, NULL,
+ dirty_bif_trap, (void *) dirty_shadow_proc->i,
+ am_erts_internal, am_dirty_bif_trap,
+ dirty_shadow_proc->arity, reg);
+ }
+ /* else:
+ * BIF rescheduled itself using erts_schedule_bif().
+ */
+ c_p->freason = dirty_shadow_proc->freason;
+ c_p->fvalue = dirty_shadow_proc->fvalue;
+ c_p->ftrace = dirty_shadow_proc->ftrace;
+ c_p->cp = dirty_shadow_proc->cp;
+ c_p->i = dirty_shadow_proc->i;
+ c_p->arity = dirty_shadow_proc->arity;
+ }
+
+ erts_flush_dirty_shadow_proc(dirty_shadow_proc);
+
+ return exiting;
}
+#endif /* ERTS_DIRTY_SCHEDULERS */
+
+
#ifdef HARDDEBUG
/*
You'll need this line in bif.tab to be able to use this debug bif
@@ -5076,12 +5741,10 @@ BIF_RETTYPE dt_restore_tag_1(BIF_ALIST_1)
SEQ_TRACE_TOKEN(BIF_P) = am_have_dt_utag;
}
}
-#else
+#else
if (BIF_ARG_1 != am_true) {
BIF_ERROR(BIF_P,BADARG);
}
#endif
BIF_RET(am_true);
}
-
-
diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h
index 51b77a95ed..01cca90a7a 100644
--- a/erts/emulator/beam/bif.h
+++ b/erts/emulator/beam/bif.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -20,20 +21,42 @@
#ifndef __BIF_H__
#define __BIF_H__
+extern Export *erts_await_result;
extern Export* erts_format_cpu_topology_trap;
+extern Export *erts_convert_time_unit_trap;
#define BIF_RETTYPE Eterm
#define BIF_P A__p
-#define BIF_ALIST_0 Process* A__p, Eterm* BIF__ARGS
-#define BIF_ALIST_1 Process* A__p, Eterm* BIF__ARGS
-#define BIF_ALIST_2 Process* A__p, Eterm* BIF__ARGS
-#define BIF_ALIST_3 Process* A__p, Eterm* BIF__ARGS
+#define BIF_ALIST Process* A__p, Eterm* BIF__ARGS, BeamInstr *A__I
+#define BIF_CALL_ARGS A__p, BIF__ARGS, A__I
+
+#define BIF_ALIST_0 BIF_ALIST
+#define BIF_ALIST_1 BIF_ALIST
+#define BIF_ALIST_2 BIF_ALIST
+#define BIF_ALIST_3 BIF_ALIST
+#define BIF_ALIST_4 BIF_ALIST
#define BIF_ARG_1 (BIF__ARGS[0])
#define BIF_ARG_2 (BIF__ARGS[1])
#define BIF_ARG_3 (BIF__ARGS[2])
+#define BIF_ARG_4 (BIF__ARGS[3])
+
+#define BIF_I A__I
+
+/* NBIF_* is for bif calls from native code... */
+
+#define NBIF_ALIST Process* A__p, Eterm* BIF__ARGS
+#define NBIF_CALL_ARGS A__p, BIF__ARGS
+
+#define NBIF_ALIST_0 NBIF_ALIST
+#define NBIF_ALIST_1 NBIF_ALIST
+#define NBIF_ALIST_2 NBIF_ALIST
+#define NBIF_ALIST_3 NBIF_ALIST
+#define NBIF_ALIST_4 NBIF_ALIST
+
+typedef BIF_RETTYPE (*ErtsBifFunc)(BIF_ALIST);
#define ERTS_IS_PROC_OUT_OF_REDS(p) \
((p)->fcalls > 0 \
@@ -47,24 +70,27 @@ extern Export* erts_format_cpu_topology_trap;
(p)->fcalls = 0; \
else \
(p)->fcalls = -CONTEXT_REDS; \
+ ASSERT(ERTS_BIF_REDS_LEFT((p)) == 0); \
} 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_sched_data((p))->virtual_reds += (fcalls); \
+ (fcalls) = 0; \
} \
else { \
- if ((p)->fcalls > -CONTEXT_REDS) \
- ERTS_PROC_GET_SCHDATA((p))->virtual_reds \
- += ((p)->fcalls - (-CONTEXT_REDS)); \
- (p)->fcalls = -CONTEXT_REDS; \
+ if ((fcalls) > -CONTEXT_REDS) \
+ erts_proc_sched_data((p))->virtual_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));\
@@ -83,32 +109,56 @@ do { \
if (!ERTS_PROC_GET_SAVED_CALLS_BUF((p))) { \
if ((p)->fcalls >= reds) { \
(p)->fcalls -= reds; \
- ERTS_PROC_GET_SCHDATA((p))->virtual_reds += reds; \
+ erts_proc_sched_data((p))->virtual_reds += reds; \
} \
else { \
if ((p)->fcalls > 0) \
- ERTS_PROC_GET_SCHDATA((p))->virtual_reds += (p)->fcalls;\
+ erts_proc_sched_data((p))->virtual_reds += (p)->fcalls; \
(p)->fcalls = 0; \
} \
} \
else { \
if ((p)->fcalls >= reds - CONTEXT_REDS) { \
(p)->fcalls -= reds; \
- ERTS_PROC_GET_SCHDATA((p))->virtual_reds += reds; \
+ erts_proc_sched_data((p))->virtual_reds += reds; \
} \
else { \
if ((p)->fcalls > -CONTEXT_REDS) \
- ERTS_PROC_GET_SCHDATA((p))->virtual_reds \
+ erts_proc_sched_data((p))->virtual_reds \
+= (p)->fcalls - (-CONTEXT_REDS); \
(p)->fcalls = -CONTEXT_REDS; \
} \
} \
} 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_sched_data((P))->virtual_reds \
+ += (FCalls) - nreds__; \
+ (FCalls) = nreds__; \
+ } \
+ } \
+ else { \
+ if ((FCalls) > (Reds)) { \
+ erts_proc_sched_data((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)); \
@@ -124,12 +174,85 @@ do { \
return THE_NON_VALUE; \
} while(0)
+#define ERTS_BIF_ERROR_TRAPPED0(Proc, Reason, Bif) \
+do { \
+ (Proc)->freason = (Reason); \
+ (Proc)->current = &(Bif)->info.mfa; \
+ return THE_NON_VALUE; \
+} while (0)
+
+#define ERTS_BIF_ERROR_TRAPPED1(Proc, Reason, Bif, A0) \
+do { \
+ Eterm* reg = erts_proc_sched_data((Proc))->x_reg_array; \
+ (Proc)->freason = (Reason); \
+ (Proc)->current = &(Bif)->info.mfa; \
+ reg[0] = (Eterm) (A0); \
+ return THE_NON_VALUE; \
+} while (0)
+
+#define ERTS_BIF_ERROR_TRAPPED2(Proc, Reason, Bif, A0, A1) \
+do { \
+ Eterm* reg = erts_proc_sched_data((Proc))->x_reg_array; \
+ (Proc)->freason = (Reason); \
+ (Proc)->current = &(Bif)->info.mfa; \
+ reg[0] = (Eterm) (A0); \
+ reg[1] = (Eterm) (A1); \
+ return THE_NON_VALUE; \
+} while (0)
+
+#define ERTS_BIF_ERROR_TRAPPED3(Proc, Reason, Bif, A0, A1, A2) \
+do { \
+ Eterm* reg = erts_proc_sched_data((Proc))->x_reg_array; \
+ (Proc)->freason = (Reason); \
+ (Proc)->current = &(Bif)->info.mfa; \
+ reg[0] = (Eterm) (A0); \
+ reg[1] = (Eterm) (A1); \
+ reg[2] = (Eterm) (A2); \
+ return THE_NON_VALUE; \
+} while (0)
+
#define ERTS_BIF_PREP_ERROR(Ret, Proc, Reason) \
do { \
(Proc)->freason = (Reason); \
(Ret) = THE_NON_VALUE; \
} while (0)
+#define ERTS_BIF_PREP_ERROR_TRAPPED0(Ret, Proc, Reason, Bif) \
+do { \
+ (Proc)->freason = (Reason); \
+ (Proc)->current = &(Bif)->info.mfa; \
+ (Ret) = THE_NON_VALUE; \
+} while (0)
+
+#define ERTS_BIF_PREP_ERROR_TRAPPED1(Ret, Proc, Reason, Bif, A0) \
+do { \
+ Eterm* reg = erts_proc_sched_data((Proc))->x_reg_array; \
+ (Proc)->freason = (Reason); \
+ (Proc)->current = &(Bif)->info.mfa; \
+ reg[0] = (Eterm) (A0); \
+ (Ret) = THE_NON_VALUE; \
+} while (0)
+
+#define ERTS_BIF_PREP_ERROR_TRAPPED2(Ret, Proc, Reason, Bif, A0, A1) \
+do { \
+ Eterm* reg = erts_proc_sched_data((Proc))->x_reg_array; \
+ (Proc)->freason = (Reason); \
+ (Proc)->current = &(Bif)->info.mfa; \
+ reg[0] = (Eterm) (A0); \
+ reg[1] = (Eterm) (A1); \
+ (Ret) = THE_NON_VALUE; \
+} while (0)
+
+#define ERTS_BIF_PREP_ERROR_TRAPPED3(Ret, Proc, Reason, Bif, A0, A1, A2) \
+do { \
+ Eterm* reg = erts_proc_sched_data((Proc))->x_reg_array; \
+ (Proc)->freason = (Reason); \
+ (Proc)->current = &(Bif)->info.mfa; \
+ reg[0] = (Eterm) (A0); \
+ reg[1] = (Eterm) (A1); \
+ reg[2] = (Eterm) (A2); \
+ (Ret) = THE_NON_VALUE; \
+} while (0)
#define ERTS_BIF_PREP_TRAP0(Ret, Trap, Proc) \
do { \
@@ -141,7 +264,7 @@ do { \
#define ERTS_BIF_PREP_TRAP1(Ret, Trap, Proc, A0) \
do { \
- Eterm* reg = ERTS_PROC_GET_SCHDATA((Proc))->x_reg_array; \
+ Eterm* reg = erts_proc_sched_data((Proc))->x_reg_array; \
(Proc)->arity = 1; \
reg[0] = (Eterm) (A0); \
(Proc)->i = (BeamInstr*) ((Trap)->addressv[erts_active_code_ix()]); \
@@ -151,7 +274,7 @@ do { \
#define ERTS_BIF_PREP_TRAP2(Ret, Trap, Proc, A0, A1) \
do { \
- Eterm* reg = ERTS_PROC_GET_SCHDATA((Proc))->x_reg_array; \
+ Eterm* reg = erts_proc_sched_data((Proc))->x_reg_array; \
(Proc)->arity = 2; \
reg[0] = (Eterm) (A0); \
reg[1] = (Eterm) (A1); \
@@ -162,7 +285,7 @@ do { \
#define ERTS_BIF_PREP_TRAP3(Ret, Trap, Proc, A0, A1, A2) \
do { \
- Eterm* reg = ERTS_PROC_GET_SCHDATA((Proc))->x_reg_array; \
+ Eterm* reg = erts_proc_sched_data((Proc))->x_reg_array; \
(Proc)->arity = 3; \
reg[0] = (Eterm) (A0); \
reg[1] = (Eterm) (A1); \
@@ -174,7 +297,7 @@ do { \
#define ERTS_BIF_PREP_TRAP3_NO_RET(Trap, Proc, A0, A1, A2)\
do { \
- Eterm* reg = ERTS_PROC_GET_SCHDATA((Proc))->x_reg_array; \
+ Eterm* reg = erts_proc_sched_data((Proc))->x_reg_array; \
(Proc)->arity = 3; \
reg[0] = (Eterm) (A0); \
reg[1] = (Eterm) (A1); \
@@ -191,7 +314,7 @@ do { \
} while(0)
#define BIF_TRAP1(Trap_, p, A0) do { \
- Eterm* reg = ERTS_PROC_GET_SCHDATA((p))->x_reg_array; \
+ Eterm* reg = erts_proc_sched_data((p))->x_reg_array; \
(p)->arity = 1; \
reg[0] = (A0); \
(p)->i = (BeamInstr*) ((Trap_)->addressv[erts_active_code_ix()]); \
@@ -200,7 +323,7 @@ do { \
} while(0)
#define BIF_TRAP2(Trap_, p, A0, A1) do { \
- Eterm* reg = ERTS_PROC_GET_SCHDATA((p))->x_reg_array; \
+ Eterm* reg = erts_proc_sched_data((p))->x_reg_array; \
(p)->arity = 2; \
reg[0] = (A0); \
reg[1] = (A1); \
@@ -210,7 +333,7 @@ do { \
} while(0)
#define BIF_TRAP3(Trap_, p, A0, A1, A2) do { \
- Eterm* reg = ERTS_PROC_GET_SCHDATA((p))->x_reg_array; \
+ Eterm* reg = erts_proc_sched_data((p))->x_reg_array; \
(p)->arity = 3; \
reg[0] = (A0); \
reg[1] = (A1); \
@@ -234,37 +357,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))
@@ -392,6 +498,91 @@ erts_bif_prep_await_proc_exit_apply_trap(Process *c_p,
Eterm args[],
int nargs);
+#ifdef ERTS_DIRTY_SCHEDULERS
+int erts_call_dirty_bif(ErtsSchedulerData *esdp, Process *c_p,
+ BeamInstr *I, Eterm *reg);
+#endif
+
+BIF_RETTYPE
+erts_schedule_bif(Process *proc,
+ Eterm *argv,
+ BeamInstr *i,
+ ErtsBifFunc dbf,
+ ErtsSchedType sched_type,
+ Eterm mod,
+ Eterm func,
+ int argc);
+
+ERTS_GLB_INLINE BIF_RETTYPE
+erts_reschedule_bif(Process *proc,
+ Eterm *argv,
+ BeamInstr *i,
+ ErtsBifFunc dbf,
+ ErtsSchedType sched_type);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_INLINE BIF_RETTYPE
+erts_reschedule_bif(Process *proc,
+ Eterm *argv,
+ BeamInstr *i,
+ ErtsBifFunc dbf,
+ ErtsSchedType sched_type)
+{
+ return erts_schedule_bif(proc, argv, i, dbf, sched_type,
+ THE_NON_VALUE, THE_NON_VALUE, -1);
+}
+
+#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
+
+#ifdef ERL_WANT_HIPE_BIF_WRAPPER__
+
+#ifndef HIPE
+
+#define HIPE_WRAPPER_BIF_DISABLE_GC(BIF_NAME, ARITY)
+
+#else
+
+#include "erl_fun.h"
+#include "hipe_mode_switch.h"
+
+/*
+ * Hipe wrappers used by native code for BIFs that disable GC while trapping.
+ * Also add usage of the wrapper in ../hipe/hipe_bif_list.m4
+ *
+ * Problem:
+ * When native code calls a BIF that traps, hipe_mode_switch will push a
+ * "trap frame" on the Erlang stack in order to find its way back from beam_emu
+ * back to native caller when finally done. If GC is disabled and stack/heap
+ * is full there is no place to push the "trap frame".
+ *
+ * Solution:
+ * We reserve space on stack for the "trap frame" here before the BIF is called.
+ * If the BIF does not trap, the space is reclaimed here before returning.
+ * If the BIF traps, hipe_push_beam_trap_frame() will detect that a "trap frame"
+ * already is reserved and use it.
+ */
+
+
+#define HIPE_WRAPPER_BIF_DISABLE_GC(BIF_NAME, ARITY) \
+BIF_RETTYPE \
+nbif_impl_hipe_wrapper_ ## BIF_NAME ## _ ## ARITY (NBIF_ALIST); \
+BIF_RETTYPE \
+nbif_impl_hipe_wrapper_ ## BIF_NAME ## _ ## ARITY (NBIF_ALIST) \
+{ \
+ BIF_RETTYPE res; \
+ hipe_reserve_beam_trap_frame(BIF_P, BIF__ARGS, ARITY); \
+ res = nbif_impl_ ## BIF_NAME ## _ ## ARITY (NBIF_CALL_ARGS); \
+ if (is_value(res) || BIF_P->freason != TRAP) { \
+ hipe_unreserve_beam_trap_frame(BIF_P); \
+ } \
+ return res; \
+}
+
+#endif
+
+#endif /* ERL_WANT_HIPE_BIF_WRAPPER__ */
+
#include "erl_bif_table.h"
#endif
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index 2d888862bf..10ca0b5066 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -1,18 +1,19 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1996-2013. All Rights Reserved.
+# Copyright Ericsson AB 1996-2017. 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/.
+# 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
#
-# 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.
+# 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%
#
@@ -22,22 +23,24 @@
#
# Lines starting with '#' are ignored.
#
-# <bif-decl> ::= "bif" <bif> <C-name>* | "ubif" <bif> <C-name>*
+# <bif-decl> ::= "bif" <bif> <C-name>* |
+# "ubif" <bif> <C-name>* |
+# "gcbif" <bif> <C-name>*
# <bif> ::= <module> ":" <name> "/" <arity>
#
-# "ubif" is an unwrapped bif, i.e. a bif without a trace wrapper,
-# or rather; the trace entry point in the export entry is the same
-# as the normal entry point, and no trace wrapper is generated.
+# ubif: Use for operators and guard BIFs that never build anything
+# on the heap (such as tuple_size/1) and operators.
+#
+# gcbif: Use for guard BIFs that may build on the heap (such as abs/1).
#
-# Important: Use "ubif" for guard BIFs and operators; use "bif" for ordinary BIFs.
+# bif: Use for all other BIFs.
#
# Add new BIFs to the end of the file.
#
-# Note: Guards BIFs require special support in the compiler (to be able to actually
-# call them from within a guard).
+# Note: Guards BIFs usually require special support in the compiler.
#
-ubif erlang:abs/1
+gcbif erlang:abs/1
bif erlang:adler32/1
bif erlang:adler32/2
bif erlang:adler32_combine/3
@@ -45,6 +48,7 @@ bif erlang:apply/3
bif erlang:atom_to_list/1
bif erlang:binary_to_list/1
bif erlang:binary_to_list/3
+bif erlang:binary_to_term/1
bif erlang:crc32/1
bif erlang:crc32/2
bif erlang:crc32_combine/3
@@ -60,18 +64,16 @@ bif erlang:exit/1
bif erlang:exit/2
bif erlang:external_size/1
bif erlang:external_size/2
-ubif erlang:float/1
+gcbif erlang:float/1
bif erlang:float_to_list/1
bif erlang:float_to_list/2
bif erlang:fun_info/2
-bif erlang:garbage_collect/0
+bif erts_internal:garbage_collect/1
bif erlang:get/0
bif erlang:get/1
bif erlang:get_keys/1
bif erlang:group_leader/0
bif erlang:group_leader/2
-bif erlang:halt/0
-bif erlang:halt/1
bif erlang:halt/2
bif erlang:phash/2
bif erlang:phash2/1
@@ -79,18 +81,22 @@ bif erlang:phash2/2
ubif erlang:hd/1
bif erlang:integer_to_list/1
bif erlang:is_alive/0
-ubif erlang:length/1
+gcbif erlang:length/1
bif erlang:link/1
bif erlang:list_to_atom/1
bif erlang:list_to_binary/1
bif erlang:list_to_float/1
bif erlang:list_to_integer/1
bif erlang:list_to_pid/1
+bif erlang:list_to_port/1
+bif erlang:list_to_ref/1
bif erlang:list_to_tuple/1
bif erlang:loaded/0
bif erlang:localtime/0
bif erlang:localtime_to_universaltime/2
bif erlang:make_ref/0
+bif erlang:unique_integer/0
+bif erlang:unique_integer/1
bif erlang:md5/1
bif erlang:md5_init/0
bif erlang:md5_update/2
@@ -103,8 +109,15 @@ ubif erlang:node/1
ubif erlang:node/0
bif erlang:nodes/1
bif erlang:now/0
+bif erlang:monotonic_time/0
+bif erlang:monotonic_time/1
+bif erlang:system_time/0
+bif erlang:system_time/1
+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
@@ -114,14 +127,13 @@ 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
-ubif erlang:round/1
+gcbif erlang:round/1
ubif erlang:self/0
bif erlang:setelement/3
-ubif erlang:size/1
+gcbif erlang:size/1
bif erlang:spawn/3
bif erlang:spawn_link/3
bif erlang:split_binary/2
@@ -131,7 +143,7 @@ bif erlang:term_to_binary/2
bif erlang:throw/1
bif erlang:time/0
ubif erlang:tl/1
-ubif erlang:trunc/1
+gcbif erlang:trunc/1
bif erlang:tuple_to_list/1
bif erlang:universaltime/0
bif erlang:universaltime_to_localtime/1
@@ -151,21 +163,31 @@ bif erts_internal:port_command/3
bif erts_internal:port_control/3
bif erts_internal:port_close/1
bif erts_internal:port_connect/2
-bif erts_internal:binary_to_term/1
-bif erts_internal:binary_to_term/2
bif erts_internal:request_system_task/3
-bif erts_internal:check_process_code/2
+bif erts_internal:request_system_task/4
+bif erts_internal:check_process_code/1
+
+bif erts_internal:map_to_tuple_keys/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
+
+bif erts_internal:release_literal_area_switch/0
# inet_db support
bif erlang:port_set_data/2
bif erlang:port_get_data/1
# Tracing & debugging.
-bif erlang:trace_pattern/2
-bif erlang:trace_pattern/3
-bif erlang:trace/3
+bif erts_internal:trace_pattern/3
+bif erts_internal:trace/3
bif erlang:trace_info/2
bif erlang:trace_delivered/1
bif erlang:seq_trace/2
@@ -194,15 +216,20 @@ bif math:erf/1
bif math:erfc/1
bif math:exp/1
bif math:log/1
+bif math:log2/1
bif math:log10/1
bif math:sqrt/1
bif math:atan2/2
bif math:pow/2
bif erlang:start_timer/3
+bif erlang:start_timer/4
bif erlang:send_after/3
+bif erlang:send_after/4
bif erlang:cancel_timer/1
+bif erlang:cancel_timer/2
bif erlang:read_timer/1
+bif erlang:read_timer/2
bif erlang:make_tuple/2
bif erlang:append_element/2
@@ -299,7 +326,7 @@ bif erlang:match_spec_test/3
# Bifs in ets module.
#
-bif ets:all/0
+bif ets:internal_request_all/0
bif ets:new/2
bif ets:delete/1
bif ets:delete/2
@@ -335,6 +362,7 @@ bif ets:select_reverse/1
bif ets:select_reverse/2
bif ets:select_reverse/3
bif ets:select_delete/2
+bif ets:select_replace/2
bif ets:match_spec_compile/1
bif ets:match_spec_run_r/3
@@ -347,6 +375,9 @@ bif os:getenv/0
bif os:getenv/1
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)
@@ -363,6 +394,7 @@ bif erl_ddll:demonitor/1
#
# Bifs in the re module
#
+bif re:version/0
bif re:compile/1
bif re:compile/2
bif re:run/2
@@ -391,6 +423,9 @@ bif erts_debug:set_internal_state/2
bif erts_debug:display/1
bif erts_debug:dist_ext_to_term/2
bif erts_debug:instructions/0
+bif erts_debug:dirty_cpu/2
+bif erts_debug:dirty_io/2
+bif erts_debug:dirty/3
#
# Monitor testing bif's...
@@ -402,7 +437,10 @@ bif erts_debug:dump_links/1
#
# Lock counter bif's
#
-bif erts_debug:lock_counters/1
+bif erts_debug:lcnt_control/2
+bif erts_debug:lcnt_control/1
+bif erts_debug:lcnt_collect/0
+bif erts_debug:lcnt_clear/0
#
# New Bifs in R8.
@@ -426,8 +464,8 @@ bif error_logger:warning_map/0
bif erlang:get_module_info/1
bif erlang:get_module_info/2
ubif erlang:is_boolean/1
-bif string:to_integer/1
-bif string:to_float/1
+bif string:list_to_integer/1
+bif string:list_to_float/1
bif erlang:make_fun/3
bif erlang:iolist_size/1
bif erlang:iolist_to_binary/1
@@ -438,8 +476,8 @@ bif erlang:list_to_existing_atom/1
#
ubif erlang:is_bitstring/1
ubif erlang:tuple_size/1
-ubif erlang:byte_size/1
-ubif erlang:bit_size/1
+gcbif erlang:byte_size/1
+gcbif erlang:bit_size/1
bif erlang:list_to_bitstring/1
bif erlang:bitstring_to_list/1
@@ -480,14 +518,19 @@ bif erlang:call_on_load_function/1
bif erlang:finish_after_on_load/2
#
+# New Bifs in R13B04
+#
+bif erlang:binary_to_term/2
+
+#
# The binary match bifs (New in R14A - EEP9)
#
#
# The searching/splitting/substituting thingies
#
-ubif erlang:binary_part/2
-ubif erlang:binary_part/3
+gcbif erlang:binary_part/2
+gcbif erlang:binary_part/3
bif binary:compile_pattern/1
bif binary:match/2
@@ -573,13 +616,13 @@ bif io:printable_range/0
bif os:unsetenv/1
#
-# New in R17A
+# New in 17.0
#
bif re:inspect/2
ubif erlang:is_map/1
-ubif erlang:map_size/1
+gcbif erlang:map_size/1
bif maps:to_list/1
bif maps:find/2
bif maps:get/2
@@ -595,8 +638,50 @@ bif maps:values/1
bif erts_internal:cmp_term/2
+bif ets:take/2
+
+#
+# New in 17.1
+#
+
+bif erlang:fun_info_mfa/1
+
+# New in 18.0
+#
+
+bif erlang:get_keys/0
+bif ets:update_counter/4
+bif erts_debug:map_info/1
+
+#
+# New in 19.0
+#
+
+bif erts_internal:is_process_executing_dirty/1
+bif erts_internal:check_dirty_process_code/2
+bif erts_internal:purge_module/2
+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
+
+bif maps:take/2
+
+#
+# New in 20.0
+#
+
+gcbif erlang:floor/1
+gcbif erlang:ceil/1
+bif math:floor/1
+bif math:ceil/1
+bif math:fmod/2
+bif os:set_signal/2
+bif erts_internal:maps_to_list/2
+
#
-# Obsolete
+# New in 20.1
#
-bif erlang:hash/2
+bif erlang:iolist_to_iovec/1
diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c
index 41a041eba6..5eaf262cd8 100644
--- a/erts/emulator/beam/big.c
+++ b/erts/emulator/beam/big.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2014. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -47,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 */
@@ -274,7 +275,9 @@
_b = _b << _s; \
_vn1 = _b >> H_EXP; \
_vn0 = _b & LO_MASK; \
- _un32 = (_a1 << _s) | ((_a0>>(D_EXP-_s)) & (-_s >> (D_EXP-1))); \
+ /* If needed to avoid undefined behaviour */ \
+ if (_s) _un32 = (_a1 << _s) | ((_a0>>(D_EXP-_s)) & (-_s >> (D_EXP-1))); \
+ else _un32 = _a1; \
_un10 = _a0 << _s; \
_un1 = _un10 >> H_EXP; \
_un0 = _un10 & LO_MASK; \
@@ -420,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
*/
@@ -1271,8 +1293,11 @@ static dsize_t I_bxor(ErtsDigit* x, dsize_t xl, short xsgn,
*r++ = ~c ^ *y++;
x++;
}
- while(xl--)
- *r++ = ~*x++;
+ while(xl--) {
+ DSUBb(*x,0,b,c);
+ *r++ = ~c;
+ x++;
+ }
}
else {
ErtsDigit b1, b2;
@@ -1290,7 +1315,9 @@ static dsize_t I_bxor(ErtsDigit* x, dsize_t xl, short xsgn,
x++; y++;
}
while(xl--) {
- *r++ = *x++;
+ DSUBb(*x,0,b1,c1);
+ *r++ = c1;
+ x++;
}
}
}
@@ -1484,20 +1511,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);
}
@@ -1506,13 +1521,15 @@ Eterm uword_to_big(UWord x, Eterm *y)
*/
Eterm small_to_big(Sint x, Eterm *y)
{
+ Uint xu;
if (x >= 0) {
+ xu = x;
*y = make_pos_bignum_header(1);
} else {
- x = -x;
+ xu = -(Uint)x;
*y = make_neg_bignum_header(1);
}
- BIG_DIGIT(y, 0) = x;
+ BIG_DIGIT(y, 0) = xu;
return make_big(y);
}
@@ -1520,7 +1537,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));
@@ -1540,21 +1557,24 @@ Eterm erts_uint64_to_big(Uint64 x, Eterm **hpp)
Eterm erts_sint64_to_big(Sint64 x, Eterm **hpp)
{
Eterm *hp = *hpp;
+ Uint64 ux;
int neg;
- if (x >= 0)
+ if (x >= 0) {
neg = 0;
+ ux = x;
+ }
else {
neg = 1;
- x = -x;
+ ux = -(Uint64)x;
}
-#if defined(ARCH_32) || HALFWORD_HEAP
- if (x >= (((Uint64) 1) << 32)) {
+#if defined(ARCH_32)
+ if (ux >= (((Uint64) 1) << 32)) {
if (neg)
*hp = make_neg_bignum_header(2);
else
*hp = make_pos_bignum_header(2);
- BIG_DIGIT(hp, 0) = (Uint) (x & ((Uint) 0xffffffff));
- BIG_DIGIT(hp, 1) = (Uint) ((x >> 32) & ((Uint) 0xffffffff));
+ BIG_DIGIT(hp, 0) = (Uint) (ux & ((Uint) 0xffffffff));
+ BIG_DIGIT(hp, 1) = (Uint) ((ux >> 32) & ((Uint) 0xffffffff));
*hpp += 3;
}
else
@@ -1564,12 +1584,52 @@ Eterm erts_sint64_to_big(Sint64 x, Eterm **hpp)
*hp = make_neg_bignum_header(1);
else
*hp = make_pos_bignum_header(1);
- BIG_DIGIT(hp, 0) = (Uint) x;
+ BIG_DIGIT(hp, 0) = (Uint) ux;
*hpp += 2;
}
return make_big(hp);
}
+Eterm
+erts_uint64_array_to_big(Uint **hpp, int neg, int len, Uint64 *array)
+{
+ Uint *headerp;
+ int i, pot_digits, digits;
+
+ headerp = *hpp;
+
+ pot_digits = digits = 0;
+ for (i = 0; i < len; i++) {
+#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;
+ pot_digits++;
+ if (low_val)
+ digits = pot_digits;
+ BIG_DIGIT(headerp, pot_digits) = high_val;
+ pot_digits++;
+ if (high_val)
+ digits = pot_digits;
+#else
+ Uint val = array[i];
+ BIG_DIGIT(headerp, pot_digits) = val;
+ pot_digits++;
+ if (val)
+ digits = pot_digits;
+#endif
+ }
+
+ if (neg)
+ *headerp = make_neg_bignum_header(digits);
+ else
+ *headerp = make_pos_bignum_header(digits);
+
+ *hpp = headerp + 1 + digits;
+
+ return make_big(headerp);
+}
+
/*
** Convert a bignum to a double float
*/
@@ -1603,8 +1663,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)
@@ -1635,7 +1693,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);
@@ -1685,8 +1743,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++;
@@ -1704,7 +1764,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++;
@@ -1712,7 +1772,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;
@@ -1893,6 +1953,8 @@ Eterm bytes_to_big(byte *xp, dsize_t xsz, int xsgn, Eterm *r)
*rwp = d;
rwp++;
}
+ if (rsz > BIG_ARITY_MAX)
+ return NIL;
if (xsgn) {
*r = make_neg_bignum_header(rsz);
}
@@ -1978,6 +2040,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)
{
@@ -2183,21 +2271,6 @@ Eterm big_minus(Eterm x, Eterm y, Eterm *r)
}
/*
-** Subtract a digit from big number
-*/
-Eterm big_minus_small(Eterm x, Eterm y, Eterm *r)
-{
- Eterm* xp = big_val(x);
-
- if (BIG_SIGN(xp))
- return big_norm(r, D_add(BIG_V(xp),BIG_SIZE(xp), (ErtsDigit) y, BIG_V(r)),
- (short) BIG_SIGN(xp));
- else
- return big_norm(r, D_sub(BIG_V(xp),BIG_SIZE(xp), (ErtsDigit) y, BIG_V(r)),
- (short) BIG_SIGN(xp));
-}
-
-/*
** Multiply smallnums
*/
@@ -2329,16 +2402,6 @@ Eterm big_rem(Eterm x, Eterm y, Eterm *r)
}
}
-Eterm big_neg(Eterm x, Eterm *r)
-{
- Eterm* xp = big_val(x);
- dsize_t xsz = BIG_SIZE(xp);
- short xsgn = BIG_SIGN(xp);
-
- MOVE_DIGITS(BIG_V(r), BIG_V(xp), xsz);
- return big_norm(r, xsz, (short) !xsgn);
-}
-
Eterm big_band(Eterm x, Eterm y, Eterm *r)
{
Eterm* xp = big_val(x);
@@ -2486,63 +2549,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))))));
+}
-#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])
+static ERTS_INLINE byte c2int_digit_from_base(byte ch) {
+ return ch <= '9' ? ch - '0'
+ : (10 + (ch <= 'Z' ? ch - 'A' : ch - 'a'));
+}
/*
- * 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 bits are needed to store 1 digit of given base in binary
+ * Wo.Alpha formula: Table [log2[n], {n,2,36}]
*/
-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 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
- * 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 a signed int (Sint) for given base, we take
+ * one digit away just to be on the safer side (some corner cases).
*/
-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_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_base_lookup[i-2] = pow(i,d_base_exp_lookup[i-2]);
- * end
- * How much can the characters which fit in 31 bit represent
+ * How many digits can fit into Erlang Small (SMALL_BITS-1) counting sign bit
*/
-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 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
+};
+
+/*
+ * 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.
+ */
+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) {
@@ -2552,8 +2652,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;
@@ -2568,55 +2671,69 @@ Eterm erts_chars_to_integer(Process *BIF_P, char *bytes,
size--;
}
- 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++;
+ /* 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 (b < '0' || b > ('0'+base-1))
- goto bytebuf_to_integer_1_error;
+ if (size == 0)
+ goto bytebuf_to_integer_1_error;
- i = i * base + b - '0';
- }
+ 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 (neg)
- i = -i;
- res = make_small(i);
- goto bytebuf_to_integer_1_done;
- }
+ if (b < '0' || b > ('0'+base-1))
+ goto bytebuf_to_integer_1_error;
- /*
- * Calculate the maximum number of bits which will
- * be needed to represent the binary
- */
- lg2 = ((size+2)*LG2_LOOKUP(base)+1);
+ i = i * base + b - '0';
+ }
- 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 (neg)
+ i = -i;
+ res = make_small(i);
+ goto bytebuf_to_integer_1_done;
+ }
- if (IS_VALID_CHARACTER(b,base))
- goto bytebuf_to_integer_1_error;
+ /* Take shortcut if we know it will fit in a small.
+ * This improves speed by about 30%.
+ */
+ while (size) {
+ b = *bytes++;
+ size--;
- i = i * base + CHARACTER_FROM_BASE(b);
+ if (c2int_is_invalid_char(b, base))
+ goto bytebuf_to_integer_1_error;
- }
-
- if (neg)
- i = -i;
- res = make_small(i);
- goto bytebuf_to_integer_1_done;
+ 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)*lookup_log2(base)+1);
+
/* Start calculating bignum */
m = (lg2 + D_EXP-1)/D_EXP;
m = BIG_NEED_SIZE(m);
@@ -2624,8 +2741,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;
@@ -2633,43 +2750,40 @@ 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);
}
res = big_plus_small(res, m, hp);
}
- if (is_big(res)) /* check if small */
- res = big_plus_small(res, 0, hp); /* includes conversion to small */
-
if (neg) {
if (is_small(res))
res = make_small(-signed_val(res));
@@ -2679,8 +2793,12 @@ Eterm erts_chars_to_integer(Process *BIF_P, char *bytes,
}
}
- if (is_big(res)) {
- hp += (big_arity(res) + 1);
+ 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);
goto bytebuf_to_integer_1_done;
@@ -2690,5 +2808,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 d80111822e..48efce20e7 100644
--- a/erts/emulator/beam/big.h
+++ b/erts/emulator/beam/big.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2014. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -20,21 +21,12 @@
#ifndef __BIG_H__
#define __BIG_H__
-#ifndef __SYS_H__
#include "sys.h"
-#endif
-
-#ifndef __CONFIG_H__
-#include "erl_vm.h"
-#endif
-
-#ifndef __GLOBAL_H__
#include "global.h"
-#endif
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;
@@ -53,9 +45,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)
@@ -85,25 +74,25 @@ typedef Uint dsize_t; /* Vector size type */
/* The heap size needed for a bignum */
#define BIG_NEED_SIZE(x) ((x) + 1)
+#define BIG_NEED_FOR_BITS(bits) BIG_NEED_SIZE(((bits)-1)/D_EXP + 1)
#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))
#define ERTS_SINT64_HEAP_SIZE(X) \
(IS_SSMALL((X)) \
? 0 \
- : ERTS_UINT64_BIG_HEAP_SIZE__((X) >= 0 ? (X) : -(X)))
+ : ERTS_UINT64_BIG_HEAP_SIZE__((X) >= 0 ? (X) : -(Uint64)(X)))
#define ERTS_UINT64_HEAP_SIZE(X) \
(IS_USMALL(0, (X)) ? 0 : ERTS_UINT64_BIG_HEAP_SIZE__((X)))
+#define ERTS_MAX_SINT64_HEAP_SIZE (1 + 2)
+#define ERTS_MAX_UINT64_HEAP_SIZE (1 + 2)
+#define ERTS_UINT64_ARRAY_TO_BIG_MAX_HEAP_SZ(LEN) (2*(LEN)+1)
#else
@@ -111,6 +100,9 @@ typedef Uint dsize_t; /* Vector size type */
(IS_SSMALL((X)) ? 0 : (1 + 1))
#define ERTS_UINT64_HEAP_SIZE(X) \
(IS_USMALL(0, (X)) ? 0 : (1 + 1))
+#define ERTS_MAX_SINT64_HEAP_SIZE (1 + 1)
+#define ERTS_MAX_UINT64_HEAP_SIZE (1 + 1)
+#define ERTS_UINT64_ARRAY_TO_BIG_MAX_HEAP_SZ(LEN) ((LEN)+1)
#endif
@@ -126,9 +118,7 @@ Eterm big_minus(Eterm, Eterm, Eterm*);
Eterm big_times(Eterm, Eterm, Eterm*);
Eterm big_div(Eterm, Eterm, Eterm*);
Eterm big_rem(Eterm, Eterm, Eterm*);
-Eterm big_neg(Eterm, Eterm*);
-Eterm big_minus_small(Eterm, Uint, Eterm*);
Eterm big_plus_small(Eterm, Uint, Eterm*);
Eterm big_times_small(Eterm, Uint, Eterm*);
@@ -153,9 +143,11 @@ 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
+Eterm erts_uint64_array_to_big(Uint **, int, int, Uint64 *);
int term_to_Uint64(Eterm, Uint64*);
int term_to_Sint64(Eterm, Sint64*);
#endif
@@ -168,5 +160,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 c7926f18af..ca3e48e205 100644
--- a/erts/emulator/beam/binary.c
+++ b/erts/emulator/beam/binary.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -26,29 +27,37 @@
#include "global.h"
#include "erl_process.h"
#include "error.h"
+#define ERL_WANT_HIPE_BIF_WRAPPER__
#include "bif.h"
+#undef ERL_WANT_HIPE_BIF_WRAPPER__
#include "big.h"
#include "erl_binary.h"
#include "erl_bits.h"
-#ifdef DEBUG
-static int list_to_bitstr_buf(Eterm obj, char* buf, Uint len);
-#else
-static int list_to_bitstr_buf(Eterm obj, char* buf);
-#endif
-static int bitstr_list_len(Eterm obj, Uint* num_bytes);
+#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;
+
+static BIF_RETTYPE binary_to_list_continue(BIF_ALIST_1);
+static BIF_RETTYPE list_to_binary_continue(BIF_ALIST_1);
void
erts_init_binary(void)
{
/* Verify Binary alignment... */
- 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,
- "Internal error: Address of orig_bytes[0] of a Binary"
- " is *not* 8-byte aligned\n");
- }
+ ERTS_CT_ASSERT((offsetof(Binary,orig_bytes) % 8) == 0);
+ ERTS_CT_ASSERT((offsetof(ErtsMagicBinary,u.aligned.data) % 8) == 0);
+
+ erts_init_trap_export(&binary_to_list_continue_export,
+ am_erts_internal, am_binary_to_list_continue, 1,
+ &binary_to_list_continue);
+
+ erts_init_trap_export(&list_to_binary_continue_export,
+ am_erts_internal, am_list_to_binary_continue, 1,
+ &list_to_binary_continue);
+
}
/*
@@ -75,9 +84,6 @@ new_binary(Process *p, byte *buf, Uint len)
* Allocate the binary struct itself.
*/
bptr = erts_bin_nrml_alloc(len);
- bptr->flags = 0;
- bptr->orig_size = len;
- erts_refc_init(&bptr->refc, 1);
if (buf != NULL) {
sys_memcpy(bptr->orig_bytes, buf, len);
}
@@ -95,7 +101,7 @@ new_binary(Process *p, byte *buf, Uint len)
pb->flags = 0;
/*
- * Miscellanous updates. Return the tagged binary.
+ * Miscellaneous updates. Return the tagged binary.
*/
OH_OVERHEAD(&(MSO(p)), pb->size / sizeof(Eterm));
return make_binary(pb);
@@ -105,7 +111,7 @@ new_binary(Process *p, byte *buf, Uint len)
* When heap binary is not desired...
*/
-Eterm erts_new_mso_binary(Process *p, byte *buf, int len)
+Eterm erts_new_mso_binary(Process *p, byte *buf, Uint len)
{
ProcBin* pb;
Binary* bptr;
@@ -114,9 +120,6 @@ Eterm erts_new_mso_binary(Process *p, byte *buf, int len)
* Allocate the binary struct itself.
*/
bptr = erts_bin_nrml_alloc(len);
- bptr->flags = 0;
- bptr->orig_size = len;
- erts_refc_init(&bptr->refc, 1);
if (buf != NULL) {
sys_memcpy(bptr->orig_bytes, buf, len);
}
@@ -134,7 +137,7 @@ Eterm erts_new_mso_binary(Process *p, byte *buf, int len)
pb->flags = 0;
/*
- * Miscellanous updates. Return the tagged binary.
+ * Miscellaneous updates. Return the tagged binary.
*/
OH_OVERHEAD(&(MSO(p)), pb->size / sizeof(Eterm));
return make_binary(pb);
@@ -169,7 +172,6 @@ erts_realloc_binary(Eterm bin, size_t size)
} else { /* REFC */
ProcBin* pb = (ProcBin *) bval;
Binary* newbin = erts_bin_realloc(pb->val, size);
- newbin->orig_size = size;
pb->val = newbin;
pb->size = size;
pb->bytes = (byte*) newbin->orig_bytes;
@@ -333,6 +335,132 @@ BIF_RETTYPE integer_to_binary_1(BIF_ALIST_1)
BIF_RET(res);
}
+#define ERTS_B2L_BYTES_PER_REDUCTION 256
+
+typedef struct {
+ Eterm res;
+ Eterm *hp;
+#ifdef DEBUG
+ Eterm *hp_end;
+#endif
+ byte *bytes;
+ Uint size;
+ Uint bitoffs;
+} ErtsB2LState;
+
+static int b2l_state_destructor(Binary *mbp)
+{
+ ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(mbp) == b2l_state_destructor);
+ return 1;
+}
+
+static BIF_RETTYPE
+binary_to_list_chunk(Process *c_p,
+ Eterm mb_eterm,
+ ErtsB2LState* sp,
+ int reds_left,
+ int gc_disabled)
+{
+ BIF_RETTYPE ret;
+ int bump_reds;
+ Uint size;
+ byte *bytes;
+
+ size = (reds_left + 1)*ERTS_B2L_BYTES_PER_REDUCTION;
+ if (size > sp->size)
+ size = sp->size;
+ bytes = sp->bytes + (sp->size - size);
+
+ bump_reds = (size - 1)/ERTS_B2L_BYTES_PER_REDUCTION + 1;
+ BUMP_REDS(c_p, bump_reds);
+
+ ASSERT(is_list(sp->res) || is_nil(sp->res));
+
+ sp->res = erts_bin_bytes_to_list(sp->res,
+ sp->hp,
+ bytes,
+ size,
+ sp->bitoffs);
+ sp->size -= size;
+ sp->hp += 2*size;
+
+ if (sp->size > 0) {
+
+ if (!gc_disabled)
+ erts_set_gc_state(c_p, 0);
+
+ ASSERT(c_p->flags & F_DISABLE_GC);
+ ASSERT(is_value(mb_eterm));
+ ERTS_BIF_PREP_TRAP1(ret,
+ &binary_to_list_continue_export,
+ c_p,
+ mb_eterm);
+ }
+ else {
+
+ ASSERT(sp->hp == sp->hp_end);
+ ASSERT(sp->size == 0);
+
+ if (!gc_disabled || !erts_set_gc_state(c_p, 1))
+ ERTS_BIF_PREP_RET(ret, sp->res);
+ else
+ ERTS_BIF_PREP_YIELD_RETURN(ret, c_p, sp->res);
+ ASSERT(!(c_p->flags & F_DISABLE_GC));
+ }
+
+ return ret;
+}
+
+static ERTS_INLINE BIF_RETTYPE
+binary_to_list(Process *c_p, Eterm *hp, Eterm tail, byte *bytes,
+ Uint size, Uint bitoffs, int reds_left, int one_chunk)
+{
+ if (one_chunk) {
+ Eterm res;
+ BIF_RETTYPE ret;
+ int bump_reds = (size - 1)/ERTS_B2L_BYTES_PER_REDUCTION + 1;
+ BUMP_REDS(c_p, bump_reds);
+ res = erts_bin_bytes_to_list(tail, hp, bytes, size, bitoffs);
+ ERTS_BIF_PREP_RET(ret, res);
+ return ret;
+ }
+ else {
+ Binary *mbp = erts_create_magic_binary(sizeof(ErtsB2LState),
+ b2l_state_destructor);
+ ErtsB2LState *sp = ERTS_MAGIC_BIN_DATA(mbp);
+ Eterm mb;
+
+ sp->res = tail;
+ sp->hp = hp;
+#ifdef DEBUG
+ sp->hp_end = sp->hp + 2*size;
+#endif
+ sp->bytes = bytes;
+ sp->size = size;
+ sp->bitoffs = bitoffs;
+
+ hp = HAlloc(c_p, ERTS_MAGIC_REF_THING_SIZE);
+ mb = erts_mk_magic_ref(&hp, &MSO(c_p), mbp);
+ return binary_to_list_chunk(c_p, mb, sp, reds_left, 0);
+ }
+}
+
+static BIF_RETTYPE binary_to_list_continue(BIF_ALIST_1)
+{
+ Binary *mbp = erts_magic_ref2bin(BIF_ARG_1);
+
+ ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(mbp) == b2l_state_destructor);
+ ASSERT(BIF_P->flags & F_DISABLE_GC);
+
+ return binary_to_list_chunk(BIF_P,
+ BIF_ARG_1,
+ (ErtsB2LState*) ERTS_MAGIC_BIN_DATA(mbp),
+ ERTS_BIF_REDS_LEFT(BIF_P),
+ 1);
+}
+
+HIPE_WRAPPER_BIF_DISABLE_GC(binary_to_list, 1)
+
BIF_RETTYPE binary_to_list_1(BIF_ALIST_1)
{
Eterm real_bin;
@@ -340,11 +468,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;
@@ -354,14 +500,16 @@ BIF_RETTYPE binary_to_list_1(BIF_ALIST_1)
} else {
Eterm* hp = HAlloc(BIF_P, 2 * size);
byte* bytes = binary_bytes(real_bin)+offset;
-
- BIF_RET(erts_bin_bytes_to_list(NIL, hp, bytes, size, bitoffs));
+ return binary_to_list(BIF_P, hp, NIL, bytes, size,
+ bitoffs, reds_left, one_chunk);
}
error:
BIF_ERROR(BIF_P, BADARG);
}
+HIPE_WRAPPER_BIF_DISABLE_GC(binary_to_list, 3)
+
BIF_RETTYPE binary_to_list_3(BIF_ALIST_3)
{
byte* bytes;
@@ -372,6 +520,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;
@@ -380,6 +530,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 ) {
@@ -387,12 +552,14 @@ BIF_RETTYPE binary_to_list_3(BIF_ALIST_3)
}
i = stop-start+1;
hp = HAlloc(BIF_P, 2*i);
- BIF_RET(erts_bin_bytes_to_list(NIL, hp, 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);
}
+HIPE_WRAPPER_BIF_DISABLE_GC(bitstring_to_list, 1)
+
BIF_RETTYPE bitstring_to_list_1(BIF_ALIST_1)
{
Eterm real_bin;
@@ -403,11 +570,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) {
@@ -431,124 +614,453 @@ BIF_RETTYPE bitstring_to_list_1(BIF_ALIST_1)
previous = CONS(hp, make_binary(last), previous);
hp += 2;
}
- BIF_RET(erts_bin_bytes_to_list(previous, hp, bytes, size, bitoffs));
+
+ return binary_to_list(BIF_P, hp, previous, bytes, size,
+ bitoffs, reds_left, one_chunk);
}
/* Turn a possibly deep list of ints (and binaries) into */
/* One large binary object */
-/*
- * This bif also exists in the binary module, under the name
- * binary:list_to_bin/1, why it's divided into interface and
- * implementation. Also the backend for iolist_to_binary_1.
- */
+typedef enum {
+ ERTS_L2B_OK,
+ ERTS_L2B_YIELD,
+ ERTS_L2B_TYPE_ERROR,
+ ERTS_L2B_OVERFLOW_ERROR
+} ErtsL2BResult;
-BIF_RETTYPE erts_list_to_binary_bif(Process *p, Eterm arg)
-{
+#define ERTS_L2B_STATE_INITER(C_P, ARG, BIF, SZFunc, TBufFunc) \
+ {ERTS_IOLIST2BUF_STATE_INITER((C_P), (ARG)), \
+ (ARG), THE_NON_VALUE, (BIF), (SZFunc), (TBufFunc)}
+
+#define ERTS_L2B_STATE_MOVE(TO, FROM) \
+ sys_memcpy((void *) (TO), (void *) (FROM), sizeof(ErtsL2BState))
+
+typedef struct ErtsL2BState_ ErtsL2BState;
+
+struct ErtsL2BState_ {
+ ErtsIOList2BufState buf;
+ Eterm arg;
Eterm bin;
- Eterm h,t;
- ErlDrvSizeT size;
- byte* bytes;
-#ifdef DEBUG
- ErlDrvSizeT offset;
-#endif
+ Export *bif;
+ int (*iolist_to_buf_size)(ErtsIOListState *);
+ ErlDrvSizeT (*iolist_to_buf)(ErtsIOList2BufState *);
+};
+
+static ERTS_INLINE ErtsL2BResult
+list_to_binary_engine(ErtsL2BState *sp)
+{
+ ErlDrvSizeT res;
+ Process *c_p = sp->buf.iolist.c_p;
+
+ /*
+ * have_size == 0 while sp->iolist_to_buf_size()
+ * has not finished the calculation.
+ */
+
+ if (!sp->buf.iolist.have_size) {
+ switch (sp->iolist_to_buf_size(&sp->buf.iolist)) {
+ case ERTS_IOLIST_YIELD:
+ return ERTS_L2B_YIELD;
+ case ERTS_IOLIST_OVERFLOW:
+ return ERTS_L2B_OVERFLOW_ERROR;
+ case ERTS_IOLIST_TYPE:
+ return ERTS_L2B_TYPE_ERROR;
+ case ERTS_IOLIST_OK:
+ break;
+ default:
+ ASSERT(0);
+ break;
+ }
+
+ ASSERT(sp->buf.iolist.have_size);
+
+ /*
+ * Size calculated... Setup state for
+ * sp->iolist_to_buf_*()
+ */
+
+ sp->bin = new_binary(c_p,
+ (byte *) NULL,
+ sp->buf.iolist.size);
+
+ if (sp->buf.iolist.size == 0)
+ return ERTS_L2B_OK;
+
+ sp->buf.buf = (char *) binary_bytes(sp->bin);
+ sp->buf.len = sp->buf.iolist.size;
+ sp->buf.iolist.obj = sp->arg;
- if (is_nil(arg)) {
- BIF_RET(new_binary(p,(byte*)"",0));
+ if (sp->buf.iolist.reds_left <= 0) {
+ BUMP_ALL_REDS(c_p);
+ return ERTS_L2B_YIELD;
+ }
}
- if (is_not_list(arg)) {
- goto error;
+
+ ASSERT(sp->buf.iolist.size != 0);
+ ASSERT(is_value(sp->bin));
+ ASSERT(sp->buf.buf);
+
+ res = sp->iolist_to_buf(&sp->buf);
+
+ if (!ERTS_IOLIST_TO_BUF_FAILED(res)) {
+ ASSERT(res == 0);
+ return ERTS_L2B_OK;
}
- /* check for [binary()] case */
- h = CAR(list_val(arg));
- t = CDR(list_val(arg));
- if (is_binary(h) && is_nil(t) && !(
- HEADER_SUB_BIN == *(binary_val(h)) && (
- ((ErlSubBin *)binary_val(h))->bitoffs != 0 ||
- ((ErlSubBin *)binary_val(h))->bitsize != 0
- ))) {
- return h;
- }
- switch (erts_iolist_size(arg, &size)) {
- case ERTS_IOLIST_OVERFLOW: BIF_ERROR(p, SYSTEM_LIMIT);
- case ERTS_IOLIST_TYPE: goto error;
- default: ;
- }
- bin = new_binary(p, (byte *)NULL, size);
- bytes = binary_bytes(bin);
-#ifdef DEBUG
- offset =
-#endif
- erts_iolist_to_buf(arg, (char*) bytes, size);
- ASSERT(offset == 0);
- BIF_RET(bin);
+ switch (res) {
+ case ERTS_IOLIST_TO_BUF_YIELD:
+ return ERTS_L2B_YIELD;
+ case ERTS_IOLIST_TO_BUF_OVERFLOW:
+ return ERTS_L2B_OVERFLOW_ERROR;
+ case ERTS_IOLIST_TO_BUF_TYPE_ERROR:
+ return ERTS_L2B_TYPE_ERROR;
+ default:
+ ERTS_INTERNAL_ERROR("Invalid return value from iolist_to_buf_yielding()");
+ return ERTS_L2B_TYPE_ERROR;
+ }
+}
+
+static int
+l2b_state_destructor(Binary *mbp)
+{
+ ErtsL2BState *sp = ERTS_MAGIC_BIN_DATA(mbp);
+ ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(mbp) == l2b_state_destructor);
+ DESTROY_SAVED_ESTACK(&sp->buf.iolist.estack);
+ return 1;
+}
+
+static ERTS_INLINE Eterm
+l2b_final_touch(Process *c_p, ErtsL2BState *sp)
+{
+ Eterm *hp;
+ ErlSubBin* sbin;
+ if (sp->buf.offset == 0)
+ return sp->bin;
+
+ hp = HAlloc(c_p, ERL_SUB_BIN_SIZE);
+ ASSERT(sp->buf.offset > 0);
+ sbin = (ErlSubBin *) hp;
+ sbin->thing_word = HEADER_SUB_BIN;
+ sbin->size = sp->buf.iolist.size-1;
+ sbin->offs = 0;
+ sbin->orig = sp->bin;
+ sbin->bitoffs = 0;
+ sbin->bitsize = sp->buf.offset;
+ sbin->is_writable = 0;
+ return make_binary(sbin);
+}
+
+static BIF_RETTYPE
+list_to_binary_chunk(Eterm mb_eterm,
+ ErtsL2BState* sp,
+ int reds_left,
+ int gc_disabled)
+{
+ Eterm err = BADARG;
+ BIF_RETTYPE ret;
+ Process *c_p = sp->buf.iolist.c_p;
+
+ sp->buf.iolist.reds_left = reds_left;
- error:
- BIF_ERROR(p, BADARG);
+ switch (list_to_binary_engine(sp)) {
+
+ case ERTS_L2B_OK: {
+ Eterm result = l2b_final_touch(c_p, sp);
+ if (!gc_disabled || !erts_set_gc_state(c_p, 1))
+ ERTS_BIF_PREP_RET(ret, result);
+ else
+ ERTS_BIF_PREP_YIELD_RETURN(ret, c_p, result);
+ ASSERT(!(c_p->flags & F_DISABLE_GC));
+ break;
+ }
+ case ERTS_L2B_YIELD:
+ if (!gc_disabled) {
+ /* first yield... */
+ Eterm *hp;
+ Binary *mbp = erts_create_magic_binary(sizeof(ErtsL2BState),
+ l2b_state_destructor);
+ ErtsL2BState *new_sp = ERTS_MAGIC_BIN_DATA(mbp);
+
+ ERTS_L2B_STATE_MOVE(new_sp, sp);
+ sp = new_sp;
+
+ hp = HAlloc(c_p, ERTS_MAGIC_REF_THING_SIZE);
+ mb_eterm = erts_mk_magic_ref(&hp, &MSO(c_p), mbp);
+
+ ASSERT(is_value(mb_eterm));
+
+ erts_set_gc_state(c_p, 0);
+ }
+
+ ASSERT(c_p->flags & F_DISABLE_GC);
+
+ ERTS_BIF_PREP_TRAP1(ret,
+ &list_to_binary_continue_export,
+ c_p,
+ mb_eterm);
+ break;
+
+ case ERTS_L2B_OVERFLOW_ERROR:
+ err = SYSTEM_LIMIT;
+ /* fall through */
+
+ case ERTS_L2B_TYPE_ERROR:
+ if (!gc_disabled)
+ ERTS_BIF_PREP_ERROR(ret, c_p, err);
+ else {
+ if (erts_set_gc_state(c_p, 1))
+ ERTS_VBUMP_ALL_REDS(c_p);
+
+ ERTS_BIF_PREP_ERROR_TRAPPED1(ret,
+ c_p,
+ err,
+ sp->bif,
+ sp->arg);
+ }
+
+ ASSERT(!(c_p->flags & F_DISABLE_GC));
+ break;
+
+ default:
+ ERTS_INTERNAL_ERROR("Invalid return value from list_to_binary_engine()");
+ ERTS_BIF_PREP_ERROR(ret,c_p, EXC_INTERNAL_ERROR);
+ break;
+ }
+ return ret;
+}
+
+static BIF_RETTYPE list_to_binary_continue(BIF_ALIST_1)
+{
+ Binary *mbp = erts_magic_ref2bin(BIF_ARG_1);
+
+ ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(mbp) == l2b_state_destructor);
+ ASSERT(BIF_P->flags & F_DISABLE_GC);
+
+ return list_to_binary_chunk(BIF_ARG_1,
+ ERTS_MAGIC_BIN_DATA(mbp),
+ ERTS_BIF_REDS_LEFT(BIF_P),
+ 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))
+ ERTS_BIF_PREP_ERROR(ret, c_p, BADARG);
+ else {
+ /* check for [binary()] case */
+ Eterm h = CAR(list_val(arg));
+ Eterm t = CDR(list_val(arg));
+ if (is_binary(h)
+ && is_nil(t)
+ && !(HEADER_SUB_BIN == *(binary_val(h))
+ && (((ErlSubBin *)binary_val(h))->bitoffs != 0
+ || ((ErlSubBin *)binary_val(h))->bitsize != 0))) {
+ ERTS_BIF_PREP_RET(ret, h);
+ }
+ else {
+ ErtsL2BState state = ERTS_L2B_STATE_INITER(c_p,
+ arg,
+ bif,
+ erts_iolist_size_yielding,
+ erts_iolist_to_buf_yielding);
+
+ /*
+ * First try to do it all at once without having to use
+ * yielding iolist_to_buf().
+ */
+ state.buf.iolist.reds_left = orig_reds_left;
+ switch (erts_iolist_size_yielding(&state.buf.iolist)) {
+ case ERTS_IOLIST_OK: {
+ ErlDrvSizeT size = state.buf.iolist.size;
+ Eterm bin;
+ char *buf;
+
+ if (size == 0) {
+ ERTS_BIF_PREP_RET(ret, new_binary(c_p, (byte *) NULL, 0));
+ break; /* done */
+ }
+
+ bin = new_binary(c_p, (byte *) NULL, size);
+ buf = (char *) binary_bytes(bin);
+
+ if (size < ERTS_IOLIST_TO_BUF_BYTES_PER_RED*CONTEXT_REDS) {
+ /* An (over) estimation of reductions needed */
+ int reds_left = state.buf.iolist.reds_left;
+ int to_buf_reds = orig_reds_left - reds_left;
+ to_buf_reds += size/ERTS_IOLIST_TO_BUF_BYTES_PER_RED;
+ if (to_buf_reds <= reds_left) {
+ ErlDrvSizeT res;
+
+ res = erts_iolist_to_buf(arg, buf, size);
+ if (res == 0) {
+ BUMP_REDS(c_p, to_buf_reds);
+ ERTS_BIF_PREP_RET(ret, bin);
+ break; /* done */
+ }
+ if (!ERTS_IOLIST_TO_BUF_FAILED(res))
+ ERTS_INTERNAL_ERROR("iolist_size/iolist_to_buf missmatch");
+ if (res == ERTS_IOLIST_TO_BUF_OVERFLOW)
+ goto overflow;
+ goto type_error;
+ }
+ }
+ /*
+ * Since size has been computed list_to_binary_chunk() expects
+ * state prepared for iolist_to_buf.
+ */
+ state.bin = bin;
+ state.buf.buf = buf;
+ state.buf.len = size;
+ state.buf.iolist.obj = arg;
+ /* Fall through... */
+ }
+ case ERTS_IOLIST_YIELD:
+ ret = list_to_binary_chunk(THE_NON_VALUE,
+ &state,
+ state.buf.iolist.reds_left,
+ 0);
+ break;
+ case ERTS_IOLIST_OVERFLOW:
+ overflow:
+ ERTS_BIF_PREP_ERROR(ret, c_p, SYSTEM_LIMIT);
+ break;
+ case ERTS_IOLIST_TYPE:
+ type_error:
+ default:
+ ERTS_BIF_PREP_ERROR(ret, c_p, BADARG);
+ break;
+ }
+ }
+ }
+ return ret;
+}
+
+HIPE_WRAPPER_BIF_DISABLE_GC(list_to_binary, 1)
+
BIF_RETTYPE list_to_binary_1(BIF_ALIST_1)
{
- return erts_list_to_binary_bif(BIF_P, BIF_ARG_1);
+ return erts_list_to_binary_bif(BIF_P, BIF_ARG_1, bif_export[BIF_list_to_binary_1]);
}
-/* Turn a possibly deep list of ints (and binaries) into */
-/* One large binary object */
+HIPE_WRAPPER_BIF_DISABLE_GC(iolist_to_binary, 1)
BIF_RETTYPE iolist_to_binary_1(BIF_ALIST_1)
{
if (is_binary(BIF_ARG_1)) {
BIF_RET(BIF_ARG_1);
}
- return erts_list_to_binary_bif(BIF_P, BIF_ARG_1);
+ return erts_list_to_binary_bif(BIF_P, BIF_ARG_1, bif_export[BIF_iolist_to_binary_1]);
}
+static int bitstr_list_len(ErtsIOListState *);
+static ErlDrvSizeT list_to_bitstr_buf_yielding(ErtsIOList2BufState *);
+static ErlDrvSizeT list_to_bitstr_buf_not_yielding(ErtsIOList2BufState *);
+
+HIPE_WRAPPER_BIF_DISABLE_GC(list_to_bitstring, 1)
+
BIF_RETTYPE list_to_bitstring_1(BIF_ALIST_1)
{
- Eterm bin;
- Uint sz;
- int offset;
- byte* bytes;
- ErlSubBin* sb1;
- Eterm* hp;
-
- if (is_nil(BIF_ARG_1)) {
- BIF_RET(new_binary(BIF_P,(byte*)"",0));
- }
- if (is_not_list(BIF_ARG_1)) {
- error:
- BIF_ERROR(BIF_P, BADARG);
- }
- switch (bitstr_list_len(BIF_ARG_1, &sz)) {
- case ERTS_IOLIST_TYPE:
- goto error;
- case ERTS_IOLIST_OVERFLOW:
- BIF_ERROR(BIF_P, SYSTEM_LIMIT);
- }
- bin = new_binary(BIF_P, (byte *)NULL, sz);
- bytes = binary_bytes(bin);
-#ifdef DEBUG
- offset = list_to_bitstr_buf(BIF_ARG_1, (char*) bytes, sz);
-#else
- offset = list_to_bitstr_buf(BIF_ARG_1, (char*) bytes);
-#endif
- ASSERT(offset >= 0);
- if (offset > 0) {
- hp = HAlloc(BIF_P, ERL_SUB_BIN_SIZE);
- sb1 = (ErlSubBin *) hp;
- sb1->thing_word = HEADER_SUB_BIN;
- sb1->size = sz-1;
- sb1->offs = 0;
- sb1->orig = bin;
- sb1->bitoffs = 0;
- sb1->bitsize = offset;
- sb1->is_writable = 0;
- bin = make_binary(sb1);
+ BIF_RETTYPE ret;
+
+ if (is_nil(BIF_ARG_1))
+ ERTS_BIF_PREP_RET(ret, new_binary(BIF_P, (byte *) "", 0));
+ else if (is_not_list(BIF_ARG_1))
+ ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG);
+ else {
+ /* check for [bitstring()] case */
+ Eterm h = CAR(list_val(BIF_ARG_1));
+ Eterm t = CDR(list_val(BIF_ARG_1));
+ if (is_binary(h) && is_nil(t)) {
+ ERTS_BIF_PREP_RET(ret, h);
+ }
+ else {
+ ErtsL2BState state = ERTS_L2B_STATE_INITER(BIF_P,
+ BIF_ARG_1,
+ bif_export[BIF_list_to_bitstring_1],
+ bitstr_list_len,
+ list_to_bitstr_buf_yielding);
+ int orig_reds_left = ERTS_BIF_REDS_LEFT(BIF_P);
+
+ /*
+ * First try to do it all at once without having to use
+ * yielding list_to_bitstr_buf().
+ */
+ state.buf.iolist.reds_left = orig_reds_left;
+ switch (bitstr_list_len(&state.buf.iolist)) {
+ case ERTS_IOLIST_OK: {
+ ErlDrvSizeT size = state.buf.iolist.size;
+
+ state.bin = new_binary(BIF_P, (byte *) NULL, size);
+ state.buf.buf = (char *) binary_bytes(state.bin);
+ state.buf.len = size;
+ state.buf.iolist.obj = BIF_ARG_1;
+
+ if (size < ERTS_IOLIST_TO_BUF_BYTES_PER_RED*CONTEXT_REDS) {
+ /* An (over) estimation of reductions needed */
+ int reds_left = state.buf.iolist.reds_left;
+ int to_buf_reds = orig_reds_left - reds_left;
+ to_buf_reds += size/ERTS_IOLIST_TO_BUF_BYTES_PER_RED;
+ if (to_buf_reds <= reds_left) {
+ ErlDrvSizeT res;
+
+ res = list_to_bitstr_buf_not_yielding(&state.buf);
+ if (res == 0) {
+ Eterm res_bin = l2b_final_touch(BIF_P, &state);
+ BUMP_REDS(BIF_P, to_buf_reds);
+ ERTS_BIF_PREP_RET(ret, res_bin);
+ break; /* done */
+ }
+ if (!ERTS_IOLIST_TO_BUF_FAILED(res))
+ ERTS_INTERNAL_ERROR("iolist_size/iolist_to_buf missmatch");
+ if (res == ERTS_IOLIST_TO_BUF_OVERFLOW)
+ goto overflow;
+ goto type_error;
+ }
+ }
+ /*
+ * Since size has been computed list_to_binary_chunk() expects
+ * the state prepared for list_to_bitstr_buf.
+ */
+
+ /* Fall through... */
+ }
+ case ERTS_IOLIST_YIELD:
+ ret = list_to_binary_chunk(THE_NON_VALUE,
+ &state,
+ state.buf.iolist.reds_left,
+ 0);
+ break;
+ case ERTS_IOLIST_OVERFLOW:
+ overflow:
+ ERTS_BIF_PREP_ERROR(ret, BIF_P, SYSTEM_LIMIT);
+ break;
+ case ERTS_IOLIST_TYPE:
+ type_error:
+ default:
+ ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG);
+ break;
+ }
+ }
}
-
- BIF_RET(bin);
+
+ return ret;
}
BIF_RETTYPE split_binary_2(BIF_ALIST_2)
@@ -605,123 +1117,353 @@ BIF_RETTYPE split_binary_2(BIF_ALIST_2)
* Local functions.
*/
+static int
+list_to_bitstr_buf_bcopy(ErtsIOList2BufState *state, Eterm obj, int *yield_countp);
+
/*
* The input list is assumed to be type-correct and the buffer is
* assumed to be of sufficient size. Those assumptions are verified in
* the DEBUG-built emulator.
*/
-static int
+static ErlDrvSizeT
+list_to_bitstr_buf(int yield_support, ErtsIOList2BufState *state)
+{
+
+#undef LIST_TO_BITSTR_BUF_BCOPY_DBG
+#undef LIST_TO_BITSTR_BUF_BCOPY
#ifdef DEBUG
-list_to_bitstr_buf(Eterm obj, char* buf, Uint len)
+#define LIST_TO_BITSTR_BUF_BCOPY_DBG \
+ len -= size + (offset>7);
#else
-list_to_bitstr_buf(Eterm obj, char* buf)
+#define LIST_TO_BITSTR_BUF_BCOPY_DBG
#endif
-{
- Eterm* objp;
- int offset = 0;
+#define LIST_TO_BITSTR_BUF_BCOPY(CONSP) \
+ do { \
+ byte* bptr; \
+ Uint bitsize; \
+ Uint bitoffs; \
+ Uint num_bits; \
+ size_t size = binary_size(obj); \
+ if (yield_support) { \
+ size_t max_size = ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT; \
+ if (yield_count > 0) \
+ max_size *= yield_count+1; \
+ if (size > max_size) { \
+ state->objp = CONSP; \
+ goto L_bcopy_yield; \
+ } \
+ if (size >= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT) { \
+ int cost = (int) size; \
+ cost /= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT; \
+ yield_count -= cost; \
+ } \
+ } \
+ ASSERT(size <= len); \
+ ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize); \
+ num_bits = 8*size+bitsize; \
+ copy_binary_to_buffer(buf, offset, bptr, bitoffs, num_bits); \
+ offset += bitsize; \
+ buf += size + (offset>7); \
+ LIST_TO_BITSTR_BUF_BCOPY_DBG; \
+ offset = offset & 7; \
+ } while(0)
+
+#ifdef DEBUG
+ ErlDrvSizeT len;
+#endif
+ Eterm obj;
+ char *buf;
+ Eterm *objp = NULL;
+ int offset;
+ int init_yield_count = 0, yield_count;
DECLARE_ESTACK(s);
- goto L_again;
-
- while (!ESTACK_ISEMPTY(s)) {
- obj = ESTACK_POP(s);
- L_again:
- if (is_list(obj)) {
- L_iter_list:
- objp = list_val(obj);
- obj = CAR(objp);
- if (is_byte(obj)) {
- ASSERT(len > 0);
- if (offset == 0) {
- *buf++ = unsigned_val(obj);
- } else {
- *buf = (char)((unsigned_val(obj) >> offset) |
- ((*buf >> (8-offset)) << (8-offset)));
- buf++;
- *buf = (unsigned_val(obj) << (8-offset));
- }
+
+ obj = state->iolist.obj;
+ buf = state->buf;
+ offset = state->offset;
#ifdef DEBUG
- len--;
+ len = state->len;
#endif
- } else if (is_binary(obj)) {
- byte* bptr;
- size_t size = binary_size(obj);
- Uint bitsize;
- Uint bitoffs;
- Uint num_bits;
-
- ASSERT(size <= len);
- ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);
- num_bits = 8*size+bitsize;
- copy_binary_to_buffer(buf, offset, bptr, bitoffs, num_bits);
- offset += bitsize;
- buf += size + (offset>7);
+
+ if (!yield_support) {
+ yield_count = init_yield_count = 0; /* Shut up faulty warning... >:-( */
+ goto L_again;
+ }
+ else {
+
+ if (state->iolist.reds_left <= 0)
+ return ERTS_IOLIST_TO_BUF_YIELD;
+
+ ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK);
+ init_yield_count = (ERTS_IOLIST_TO_BUF_YIELD_COUNT_PER_RED
+ * state->iolist.reds_left);
+ yield_count = init_yield_count;
+
+ if (!state->iolist.estack.start)
+ goto L_again;
+ else {
+ int chk_stack;
+ /* Restart; restore state... */
+ ESTACK_RESTORE(s, &state->iolist.estack);
+
+ if (!state->bcopy.bptr)
+ chk_stack = 0;
+ else {
+ chk_stack = 1;
+ if (list_to_bitstr_buf_bcopy(state, THE_NON_VALUE, &yield_count)) {
+ /* Yield again... */
+ BUMP_ALL_REDS(state->iolist.c_p);
+ state->iolist.reds_left = 0;
+ ESTACK_SAVE(s, &state->iolist.estack);
+ return ERTS_IOLIST_TO_BUF_YIELD;
+ }
+ buf = state->buf;
+ offset = state->offset;
#ifdef DEBUG
- len -= size + (offset>7);
+ len = state->len;
#endif
- offset = offset & 7;
- } else if (is_list(obj)) {
- ESTACK_PUSH(s, CDR(objp));
- goto L_iter_list; /* on head */
- } else {
- ASSERT(is_nil(obj));
}
- obj = CDR(objp);
- if (is_list(obj)) {
- goto L_iter_list; /* on tail */
- } else if (is_binary(obj)) {
- byte* bptr;
- size_t size = binary_size(obj);
- Uint bitsize;
- Uint bitoffs;
- Uint num_bits;
-
- ASSERT(size <= len);
- ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);
- num_bits = 8*size+bitsize;
- copy_binary_to_buffer(buf, offset, bptr, bitoffs, num_bits);
- offset += bitsize;
- buf += size+(offset>7);
+ objp = state->objp;
+ state->objp = NULL;
+
+ if (objp)
+ goto L_tail;
+ if (!chk_stack)
+ goto L_again;
+ /* check stack */
+ }
+ }
+
+ while (!ESTACK_ISEMPTY(s)) {
+ obj = ESTACK_POP(s);
+ L_again:
+ if (is_list(obj)) {
+ while (1) { /* Tail loop */
+ while (1) { /* Head loop */
+ if (yield_support && --yield_count <= 0)
+ goto L_yield;
+ objp = list_val(obj);
+ obj = CAR(objp);
+ if (is_byte(obj)) {
+ ASSERT(len > 0);
+ if (offset == 0) {
+ *buf++ = unsigned_val(obj);
+ } else {
+ *buf = (char)((unsigned_val(obj) >> offset) |
+ ((*buf >> (8-offset)) << (8-offset)));
+ buf++;
+ *buf = (unsigned_val(obj) << (8-offset));
+ }
#ifdef DEBUG
- len -= size+(offset>7);
+ len--;
#endif
- offset = offset & 7;
- } else {
- ASSERT(is_nil(obj));
+ } else if (is_binary(obj)) {
+ LIST_TO_BITSTR_BUF_BCOPY(objp);
+ } else if (is_list(obj)) {
+ ESTACK_PUSH(s, CDR(objp));
+ continue; /* Head loop */
+ } else {
+ ASSERT(is_nil(obj));
+ }
+ break;
+ }
+
+ L_tail:
+
+ obj = CDR(objp);
+ if (is_list(obj)) {
+ continue; /* Tail loop */
+ } else if (is_binary(obj)) {
+ LIST_TO_BITSTR_BUF_BCOPY(NULL);
+ } else {
+ ASSERT(is_nil(obj));
+ }
+ break;
}
} else if (is_binary(obj)) {
- byte* bptr;
- size_t size = binary_size(obj);
- Uint bitsize;
- Uint bitoffs;
- Uint num_bits;
-
- ASSERT(size <= len);
- ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);
- num_bits = 8*size+bitsize;
- copy_binary_to_buffer(buf, offset, bptr, bitoffs, num_bits);
- offset += bitsize;
- buf += size + (offset>7);
-#ifdef DEBUG
- len -= size + (offset>7);
-#endif
- offset = offset & 7;
+ LIST_TO_BITSTR_BUF_BCOPY(NULL);
} else {
+ if (yield_support && --yield_count <= 0)
+ goto L_yield;
ASSERT(is_nil(obj));
}
}
DESTROY_ESTACK(s);
- return offset;
+
+ if (yield_support) {
+ int reds;
+ CLEAR_SAVED_ESTACK(&state->iolist.estack);
+ reds = ((init_yield_count - yield_count - 1)
+ / ERTS_IOLIST_TO_BUF_YIELD_COUNT_PER_RED) + 1;
+ BUMP_REDS(state->iolist.c_p, reds);
+ state->iolist.reds_left -= reds;
+ if (state->iolist.reds_left < 0)
+ state->iolist.reds_left = 0;
+ }
+ state->buf = buf;
+ state->offset = offset;
+ return 0;
+
+L_bcopy_yield:
+
+ state->buf = buf;
+ state->offset = offset;
+#ifdef DEBUG
+ state->len = len;
+#endif
+
+ if (list_to_bitstr_buf_bcopy(state, obj, &yield_count) == 0)
+ ERTS_INTERNAL_ERROR("Missing yield");
+
+ BUMP_ALL_REDS(state->iolist.c_p);
+ state->iolist.reds_left = 0;
+ ESTACK_SAVE(s, &state->iolist.estack);
+ return ERTS_IOLIST_TO_BUF_YIELD;
+
+L_yield:
+
+ BUMP_ALL_REDS(state->iolist.c_p);
+ state->iolist.reds_left = 0;
+ state->iolist.obj = obj;
+ state->buf = buf;
+ state->offset = offset;
+ ESTACK_SAVE(s, &state->iolist.estack);
+#ifdef DEBUG
+ state->len = len;
+#endif
+ return ERTS_IOLIST_TO_BUF_YIELD;
+
+
+#undef LIST_TO_BITSTR_BUF_BCOPY_DBG
+#undef LIST_TO_BITSTR_BUF_BCOPY
+
+}
+
+static ErlDrvSizeT
+list_to_bitstr_buf_yielding(ErtsIOList2BufState *state)
+{
+ return list_to_bitstr_buf(1, state);
+}
+
+static ErlDrvSizeT
+list_to_bitstr_buf_not_yielding(ErtsIOList2BufState *state)
+{
+ return list_to_bitstr_buf(0, state);
+}
+
+static int
+list_to_bitstr_buf_bcopy(ErtsIOList2BufState *state, Eterm obj, int *yield_countp)
+{
+ int res;
+ char *buf = state->buf;
+ char *next_buf;
+ int offset = state->offset;
+ int next_offset;
+#ifdef DEBUG
+ ErlDrvSizeT len = state->len;
+ ErlDrvSizeT next_len;
+#endif
+ byte* bptr;
+ size_t size;
+ size_t max_size;
+ Uint bitoffs;
+ Uint num_bits;
+ Uint bitsize;
+ int yield_count = *yield_countp;
+
+ if (state->bcopy.bptr) {
+ bptr = state->bcopy.bptr;
+ size = state->bcopy.size;
+ bitoffs = state->bcopy.bitoffs;
+ bitsize = state->bcopy.bitsize;
+ state->bcopy.bptr = NULL;
+ }
+ else {
+
+ ASSERT(is_binary(obj));
+
+ size = binary_size(obj);
+
+ ASSERT(size <= len);
+
+ ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);
+ }
+
+ max_size = (size_t) ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT;
+ if (yield_count > 0)
+ max_size *= (size_t) (yield_count+1);
+
+ if (size <= max_size) {
+ if (size >= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT) {
+ int cost = (int) size;
+ cost /= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT;
+ yield_count -= cost;
+ }
+ next_offset = offset + bitsize;
+ next_buf = buf + size+(next_offset>7);
+#ifdef DEBUG
+ next_len = len - size+(next_offset>7);
+#endif
+ next_offset &= 7;
+ num_bits = 8*size+bitsize;
+ res = 0;
+ }
+ else {
+ ASSERT(0 < max_size && max_size < size);
+ yield_count = 0;
+ state->bcopy.bptr = bptr + max_size;
+ state->bcopy.bitoffs = bitoffs;
+ state->bcopy.bitsize = bitsize;
+ state->bcopy.size = size - max_size;
+ next_buf = buf + max_size;
+#ifdef DEBUG
+ next_len = len - max_size;
+#endif
+ next_offset = offset;
+ num_bits = 8*max_size;
+ size = max_size;
+ res = 1;
+ }
+
+ copy_binary_to_buffer(buf, offset, bptr, bitoffs, num_bits);
+
+ state->offset = next_offset;
+ state->buf = next_buf;
+#ifdef DEBUG
+ state->len = next_len;
+#endif
+ *yield_countp = yield_count;
+
+ return res;
}
static int
-bitstr_list_len(Eterm obj, Uint* num_bytes)
+bitstr_list_len(ErtsIOListState *state)
{
Eterm* objp;
- Uint len = 0;
- Uint offs = 0;
+ Eterm obj;
+ Uint len, offs;
+ int res, init_yield_count, yield_count;
DECLARE_ESTACK(s);
+
+ if (state->reds_left <= 0)
+ return ERTS_IOLIST_YIELD;
+
+ len = (Uint) state->size;
+ offs = state->offs;
+ obj = state->obj;
+
+ ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK);
+ init_yield_count = ERTS_IOLIST_SIZE_YIELDS_COUNT_PER_RED;
+ init_yield_count *= state->reds_left;
+ yield_count = init_yield_count;
+ if (state->estack.start) {
+ /* Restart; restore estack... */
+ ESTACK_RESTORE(s, &state->estack);
+ }
+
goto L_again;
#define SAFE_ADD(Var, Val) \
@@ -748,46 +1490,55 @@ bitstr_list_len(Eterm obj, Uint* num_bytes)
obj = ESTACK_POP(s);
L_again:
if (is_list(obj)) {
- L_iter_list:
- objp = list_val(obj);
- /* Head */
- obj = CAR(objp);
- if (is_byte(obj)) {
- len++;
- if (len == 0) {
- goto L_overflow_error;
+ while (1) { /* Tail loop */
+ while (1) { /* Head loop */
+ if (--yield_count <= 0)
+ goto L_yield;
+ objp = list_val(obj);
+ /* Head */
+ obj = CAR(objp);
+ if (is_byte(obj)) {
+ len++;
+ if (len == 0) {
+ goto L_overflow_error;
+ }
+ } else if (is_binary(obj)) {
+ SAFE_ADD(len, binary_size(obj));
+ SAFE_ADD_BITSIZE(offs, obj);
+ } else if (is_list(obj)) {
+ ESTACK_PUSH(s, CDR(objp));
+ continue; /* Head loop */
+ } else if (is_not_nil(obj)) {
+ goto L_type_error;
+ }
+ break;
}
- } else if (is_binary(obj)) {
- SAFE_ADD(len, binary_size(obj));
- SAFE_ADD_BITSIZE(offs, obj);
- } else if (is_list(obj)) {
- ESTACK_PUSH(s, CDR(objp));
- goto L_iter_list; /* on head */
- } else if (is_not_nil(obj)) {
- goto L_type_error;
+ /* Tail */
+ obj = CDR(objp);
+ if (is_list(obj))
+ continue; /* Tail loop */
+ else if (is_binary(obj)) {
+ SAFE_ADD(len, binary_size(obj));
+ SAFE_ADD_BITSIZE(offs, obj);
+ } else if (is_not_nil(obj)) {
+ goto L_type_error;
+ }
+ break;
}
- /* Tail */
- obj = CDR(objp);
- if (is_list(obj))
- goto L_iter_list; /* on tail */
- else if (is_binary(obj)) {
+ } else {
+ if (--yield_count <= 0)
+ goto L_yield;
+ if (is_binary(obj)) {
SAFE_ADD(len, binary_size(obj));
SAFE_ADD_BITSIZE(offs, obj);
} else if (is_not_nil(obj)) {
goto L_type_error;
}
- } else if (is_binary(obj)) {
- SAFE_ADD(len, binary_size(obj));
- SAFE_ADD_BITSIZE(offs, obj);
- } else if (is_not_nil(obj)) {
- goto L_type_error;
}
}
#undef SAFE_ADD
#undef SAFE_ADD_BITSIZE
- DESTROY_ESTACK(s);
-
/*
* Make sure that the number of bits in the bitstring will fit
* in an Uint to ensure that the binary can be matched using
@@ -800,15 +1551,42 @@ bitstr_list_len(Eterm obj, Uint* num_bytes)
if (len << 3 < len) {
goto L_overflow_error;
}
- *num_bytes = len;
- return ERTS_IOLIST_OK;
+ state->size = len;
- L_type_error:
- DESTROY_ESTACK(s);
- return ERTS_IOLIST_TYPE;
+ res = ERTS_IOLIST_OK;
+
+ L_return: {
+ int yc = init_yield_count - yield_count;
+ int reds;
+
+ DESTROY_ESTACK(s);
+ CLEAR_SAVED_ESTACK(&state->estack);
+
+ reds = (yc - 1)/ERTS_IOLIST_SIZE_YIELDS_COUNT_PER_RED + 1;
+ BUMP_REDS(state->c_p, reds);
+ state->reds_left -= reds;
+ state->size = (ErlDrvSizeT) len;
+ state->have_size = 1;
+ return res;
+ }
L_overflow_error:
- DESTROY_ESTACK(s);
- return ERTS_IOLIST_OVERFLOW;
+ res = ERTS_IOLIST_OVERFLOW;
+ len = 0;
+ goto L_return;
+
+ L_type_error:
+ res = ERTS_IOLIST_TYPE;
+ len = 0;
+ goto L_return;
+
+ L_yield:
+ BUMP_ALL_REDS(state->c_p);
+ state->reds_left = 0;
+ state->size = len;
+ state->offs = offs;
+ state->obj = obj;
+ ESTACK_SAVE(s, &state->estack);
+ return ERTS_IOLIST_YIELD;
}
diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c
index 7d4f52ee23..e57be5a595 100644
--- a/erts/emulator/beam/break.c
+++ b/erts/emulator/beam/break.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -36,30 +37,31 @@
#include "atom.h"
#include "beam_load.h"
#include "erl_instrument.h"
-#include "erl_bif_timer.h"
+#include "erl_hl_timer.h"
#include "erl_thr_progress.h"
/* Forward declarations -- should really appear somewhere else */
static void process_killer(void);
void do_break(void);
void erl_crash_dump_v(char *file, int line, char* fmt, va_list args);
-void erl_crash_dump(char* file, int line, char* fmt, ...);
#ifdef DEBUG
static void bin_check(void);
#endif
-static void print_garb_info(int to, void *to_arg, Process* p);
+static void print_garb_info(fmtfn_t to, void *to_arg, Process* p);
#ifdef OPPROF
static void dump_frequencies(void);
#endif
-static void dump_attributes(int to, void *to_arg, byte* ptr, int size);
+static void dump_attributes(fmtfn_t to, void *to_arg, byte* ptr, int size);
extern char* erts_system_version[];
+#define WRITE_BUFFER_SIZE (64*1024)
+
static void
-port_info(int to, void *to_arg)
+port_info(fmtfn_t to, void *to_arg)
{
int i, max = erts_ptab_max(&erts_port);
for (i = 0; i < max; i++) {
@@ -70,7 +72,7 @@ port_info(int to, void *to_arg)
}
void
-process_info(int to, void *to_arg)
+process_info(fmtfn_t to, void *to_arg)
{
int i, max = erts_ptab_max(&erts_proc);
for (i = 0; i < max; i++) {
@@ -103,12 +105,12 @@ 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;
erts_aint32_t state;
- erts_smp_proc_inc_refc(rp);
+ erts_proc_inc_refc(rp);
erts_smp_proc_lock(rp, rp_locks);
state = erts_smp_atomic32_read_acqb(&rp->state);
if (state & (ERTS_PSFLG_FREE
@@ -117,7 +119,9 @@ process_killer(void)
| ERTS_PSFLG_ACTIVE_SYS
| ERTS_PSFLG_IN_RUNQ
| ERTS_PSFLG_RUNNING
- | ERTS_PSFLG_RUNNING_SYS)) {
+ | ERTS_PSFLG_RUNNING_SYS
+ | ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS)) {
erts_printf("Can only kill WAITING processes this way\n");
}
else {
@@ -131,7 +135,7 @@ process_killer(void)
0);
}
erts_smp_proc_unlock(rp, rp_locks);
- erts_smp_proc_dec_refc(rp);
+ erts_proc_dec_refc(rp);
}
case 'n': br = 1; break;
case 'r': return;
@@ -145,14 +149,14 @@ process_killer(void)
typedef struct {
int is_first;
- int to;
+ fmtfn_t to;
void *to_arg;
} PrintMonitorContext;
static void doit_print_link(ErtsLink *lnk, void *vpcontext)
{
PrintMonitorContext *pcontext = vpcontext;
- int to = pcontext->to;
+ fmtfn_t to = pcontext->to;
void *to_arg = pcontext->to_arg;
if (pcontext->is_first) {
@@ -167,7 +171,7 @@ static void doit_print_link(ErtsLink *lnk, void *vpcontext)
static void doit_print_monitor(ErtsMonitor *mon, void *vpcontext)
{
PrintMonitorContext *pcontext = vpcontext;
- int to = pcontext->to;
+ fmtfn_t to = pcontext->to;
void *to_arg = pcontext->to_arg;
char *prefix = ", ";
@@ -176,26 +180,34 @@ static void doit_print_monitor(ErtsMonitor *mon, void *vpcontext)
prefix = "";
}
- if (mon->type == MON_ORIGIN) {
- if (is_atom(mon->pid)) { /* dist by name */
- ASSERT(is_node_name_atom(mon->pid));
+ switch (mon->type) {
+ case MON_ORIGIN:
+ if (is_atom(mon->u.pid)) { /* dist by name */
+ ASSERT(is_node_name_atom(mon->u.pid));
erts_print(to, to_arg, "%s{to,{%T,%T},%T}", prefix, mon->name,
- mon->pid, mon->ref);
- erts_print(to, to_arg,"}");
+ mon->u.pid, mon->ref);
} else if (is_atom(mon->name)){ /* local by name */
erts_print(to, to_arg, "%s{to,{%T,%T},%T}", prefix, mon->name,
erts_this_dist_entry->sysname, mon->ref);
} else { /* local and distributed by pid */
- erts_print(to, to_arg, "%s{to,%T,%T}", prefix, mon->pid, mon->ref);
+ erts_print(to, to_arg, "%s{to,%T,%T}", prefix, mon->u.pid, mon->ref);
}
- } else { /* MON_TARGET */
- erts_print(to, to_arg, "%s{from,%T,%T}", prefix, mon->pid, mon->ref);
+ break;
+ case MON_TARGET:
+ erts_print(to, to_arg, "%s{from,%T,%T}", prefix, mon->u.pid, mon->ref);
+ break;
+ case MON_NIF_TARGET: {
+ ErtsResource* rsrc = mon->u.resource;
+ erts_print(to, to_arg, "%s{from,{%T,%T},%T}", prefix, rsrc->type->module,
+ rsrc->type->name, mon->ref);
+ break;
+ }
}
}
/* Display info about an individual Erlang process */
void
-print_process_info(int to, void *to_arg, Process *p)
+print_process_info(fmtfn_t to, void *to_arg, Process *p)
{
time_t approx_started;
int garbing = 0;
@@ -210,25 +222,13 @@ print_process_info(int to, void *to_arg, Process *p)
erts_print(to, to_arg, "State: ");
state = erts_smp_atomic32_read_acqb(&p->state);
- if (state & ERTS_PSFLG_FREE)
- erts_print(to, to_arg, "Non Existing\n"); /* Should never happen */
- else if (state & ERTS_PSFLG_EXITING)
- erts_print(to, to_arg, "Exiting\n");
- else if (state & ERTS_PSFLG_GC) {
- garbing = 1;
- running = 1;
- erts_print(to, to_arg, "Garbing\n");
- }
- else if (state & ERTS_PSFLG_SUSPENDED)
- erts_print(to, to_arg, "Suspended\n");
- else if (state & ERTS_PSFLG_RUNNING) {
- running = 1;
- erts_print(to, to_arg, "Running\n");
- }
- else if (state & ERTS_PSFLG_ACTIVE)
- erts_print(to, to_arg, "Scheduled\n");
- else
- erts_print(to, to_arg, "Waiting\n");
+ erts_dump_process_state(to, to_arg, state);
+ if (state & ERTS_PSFLG_GC) {
+ garbing = 1;
+ running = 1;
+ } else if (state & (ERTS_PSFLG_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING))
+ running = 1;
/*
* If the process is registered as a global process, display the
@@ -241,9 +241,9 @@ print_process_info(int to, void *to_arg, Process *p)
* Display the initial function name
*/
erts_print(to, to_arg, "Spawned as: %T:%T/%bpu\n",
- p->initial[INITIAL_MOD],
- p->initial[INITIAL_FUN],
- p->initial[INITIAL_ARI]);
+ p->u.initial.module,
+ p->u.initial.function,
+ p->u.initial.arity);
if (p->current != NULL) {
if (running) {
@@ -252,9 +252,9 @@ print_process_info(int to, void *to_arg, Process *p)
erts_print(to, to_arg, "Current call: ");
}
erts_print(to, to_arg, "%T:%T/%bpu\n",
- p->current[0],
- p->current[1],
- p->current[2]);
+ p->current->module,
+ p->current->function,
+ p->current->arity);
}
erts_print(to, to_arg, "Spawned by: %T\n", p->parent);
@@ -265,7 +265,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));
@@ -301,16 +301,16 @@ print_process_info(int to, void *to_arg, Process *p)
erts_print(to, to_arg, "timeout");
else
erts_print(to, to_arg, "%T:%T/%bpu\n",
- scb->ct[j]->code[0],
- scb->ct[j]->code[1],
- scb->ct[j]->code[2]);
+ scb->ct[j]->info.mfa.module,
+ scb->ct[j]->info.mfa.function,
+ scb->ct[j]->info.mfa.arity);
}
erts_print(to, to_arg, "\n");
}
/* display the links only if there are any*/
if (ERTS_P_LINKS(p) || ERTS_P_MONITORS(p)) {
- PrintMonitorContext context = {1,to};
+ PrintMonitorContext context = {1, to, to_arg};
erts_print(to, to_arg,"Link list: [");
erts_doforall_links(ERTS_P_LINKS(p), &doit_print_link, &context);
erts_doforall_monitors(ERTS_P_MONITORS(p), &doit_print_monitor, &context);
@@ -336,7 +336,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);
@@ -351,13 +351,20 @@ print_process_info(int to, void *to_arg, Process *p)
#endif
erts_stack_dump(to, to_arg, p);
}
+
+ /* Display all states */
+ erts_print(to, to_arg, "Internal State: ");
+ erts_dump_extended_process_state(to, to_arg, state);
}
static void
-print_garb_info(int to, void *to_arg, Process* p)
+print_garb_info(fmtfn_t to, void *to_arg, Process* p)
{
+#ifdef ERTS_SMP
/* ERTS_SMP: A scheduler is probably concurrently doing gc... */
-#ifndef ERTS_SMP
+ if (!ERTS_IS_CRASH_DUMPING)
+ return;
+#endif
erts_print(to, to_arg, "New heap start: %bpX\n", p->heap);
erts_print(to, to_arg, "New heap top: %bpX\n", p->htop);
erts_print(to, to_arg, "Stack top: %bpX\n", p->stop);
@@ -365,11 +372,10 @@ print_garb_info(int to, void *to_arg, Process* p)
erts_print(to, to_arg, "Old heap start: %bpX\n", OLD_HEAP(p));
erts_print(to, to_arg, "Old heap top: %bpX\n", OLD_HTOP(p));
erts_print(to, to_arg, "Old heap end: %bpX\n", OLD_HEND(p));
-#endif
}
void
-info(int to, void *to_arg)
+info(fmtfn_t to, void *to_arg)
{
erts_memory(&to, to_arg, NULL, THE_NON_VALUE);
atom_info(to, to_arg);
@@ -384,13 +390,25 @@ info(int to, void *to_arg)
}
+static int code_size(struct erl_module_instance* modi)
+{
+ int size = modi->code_length;
+
+ if (modi->code_hdr) {
+ ErtsLiteralArea* lit = modi->code_hdr->literal_area;
+ if (lit)
+ size += (lit->end - lit->start) * sizeof(Eterm);
+ }
+ return size;
+}
+
void
-loaded(int to, void *to_arg)
+loaded(fmtfn_t to, void *to_arg)
{
int i;
int old = 0;
int cur = 0;
- BeamInstr* code;
+ BeamCodeHeader* code;
Module* modp;
ErtsCodeIndex code_ix;
@@ -401,13 +419,9 @@ loaded(int to, void *to_arg)
* Calculate and print totals.
*/
for (i = 0; i < module_code_size(code_ix); i++) {
- if ((modp = module_code(i, code_ix)) != NULL &&
- ((modp->curr.code_length != 0) ||
- (modp->old.code_length != 0))) {
- cur += modp->curr.code_length;
- if (modp->old.code_length != 0) {
- old += modp->old.code_length;
- }
+ if ((modp = module_code(i, code_ix)) != NULL) {
+ cur += code_size(&modp->curr);
+ old += code_size(&modp->old);
}
}
erts_print(to, to_arg, "Current code: %d\n", cur);
@@ -423,55 +437,49 @@ loaded(int to, void *to_arg)
/*
* Interactive dump; keep it brief.
*/
- if (modp != NULL &&
- ((modp->curr.code_length != 0) ||
- (modp->old.code_length != 0))) {
- erts_print(to, to_arg, "%T", make_atom(modp->module));
- cur += modp->curr.code_length;
- erts_print(to, to_arg, " %d", modp->curr.code_length );
- if (modp->old.code_length != 0) {
- erts_print(to, to_arg, " (%d old)",
- modp->old.code_length );
- old += modp->old.code_length;
- }
+ if (modp != NULL && ((modp->curr.code_length != 0) ||
+ (modp->old.code_length != 0))) {
+ erts_print(to, to_arg, "%T %d", make_atom(modp->module),
+ code_size(&modp->curr));
+ if (modp->old.code_length != 0)
+ erts_print(to, to_arg, " (%d old)", code_size(&modp->old));
erts_print(to, to_arg, "\n");
}
} else {
/*
* To crash dump; make it parseable.
*/
- if (modp != NULL &&
- ((modp->curr.code_length != 0) ||
- (modp->old.code_length != 0))) {
+ if (modp != NULL && ((modp->curr.code_length != 0) ||
+ (modp->old.code_length != 0))) {
erts_print(to, to_arg, "=mod:");
erts_print(to, to_arg, "%T", make_atom(modp->module));
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_size(&modp->curr));
+ 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]) {
+ erts_print(to, to_arg, "Old size: %d\n", code_size(&modp->old));
+ 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);
}
}
}
@@ -482,7 +490,7 @@ loaded(int to, void *to_arg)
static void
-dump_attributes(int to, void *to_arg, byte* ptr, int size)
+dump_attributes(fmtfn_t to, void *to_arg, byte* ptr, int size)
{
while (size-- > 0) {
erts_print(to, to_arg, "%02X", *ptr++);
@@ -502,17 +510,19 @@ 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__ */
+ ASSERT(erts_smp_thr_progress_is_blocking());
+
erts_printf("\n"
"BREAK: (a)bort (c)ontinue (p)roc info (i)nfo (l)oaded\n"
" (v)ersion (k)ill (D)b-tables (d)istribution\n");
while (1) {
if ((i = sys_get_key(0)) <= 0)
- erl_exit(0, "");
+ erts_exit(0, "");
switch (i) {
case 'q':
case 'a':
@@ -522,9 +532,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':
@@ -545,7 +555,9 @@ do_break(void)
erts_printf("Erlang (%s) emulator version "
ERLANG_VERSION "\n",
EMULATOR);
+#if ERTS_SAVED_COMPILE_TIME
erts_printf("Compiled on " ERLANG_COMPILE_DATE "\n");
+#endif
return;
case 'd':
distribution_info(ERTS_PRINT_STDOUT, NULL);
@@ -580,7 +592,7 @@ do_break(void)
#endif
#ifdef DEBUG
case 't':
- erts_p_slpq();
+ /* erts_p_slpq(); */
return;
case 'b':
bin_check();
@@ -650,7 +662,7 @@ bin_check(void)
erts_printf("%p orig_size: %bpd, norefs = %bpd\n",
bp->val,
bp->val->orig_size,
- erts_smp_atomic_read_nob(&bp->val->refc));
+ erts_refc_read(&bp->val->intern.refc, 1));
}
}
if (printed) {
@@ -664,6 +676,36 @@ bin_check(void)
#endif
+static Sint64 crash_dump_limit = ERTS_SINT64_MAX;
+static Sint64 crash_dump_written = 0;
+
+typedef struct LimitedWriterInfo_ {
+ fmtfn_t to;
+ void* to_arg;
+} LimitedWriterInfo;
+
+static int
+crash_dump_limited_writer(void* vfdp, char* buf, size_t len)
+{
+ const char stop_msg[] = "\n=abort:CRASH DUMP SIZE LIMIT REACHED\n";
+ LimitedWriterInfo* lwi = (LimitedWriterInfo *) vfdp;
+
+ crash_dump_written += len;
+ if (crash_dump_written <= crash_dump_limit) {
+ return lwi->to(lwi->to_arg, buf, len);
+ }
+
+ len -= (crash_dump_written - crash_dump_limit);
+ lwi->to(lwi->to_arg, buf, len);
+ lwi->to(lwi->to_arg, (char*)stop_msg, sizeof(stop_msg)-1);
+ if (lwi->to == &erts_write_fp) {
+ fclose((FILE *) lwi->to_arg);
+ }
+
+ /* We assume that crash dump was called from erts_exit_vv() */
+ erts_exit_epilogue();
+}
+
/* XXX THIS SHOULD BE IN SYSTEM !!!! */
void
erl_crash_dump_v(char *file, int line, char* fmt, va_list args)
@@ -680,27 +722,46 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args)
char* dumpname;
int secs;
int env_erl_crash_dump_seconds_set = 1;
+ int i;
+ fmtfn_t to = &erts_write_fd;
+ void* to_arg;
+ FILE* fp = 0;
+ LimitedWriterInfo lwi;
+ static char* write_buffer; /* 'static' to avoid a leak warning in valgrind */
if (ERTS_SOMEONE_IS_CRASH_DUMPING)
return;
#ifdef ERTS_SMP
+ /* Order all managed threads to block, this has to be done
+ first to guarantee that this is the only thread to generate
+ crash dump. */
+ erts_thr_progress_fatal_error_block(&tpd_buf);
+
+#ifdef ERTS_SYS_SUSPEND_SIGNAL
/*
- * Wait for all managed threads to block. If all threads haven't blocked
- * after a minute, we go anyway and hope for the best...
- *
- * We do not release system again. We expect an exit() or abort() after
- * dump has been written.
+ * We suspend all scheduler threads so that we can dump some
+ * data about the currently running processes and scheduler data.
+ * We have to be very very careful when doing this as the schedulers
+ * could be anywhere.
*/
- erts_thr_progress_fatal_error_block(60000, &tpd_buf);
- /* Either worked or not... */
+ sys_init_suspend_handler();
+
+ for (i = 0; i < erts_no_schedulers; i++) {
+ erts_tid_t tid = ERTS_SCHEDULER_IX(i)->tid;
+ if (!erts_equal_tids(tid,erts_thr_self()))
+ sys_thr_suspend(tid);
+ }
+
+#endif
/* Allow us to pass certain places without locking... */
erts_smp_atomic32_set_mb(&erts_writing_erl_crash_dump, 1);
erts_smp_tsd_set(erts_is_crash_dumping_key, (void *) 1);
-#else
+
+#else /* !ERTS_SMP */
erts_writing_erl_crash_dump = 1;
-#endif
+#endif /* ERTS_SMP */
envsz = sizeof(env);
/* ERL_CRASH_DUMP_SECONDS not set
@@ -749,69 +810,168 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args)
return;
}
+ crash_dump_limit = ERTS_SINT64_MAX;
+ envsz = sizeof(env);
+ if (erts_sys_getenv__("ERL_CRASH_DUMP_BYTES", env, &envsz) == 0) {
+ Sint64 limit;
+ char* endptr;
+ errno = 0;
+ limit = ErtsStrToSint64(env, &endptr, 10);
+ if (errno == 0 && limit >= 0 && endptr != env && *endptr == 0) {
+ if (limit == 0)
+ return;
+ crash_dump_limit = limit;
+ to = &crash_dump_limited_writer;
+ }
+ }
+
if (erts_sys_getenv__("ERL_CRASH_DUMP",&dumpnamebuf[0],&dumpnamebufsize) != 0)
dumpname = "erl_crash.dump";
else
dumpname = &dumpnamebuf[0];
+
+ erts_fprintf(stderr,"\nCrash dump is being written to: %s...", dumpname);
fd = open(dumpname,O_WRONLY | O_CREAT | O_TRUNC,0640);
- if (fd < 0)
+ if (fd < 0)
return; /* Can't create the crash dump, skip it */
-
+
+ /*
+ * Wrap into a FILE* so that we can use buffered output. Set an
+ * explicit buffer to make sure the first write does not fail because
+ * of a failure to allocate a buffer.
+ */
+ write_buffer = (char *) erts_alloc_fnf(ERTS_ALC_T_TMP, WRITE_BUFFER_SIZE);
+ if (write_buffer && (fp = fdopen(fd, "w")) != NULL) {
+ setvbuf(fp, write_buffer, _IOFBF, WRITE_BUFFER_SIZE);
+ lwi.to = &erts_write_fp;
+ lwi.to_arg = (void*)fp;
+ } else {
+ lwi.to = &erts_write_fd;
+ lwi.to_arg = (void*)&fd;
+ }
+ if (to == &crash_dump_limited_writer) {
+ to_arg = (void *) &lwi;
+ } else {
+ to = lwi.to;
+ to_arg = lwi.to_arg;
+ }
+
time(&now);
- erts_fdprintf(fd, "=erl_crash_dump:0.3\n%s", ctime(&now));
+ erts_cbprintf(to, to_arg, "=erl_crash_dump:0.4\n%s", ctime(&now));
if (file != NULL)
- erts_fdprintf(fd, "The error occurred in file %s, line %d\n", file, line);
+ erts_cbprintf(to, to_arg, "The error occurred in file %s, line %d\n", file, line);
if (fmt != NULL && *fmt != '\0') {
- erts_fdprintf(fd, "Slogan: ");
- erts_vfdprintf(fd, fmt, args);
- }
- erts_fdprintf(fd, "System version: ");
- erts_print_system_version(fd, NULL, NULL);
- erts_fdprintf(fd, "%s\n", "Compiled: " ERLANG_COMPILE_DATE);
- erts_fdprintf(fd, "Taints: ");
- erts_print_nif_taints(fd, NULL);
- erts_fdprintf(fd, "Atoms: %d\n", atom_table_size());
- info(fd, NULL); /* General system info */
+ erts_cbprintf(to, to_arg, "Slogan: ");
+ erts_vcbprintf(to, to_arg, fmt, args);
+ }
+ erts_cbprintf(to, to_arg, "System version: ");
+ erts_print_system_version(to, to_arg, NULL);
+#if ERTS_SAVED_COMPILE_TIME
+ erts_cbprintf(to, to_arg, "%s\n", "Compiled: " ERLANG_COMPILE_DATE);
+#endif
+
+ erts_cbprintf(to, to_arg, "Taints: ");
+ erts_print_nif_taints(to, to_arg);
+ erts_cbprintf(to, to_arg, "Atoms: %d\n", atom_table_size());
+
+#ifdef USE_THREADS
+ /* We want to note which thread it was that called erts_exit */
+ if (erts_get_scheduler_data()) {
+ erts_cbprintf(to, to_arg, "Calling Thread: scheduler:%d\n",
+ erts_get_scheduler_data()->no);
+ } else {
+ if (!erts_thr_getname(erts_thr_self(), dumpnamebuf, MAXPATHLEN))
+ erts_cbprintf(to, to_arg, "Calling Thread: %s\n", dumpnamebuf);
+ else
+ erts_cbprintf(to, to_arg, "Calling Thread: %p\n", erts_thr_self());
+ }
+#else
+ erts_cbprintf(to, to_arg, "Calling Thread: scheduler:1\n");
+#endif
+
+#if defined(ERTS_HAVE_TRY_CATCH)
+
+ /*
+ * erts_print_scheduler_info is not guaranteed to be safe to call
+ * here for all schedulers as we may have suspended a scheduler
+ * in the middle of updating the STACK_TOP and STACK_START
+ * variables and thus when scanning the stack we could get
+ * segmentation faults. We protect against this very unlikely
+ * scenario by using the ERTS_SYS_TRY_CATCH.
+ */
+ for (i = 0; i < erts_no_schedulers; i++) {
+ ERTS_SYS_TRY_CATCH(
+ erts_print_scheduler_info(to, to_arg, ERTS_SCHEDULER_IX(i)),
+ erts_cbprintf(to, to_arg, "** crashed **\n"));
+ }
+#endif
+
+#ifdef ERTS_SMP
+
+#ifdef ERTS_SYS_SUSPEND_SIGNAL
+
+ /* We resume all schedulers so that we are in a known safe state
+ when we write the rest of the crash dump */
+ for (i = 0; i < erts_no_schedulers; i++) {
+ erts_tid_t tid = ERTS_SCHEDULER_IX(i)->tid;
+ if (!erts_equal_tids(tid,erts_thr_self()))
+ sys_thr_resume(tid);
+ }
+#endif
+
+ /*
+ * Wait for all managed threads to block. If all threads haven't blocked
+ * after a minute, we go anyway and hope for the best...
+ *
+ * We do not release system again. We expect an exit() or abort() after
+ * dump has been written.
+ */
+ erts_thr_progress_fatal_error_wait(60000);
+ /* Either worked or not... */
+#endif
+
+#ifndef ERTS_HAVE_TRY_CATCH
+ /* This is safe to call here, as all schedulers are blocked */
+ for (i = 0; i < erts_no_schedulers; i++) {
+ erts_print_scheduler_info(to, to_arg, ERTS_SCHEDULER_IX(i));
+ }
+#endif
+
+ info(to, to_arg); /* General system info */
if (erts_ptab_initialized(&erts_proc))
- process_info(fd, NULL); /* Info about each process and port */
- db_info(fd, NULL, 0);
- erts_print_bif_timer_info(fd, NULL);
- distribution_info(fd, NULL);
- erts_fdprintf(fd, "=loaded_modules\n");
- loaded(fd, NULL);
- erts_dump_fun_entries(fd, NULL);
- erts_deep_process_dump(fd, NULL);
- erts_fdprintf(fd, "=atoms\n");
- dump_atoms(fd, NULL);
+ process_info(to, to_arg); /* Info about each process and port */
+ db_info(to, to_arg, 0);
+ erts_print_bif_timer_info(to, to_arg);
+ distribution_info(to, to_arg);
+ erts_cbprintf(to, to_arg, "=loaded_modules\n");
+ loaded(to, to_arg);
+ erts_dump_fun_entries(to, to_arg);
+ erts_deep_process_dump(to, to_arg);
+ erts_cbprintf(to, to_arg, "=atoms\n");
+ dump_atoms(to, to_arg);
/* Keep the instrumentation data at the end of the dump */
if (erts_instr_memory_map || erts_instr_stat) {
- erts_fdprintf(fd, "=instr_data\n");
+ erts_cbprintf(to, to_arg, "=instr_data\n");
if (erts_instr_stat) {
- erts_fdprintf(fd, "=memory_status\n");
- erts_instr_dump_stat_to_fd(fd, 0);
+ erts_cbprintf(to, to_arg, "=memory_status\n");
+ erts_instr_dump_stat_to(to, to_arg, 0);
}
if (erts_instr_memory_map) {
- erts_fdprintf(fd, "=memory_map\n");
- erts_instr_dump_memory_map_to_fd(fd);
+ erts_cbprintf(to, to_arg, "=memory_map\n");
+ erts_instr_dump_memory_map_to(to, to_arg);
}
}
- erts_fdprintf(fd, "=end\n");
+ erts_cbprintf(to, to_arg, "=end\n");
+ if (fp) {
+ fclose(fp);
+ }
close(fd);
- erts_fprintf(stderr,"\nCrash dump was written to: %s\n", dumpname);
+ erts_fprintf(stderr,"done\n");
}
-void
-erl_crash_dump(char* file, int line, char* fmt, ...)
-{
- va_list args;
-
- va_start(args, fmt);
- erl_crash_dump_v(file, line, fmt, args);
- va_end(args);
-}
diff --git a/erts/emulator/beam/code_ix.c b/erts/emulator/beam/code_ix.c
index 4344558348..8a3d1b20b4 100644
--- a/erts/emulator/beam/code_ix.c
+++ b/erts/emulator/beam/code_ix.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2012. All Rights Reserved.
+ * Copyright Ericsson AB 2012-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -56,7 +57,8 @@ void erts_code_ix_init(void)
*/
erts_smp_atomic32_init_nob(&the_active_code_index, 0);
erts_smp_atomic32_init_nob(&the_staging_code_index, 0);
- erts_smp_mtx_init(&code_write_permission_mtx, "code_write_permission");
+ erts_smp_mtx_init(&code_write_permission_mtx, "code_write_permission", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_tsd_key_create(&has_code_write_permission,
"erts_has_code_write_permission");
@@ -64,12 +66,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");
}
@@ -93,6 +95,7 @@ void erts_commit_staging_code_ix(void)
ix = (ix + 1) % ERTS_NUM_CODE_IX;
erts_smp_atomic32_set_nob(&the_staging_code_index, ix);
export_staging_unlock();
+ erts_tracer_nif_clear();
CIX_TRACE("activate");
}
@@ -130,7 +133,7 @@ int erts_try_seize_code_write_permission(Process* c_p)
ASSERT(code_writing_process != c_p);
qitem = erts_alloc(ERTS_ALC_T_CODE_IX_LOCK_Q, sizeof(*qitem));
qitem->p = c_p;
- erts_smp_proc_inc_refc(c_p);
+ erts_proc_inc_refc(c_p);
qitem->next = code_write_queue;
code_write_queue = qitem;
erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL);
@@ -151,7 +154,7 @@ void erts_release_code_write_permission(void)
}
erts_smp_proc_unlock(qitem->p, ERTS_PROC_LOCK_STATUS);
code_write_queue = qitem->next;
- erts_smp_proc_dec_refc(qitem->p);
+ erts_proc_dec_refc(qitem->p);
erts_free(ERTS_ALC_T_CODE_IX_LOCK_Q, qitem);
}
code_writing_process = NULL;
diff --git a/erts/emulator/beam/code_ix.h b/erts/emulator/beam/code_ix.h
index 16ad900228..a28b0cd36e 100644
--- a/erts/emulator/beam/code_ix.h
+++ b/erts/emulator/beam/code_ix.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2012-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2012-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -55,12 +56,55 @@
# endif
# include "sys.h"
#endif
+
+#include "beam_opcodes.h"
+
struct process;
#define ERTS_NUM_CODE_IX 3
typedef unsigned ErtsCodeIndex;
+typedef struct ErtsCodeMFA_ {
+ Eterm module;
+ Eterm function;
+ Uint arity;
+} ErtsCodeMFA;
+
+/*
+ * The ErtsCodeInfo structure is used both in the Export entry
+ * and in the code as the function header.
+ */
+
+/* If you change the size of this, you also have to update the code
+ in ops.tab to reflect the new func_info size */
+typedef struct ErtsCodeInfo_ {
+ BeamInstr op; /* OpCode(i_func_info) */
+ union {
+ struct generic_bp* gen_bp; /* Trace breakpoint */
+#ifdef HIPE
+ void (*ncallee)(void);
+ struct hipe_call_count* hcc;
+#endif
+ }u;
+ ErtsCodeMFA mfa;
+} ErtsCodeInfo;
+
+/* Get the code associated with a ErtsCodeInfo ptr. */
+ERTS_GLB_INLINE
+BeamInstr *erts_codeinfo_to_code(ErtsCodeInfo *ci);
+
+/* Get the ErtsCodeInfo for from a code ptr. */
+ERTS_GLB_INLINE
+ErtsCodeInfo *erts_code_to_codeinfo(BeamInstr *I);
+
+/* Get the code associated with a ErtsCodeMFA ptr. */
+ERTS_GLB_INLINE
+BeamInstr *erts_codemfa_to_code(ErtsCodeMFA *mfa);
+
+/* Get the ErtsCodeMFA from a code ptr. */
+ERTS_GLB_INLINE
+ErtsCodeMFA *erts_code_to_codemfa(BeamInstr *I);
/* Called once at emulator initialization.
*/
@@ -99,7 +143,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".
@@ -120,10 +164,47 @@ void erts_abort_staging_code_ix(void);
int erts_has_code_write_permission(void);
#endif
-
+/* module/function/arity can be NIL/NIL/-1 when the MFA is pointing to some
+ invalid code, for instance unloaded_fun. */
+#define ASSERT_MFA(MFA) \
+ ASSERT((is_atom((MFA)->module) || is_nil((MFA)->module)) && \
+ (is_atom((MFA)->function) || is_nil((MFA)->function)) && \
+ (((MFA)->arity >= 0 && (MFA)->arity < 1024) || (MFA)->arity == -1))
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+ERTS_GLB_INLINE
+BeamInstr *erts_codeinfo_to_code(ErtsCodeInfo *ci)
+{
+ ASSERT(ci->op == (BeamInstr) BeamOp(op_i_func_info_IaaI) || !ci->op);
+ ASSERT_MFA(&ci->mfa);
+ return (BeamInstr*)(ci + 1);
+}
+
+ERTS_GLB_INLINE
+ErtsCodeInfo *erts_code_to_codeinfo(BeamInstr *I)
+{
+ ErtsCodeInfo *ci = ((ErtsCodeInfo *)(((char *)(I)) - sizeof(ErtsCodeInfo)));
+ ASSERT(ci->op == (BeamInstr) BeamOp(op_i_func_info_IaaI) || !ci->op);
+ ASSERT_MFA(&ci->mfa);
+ return ci;
+}
+
+ERTS_GLB_INLINE
+BeamInstr *erts_codemfa_to_code(ErtsCodeMFA *mfa)
+{
+ ASSERT_MFA(mfa);
+ return (BeamInstr*)(mfa + 1);
+}
+
+ERTS_GLB_INLINE
+ErtsCodeMFA *erts_code_to_codemfa(BeamInstr *I)
+{
+ ErtsCodeMFA *mfa = ((ErtsCodeMFA *)(((char *)(I)) - sizeof(ErtsCodeMFA)));
+ ASSERT_MFA(mfa);
+ return mfa;
+}
+
extern erts_smp_atomic32_t the_active_code_index;
extern erts_smp_atomic32_t the_staging_code_index;
diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c
index 50548850eb..fefde256d7 100644
--- a/erts/emulator/beam/copy.c
+++ b/erts/emulator/beam/copy.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2012. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -21,6 +22,8 @@
# include "config.h"
#endif
+#define ERL_WANT_GC_INTERNALS__
+
#include "sys.h"
#include "erl_vm.h"
#include "global.h"
@@ -32,69 +35,86 @@
#include "erl_bits.h"
#include "dtrace-wrapper.h"
-static void move_one_frag(Eterm** hpp, Eterm* src, Uint src_sz, ErlOffHeap*);
+static void move_one_frag(Eterm** hpp, ErlHeapFragment*, ErlOffHeap*, int);
/*
* Copy object "obj" to process p.
*/
-Eterm
-copy_object(Eterm obj, Process* to)
+Eterm copy_object_x(Eterm obj, Process* to, Uint extra)
{
- Uint size = size_object(obj);
- Eterm* hp = HAlloc(to, size);
- Eterm res;
+ 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
+#define in_literal_purge_area(PTR) \
+ (lit_purge_ptr && ( \
+ (lit_purge_ptr <= (PTR) && \
+ (PTR) < (lit_purge_ptr + lit_purge_sz))))
+
+Uint size_object_x(Eterm obj, erts_literal_area_t *litopt)
{
Uint sum = 0;
Eterm* ptr;
int arity;
-
+ Eterm *lit_purge_ptr = litopt ? litopt->lit_purge_ptr : NULL;
+ Uint lit_purge_sz = litopt ? litopt->lit_purge_sz : 0;
+#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:
+ ptr = list_val(obj);
+ if (litopt && erts_is_literal(obj,ptr) && !in_literal_purge_area(ptr)) {
+ goto pop_next;
+ }
sum += 2;
- ptr = list_val_rel(obj,base);
obj = *ptr++;
if (!IS_CONST(obj)) {
ESTACK_PUSH(s, obj);
- }
+ }
obj = *ptr;
break;
case TAG_PRIMARY_BOXED:
{
- Eterm hdr = *boxed_val_rel(obj,base);
+ Eterm hdr;
+ ptr = boxed_val(obj);
+ if (litopt && erts_is_literal(obj,ptr) && !in_literal_purge_area(ptr)) {
+ goto pop_next;
+ }
+ hdr = *ptr;
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. */
@@ -110,7 +130,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);
@@ -125,6 +145,52 @@ Uint size_object(Eterm obj)
obj = *bptr;
break;
}
+ case MAP_SUBTAG:
+ switch (MAP_HEADER_TYPE(hdr)) {
+ case MAP_HEADER_TAG_FLATMAP_HEAD :
+ {
+ Uint n;
+ flatmap_t *mp;
+ mp = (flatmap_t*)flatmap_val(obj);
+ ptr = (Eterm *)mp;
+ n = flatmap_get_size(mp) + 1;
+ sum += n + 2;
+ ptr += 2; /* hdr + size words */
+ while (n--) {
+ obj = *ptr++;
+ if (!IS_CONST(obj)) {
+ ESTACK_PUSH(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 :
+ {
+ Eterm *head;
+ Uint sz;
+ head = hashmap_val(obj);
+ sz = hashmap_bitcount(MAP_HEADER_VAL(hdr));
+ sum += 1 + sz + header_arity(hdr);
+ head += 1 + header_arity(hdr);
+
+ if (sz == 0) {
+ goto pop_next;
+ }
+ while(sz-- > 1) {
+ obj = head[sz];
+ if (!IS_CONST(obj)) {
+ ESTACK_PUSH(s, obj);
+ }
+ }
+ obj = head[0];
+ }
+ break;
+ default:
+ erts_exit(ERTS_ABORT_EXIT, "size_object: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr));
+ }
+ break;
case SUB_BINARY_SUBTAG:
{
Eterm real_bin;
@@ -133,7 +199,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;
@@ -143,35 +209,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 MAP_SUBTAG:
- {
- Uint n;
- map_t *mp;
- mp = (map_t*)map_val_rel(obj,base);
- ptr = (Eterm *)mp;
- n = map_get_size(mp) + 1;
- sum += n + 2;
- ptr += 2; /* hdr + size words */
- while (n--) {
- obj = *ptr++;
- if (!IS_CONST(obj)) {
- ESTACK_PUSH(s, obj);
- }
- }
- goto pop_next;
- }
- break;
- case BIN_MATCHSTATE_SUBTAG:
- erl_exit(ERTS_ABORT_EXIT,
+ case BIN_MATCHSTATE_SUBTAG:
+ erts_exit(ERTS_ABORT_EXIT,
"size_object: matchstate term not allowed");
default:
sum += thing_arityval(hdr) + 1;
@@ -183,25 +231,380 @@ 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 COUNT_OFF_HEAP (0)
+
+/*
+ * 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, erts_literal_area_t *litopt)
{
char* hstart;
Uint hsize;
@@ -216,19 +619,25 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
Eterm* argp;
Eterm* const_tuple;
Eterm hdr;
+ Eterm *hend;
int i;
+ Eterm *lit_purge_ptr = litopt ? litopt->lit_purge_ptr : NULL;
+ Uint lit_purge_sz = litopt ? litopt->lit_purge_sz : 0;
#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;
@@ -237,11 +646,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);
}
@@ -249,25 +658,25 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
L_copy:
while (hp != htop) {
obj = *hp;
-
switch (primary_tag(obj)) {
case TAG_PRIMARY_IMMED1:
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 */
L_copy_list:
tailp = argp;
+ if (litopt && erts_is_literal(obj,objp) && !in_literal_purge_area(objp)) {
+ *tailp = obj;
+ goto L_copy;
+ }
for (;;) {
tp = tailp;
elem = CAR(objp);
@@ -275,55 +684,53 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
hbot -= 2;
CAR(hbot) = elem;
tailp = &CDR(hbot);
- }
- else {
+ } 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);
+
+ if (litopt && erts_is_literal(obj,objp) && !in_literal_purge_area(objp)) {
+ *tailp = obj;
+ goto L_copy;
+ }
}
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);
+ if (litopt && erts_is_literal(obj,objp) && !in_literal_purge_area(objp)) {
+ *argp = obj;
+ break;
+ }
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--) {
@@ -338,15 +745,6 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
}
}
break;
- case MAP_SUBTAG:
- {
- i = map_get_size(objp) + 3;
- *argp = make_map_rel(htop, dst_base);
- while (i--) {
- *htop++ = *objp++;
- }
- }
- break;
case REFC_BINARY_SUBTAG:
{
ProcBin* pb;
@@ -361,9 +759,9 @@ 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);
+ erts_refc_inc(&pb->val->intern.refc, 2);
pb->next = off_heap->first;
pb->flags = 0;
off_heap->first = (struct erl_off_heap_header*) pb;
@@ -386,9 +784,9 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
extra_bytes = 1;
} else {
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;
@@ -401,7 +799,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
} else {
ProcBin* from = (ProcBin *) objp;
ProcBin* to;
-
+
ASSERT(thing_subtag(*objp) == REFC_BINARY_SUBTAG);
if (from->flags) {
erts_emasculate_writable_binary(from);
@@ -411,14 +809,14 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
to->thing_word = HEADER_PROC_BIN;
to->size = real_size;
to->val = from->val;
- erts_refc_inc(&to->val->refc, 2);
+ erts_refc_inc(&to->val->intern.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));
}
- *argp = make_binary_rel(hbot, dst_base);
+ *argp = make_binary(hbot);
if (extra_bytes != 0) {
ErlSubBin* res;
hbot -= ERL_SUB_BIN_SIZE;
@@ -430,7 +828,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;
}
@@ -447,38 +845,71 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
funp = (ErlFunThing *) tp;
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);
+ erts_smp_refc_inc(&funp->fe->refc, 2);
+ *argp = make_fun(tp);
}
break;
case EXTERNAL_PID_SUBTAG:
case EXTERNAL_PORT_SUBTAG:
case EXTERNAL_REF_SUBTAG:
{
- ExternalThing *etp = (ExternalThing *) htop;
-
- i = thing_arityval(hdr) + 1;
+ ExternalThing *etp = (ExternalThing *) objp;
+ erts_smp_refc_inc(&etp->node->refc, 2);
+ }
+ L_off_heap_node_container_common:
+ {
+ struct erl_off_heap_header *ohhp;
+ ohhp = (struct erl_off_heap_header *) htop;
+ i = thing_arityval(hdr) + 1;
+ *argp = make_boxed(htop);
tp = htop;
while (i--) {
*htop++ = *objp++;
}
- etp->next = off_heap->first;
- off_heap->first = (struct erl_off_heap_header*)etp;
- erts_refc_inc(&etp->node->refc, 2);
+ ohhp->next = off_heap->first;
+ off_heap->first = ohhp;
- *argp = make_external_rel(tp, dst_base);
+ }
+ break;
+ case MAP_SUBTAG:
+ tp = htop;
+ switch (MAP_HEADER_TYPE(hdr)) {
+ case MAP_HEADER_TAG_FLATMAP_HEAD :
+ i = flatmap_get_size(objp) + 3;
+ *argp = make_flatmap(htop);
+ while (i--) {
+ *htop++ = *objp++;
+ }
+ break;
+ case MAP_HEADER_TAG_HAMT_HEAD_BITMAP :
+ case MAP_HEADER_TAG_HAMT_HEAD_ARRAY :
+ *htop++ = *objp++;
+ case MAP_HEADER_TAG_HAMT_NODE_BITMAP :
+ i = 1 + hashmap_bitcount(MAP_HEADER_VAL(hdr));
+ while (i--) { *htop++ = *objp++; }
+ *argp = make_hashmap(tp);
+ break;
+ default:
+ 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");
+ case REF_SUBTAG:
+ if (is_magic_ref_thing(objp)) {
+ ErtsMRefThing *mreft = (ErtsMRefThing *) objp;
+ erts_refc_inc(&mreft->mb->intern.refc, 2);
+ goto L_off_heap_node_container_common;
+ }
+ /* Fall through... */
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++;
}
@@ -494,22 +925,893 @@ 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 (!eq(org_obj, res)) {
+ erts_exit(ERTS_ABORT_EXIT,
+ "Internal error in copy_struct() when copying %T:"
+ " not equal to copy %T\n",
+ org_obj, res);
+ }
+ 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;
+ Eterm *lit_purge_ptr = info->lit_purge_ptr;
+ Uint lit_purge_sz = info->lit_purge_sz;
+#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(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(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;
+ Eterm *lit_purge_ptr = info->lit_purge_ptr;
+ Uint lit_purge_sz = info->lit_purge_sz;
+#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(ptr)) {
+ *resp = obj;
+ } else {
+ Uint bsz = 0;
+ *resp = copy_struct_x(obj, hbot - hp, &hp, off_heap, &bsz, NULL); /* copy literal */
+ 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(ptr)) {
+ *resp = obj;
+ } else {
+ Uint bsz = 0;
+ *resp = copy_struct_x(obj, hbot - hp, &hp, off_heap, &bsz, NULL); /* copy literal */
+ 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_smp_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->intern.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->intern.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 *) ptr;
+ erts_smp_refc_inc(&etp->node->refc, 2);
+ }
+ off_heap_node_container_common:
+ {
+ struct erl_off_heap_header *ohhp;
+ ohhp = (struct erl_off_heap_header *) hp;
+ sz = thing_arityval(hdr);
+ *resp = make_boxed(hp);
+ *hp++ = hdr;
+ ptr++;
+ while (sz-- > 0) {
+ *hp++ = *ptr++;
+ }
+ ohhp->next = off_heap->first;
+ off_heap->first = ohhp;
+ goto cleanup_next;
+ }
+ case REF_SUBTAG:
+ if (is_magic_ref_thing(ptr)) {
+ ErtsMRefThing *mreft = (ErtsMRefThing *) ptr;
+ erts_refc_inc(&mreft->mb->intern.refc, 2);
+ goto off_heap_node_container_common;
+ }
+ /* Fall through... */
+ 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
@@ -519,21 +1821,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++;
@@ -554,7 +1847,7 @@ Eterm copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
case REFC_BINARY_SUBTAG:
{
ProcBin* pb = (ProcBin *) (tp-1);
- erts_refc_inc(&pb->val->refc, 2);
+ erts_refc_inc(&pb->val->intern.refc, 2);
OH_OVERHEAD(off_heap, pb->size / sizeof(Eterm));
}
goto off_heap_common;
@@ -562,20 +1855,15 @@ Eterm copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
case FUN_SUBTAG:
{
ErlFunThing* funp = (ErlFunThing *) (tp-1);
- erts_refc_inc(&funp->fe->refc, 2);
+ erts_smp_refc_inc(&funp->fe->refc, 2);
}
goto off_heap_common;
-
- case MAP_SUBTAG:
- *hp++ = *tp++;
- sz--;
- break;
case EXTERNAL_PID_SUBTAG:
case EXTERNAL_PORT_SUBTAG:
case EXTERNAL_REF_SUBTAG:
{
ExternalThing* etp = (ExternalThing *) (tp-1);
- erts_refc_inc(&etp->node->refc, 2);
+ erts_smp_refc_inc(&etp->node->refc, 2);
}
off_heap_common:
{
@@ -590,6 +1878,15 @@ Eterm copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
off_heap->first = ohh;
}
break;
+ case REF_SUBTAG: {
+ ErtsRefThing *rtp = (ErtsRefThing *) (tp - 1);
+ if (is_magic_ref_thing(rtp)) {
+ ErtsMRefThing *mreft = (ErtsMRefThing *) rtp;
+ erts_refc_inc(&mreft->mb->intern.refc, 2);
+ goto off_heap_common;
+ }
+ /* Fall through... */
+ }
default:
{
int tari = header_arity(val);
@@ -605,7 +1902,6 @@ Eterm copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
}
}
*hpp = hp;
-
return res;
}
@@ -614,18 +1910,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->mem, bp->used_size, off_heap);
- OH_OVERHEAD(off_heap, bp->off_heap.overhead);
+ move_one_frag(hpp, bp, off_heap, literals);
}
hp_end = *hpp;
for (hp=hp_start; hp<hp_end; ++hp) {
@@ -638,6 +1940,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;
@@ -645,7 +1950,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:
@@ -656,15 +1965,15 @@ 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, Eterm* src, Uint src_sz, ErlOffHeap* off_heap)
+move_one_frag(Eterm** hpp, ErlHeapFragment* frag, ErlOffHeap* off_heap, int literals)
{
- Eterm* ptr = src;
- Eterm* end = ptr + src_sz;
+ Eterm* ptr = frag->mem;
+ Eterm* end = ptr + frag->used_size;
Eterm dummy_ref;
Eterm* hp = *hpp;
@@ -676,8 +1985,11 @@ move_one_frag(Eterm** hpp, Eterm* src, Uint src_sz, ErlOffHeap* off_heap)
if (is_header(val)) {
struct erl_off_heap_header* hdr = (struct erl_off_heap_header*)hp;
ASSERT(ptr + header_arity(val) < end);
- MOVE_BOXED(ptr, val, hp, &dummy_ref);
+ move_boxed(&ptr, val, &hp, &dummy_ref);
switch (val & _HEADER_SUBTAG_MASK) {
+ case REF_SUBTAG:
+ if (is_ordinary_ref_thing(hdr))
+ break;
case REFC_BINARY_SUBTAG:
case FUN_SUBTAG:
case EXTERNAL_PID_SUBTAG:
@@ -690,10 +2002,11 @@ move_one_frag(Eterm** hpp, Eterm* src, Uint src_sz, ErlOffHeap* off_heap)
}
else { /* must be a cons cell */
ASSERT(ptr+1 < end);
- MOVE_CONS(ptr, val, hp, &dummy_ref);
+ move_cons(&ptr, val, &hp, &dummy_ref);
ptr += 2;
}
}
*hpp = hp;
+ 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 ec07ddcd9c..09fdb897f5 100644
--- a/erts/emulator/beam/dist.c
+++ b/erts/emulator/beam/dist.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -24,6 +25,7 @@
/* define this to get a lot of debug output */
/* #define ERTS_DIST_MSG_DBG */
+/* #define ERTS_RAW_DIST_MSG_DBG */
#ifdef HAVE_CONFIG_H
# include "config.h"
@@ -44,6 +46,8 @@
#include "erl_thr_progress.h"
#include "dtrace-wrapper.h"
+#define DIST_CTL_DEFAULT_SIZE 64
+
/* Turn this on to get printouts of all distribution messages
* which go on the line
*/
@@ -65,9 +69,13 @@ static void bw(byte *buf, ErlDrvSizeT sz)
static void
dist_msg_dbg(ErtsDistExternal *edep, char *what, byte *buf, int sz)
{
+ ErtsHeapFactory factory;
+ DeclareTmpHeapNoproc(ctl_default,DIST_CTL_DEFAULT_SIZE);
+ Eterm* ctl = ctl_default;
byte *extp = edep->extp;
Eterm msg;
- Sint size = erts_decode_dist_ext_size(edep);
+ Sint ctl_len;
+ Sint size = ctl_len = erts_decode_dist_ext_size(edep);
if (size < 0) {
erts_fprintf(stderr,
"DIST MSG DEBUG: erts_decode_dist_ext_size(%s) failed:\n",
@@ -75,10 +83,9 @@ dist_msg_dbg(ErtsDistExternal *edep, char *what, byte *buf, int sz)
bw(buf, sz);
}
else {
- Eterm *hp;
ErlHeapFragment *mbuf = new_message_buffer(size);
- hp = mbuf->mem;
- msg = erts_decode_dist_ext(&hp, &mbuf->off_heap, edep);
+ erts_factory_static_init(&factory, ctl, ctl_len, &mbuf->off_heap);
+ msg = erts_decode_dist_ext(&factory, edep);
if (is_value(msg))
erts_fprintf(stderr, " %s: %T\n", what, msg);
else {
@@ -119,7 +126,7 @@ Export* dmonitor_p_trap = NULL;
/* forward declarations */
static void clear_dist_entry(DistEntry*);
-static int dsig_send(ErtsDSigData *, Eterm, Eterm, int);
+static int dsig_send_ctl(ErtsDSigData* dsdp, Eterm ctl, int force_busy);
static void send_nodes_mon_msgs(Process *, Eterm, Eterm, Eterm, Eterm);
static void init_nodes_monitors(void);
@@ -252,12 +259,12 @@ static void doit_monitor_net_exits(ErtsMonitor *mon, void *vnecp)
DistEntry *dep = ((NetExitsContext *) vnecp)->dep;
ErtsProcLocks rp_locks = ERTS_PROC_LOCK_LINK;
- rp = erts_pid2proc(NULL, 0, mon->pid, rp_locks);
+ rp = erts_pid2proc(NULL, 0, mon->u.pid, rp_locks);
if (!rp)
goto done;
if (mon->type == MON_ORIGIN) {
- /* local pid is beeing monitored */
+ /* local pid is being monitored */
rmon = erts_remove_monitor(&ERTS_P_MONITORS(rp), mon->ref);
/* ASSERT(rmon != NULL); nope, can happen during process exit */
if (rmon != NULL) {
@@ -271,10 +278,11 @@ static void doit_monitor_net_exits(ErtsMonitor *mon, void *vnecp)
rmon = erts_remove_monitor(&ERTS_P_MONITORS(rp), mon->ref);
/* ASSERT(rmon != NULL); can happen during process exit */
if (rmon != NULL) {
+ ASSERT(rmon->type == MON_ORIGIN);
ASSERT(is_atom(rmon->name) || is_nil(rmon->name));
watched = (is_atom(rmon->name)
? TUPLE2(lhp, rmon->name, dep->sysname)
- : rmon->pid);
+ : rmon->u.pid);
#ifdef ERTS_SMP
rp_locks |= ERTS_PROC_LOCKS_MSG_SEND;
erts_smp_proc_lock(rp, ERTS_PROC_LOCKS_MSG_SEND);
@@ -331,7 +339,7 @@ static void doit_link_net_exits_sub(ErtsLink *sublnk, void *vlnecp)
erts_destroy_link(rlnk);
if (xres >= 0 && IS_TRACED_FL(rp, F_TRACE_PROCS)) {
/* We didn't exit the process and it is traced */
- trace_proc(NULL, rp, am_getting_unlinked, sublnk->pid);
+ trace_proc(NULL, 0, rp, am_getting_unlinked, sublnk->pid);
}
}
erts_smp_proc_unlock(rp, rp_locks);
@@ -372,10 +380,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));
@@ -383,16 +392,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
-#ifdef USE_VM_PROBES
- , NIL
-#endif
- );
+ erts_queue_message(rp, rp_locks, msgp, tup, am_system);
}
erts_smp_proc_unlock(rp, rp_locks);
}
@@ -622,9 +629,6 @@ alloc_dist_obuf(Uint size)
ErtsDistOutputBuf *obuf;
Uint obuf_size = sizeof(ErtsDistOutputBuf)+sizeof(byte)*(size-1);
Binary *bin = erts_bin_drv_alloc(obuf_size);
- bin->flags = BIN_FLAG_DRV;
- erts_refc_init(&bin->refc, 1);
- bin->orig_size = (SWord) obuf_size;
obuf = (ErtsDistOutputBuf *) &bin->orig_bytes[0];
#ifdef DEBUG
obuf->dbg_pattern = ERTS_DIST_OUTPUT_BUF_DBG_PATTERN;
@@ -638,8 +642,7 @@ free_dist_obuf(ErtsDistOutputBuf *obuf)
{
Binary *bin = ErtsDistOutputBuf2Binary(obuf);
ASSERT(obuf->dbg_pattern == ERTS_DIST_OUTPUT_BUF_DBG_PATTERN);
- if (erts_refc_dectest(&bin->refc, 0) == 0)
- erts_bin_free(bin);
+ erts_bin_release(bin);
}
static ERTS_INLINE Sint
@@ -709,6 +712,49 @@ static void clear_dist_entry(DistEntry *dep)
}
}
+int erts_dsend_context_dtor(Binary* ctx_bin)
+{
+ ErtsSendContext* ctx = ERTS_MAGIC_BIN_DATA(ctx_bin);
+ switch (ctx->dss.phase) {
+ case ERTS_DSIG_SEND_PHASE_MSG_SIZE:
+ DESTROY_SAVED_WSTACK(&ctx->dss.u.sc.wstack);
+ break;
+ case ERTS_DSIG_SEND_PHASE_MSG_ENCODE:
+ DESTROY_SAVED_WSTACK(&ctx->dss.u.ec.wstack);
+ break;
+ default:;
+ }
+ if (ctx->dss.phase >= ERTS_DSIG_SEND_PHASE_ALLOC && ctx->dss.obuf) {
+ free_dist_obuf(ctx->dss.obuf);
+ }
+ if (ctx->dep_to_deref)
+ erts_deref_dist_entry(ctx->dep_to_deref);
+
+ return 1;
+}
+
+Eterm erts_dsend_export_trap_context(Process* p, ErtsSendContext* ctx)
+{
+ struct exported_ctx {
+ ErtsSendContext ctx;
+ ErtsAtomCacheMap acm;
+ };
+ 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);
+ Eterm* hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE);
+
+ sys_memcpy(&dst->ctx, ctx, sizeof(ErtsSendContext));
+ ASSERT(ctx->dss.ctl == make_tuple(ctx->ctl_heap));
+ dst->ctx.dss.ctl = make_tuple(dst->ctx.ctl_heap);
+ if (ctx->dss.acmp) {
+ sys_memcpy(&dst->acm, ctx->dss.acmp, sizeof(ErtsAtomCacheMap));
+ dst->ctx.dss.acmp = &dst->acm;
+ }
+ return erts_mk_magic_ref(&hp, &MSO(p), ctx_bin);
+}
+
+
/*
* The erts_dsig_send_*() functions implemented below, sends asynchronous
* distributed signals to other Erlang nodes. Before sending a distributed
@@ -731,7 +777,7 @@ erts_dsig_send_link(ErtsDSigData *dsdp, Eterm local, Eterm remote)
int res;
UseTmpHeapNoproc(4);
- res = dsig_send(dsdp, ctl, THE_NON_VALUE, 0);
+ res = dsig_send_ctl(dsdp, ctl, 0);
UnUseTmpHeapNoproc(4);
return res;
}
@@ -744,13 +790,13 @@ erts_dsig_send_unlink(ErtsDSigData *dsdp, Eterm local, Eterm remote)
int res;
UseTmpHeapNoproc(4);
- res = dsig_send(dsdp, ctl, THE_NON_VALUE, 0);
+ res = dsig_send_ctl(dsdp, ctl, 0);
UnUseTmpHeapNoproc(4);
return res;
}
-/* A local process that's beeing monitored by a remote one exits. We send:
+/* A local process that's being monitored by a remote one exits. We send:
{DOP_MONITOR_P_EXIT, Local pid or name, Remote pid, ref, reason},
which is rather sad as only the ref is needed, no pid's... */
int
@@ -772,7 +818,7 @@ erts_dsig_send_m_exit(ErtsDSigData *dsdp, Eterm watcher, Eterm watched,
erts_smp_de_links_unlock(dsdp->dep);
#endif
- res = dsig_send(dsdp, ctl, THE_NON_VALUE, 1);
+ res = dsig_send_ctl(dsdp, ctl, 1);
UnUseTmpHeapNoproc(6);
return res;
}
@@ -793,7 +839,7 @@ erts_dsig_send_monitor(ErtsDSigData *dsdp, Eterm watcher, Eterm watched,
make_small(DOP_MONITOR_P),
watcher, watched, ref);
- res = dsig_send(dsdp, ctl, THE_NON_VALUE, 0);
+ res = dsig_send_ctl(dsdp, ctl, 0);
UnUseTmpHeapNoproc(5);
return res;
}
@@ -815,18 +861,17 @@ erts_dsig_send_demonitor(ErtsDSigData *dsdp, Eterm watcher,
make_small(DOP_DEMONITOR_P),
watcher, watched, ref);
- res = dsig_send(dsdp, ctl, THE_NON_VALUE, force);
+ res = dsig_send_ctl(dsdp, ctl, force);
UnUseTmpHeapNoproc(5);
return res;
}
int
-erts_dsig_send_msg(ErtsDSigData *dsdp, Eterm remote, Eterm message)
+erts_dsig_send_msg(Eterm remote, Eterm message, ErtsSendContext* ctx)
{
Eterm ctl;
- DeclareTmpHeapNoproc(ctl_heap,5);
Eterm token = NIL;
- Process *sender = dsdp->proc;
+ Process *sender = ctx->dsd.proc;
int res;
#ifdef USE_VM_PROBES
Sint tok_label = 0;
@@ -838,12 +883,7 @@ erts_dsig_send_msg(ErtsDSigData *dsdp, Eterm remote, Eterm message)
DTRACE_CHARBUF(receiver_name, 64);
#endif
- UseTmpHeapNoproc(5);
- 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);
@@ -852,13 +892,13 @@ erts_dsig_send_msg(ErtsDSigData *dsdp, Eterm remote, Eterm message)
*node_name = *sender_name = *receiver_name = '\0';
if (DTRACE_ENABLED(message_send) || DTRACE_ENABLED(message_send_remote)) {
erts_snprintf(node_name, sizeof(DTRACE_CHARBUF_NAME(node_name)),
- "%T", dsdp->dep->sysname);
+ "%T", ctx->dsd.dep->sysname);
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", 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));
@@ -867,26 +907,28 @@ erts_dsig_send_msg(ErtsDSigData *dsdp, Eterm remote, Eterm message)
#endif
if (token != NIL)
- ctl = TUPLE4(&ctl_heap[0],
- make_small(DOP_SEND_TT), am_Cookie, remote, token);
+ ctl = TUPLE4(&ctx->ctl_heap[0],
+ make_small(DOP_SEND_TT), am_Empty, remote, token);
else
- ctl = TUPLE3(&ctl_heap[0], make_small(DOP_SEND), am_Cookie, remote);
+ ctl = TUPLE3(&ctx->ctl_heap[0], make_small(DOP_SEND), am_Empty, remote);
DTRACE6(message_send, sender_name, receiver_name,
msize, tok_label, tok_lastcnt, tok_serial);
DTRACE7(message_send_remote, sender_name, node_name, receiver_name,
msize, tok_label, tok_lastcnt, tok_serial);
- res = dsig_send(dsdp, ctl, message, 0);
- UnUseTmpHeapNoproc(5);
+ ctx->dss.ctl = ctl;
+ ctx->dss.msg = message;
+ ctx->dss.force_busy = 0;
+ res = erts_dsig_send(&ctx->dsd, &ctx->dss);
return res;
}
int
-erts_dsig_send_reg_msg(ErtsDSigData *dsdp, Eterm remote_name, Eterm message)
+erts_dsig_send_reg_msg(Eterm remote_name, Eterm message,
+ ErtsSendContext* ctx)
{
Eterm ctl;
- DeclareTmpHeapNoproc(ctl_heap,6);
Eterm token = NIL;
- Process *sender = dsdp->proc;
+ Process *sender = ctx->dsd.proc;
int res;
#ifdef USE_VM_PROBES
Sint tok_label = 0;
@@ -898,12 +940,7 @@ erts_dsig_send_reg_msg(ErtsDSigData *dsdp, Eterm remote_name, Eterm message)
DTRACE_CHARBUF(receiver_name, 128);
#endif
- UseTmpHeapNoproc(6);
- 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);
@@ -912,13 +949,13 @@ erts_dsig_send_reg_msg(ErtsDSigData *dsdp, Eterm remote_name, Eterm message)
*node_name = *sender_name = *receiver_name = '\0';
if (DTRACE_ENABLED(message_send) || DTRACE_ENABLED(message_send_remote)) {
erts_snprintf(node_name, sizeof(DTRACE_CHARBUF_NAME(node_name)),
- "%T", dsdp->dep->sysname);
+ "%T", ctx->dsd.dep->sysname);
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,%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));
@@ -927,17 +964,19 @@ erts_dsig_send_reg_msg(ErtsDSigData *dsdp, Eterm remote_name, Eterm message)
#endif
if (token != NIL)
- ctl = TUPLE5(&ctl_heap[0], make_small(DOP_REG_SEND_TT),
- sender->common.id, am_Cookie, remote_name, token);
+ ctl = TUPLE5(&ctx->ctl_heap[0], make_small(DOP_REG_SEND_TT),
+ sender->common.id, am_Empty, remote_name, token);
else
- ctl = TUPLE4(&ctl_heap[0], make_small(DOP_REG_SEND),
- sender->common.id, am_Cookie, remote_name);
+ ctl = TUPLE4(&ctx->ctl_heap[0], make_small(DOP_REG_SEND),
+ sender->common.id, am_Empty, remote_name);
DTRACE6(message_send, sender_name, receiver_name,
msize, tok_label, tok_lastcnt, tok_serial);
DTRACE7(message_send_remote, sender_name, node_name, receiver_name,
msize, tok_label, tok_lastcnt, tok_serial);
- res = dsig_send(dsdp, ctl, message, 0);
- UnUseTmpHeapNoproc(6);
+ ctx->dss.ctl = ctl;
+ ctx->dss.msg = message;
+ ctx->dss.force_busy = 0;
+ res = erts_dsig_send(&ctx->dsd, &ctx->dss);
return res;
}
@@ -961,11 +1000,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],
@@ -984,7 +1019,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));
@@ -994,7 +1029,7 @@ erts_dsig_send_exit_tt(ErtsDSigData *dsdp, Eterm local, Eterm remote,
DTRACE7(process_exit_signal_remote, sender_name, node_name,
remote_name, reason_str, tok_label, tok_lastcnt, tok_serial);
/* forced, i.e ignore busy */
- res = dsig_send(dsdp, ctl, THE_NON_VALUE, 1);
+ res = dsig_send_ctl(dsdp, ctl, 1);
UnUseTmpHeapNoproc(6);
return res;
}
@@ -1010,7 +1045,7 @@ erts_dsig_send_exit(ErtsDSigData *dsdp, Eterm local, Eterm remote, Eterm reason)
ctl = TUPLE4(&ctl_heap[0],
make_small(DOP_EXIT), local, remote, reason);
/* forced, i.e ignore busy */
- res = dsig_send(dsdp, ctl, THE_NON_VALUE, 1);
+ res = dsig_send_ctl(dsdp, ctl, 1);
UnUseTmpHeapNoproc(5);
return res;
}
@@ -1026,7 +1061,7 @@ erts_dsig_send_exit2(ErtsDSigData *dsdp, Eterm local, Eterm remote, Eterm reason
ctl = TUPLE4(&ctl_heap[0],
make_small(DOP_EXIT2), local, remote, reason);
- res = dsig_send(dsdp, ctl, THE_NON_VALUE, 0);
+ res = dsig_send_ctl(dsdp, ctl, 0);
UnUseTmpHeapNoproc(5);
return res;
}
@@ -1043,7 +1078,7 @@ erts_dsig_send_group_leader(ErtsDSigData *dsdp, Eterm leader, Eterm remote)
ctl = TUPLE3(&ctl_heap[0],
make_small(DOP_GROUP_LEADER), leader, remote);
- res = dsig_send(dsdp, ctl, THE_NON_VALUE, 0);
+ res = dsig_send_ctl(dsdp, ctl, 0);
UnUseTmpHeapNoproc(4);
return res;
}
@@ -1091,7 +1126,6 @@ int erts_net_message(Port *prt,
byte *buf,
ErlDrvSizeT len)
{
-#define DIST_CTL_DEFAULT_SIZE 64
ErtsDistExternal ede;
byte *t;
Sint ctl_len;
@@ -1104,7 +1138,7 @@ 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;
Eterm token;
@@ -1118,9 +1152,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;
@@ -1181,14 +1212,15 @@ int erts_net_message(Port *prt,
}
hp = ctl;
- arg = erts_decode_dist_ext(&hp, &off_heap, &ede);
+ 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;
@@ -1245,7 +1277,7 @@ int erts_net_message(Port *prt,
erts_smp_de_links_unlock(dep);
if (IS_TRACED_FL(rp, F_TRACE_PROCS))
- trace_proc(NULL, rp, am_getting_linked, from);
+ trace_proc(NULL, 0, rp, am_getting_linked, from);
erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
break;
@@ -1270,7 +1302,7 @@ int erts_net_message(Port *prt,
lnk = erts_remove_link(&ERTS_P_LINKS(rp), from);
if (IS_TRACED_FL(rp, F_TRACE_PROCS) && lnk != NULL) {
- trace_proc(NULL, rp, am_getting_unlinked, from);
+ trace_proc(NULL, 0, rp, am_getting_unlinked, from);
}
erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
@@ -1358,7 +1390,7 @@ int erts_net_message(Port *prt,
if (mon == NULL) {
break;
}
- watched = mon->pid;
+ watched = mon->u.pid;
erts_destroy_monitor(mon);
rp = erts_pid2proc_opt(NULL, 0,
watched, ERTS_PROC_LOCK_LINK,
@@ -1419,14 +1451,14 @@ 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];
token = copy_struct(token, token_size, &hp, ohp);
}
- erts_queue_dist_message(rp, &locks, ede_copy, token);
+ erts_queue_dist_message(rp, locks, ede_copy, token, from);
if (locks)
erts_smp_proc_unlock(rp, locks);
}
@@ -1468,14 +1500,14 @@ 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];
token = copy_struct(token, token_size, &hp, ohp);
}
- erts_queue_dist_message(rp, &locks, ede_copy, token);
+ erts_queue_dist_message(rp, locks, ede_copy, token, tuple[2]);
if (locks)
erts_smp_proc_unlock(rp, locks);
}
@@ -1516,7 +1548,7 @@ int erts_net_message(Port *prt,
if (mon == NULL) {
break;
}
- rp = erts_pid2proc(NULL, 0, mon->pid, rp_locks);
+ rp = erts_pid2proc(NULL, 0, mon->u.pid, rp_locks);
erts_destroy_monitor(mon);
if (rp == NULL) {
@@ -1533,7 +1565,7 @@ int erts_net_message(Port *prt,
watched = (is_not_nil(mon->name)
? TUPLE2(&lhp[0], mon->name, sysname)
- : mon->pid);
+ : mon->u.pid);
erts_queue_monitor_message(rp, &rp_locks,
ref, am_process, watched, reason);
@@ -1598,7 +1630,11 @@ int erts_net_message(Port *prt,
ERTS_XSIG_FLG_IGN_KILL);
if (xres >= 0 && IS_TRACED_FL(rp, F_TRACE_PROCS)) {
/* We didn't exit the process and it is traced */
- trace_proc(NULL, rp, am_getting_unlinked, from);
+ if (rp_locks & ERTS_PROC_LOCKS_XSIG_SEND) {
+ erts_smp_proc_unlock(rp, ERTS_PROC_LOCKS_XSIG_SEND);
+ rp_locks &= ~ERTS_PROC_LOCKS_XSIG_SEND;
+ }
+ trace_proc(NULL, 0, rp, am_getting_unlinked, from);
}
}
erts_smp_proc_unlock(rp, rp_locks);
@@ -1668,7 +1704,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);
}
@@ -1681,206 +1717,248 @@ 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_deliver_port_exit(prt, dep->cid, am_killed, 0, 1);
ERTS_SMP_CHK_NO_PROC_LOCKS;
return -1;
}
-static int
-dsig_send(ErtsDSigData *dsdp, Eterm ctl, Eterm msg, int force_busy)
+static int dsig_send_ctl(ErtsDSigData* dsdp, Eterm ctl, int force_busy)
+{
+ struct erts_dsig_send_context ctx;
+ int ret;
+ ctx.ctl = ctl;
+ ctx.msg = THE_NON_VALUE;
+ ctx.force_busy = force_busy;
+ ctx.phase = ERTS_DSIG_SEND_PHASE_INIT;
+#ifdef DEBUG
+ ctx.reds = 1; /* provoke assert below (no reduction count without msg) */
+#endif
+ ret = erts_dsig_send(dsdp, &ctx);
+ ASSERT(ret != ERTS_DSIG_SEND_CONTINUE);
+ return ret;
+}
+
+int
+erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx)
{
+ int retval;
+ Sint initial_reds = ctx->reds;
Eterm cid;
- int suspended = 0;
- int resume = 0;
- Uint32 pass_through_size;
- Uint data_size, dhdr_ext_size;
- ErtsAtomCacheMap *acmp;
- ErtsDistOutputBuf *obuf;
- DistEntry *dep = dsdp->dep;
- Uint32 flags = dep->flags;
- Process *c_p = dsdp->proc;
- if (!c_p || dsdp->no_suspend)
- force_busy = 1;
+ while (1) {
+ switch (ctx->phase) {
+ case ERTS_DSIG_SEND_PHASE_INIT:
+ ctx->flags = dsdp->dep->flags;
+ ctx->c_p = dsdp->proc;
- ERTS_SMP_LC_ASSERT(!c_p
- || (ERTS_PROC_LOCK_MAIN
- == erts_proc_lc_my_proc_locks(c_p)));
+ if (!ctx->c_p || dsdp->no_suspend)
+ ctx->force_busy = 1;
- if (!erts_is_alive)
- return ERTS_DSIG_SEND_OK;
+ ERTS_SMP_LC_ASSERT(!ctx->c_p
+ || (ERTS_PROC_LOCK_MAIN
+ == erts_proc_lc_my_proc_locks(ctx->c_p)));
- if (flags & DFLAG_DIST_HDR_ATOM_CACHE) {
- acmp = erts_get_atom_cache_map(c_p);
- pass_through_size = 0;
- }
- else {
- acmp = NULL;
- pass_through_size = 1;
- }
+ if (!erts_is_alive)
+ return ERTS_DSIG_SEND_OK;
-#ifdef ERTS_DIST_MSG_DBG
- erts_fprintf(stderr, ">>%s CTL: %T\n", pass_through_size ? "P" : " ", ctl);
- if (is_value(msg))
- erts_fprintf(stderr, " MSG: %T\n", msg);
-#endif
+ if (ctx->flags & DFLAG_DIST_HDR_ATOM_CACHE) {
+ ctx->acmp = erts_get_atom_cache_map(ctx->c_p);
+ ctx->pass_through_size = 0;
+ }
+ else {
+ ctx->acmp = NULL;
+ ctx->pass_through_size = 1;
+ }
- data_size = pass_through_size;
- erts_reset_atom_cache_map(acmp);
- data_size += erts_encode_dist_ext_size(ctl, flags, acmp);
- if (is_value(msg))
- data_size += erts_encode_dist_ext_size(msg, flags, acmp);
- erts_finalize_atom_cache_map(acmp, flags);
+ #ifdef ERTS_DIST_MSG_DBG
+ erts_fprintf(stderr, ">>%s CTL: %T\n", ctx->pass_through_size ? "P" : " ", ctx->ctl);
+ if (is_value(ctx->msg))
+ erts_fprintf(stderr, " MSG: %T\n", ctx->msg);
+ #endif
+
+ ctx->data_size = ctx->pass_through_size;
+ erts_reset_atom_cache_map(ctx->acmp);
+ erts_encode_dist_ext_size(ctx->ctl, ctx->flags, ctx->acmp, &ctx->data_size);
+
+ if (is_value(ctx->msg)) {
+ ctx->u.sc.wstack.wstart = NULL;
+ ctx->u.sc.flags = ctx->flags;
+ ctx->u.sc.level = 0;
+ ctx->phase = ERTS_DSIG_SEND_PHASE_MSG_SIZE;
+ } else {
+ ctx->phase = ERTS_DSIG_SEND_PHASE_ALLOC;
+ }
+ break;
- dhdr_ext_size = erts_encode_ext_dist_header_size(acmp);
- data_size += dhdr_ext_size;
+ case ERTS_DSIG_SEND_PHASE_MSG_SIZE:
+ if (erts_encode_dist_ext_size_int(ctx->msg, ctx, &ctx->data_size)) {
+ retval = ERTS_DSIG_SEND_CONTINUE;
+ goto done;
+ }
- obuf = alloc_dist_obuf(data_size);
- obuf->ext_endp = &obuf->data[0] + pass_through_size + dhdr_ext_size;
+ ctx->phase = ERTS_DSIG_SEND_PHASE_ALLOC;
+ case ERTS_DSIG_SEND_PHASE_ALLOC:
+ erts_finalize_atom_cache_map(ctx->acmp, ctx->flags);
+
+ ctx->dhdr_ext_size = erts_encode_ext_dist_header_size(ctx->acmp);
+ ctx->data_size += ctx->dhdr_ext_size;
+
+ ctx->obuf = alloc_dist_obuf(ctx->data_size);
+ ctx->obuf->ext_endp = &ctx->obuf->data[0] + ctx->pass_through_size + ctx->dhdr_ext_size;
+
+ /* Encode internal version of dist header */
+ ctx->obuf->extp = erts_encode_ext_dist_header_setup(ctx->obuf->ext_endp, ctx->acmp);
+ /* Encode control message */
+ erts_encode_dist_ext(ctx->ctl, &ctx->obuf->ext_endp, ctx->flags, ctx->acmp, NULL, NULL);
+ if (is_value(ctx->msg)) {
+ ctx->u.ec.flags = ctx->flags;
+ ctx->u.ec.level = 0;
+ ctx->u.ec.wstack.wstart = NULL;
+ ctx->phase = ERTS_DSIG_SEND_PHASE_MSG_ENCODE;
+ } else {
+ ctx->phase = ERTS_DSIG_SEND_PHASE_FIN;
+ }
+ break;
- /* Encode internal version of dist header */
- obuf->extp = erts_encode_ext_dist_header_setup(obuf->ext_endp, acmp);
- /* Encode control message */
- erts_encode_dist_ext(ctl, &obuf->ext_endp, flags, acmp);
- if (is_value(msg)) {
- /* Encode message */
- erts_encode_dist_ext(msg, &obuf->ext_endp, flags, acmp);
- }
+ case ERTS_DSIG_SEND_PHASE_MSG_ENCODE:
+ if (erts_encode_dist_ext(ctx->msg, &ctx->obuf->ext_endp, ctx->flags, ctx->acmp, &ctx->u.ec, &ctx->reds)) {
+ retval = ERTS_DSIG_SEND_CONTINUE;
+ goto done;
+ }
- ASSERT(obuf->extp < obuf->ext_endp);
- ASSERT(&obuf->data[0] <= obuf->extp - pass_through_size);
- ASSERT(obuf->ext_endp <= &obuf->data[0] + data_size);
+ ctx->phase = ERTS_DSIG_SEND_PHASE_FIN;
+ case ERTS_DSIG_SEND_PHASE_FIN: {
+ DistEntry *dep = dsdp->dep;
+ int suspended = 0;
+ int resume = 0;
- data_size = obuf->ext_endp - obuf->extp;
+ ASSERT(ctx->obuf->extp < ctx->obuf->ext_endp);
+ ASSERT(&ctx->obuf->data[0] <= ctx->obuf->extp - ctx->pass_through_size);
+ ASSERT(ctx->obuf->ext_endp <= &ctx->obuf->data[0] + ctx->data_size);
- /*
- * Signal encoded; now verify that the connection still exists,
- * and if so enqueue the signal and schedule it for send.
- */
- obuf->next = NULL;
- erts_smp_de_rlock(dep);
- cid = dep->cid;
- if (cid != dsdp->cid
- || dep->connection_id != dsdp->connection_id
- || dep->status & ERTS_DE_SFLG_EXITING) {
- /* Not the same connection as when we started; drop message... */
- erts_smp_de_runlock(dep);
- free_dist_obuf(obuf);
- }
- else {
- ErtsProcList *plp = NULL;
- erts_smp_mtx_lock(&dep->qlock);
- dep->qsize += size_obuf(obuf);
- if (dep->qsize >= erts_dist_buf_busy_limit)
- dep->qflgs |= ERTS_DE_QFLG_BUSY;
- if (!force_busy && (dep->qflgs & ERTS_DE_QFLG_BUSY)) {
- erts_smp_mtx_unlock(&dep->qlock);
+ ctx->data_size = ctx->obuf->ext_endp - ctx->obuf->extp;
- plp = erts_proclist_create(c_p);
- erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL);
- suspended = 1;
- erts_smp_mtx_lock(&dep->qlock);
- }
+ /*
+ * Signal encoded; now verify that the connection still exists,
+ * and if so enqueue the signal and schedule it for send.
+ */
+ ctx->obuf->next = NULL;
+ erts_smp_de_rlock(dep);
+ cid = dep->cid;
+ if (cid != dsdp->cid
+ || dep->connection_id != dsdp->connection_id
+ || dep->status & ERTS_DE_SFLG_EXITING) {
+ /* Not the same connection as when we started; drop message... */
+ erts_smp_de_runlock(dep);
+ free_dist_obuf(ctx->obuf);
+ }
+ else {
+ ErtsProcList *plp = NULL;
+ erts_smp_mtx_lock(&dep->qlock);
+ dep->qsize += size_obuf(ctx->obuf);
+ if (dep->qsize >= erts_dist_buf_busy_limit)
+ dep->qflgs |= ERTS_DE_QFLG_BUSY;
+ if (!ctx->force_busy && (dep->qflgs & ERTS_DE_QFLG_BUSY)) {
+ erts_smp_mtx_unlock(&dep->qlock);
+
+ plp = erts_proclist_create(ctx->c_p);
+ erts_suspend(ctx->c_p, ERTS_PROC_LOCK_MAIN, NULL);
+ suspended = 1;
+ erts_smp_mtx_lock(&dep->qlock);
+ }
- /* Enqueue obuf on dist entry */
- if (dep->out_queue.last)
- dep->out_queue.last->next = obuf;
- else
- dep->out_queue.first = obuf;
- dep->out_queue.last = obuf;
+ /* Enqueue obuf on dist entry */
+ if (dep->out_queue.last)
+ dep->out_queue.last->next = ctx->obuf;
+ else
+ dep->out_queue.first = ctx->obuf;
+ dep->out_queue.last = ctx->obuf;
+
+ if (!ctx->force_busy) {
+ if (!(dep->qflgs & ERTS_DE_QFLG_BUSY)) {
+ if (suspended)
+ resume = 1; /* was busy when we started, but isn't now */
+ #ifdef USE_VM_PROBES
+ if (resume && DTRACE_ENABLED(dist_port_not_busy)) {
+ DTRACE_CHARBUF(port_str, 64);
+ DTRACE_CHARBUF(remote_str, 64);
+
+ erts_snprintf(port_str, sizeof(DTRACE_CHARBUF_NAME(port_str)),
+ "%T", cid);
+ erts_snprintf(remote_str, sizeof(DTRACE_CHARBUF_NAME(remote_str)),
+ "%T", dep->sysname);
+ DTRACE3(dist_port_not_busy, erts_this_node_sysname,
+ port_str, remote_str);
+ }
+ #endif
+ }
+ else {
+ /* Enqueue suspended process on dist entry */
+ ASSERT(plp);
+ erts_proclist_store_last(&dep->suspended, plp);
+ }
+ }
- if (!force_busy) {
- if (!(dep->qflgs & ERTS_DE_QFLG_BUSY)) {
- if (suspended)
- resume = 1; /* was busy when we started, but isn't now */
-#ifdef USE_VM_PROBES
- if (resume && DTRACE_ENABLED(dist_port_not_busy)) {
- DTRACE_CHARBUF(port_str, 64);
- DTRACE_CHARBUF(remote_str, 64);
-
- erts_snprintf(port_str, sizeof(DTRACE_CHARBUF_NAME(port_str)),
- "%T", cid);
- erts_snprintf(remote_str, sizeof(DTRACE_CHARBUF_NAME(remote_str)),
- "%T", dep->sysname);
- DTRACE3(dist_port_not_busy, erts_this_node_sysname,
- port_str, remote_str);
- }
-#endif
+ erts_smp_mtx_unlock(&dep->qlock);
+ erts_schedule_dist_command(NULL, dep);
+ erts_smp_de_runlock(dep);
+
+ if (resume) {
+ erts_resume(ctx->c_p, ERTS_PROC_LOCK_MAIN);
+ erts_proclist_destroy(plp);
+ /*
+ * Note that the calling process still have to yield as if it
+ * suspended. If not, the calling process could later be
+ * erroneously scheduled when it shouldn't be.
+ */
+ }
}
- else {
- /* Enqueue suspended process on dist entry */
- ASSERT(plp);
- erts_proclist_store_last(&dep->suspended, plp);
+ ctx->obuf = NULL;
+
+ if (suspended) {
+ #ifdef USE_VM_PROBES
+ if (!resume && DTRACE_ENABLED(dist_port_busy)) {
+ DTRACE_CHARBUF(port_str, 64);
+ DTRACE_CHARBUF(remote_str, 64);
+ DTRACE_CHARBUF(pid_str, 16);
+
+ erts_snprintf(port_str, sizeof(DTRACE_CHARBUF_NAME(port_str)), "%T", cid);
+ erts_snprintf(remote_str, sizeof(DTRACE_CHARBUF_NAME(remote_str)),
+ "%T", dep->sysname);
+ erts_snprintf(pid_str, sizeof(DTRACE_CHARBUF_NAME(pid_str)),
+ "%T", ctx->c_p->common.id);
+ DTRACE4(dist_port_busy, erts_this_node_sysname,
+ port_str, remote_str, pid_str);
+ }
+ #endif
+ if (!resume && erts_system_monitor_flags.busy_dist_port)
+ monitor_generic(ctx->c_p, am_busy_dist_port, cid);
+ retval = ERTS_DSIG_SEND_YIELD;
+ } else {
+ retval = ERTS_DSIG_SEND_OK;
}
+ goto done;
}
-
- erts_smp_mtx_unlock(&dep->qlock);
- erts_schedule_dist_command(NULL, dep);
- erts_smp_de_runlock(dep);
-
- if (resume) {
- erts_resume(c_p, ERTS_PROC_LOCK_MAIN);
- erts_proclist_destroy(plp);
- /*
- * Note that the calling process still have to yield as if it
- * suspended. If not, the calling process could later be
- * erroneously scheduled when it shouldn't be.
- */
+ default:
+ erts_exit(ERTS_ABORT_EXIT, "dsig_send invalid phase (%d)\n", (int)ctx->phase);
}
}
- if (c_p) {
- int reds;
- /*
- * Bump reductions on calling process.
- *
- * This is the reduction cost: Always a base cost of 8 reductions
- * plus 16 reductions per kilobyte generated external data.
- */
-
- data_size >>= (10-4);
-#if defined(ARCH_64) && !HALFWORD_HEAP
- data_size &= 0x003fffffffffffff;
-#elif defined(ARCH_32) || HALFWORD_HEAP
- data_size &= 0x003fffff;
-#else
-# error "Ohh come on ... !?!"
-#endif
- reds = 8 + ((int) data_size > 1000000 ? 1000000 : (int) data_size);
- BUMP_REDS(c_p, reds);
- }
-
- if (suspended) {
-#ifdef USE_VM_PROBES
- if (!resume && DTRACE_ENABLED(dist_port_busy)) {
- DTRACE_CHARBUF(port_str, 64);
- DTRACE_CHARBUF(remote_str, 64);
- DTRACE_CHARBUF(pid_str, 16);
-
- erts_snprintf(port_str, sizeof(DTRACE_CHARBUF_NAME(port_str)), "%T", cid);
- erts_snprintf(remote_str, sizeof(DTRACE_CHARBUF_NAME(remote_str)),
- "%T", dep->sysname);
- erts_snprintf(pid_str, sizeof(DTRACE_CHARBUF_NAME(pid_str)),
- "%T", c_p->common.id);
- DTRACE4(dist_port_busy, erts_this_node_sysname,
- port_str, remote_str, pid_str);
- }
-#endif
- if (!resume && erts_system_monitor_flags.busy_dist_port)
- monitor_generic(c_p, am_busy_dist_port, cid);
- return ERTS_DSIG_SEND_YIELD;
+done:
+ if (ctx->msg && ctx->c_p) {
+ BUMP_REDS(ctx->c_p, (initial_reds - ctx->reds) / TERM_TO_BINARY_LOOP_FACTOR);
}
- return ERTS_DSIG_SEND_OK;
+ return retval;
}
-
static Uint
dist_port_command(Port *prt, ErtsDistOutputBuf *obuf)
{
@@ -1891,7 +1969,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_DUMP_EXIT,
"Absurdly large distribution output data buffer "
"(%beu bytes) passed.\n",
size);
@@ -1931,7 +2009,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_DUMP_EXIT,
"Absurdly large distribution output data buffer "
"(%beu bytes) passed.\n",
size);
@@ -1973,9 +2051,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 ... !?!"
@@ -2001,10 +2079,11 @@ erts_dist_command(Port *prt, int reds_limit)
DistEntry *dep = prt->dist_entry;
Uint (*send)(Port *prt, ErtsDistOutputBuf *obuf);
erts_aint32_t sched_flags;
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
- erts_refc_inc(&dep->refc, 1); /* Otherwise dist_entry might be
+ erts_smp_refc_inc(&dep->refc, 1); /* Otherwise dist_entry might be
removed if port command fails */
erts_smp_atomic_set_mb(&dep->dist_cmd_scheduled, 0);
@@ -2016,7 +2095,7 @@ erts_dist_command(Port *prt, int reds_limit)
erts_smp_de_runlock(dep);
if (status & ERTS_DE_SFLG_EXITING) {
- erts_deliver_port_exit(prt, prt->common.id, am_killed, 0);
+ erts_deliver_port_exit(prt, prt->common.id, am_killed, 0, 1);
erts_deref_dist_entry(dep);
return reds + ERTS_PORT_REDS_DIST_CMD_EXIT;
}
@@ -2055,12 +2134,12 @@ erts_dist_command(Port *prt, int reds_limit)
ErtsDistOutputBuf *fob;
size = (*send)(prt, foq.first);
+ esdp->io.out += (Uint64) size;
#ifdef ERTS_RAW_DIST_MSG_DBG
erts_fprintf(stderr, ">> ");
bw(foq.first->extp, size);
#endif
reds += ERTS_PORT_REDS_DIST_CMD_DATA(size);
- erts_smp_atomic_add_nob(&erts_bytes_out, size);
fob = foq.first;
obufsize += size_obuf(fob);
foq.first = foq.first->next;
@@ -2140,12 +2219,12 @@ erts_dist_command(Port *prt, int reds_limit)
ASSERT(&oq.first->data[0] <= oq.first->extp
&& oq.first->extp < oq.first->ext_endp);
size = (*send)(prt, oq.first);
+ esdp->io.out += (Uint64) size;
#ifdef ERTS_RAW_DIST_MSG_DBG
erts_fprintf(stderr, ">> ");
bw(oq.first->extp, size);
#endif
reds += ERTS_PORT_REDS_DIST_CMD_DATA(size);
- erts_smp_atomic_add_nob(&erts_bytes_out, size);
fob = oq.first;
obufsize += size_obuf(fob);
oq.first = oq.first->next;
@@ -2325,36 +2404,36 @@ erts_kill_dist_connection(DistEntry *dep, Uint32 connection_id)
}
struct print_to_data {
- int to;
+ fmtfn_t to;
void *arg;
};
static void doit_print_monitor_info(ErtsMonitor *mon, void *vptdp)
{
- int to = ((struct print_to_data *) vptdp)->to;
+ fmtfn_t to = ((struct print_to_data *) vptdp)->to;
void *arg = ((struct print_to_data *) vptdp)->arg;
Process *rp;
ErtsMonitor *rmon;
- rp = erts_proc_lookup(mon->pid);
+ rp = erts_proc_lookup(mon->u.pid);
if (!rp || (rmon = erts_lookup_monitor(ERTS_P_MONITORS(rp), mon->ref)) == NULL) {
- erts_print(to, arg, "Warning, stray monitor for: %T\n", mon->pid);
+ erts_print(to, arg, "Warning, stray monitor for: %T\n", mon->u.pid);
} else if (mon->type == MON_ORIGIN) {
/* Local pid is being monitored */
erts_print(to, arg, "Remotely monitored by: %T %T\n",
- mon->pid, rmon->pid);
+ mon->u.pid, rmon->u.pid);
} else {
- erts_print(to, arg, "Remote monitoring: %T ", mon->pid);
- if (is_not_atom(rmon->pid))
- erts_print(to, arg, "%T\n", rmon->pid);
+ erts_print(to, arg, "Remote monitoring: %T ", mon->u.pid);
+ if (is_not_atom(rmon->u.pid))
+ erts_print(to, arg, "%T\n", rmon->u.pid);
else
erts_print(to, arg, "{%T, %T}\n",
rmon->name,
- rmon->pid); /* which in this case is the
+ rmon->u.pid); /* which in this case is the
remote system name... */
}
}
-static void print_monitor_info(int to, void *arg, ErtsMonitor *mon)
+static void print_monitor_info(fmtfn_t to, void *arg, ErtsMonitor *mon)
{
struct print_to_data ptd = {to, arg};
erts_doforall_monitors(mon,&doit_print_monitor_info,&ptd);
@@ -2380,7 +2459,7 @@ static void doit_print_link_info(ErtsLink *lnk, void *vptdp)
}
}
-static void print_link_info(int to, void *arg, ErtsLink *lnk)
+static void print_link_info(fmtfn_t to, void *arg, ErtsLink *lnk)
{
struct print_to_data ptd = {to, arg};
erts_doforall_links(lnk, &doit_print_link_info, (void *) &ptd);
@@ -2401,7 +2480,7 @@ static void doit_print_nodelink_info(ErtsLink *lnk, void *vpcontext)
"Remote monitoring: %T %T\n", lnk->pid, pcontext->sysname);
}
-static void print_nodelink_info(int to, void *arg, ErtsLink *lnk, Eterm sysname)
+static void print_nodelink_info(fmtfn_t to, void *arg, ErtsLink *lnk, Eterm sysname)
{
PrintNodeLinkContext context = {{to, arg}, sysname};
erts_doforall_links(lnk, &doit_print_nodelink_info, &context);
@@ -2409,7 +2488,7 @@ static void print_nodelink_info(int to, void *arg, ErtsLink *lnk, Eterm sysname)
static int
-info_dist_entry(int to, void *arg, DistEntry *dep, int visible, int connected)
+info_dist_entry(fmtfn_t to, void *arg, DistEntry *dep, int visible, int connected)
{
if (visible && connected) {
@@ -2437,7 +2516,7 @@ info_dist_entry(int to, void *arg, DistEntry *dep, int visible, int connected)
erts_print(to, arg, "Name: %T", dep->sysname);
#ifdef DEBUG
- erts_print(to, arg, " (refc=%d)", erts_refc_read(&dep->refc, 1));
+ erts_print(to, arg, " (refc=%d)", erts_smp_refc_read(&dep->refc, 0));
#endif
erts_print(to, arg, "\n");
if (!connected && is_nil(dep->cid)) {
@@ -2458,7 +2537,7 @@ info_dist_entry(int to, void *arg, DistEntry *dep, int visible, int connected)
return 0;
}
-int distribution_info(int to, void *arg) /* Called by break handler */
+int distribution_info(fmtfn_t to, void *arg) /* Called by break handler */
{
DistEntry *dep;
@@ -2483,7 +2562,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);
@@ -2561,13 +2642,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)
@@ -2928,11 +3004,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)
@@ -2954,8 +3030,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) {
@@ -3145,7 +3223,8 @@ static ErtsNodesMonitor *nodes_monitors_end;
static void
init_nodes_monitors(void)
{
- erts_smp_mtx_init(&nodes_monitors_mtx, "nodes_monitors");
+ erts_smp_mtx_init(&nodes_monitors_mtx, "nodes_monitors", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
nodes_monitors = NULL;
nodes_monitors_end = NULL;
}
@@ -3186,11 +3265,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) {
@@ -3236,11 +3320,7 @@ send_nodes_mon_msg(Process *rp,
}
ASSERT(hend == hp);
- erts_queue_message(rp, rp_locksp, bp, msg, NIL
-#ifdef USE_VM_PROBES
- , NIL
-#endif
- );
+ erts_queue_message(rp, *rp_locksp, mp, msg, am_system);
}
static void
@@ -3297,7 +3377,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");
}
}
@@ -3606,7 +3686,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/dist.h b/erts/emulator/beam/dist.h
index f32b999198..3e17645997 100644
--- a/erts/emulator/beam/dist.h
+++ b/erts/emulator/beam/dist.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2014. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -22,6 +23,7 @@
#include "erl_process.h"
#include "erl_node_tables.h"
+#include "zlib.h"
#define DFLAG_PUBLISHED 0x01
#define DFLAG_ATOM_CACHE 0x02
@@ -41,6 +43,7 @@
#define DFLAG_INTERNAL_TAGS 0x8000
#define DFLAG_UTF8_ATOMS 0x10000
#define DFLAG_MAP_TAG 0x20000
+#define DFLAG_BIG_CREATION 0x40000
/* All flags that should be enabled when term_to_binary/1 is used. */
#define TERM_TO_BINARY_DFLAGS (DFLAG_EXTENDED_REFERENCES \
@@ -49,7 +52,8 @@
| DFLAG_EXTENDED_PIDS_PORTS \
| DFLAG_EXPORT_PTR_TAG \
| DFLAG_BIT_BINARIES \
- | DFLAG_MAP_TAG)
+ | DFLAG_MAP_TAG \
+ | DFLAG_BIG_CREATION)
/* opcodes used in distribution messages */
#define DOP_LINK 1
@@ -111,8 +115,8 @@ extern int erts_is_alive;
* erts_dsig_prepare() prepares a send of a distributed signal.
* One of the values defined below are returned. If the returned
* value is another than ERTS_DSIG_PREP_CONNECTED, the
- * distributed signal cannot be sent before apropriate actions
- * have been taken. Apropriate actions would typically be setting
+ * distributed signal cannot be sent before appropriate actions
+ * have been taken. Appropriate actions would typically be setting
* up the connection.
*/
@@ -264,17 +268,105 @@ erts_destroy_dist_link(ErtsDistLinkData *dldp)
#endif
+
+
+/* Define for testing */
+/* #define EXTREME_TTB_TRAPPING 1 */
+
+#ifndef EXTREME_TTB_TRAPPING
+#define TERM_TO_BINARY_LOOP_FACTOR 32
+#else
+#define TERM_TO_BINARY_LOOP_FACTOR 1
+#endif
+
+typedef enum { TTBSize, TTBEncode, TTBCompress } TTBState;
+typedef struct TTBSizeContext_ {
+ Uint flags;
+ int level;
+ Uint result;
+ Eterm obj;
+ ErtsWStack wstack;
+} TTBSizeContext;
+
+typedef struct TTBEncodeContext_ {
+ Uint flags;
+ int level;
+ byte* ep;
+ Eterm obj;
+ ErtsWStack wstack;
+ Binary *result_bin;
+} TTBEncodeContext;
+
+typedef struct {
+ Uint real_size;
+ Uint dest_len;
+ byte *dbytes;
+ Binary *result_bin;
+ Binary *destination_bin;
+ z_stream stream;
+} TTBCompressContext;
+
+typedef struct {
+ int alive;
+ TTBState state;
+ union {
+ TTBSizeContext sc;
+ TTBEncodeContext ec;
+ TTBCompressContext cc;
+ } s;
+} TTBContext;
+
+enum erts_dsig_send_phase {
+ ERTS_DSIG_SEND_PHASE_INIT,
+ ERTS_DSIG_SEND_PHASE_MSG_SIZE,
+ ERTS_DSIG_SEND_PHASE_ALLOC,
+ ERTS_DSIG_SEND_PHASE_MSG_ENCODE,
+ ERTS_DSIG_SEND_PHASE_FIN
+};
+
+struct erts_dsig_send_context {
+ enum erts_dsig_send_phase phase;
+ Sint reds;
+
+ Eterm ctl;
+ Eterm msg;
+ int force_busy;
+ Uint32 pass_through_size;
+ Uint data_size, dhdr_ext_size;
+ ErtsAtomCacheMap *acmp;
+ ErtsDistOutputBuf *obuf;
+ Uint32 flags;
+ Process *c_p;
+ union {
+ TTBSizeContext sc;
+ TTBEncodeContext ec;
+ }u;
+};
+
+typedef struct {
+ int suspend;
+
+ Eterm ctl_heap[6];
+ ErtsDSigData dsd;
+ DistEntry* dep_to_deref;
+ struct erts_dsig_send_context dss;
+
+ Eterm return_term;
+}ErtsSendContext;
+
+
/*
* erts_dsig_send_* return values.
*/
#define ERTS_DSIG_SEND_OK 0
#define ERTS_DSIG_SEND_YIELD 1
+#define ERTS_DSIG_SEND_CONTINUE 2
extern int erts_dsig_send_link(ErtsDSigData *, Eterm, Eterm);
-extern int erts_dsig_send_msg(ErtsDSigData *, Eterm, Eterm);
+extern int erts_dsig_send_msg(Eterm, Eterm, ErtsSendContext*);
extern int erts_dsig_send_exit_tt(ErtsDSigData *, Eterm, Eterm, Eterm, Eterm);
extern int erts_dsig_send_unlink(ErtsDSigData *, Eterm, Eterm);
-extern int erts_dsig_send_reg_msg(ErtsDSigData *, Eterm, Eterm);
+extern int erts_dsig_send_reg_msg(Eterm, Eterm, ErtsSendContext*);
extern int erts_dsig_send_group_leader(ErtsDSigData *, Eterm, Eterm);
extern int erts_dsig_send_exit(ErtsDSigData *, Eterm, Eterm, Eterm);
extern int erts_dsig_send_exit2(ErtsDSigData *, Eterm, Eterm, Eterm);
@@ -282,6 +374,10 @@ extern int erts_dsig_send_demonitor(ErtsDSigData *, Eterm, Eterm, Eterm, int);
extern int erts_dsig_send_monitor(ErtsDSigData *, Eterm, Eterm, Eterm);
extern int erts_dsig_send_m_exit(ErtsDSigData *, Eterm, Eterm, Eterm, Eterm);
+extern int erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx);
+extern int erts_dsend_context_dtor(Binary*);
+extern Eterm erts_dsend_export_trap_context(Process* p, ErtsSendContext* ctx);
+
extern int erts_dist_command(Port *prt, int reds);
extern void erts_dist_port_not_busy(Port *prt);
extern void erts_kill_dist_connection(DistEntry *dep, Uint32);
diff --git a/erts/emulator/beam/dtrace-wrapper.h b/erts/emulator/beam/dtrace-wrapper.h
index 6ec0c91e21..15ea182976 100644
--- a/erts/emulator/beam/dtrace-wrapper.h
+++ b/erts/emulator/beam/dtrace-wrapper.h
@@ -1,19 +1,20 @@
/*
* %CopyrightBegin%
*
- * Copyright Dustin Sallings, Michal Ptaszek, Scott Lystig Fritchie 2011-2012.
+ * Copyright Dustin Sallings, Michal Ptaszek, Scott Lystig Fritchie 2011-2017.
* 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -73,7 +74,7 @@
#if defined(_SDT_PROBE) && !defined(STAP_PROBE11)
/* SLF: This is Ubuntu 11-style SystemTap hackery */
-/* work arround for missing STAP macro */
+/* workaround for missing STAP macro */
#define STAP_PROBE11(provider,name,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9,arg10,arg11) \
_SDT_PROBE(provider, name, 11, \
(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9,arg10,arg11))
diff --git a/erts/emulator/beam/elib_memmove.c b/erts/emulator/beam/elib_memmove.c
index d2fe8649ed..2f45f69026 100644
--- a/erts/emulator/beam/elib_memmove.c
+++ b/erts/emulator/beam/elib_memmove.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1997-2009. All Rights Reserved.
+ * Copyright Ericsson AB 1997-2016. 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.
+ * 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%
*/
diff --git a/erts/emulator/beam/erl_afit_alloc.c b/erts/emulator/beam/erl_afit_alloc.c
index eca4e3b3bb..4ebe37ee1d 100644
--- a/erts/emulator/beam/erl_afit_alloc.c
+++ b/erts/emulator/beam/erl_afit_alloc.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2003-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2003-2016. 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.
+ * 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%
*/
@@ -53,7 +54,7 @@ static void link_free_block (Allctr_t *, Block_t *);
static void unlink_free_block (Allctr_t *, Block_t *);
-static Eterm info_options (Allctr_t *, char *, int *,
+static Eterm info_options (Allctr_t *, char *, fmtfn_t *,
void *arg, Uint **, Uint *);
static void init_atoms (void);
@@ -226,7 +227,7 @@ add_2tup(Uint **hpp, Uint *szp, Eterm *lp, Eterm el1, Eterm el2)
static Eterm
info_options(Allctr_t *allctr,
char *prefix,
- int *print_to_p,
+ fmtfn_t *print_to_p,
void *print_to_arg,
Uint **hpp,
Uint *szp)
@@ -240,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_afit_alloc.h b/erts/emulator/beam/erl_afit_alloc.h
index b90ac8f7c5..74258e284a 100644
--- a/erts/emulator/beam/erl_afit_alloc.h
+++ b/erts/emulator/beam/erl_afit_alloc.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2003-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2003-2016. 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.
+ * 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%
*/
diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c
index 05ac24e04d..c7ab444c96 100644
--- a/erts/emulator/beam/erl_alloc.c
+++ b/erts/emulator/beam/erl_alloc.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2002-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2002-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -29,6 +30,7 @@
#endif
#define ERTS_ALLOC_C__
#define ERTS_ALC_INTERNAL__
+#define ERTS_WANT_MEM_MAPPERS
#include "sys.h"
#define ERL_THREADS_EMU_INTERNAL__
#include "erl_threads.h"
@@ -39,12 +41,14 @@
#include "erl_instrument.h"
#include "erl_mseg.h"
#include "erl_monitors.h"
-#include "erl_bif_timer.h"
+#include "erl_hl_timer.h"
#include "erl_cpu_topology.h"
#include "erl_thr_queue.h"
+#include "erl_nfunc_sched.h"
#if defined(ERTS_ALC_T_DRV_SEL_D_STATE) || defined(ERTS_ALC_T_DRV_EV_D_STATE)
#include "erl_check_io.h"
#endif
+#include "erl_bif_unique.h"
#define GET_ERL_GF_ALLOC_IMPL
#include "erl_goodfit_alloc.h"
@@ -102,9 +106,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))
@@ -122,10 +126,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;
@@ -133,6 +133,19 @@ 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;
+#ifdef ERTS_ALC_A_EXEC
+static ErtsAllocatorState_t exec_alloc_state;
+#endif
+static ErtsAllocatorState_t test_alloc_state;
+
+enum {
+ ERTS_ALC_INFO_A_ALLOC_UTIL = ERTS_ALC_A_MAX + 1,
+ ERTS_ALC_INFO_A_MSEG_ALLOC,
+ ERTS_ALC_INFO_A_ERTS_MMAP,
+ ERTS_ALC_INFO_A_DISABLED_EXEC, /* fake a disabled "exec_alloc" */
+ ERTS_ALC_INFO_A_END
+};
typedef struct {
erts_smp_atomic32_t refc;
@@ -140,33 +153,14 @@ typedef struct {
int internal;
Uint req_sched;
Process *proc;
- Eterm ref;
- Eterm ref_heap[REF_THING_SIZE];
- int allocs[ERTS_ALC_A_MAX-ERTS_ALC_A_MIN+1+2];
+ ErtsIRefStorage iref;
+ int allocs[ERTS_ALC_INFO_A_END - ERTS_ALC_A_MIN + 1];
} ErtsAllocInfoReq;
-#define ERTS_ALC_INFO_A_ALLOC_UTIL (ERTS_ALC_A_MAX + 1)
-#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;
@@ -180,6 +174,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 {
@@ -228,13 +224,12 @@ 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 exec_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 { \
@@ -258,10 +253,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;
}
@@ -297,9 +288,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;
@@ -310,6 +301,93 @@ 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 = 1024*1024; /* Main carrier size */
+#else
+ ip->init.util.mmbcs = 256*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_mmapper_mseg_alloc;
+ ip->init.util.mseg_realloc = &erts_alcu_mmapper_mseg_realloc;
+ ip->init.util.mseg_dealloc = &erts_alcu_mmapper_mseg_dealloc;
+ ip->init.util.mseg_mmapper = &erts_literal_mmapper;
+# endif
+#else
+# error Unknown architecture
+#endif
+}
+
+#ifdef ERTS_ALC_A_EXEC
+static void
+set_default_exec_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 = "exec_";
+ ip->init.util.alloc_no = ERTS_ALC_A_EXEC;
+ ip->init.util.mmbcs = 0; /* No main carrier */
+ ip->init.util.ts = ERTS_ALC_MTA_EXEC;
+ 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;
+
+# ifdef ERTS_HAVE_EXEC_MMAPPER
+ ip->init.util.mseg_alloc = &erts_alcu_mmapper_mseg_alloc;
+ ip->init.util.mseg_realloc = &erts_alcu_mmapper_mseg_realloc;
+ ip->init.util.mseg_dealloc = &erts_alcu_mmapper_mseg_dealloc;
+ ip->init.util.mseg_mmapper = &erts_exec_mmapper;
+# else
+ ip->init.util.mseg_alloc = &erts_alcu_exec_mseg_alloc;
+ ip->init.util.mseg_realloc = &erts_alcu_exec_mseg_realloc;
+ ip->init.util.mseg_dealloc = &erts_alcu_exec_mseg_dealloc;
+# endif
+}
+#endif /* ERTS_ALC_A_EXEC */
+
+static void
set_default_temp_alloc_opts(struct au_init *ip)
{
SET_DEFAULT_ALLOC_OPTS(ip);
@@ -327,10 +405,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
@@ -349,10 +423,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;
}
@@ -431,6 +501,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
@@ -559,22 +656,35 @@ 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_NIF_SEL_D_STATE)]
+ = sizeof(ErtsNifSelectDataState);
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);
#endif
+ fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_LL_PTIMER)]
+ = erts_timer_type_size(ERTS_ALC_T_LL_PTIMER);
+ fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_HL_PTIMER)]
+ = erts_timer_type_size(ERTS_ALC_T_HL_PTIMER);
+ fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_BIF_TIMER)]
+ = erts_timer_type_size(ERTS_ALC_T_BIF_TIMER);
+ fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_NIF_EXP_TRACE)]
+ = sizeof(NifExportTrace);
+ fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_MREF_NSCHED_ENT)]
+ = sizeof(ErtsNSchedMagicRefTableEntry);
+ fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_MINDIRECTION)]
+ = ERTS_MAGIC_BIN_UNALIGNED_SIZE(sizeof(ErtsMagicIndirectionWord));
+
#ifdef HARD_DEBUG
hdbg_init();
#endif
@@ -601,6 +711,11 @@ 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);
+#ifdef ERTS_ALC_A_EXEC
+ set_default_exec_alloc_opts(&init.exec_alloc);
+#endif
+ set_default_test_alloc_opts(&init.test_alloc);
if (argc && argv)
handle_args(argc, argv, &init);
@@ -611,11 +726,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
}
@@ -628,6 +743,10 @@ 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;
+#ifdef ERTS_ALC_A_EXEC
+ init.exec_alloc.thr_spec = 0;
+#endif
#endif
/* Make adjustments for carrier migration support */
@@ -640,6 +759,10 @@ 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);
+#ifdef ERTS_ALC_A_EXEC
+ adjust_carrier_migration_support(&init.exec_alloc);
+#endif
if (init.erts_alloc_config) {
/* Adjust flags that erts_alloc_config won't like */
@@ -654,6 +777,10 @@ 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;
+#ifdef ERTS_ALC_A_EXEC
+ init.exec_alloc.thr_spec = 0;
+#endif
/* No carrier migration */
init.temp_alloc.init.util.acul = 0;
@@ -665,6 +792,10 @@ 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_ALC_A_EXEC
+ init.exec_alloc.init.util.acul = 0;
+#endif
}
#ifdef ERTS_SMP
@@ -681,6 +812,10 @@ 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);
+#ifdef ERTS_ALC_A_EXEC
+ adjust_tpref(&init.exec_alloc, erts_no_schedulers);
+#endif
#else
/* No thread specific if not smp */
@@ -699,6 +834,10 @@ 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_ALC_A_EXEC
+ refuse_af_strategy(&init.exec_alloc);
+#endif
#ifdef ERTS_SMP
if (!init.temp_alloc.thr_spec)
@@ -733,24 +872,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);
@@ -760,16 +881,21 @@ 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);
+#ifdef ERTS_ALC_A_EXEC
+ set_au_allocator(ERTS_ALC_A_EXEC, &init.exec_alloc, ncpu);
+#endif
+ 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));
}
@@ -793,14 +919,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);
@@ -820,13 +938,22 @@ 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);
+#ifdef ERTS_ALC_A_EXEC
+ start_au_allocator(ERTS_ALC_A_EXEC,
+ &init.exec_alloc,
+ &exec_alloc_state);
+#endif
+ 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();
@@ -843,7 +970,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));
}
@@ -924,6 +1051,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;
@@ -932,6 +1063,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;
@@ -965,7 +1097,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;
@@ -993,7 +1125,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);
@@ -1004,7 +1136,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)
@@ -1041,22 +1173,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;
@@ -1067,7 +1199,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);
@@ -1226,9 +1358,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;
@@ -1306,9 +1435,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;
@@ -1377,7 +1514,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) {
@@ -1406,6 +1550,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;
@@ -1425,6 +1570,26 @@ 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 'X':
+ if (has_prefix("scs", argv[i]+3)) {
+#ifdef ERTS_HAVE_EXEC_MMAPPER
+ init->mseg.exec_mmap.scs =
+#endif
+ get_mb_value(argv[i]+6, argv, &i);
+ }
+ else
+ handle_au_arg(&init->exec_alloc, &argv[i][3], argv, &i, 0);
+ break;
case 'D':
handle_au_arg(&init->std_alloc, &argv[i][3], argv, &i, 0);
break;
@@ -1461,25 +1626,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);
}
@@ -1496,6 +1661,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 */
@@ -1858,7 +2026,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;
@@ -1872,18 +2040,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(ERTS_DUMP_EXIT,
"%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;
}
}
@@ -1945,48 +2113,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)
{
@@ -1998,7 +2124,7 @@ add_fix_values(UWord *ap, UWord *up, ErtsAlcUFixInfo_t *fi, ErtsAlcType_t type)
}
Eterm
-erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg)
+erts_memory(fmtfn_t *print_to_p, void *print_to_arg, void *proc, Eterm earg)
{
/*
* NOTE! When updating this function, make sure to also update
@@ -2016,9 +2142,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;
@@ -2031,9 +2154,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)];
@@ -2092,11 +2212,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);
@@ -2190,15 +2305,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;
@@ -2210,11 +2316,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
@@ -2255,6 +2362,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;
@@ -2276,11 +2385,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
}
}
}
@@ -2307,7 +2411,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,
@@ -2317,11 +2420,26 @@ 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,
ERTS_ALC_T_MSG_REF);
+ add_fix_values(&size.processes,
+ &size.processes_used,
+ fi,
+ ERTS_ALC_T_LL_PTIMER);
+ add_fix_values(&size.processes,
+ &size.processes_used,
+ fi,
+ ERTS_ALC_T_HL_PTIMER);
+ add_fix_values(&size.processes,
+ &size.processes_used,
+ fi,
+ ERTS_ALC_T_BIF_TIMER);
+ add_fix_values(&size.processes,
+ &size.processes_used,
+ fi,
+ ERTS_ALC_T_NIF_EXP_TRACE);
}
if (want.atom || want.atom_used) {
@@ -2367,7 +2485,7 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg)
if (print_to_p) {
int i;
- int to = *print_to_p;
+ fmtfn_t to = *print_to_p;
void *arg = print_to_arg;
/* Print result... */
@@ -2421,7 +2539,7 @@ struct aa_values {
};
Eterm
-erts_allocated_areas(int *print_to_p, void *print_to_arg, void *proc)
+erts_allocated_areas(fmtfn_t *print_to_p, void *print_to_arg, void *proc)
{
#define MAX_AA_VALUES (24)
struct aa_values values[MAX_AA_VALUES];
@@ -2556,7 +2674,7 @@ erts_allocated_areas(int *print_to_p, void *print_to_arg, void *proc)
if (print_to_p) {
/* Print result... */
- int to = *print_to_p;
+ fmtfn_t to = *print_to_p;
void *arg = print_to_arg;
erts_print(to, arg, "=allocated_areas\n");
@@ -2645,14 +2763,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);
@@ -2667,7 +2788,7 @@ erts_alloc_util_allocators(void *proc)
}
void
-erts_allocator_info(int to, void *arg)
+erts_allocator_info(fmtfn_t to, void *arg)
{
ErtsAlcType_t a;
@@ -2732,10 +2853,18 @@ erts_allocator_info(int to, void *arg)
int i;
for (i = 0; i <= max; i++) {
erts_print(to, arg, "=allocator:mseg_alloc[%d]\n", i);
- erts_mseg_info(i, &to, arg, 0, NULL, NULL);
+ erts_mseg_info(i, &to, arg, 0, 0, NULL, NULL);
}
- erts_print(to, arg, "=allocator:mseg_alloc.erts_mmap\n");
- erts_mmap_info(&to, arg, NULL, NULL, &emis);
+ erts_print(to, arg, "=allocator:erts_mmap.default_mmap\n");
+ erts_mmap_info(&erts_dflt_mmapper, &to, arg, NULL, NULL, &emis);
+#if defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
+ erts_print(to, arg, "=allocator:erts_mmap.literal_mmap\n");
+ erts_mmap_info(&erts_literal_mmapper, &to, arg, NULL, NULL, &emis);
+#endif
+#ifdef ERTS_HAVE_EXEC_MMAPPER
+ erts_print(to, arg, "=allocator:erts_mmap.exec_mmap\n");
+ erts_mmap_info(&erts_exec_mmapper, &to, arg, NULL, NULL, &emis);
+#endif
}
#endif
@@ -2846,6 +2975,11 @@ erts_allocator_options(void *proc)
atoms[length] = am_atom_put("alloc_util", 10);
terms[length++] = erts_alcu_au_info_options(NULL, NULL, hpp, szp);
+#if HAVE_ERTS_MMAP
+ atoms[length] = ERTS_MAKE_AM("erts_mmap");
+ terms[length++] = erts_mmap_info_options(&erts_dflt_mmapper, NULL, NULL,
+ NULL, hpp, szp);
+#endif
{
Eterm o[3], v[3];
o[0] = am_atom_put("m", 1);
@@ -2882,7 +3016,12 @@ erts_allocator_options(void *proc)
#if ERTS_HAVE_ERTS_SYS_ALIGNED_ALLOC
terms[length++] = am_atom_put("sys_aligned_alloc", 17);
#endif
-
+#if defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
+ terms[length++] = ERTS_MAKE_AM("literal_mmap");
+#endif
+#ifdef ERTS_HAVE_EXEC_MMAPPER
+ terms[length++] = ERTS_MAKE_AM("exec_mmap");
+#endif
features = length ? erts_bld_list(hpp, szp, length, terms) : NIL;
#if defined(__GLIBC__)
@@ -2961,18 +3100,26 @@ 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;
- struct erts_mmap_info_struct emis;
+ ErtsMessage *mp = NULL;
+#if HAVE_ERTS_MMAP
+ struct erts_mmap_info_struct mmap_info_dflt;
+# if defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
+ struct erts_mmap_info_struct mmap_info_literal;
+# endif
+# ifdef ERTS_HAVE_EXEC_MMAPPER
+ struct erts_mmap_info_struct mmap_info_exec;
+# endif
+#endif
int i;
Eterm (*info_func)(Allctr_t *,
int,
int,
- int *,
+ fmtfn_t *,
void *,
Uint **,
Uint *) = (air->only_sz
@@ -2988,9 +3135,10 @@ reply_alloc_info(void *vair)
while (1) {
if (hpp)
- ref_copy = STORE_NC(hpp, ohp, air->ref);
+ ref_copy = erts_iref_storage_make_ref(&air->iref,
+ hpp, ohp, 0);
else
- *szp += REF_THING_SIZE;
+ *szp += erts_iref_storage_heap_size(&air->iref);
ai_list = NIL;
for (i = 0; air->allocs[i] != ERTS_ALC_A_INVALID; i++);
@@ -3073,30 +3221,64 @@ reply_alloc_info(void *vair)
make_small(0),
ainfo);
break;
+ case ERTS_ALC_INFO_A_ERTS_MMAP:
+ alloc_atom = erts_bld_atom(hpp, szp, "erts_mmap");
+#if HAVE_ERTS_MMAP
+ ainfo = (air->only_sz ? NIL :
+ erts_mmap_info(&erts_dflt_mmapper, NULL, NULL,
+ hpp, szp, &mmap_info_dflt));
+ ainfo = erts_bld_tuple3(hpp, szp,
+ alloc_atom,
+ erts_bld_atom(hpp,szp,"default_mmap"),
+ ainfo);
+# if defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
+ ai_list = erts_bld_cons(hpp, szp,
+ ainfo, ai_list);
+ ainfo = (air->only_sz ? NIL :
+ erts_mmap_info(&erts_literal_mmapper, NULL, NULL,
+ hpp, szp, &mmap_info_literal));
+ ainfo = erts_bld_tuple3(hpp, szp,
+ alloc_atom,
+ erts_bld_atom(hpp,szp,"literal_mmap"),
+ ainfo);
+# endif
+# ifdef ERTS_HAVE_EXEC_MMAPPER
+ ai_list = erts_bld_cons(hpp, szp,
+ ainfo, ai_list);
+ ainfo = (air->only_sz ? NIL :
+ erts_mmap_info(&erts_exec_mmapper, NULL, NULL,
+ hpp, szp, &mmap_info_exec));
+ ainfo = erts_bld_tuple3(hpp, szp,
+ alloc_atom,
+ erts_bld_atom(hpp,szp,"exec_mmap"),
+ ainfo);
+# endif
+#else /* !HAVE_ERTS_MMAP */
+ ainfo = erts_bld_tuple2(hpp, szp, alloc_atom,
+ am_false);
+#endif
+ break;
case ERTS_ALC_INFO_A_MSEG_ALLOC:
alloc_atom = erts_bld_atom(hpp, szp, "mseg_alloc");
#if HAVE_ERTS_MSEG
- ainfo = (air->only_sz
- ? NIL
- : erts_mseg_info(0, NULL, NULL, hpp != NULL,
- hpp, szp));
+ ainfo = erts_mseg_info(0, NULL, NULL, hpp != NULL,
+ air->only_sz, hpp, szp);
ainfo = erts_bld_tuple3(hpp, szp,
alloc_atom,
make_small(0),
ainfo);
- ai_list = erts_bld_cons(hpp, szp,
- ainfo, ai_list);
- ainfo = (air->only_sz ? NIL : erts_mmap_info(NULL, NULL, hpp, szp, &emis));
- ainfo = erts_bld_tuple3(hpp, szp,
- alloc_atom,
- erts_bld_atom(hpp,szp,"erts_mmap"),
- ainfo);
#else
ainfo = erts_bld_tuple2(hpp, szp, alloc_atom,
am_false);
#endif
break;
+#ifndef ERTS_ALC_A_EXEC
+ case ERTS_ALC_INFO_A_DISABLED_EXEC:
+ alloc_atom = erts_bld_atom(hpp, szp, "exec_alloc");
+ ainfo = erts_bld_tuple2(hpp, szp, alloc_atom, am_false);
+ break;
+#endif
default:
alloc_atom = erts_bld_atom(hpp, szp,
(char *) ERTS_ALC_A2AD(ai));
@@ -3114,7 +3296,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__);
}
}
@@ -3123,15 +3305,15 @@ reply_alloc_info(void *vair)
}
switch (ai) {
case ERTS_ALC_A_SYSTEM:
- case ERTS_ALC_INFO_A_ALLOC_UTIL:
+ case ERTS_ALC_INFO_A_ALLOC_UTIL:
+ case ERTS_ALC_INFO_A_ERTS_MMAP:
+ case ERTS_ALC_INFO_A_DISABLED_EXEC:
break;
case ERTS_ALC_INFO_A_MSEG_ALLOC:
#if HAVE_ERTS_MSEG && defined(ERTS_SMP)
alloc_atom = erts_bld_atom(hpp, szp, "mseg_alloc");
- ainfo = (air->only_sz
- ? NIL
- : erts_mseg_info(sched_id, NULL, NULL,
- hpp != NULL, hpp, szp));
+ ainfo = erts_mseg_info(sched_id, NULL, NULL,
+ hpp != NULL, air->only_sz, hpp, szp);
ainfo = erts_bld_tuple(hpp, szp, 3,
alloc_atom,
make_small(sched_id),
@@ -3167,33 +3349,28 @@ 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
-#ifdef USE_VM_PROBES
- , NIL
-#endif
- );
+ 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, am_system);
if (air->req_sched == sched_id)
rp_locks &= ~ERTS_PROC_LOCK_MAIN;
erts_smp_proc_unlock(rp, rp_locks);
- erts_smp_proc_dec_refc(rp);
+ erts_proc_dec_refc(rp);
- if (erts_smp_atomic32_dec_read_nob(&air->refc) == 0)
+ if (erts_smp_atomic32_dec_read_nob(&air->refc) == 0) {
+ erts_iref_storage_clean(&air->iref);
aireq_free(air);
+ }
}
int
@@ -3204,9 +3381,8 @@ erts_request_alloc_info(struct process *c_p,
int internal)
{
ErtsAllocInfoReq *air = aireq_alloc();
- Eterm req_ai[ERTS_ALC_A_MAX+1+2] = {0};
+ Eterm req_ai[ERTS_ALC_INFO_A_END] = {0};
Eterm alist;
- Eterm *hp;
int airix = 0, ai;
air->req_sched = erts_get_scheduler_id();
@@ -3220,8 +3396,7 @@ erts_request_alloc_info(struct process *c_p,
if (is_not_internal_ref(ref))
return 0;
- hp = &air->ref_heap[0];
- air->ref = STORE_NC(&hp, NULL, ref);
+ erts_iref_storage_save(&air->iref, ref);
if (is_not_list(allocs))
return 0;
@@ -3240,6 +3415,16 @@ erts_request_alloc_info(struct process *c_p,
ai = ERTS_ALC_INFO_A_MSEG_ALLOC;
goto save_alloc;
}
+ if (erts_is_atom_str("erts_mmap", alloc, 0)) {
+ ai = ERTS_ALC_INFO_A_ERTS_MMAP;
+ goto save_alloc;
+ }
+#ifndef ERTS_ALC_A_EXEC
+ if (erts_is_atom_str("exec_alloc", alloc, 0)) {
+ ai = ERTS_ALC_INFO_A_DISABLED_EXEC;
+ goto save_alloc;
+ }
+#endif
if (erts_is_atom_str("alloc_util", alloc, 0)) {
ai = ERTS_ALC_INFO_A_ALLOC_UTIL;
save_alloc:
@@ -3264,7 +3449,7 @@ erts_request_alloc_info(struct process *c_p,
erts_smp_atomic32_init_nob(&air->refc,
(erts_aint32_t) erts_no_schedulers);
- erts_smp_proc_add_refc(c_p, (Sint32) erts_no_schedulers);
+ erts_proc_add_refc(c_p, (Sint) erts_no_schedulers);
#ifdef ERTS_SMP
if (erts_no_schedulers > 1)
@@ -3327,35 +3512,13 @@ void erts_allctr_wrapper_pre_unlock(void)
}
-
-/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
- * Deprecated functions *
- * *
- * These functions are still defined since "non-OTP linked in drivers" may *
- * contain (illegal) calls to them. *
-\* */
-
-/* --- DO *NOT* USE THESE FUNCTIONS --- */
-
-void *sys_alloc(Uint sz)
-{ return erts_alloc_fnf(ERTS_ALC_T_UNDEF, sz); }
-void *sys_realloc(void *ptr, Uint sz)
-{ return erts_realloc_fnf(ERTS_ALC_T_UNDEF, ptr, sz); }
-void sys_free(void *ptr)
-{ erts_free(ERTS_ALC_T_UNDEF, ptr); }
-void *safe_alloc(Uint sz)
-{ return erts_alloc(ERTS_ALC_T_UNDEF, sz); }
-void *safe_realloc(void *ptr, Uint sz)
-{ return erts_realloc(ERTS_ALC_T_UNDEF, ptr, sz); }
-
-
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
* NOTE: erts_alc_test() is only supposed to be used for testing. *
* *
* 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)
{
@@ -3408,8 +3571,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;
@@ -3540,6 +3706,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;
}
@@ -3618,7 +3819,8 @@ hdbg_init(void)
hdbg_mblks[ERL_ALC_HDBG_MAX_MBLK-1].next = NULL;
free_hdbg_mblks = &hdbg_mblks[0];
used_hdbg_mblks = NULL;
- erts_mtx_init(&hdbg_mblk_mtx, "erts_alloc_hard_debug");
+ erts_mtx_init(&hdbg_mblk_mtx, "erts_alloc_hard_debug", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_ALLOCATOR);
}
static void *check_memory_fence(void *ptr,
@@ -3782,7 +3984,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);
@@ -3799,12 +4001,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);
@@ -3827,7 +4029,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);
@@ -3916,12 +4118,20 @@ debug_free(ErtsAlcType_t n, void *extra, void *ptr)
ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra;
void *dptr;
Uint size;
+ int free_pattern = n;
ASSERT(ERTS_ALC_N_MIN <= n && n <= ERTS_ALC_N_MAX);
dptr = check_memory_fence(ptr, &size, n, ERTS_ALC_O_FREE);
- sys_memset((void *) dptr, n, size + FENCE_SZ);
+#ifdef ERTS_ALC_A_EXEC
+# if defined(__i386__) || defined(__x86_64__)
+ if (ERTS_ALC_T2A(ERTS_ALC_N2T(n)) == ERTS_ALC_A_EXEC) {
+ free_pattern = 0x0f; /* Illegal instruction */
+ }
+# endif
+#endif
+ sys_memset((void *) dptr, free_pattern, size + FENCE_SZ);
(*real_af->free)(n, real_af->extra, dptr);
@@ -3939,7 +4149,7 @@ static Uint
install_debug_functions(void)
{
int i;
- ASSERT(sizeof(erts_allctrs) == sizeof(real_allctrs));
+ ERTS_CT_ASSERT(sizeof(erts_allctrs) == sizeof(real_allctrs));
sys_memcpy((void *)real_allctrs,(void *)erts_allctrs,sizeof(erts_allctrs));
diff --git a/erts/emulator/beam/erl_alloc.h b/erts/emulator/beam/erl_alloc.h
index d3109b9432..97a1cf1308 100644
--- a/erts/emulator/beam/erl_alloc.h
+++ b/erts/emulator/beam/erl_alloc.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2002-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2002-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -29,6 +30,7 @@
#ifdef USE_THREADS
#include "erl_threads.h"
#endif
+#include "erl_mmap.h"
#ifdef DEBUG
# undef ERTS_ALC_WANT_INLINE
@@ -42,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 \
@@ -65,11 +69,11 @@ void *erts_sys_aligned_realloc(UWord alignment, void *ptr, UWord size, UWord old
void erts_sys_aligned_free(UWord alignment, void *ptr);
#endif
-Eterm erts_memory(int *, void *, void *, Eterm);
-Eterm erts_allocated_areas(int *, void *, void *);
+Eterm erts_memory(fmtfn_t *, void *, void *, Eterm);
+Eterm erts_allocated_areas(fmtfn_t *, void *, void *);
Eterm erts_alloc_util_allocators(void *proc);
-void erts_allocator_info(int, void *);
+void erts_allocator_info(fmtfn_t, void *);
Eterm erts_allocator_options(void *proc);
struct process;
@@ -169,12 +173,11 @@ __decl_noreturn void erts_realloc_n_enomem(ErtsAlcType_t,void*,Uint)
__decl_noreturn void erts_alc_fatal_error(int,int,ErtsAlcType_t,...)
__noreturn;
-/* --- DO *NOT* USE THESE DEPRECATED FUNCTIONS --- Instead use: */
-void *safe_alloc(Uint) __deprecated; /* erts_alloc() */
-void *safe_realloc(void *, Uint) __deprecated; /* erts_realloc() */
-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
@@ -203,6 +206,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 */
@@ -220,12 +226,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);
+ 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;
}
@@ -233,6 +241,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,
@@ -240,37 +249,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
@@ -280,6 +300,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())
@@ -302,7 +344,8 @@ ERTS_QUICK_ALLOC_IMPL(NAME, TYPE, PASZ, ALCT, \
#define ERTS_SMP_QUALLOC_IMPL(NAME, TYPE, PASZ, ALCT) \
static erts_smp_spinlock_t NAME##_lck; \
ERTS_QUICK_ALLOC_IMPL(NAME, TYPE, PASZ, ALCT, \
- erts_smp_spinlock_init(&NAME##_lck, #NAME "_alloc_lock"),\
+ erts_smp_spinlock_init(&NAME##_lck, #NAME "_alloc_lock", NIL, \
+ ERTS_LOCK_FLAGS_CATEGORY_ALLOCATOR),\
erts_smp_spin_lock(&NAME##_lck), \
erts_smp_spin_unlock(&NAME##_lck))
@@ -316,7 +359,8 @@ ERTS_SMP_QUALLOC_IMPL(NAME, TYPE, PASZ, ALCT)
#define ERTS_TS_QUALLOC_IMPL(NAME, TYPE, PASZ, ALCT) \
static erts_mtx_t NAME##_lck; \
ERTS_QUICK_ALLOC_IMPL(NAME, TYPE, PASZ, ALCT, \
- erts_mtx_init(NAME##_lck, #NAME "_alloc_lock"), \
+ erts_mtx_init(NAME##_lck, #NAME "_alloc_lock", NIL, \
+ ERTS_LOCK_FLAGS_CATEGORY_ALLOCATOR),\
erts_mtx_lock(&NAME##_lck), \
erts_mtx_unlock(&NAME##_lck))
@@ -329,7 +373,8 @@ ERTS_PRE_ALLOC_IMPL(NAME, TYPE, PASZ, (void) 0, (void) 0, (void) 0)
#define ERTS_TS_PALLOC_IMPL(NAME, TYPE, PASZ) \
static erts_spinlock_t NAME##_lck; \
ERTS_PRE_ALLOC_IMPL(NAME, TYPE, PASZ, \
- erts_spinlock_init(&NAME##_lck, #NAME "_alloc_lock"),\
+ erts_spinlock_init(&NAME##_lck, #NAME "_alloc_lock", NIL, \
+ ERTS_LOCK_FLAGS_CATEGORY_ALLOCATOR),\
erts_spin_lock(&NAME##_lck), \
erts_spin_unlock(&NAME##_lck))
@@ -406,7 +451,7 @@ NAME##_free(TYPE *p) \
}
#ifdef DEBUG
-#define ERTS_PRE_ALLOC_SIZE(SZ) 2
+#define ERTS_PRE_ALLOC_SIZE(SZ) ((SZ) < 1000 ? (SZ)/10 + 10 : 100)
#define ERTS_PRE_ALLOC_CLOBBER(P, T) memset((void *) (P), 0xfd, sizeof(T))
#else
#define ERTS_PRE_ALLOC_SIZE(SZ) ((SZ) > 1 ? (SZ) : 1)
@@ -515,5 +560,3 @@ NAME##_free(TYPE *p) \
#undef ERTS_ALC_ATTRIBUTES
#endif /* #ifndef ERL_ALLOC_H__ */
-
-
diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types
index 17ac6316b7..252bf1cc7e 100644
--- a/erts/emulator/beam/erl_alloc.types
+++ b/erts/emulator/beam/erl_alloc.types
@@ -1,18 +1,19 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2003-2014. All Rights Reserved.
+# Copyright Ericsson AB 2003-2017. 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/.
+# 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
#
-# 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.
+# 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%
#
@@ -64,7 +65,7 @@
# --- Allocator declarations -------------------------------------------------
#
-# If, and only if, the same thread performes *all* allocations,
+# If, and only if, the same thread performs *all* allocations,
# reallocations and deallocations of all memory types that are handled
# by a specific allocator (<ALLOCATOR> in type declaration), set
# <MULTI_THREAD> for this specific allocator to false; otherwise, set
@@ -85,10 +86,9 @@ 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
+allocator LITERAL true literal_alloc
++if exec_alloc
+allocator EXEC true exec_alloc
+endif
+else # Non smp build
@@ -100,10 +100,9 @@ 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
+allocator LITERAL false literal_alloc
++if exec_alloc
+allocator EXEC false exec_alloc
+endif
+endif
@@ -111,7 +110,7 @@ allocator STANDARD_LOW false std_low_alloc
allocator BINARY true binary_alloc
allocator DRIVER true driver_alloc
-
+allocator TEST true test_alloc
# --- Class declarations -----------------------------------------------------
#
@@ -159,13 +158,18 @@ 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
type PREPARED_CODE SHORT_LIVED CODE prepared_code
-type BIF_TIMER_TABLE LONG_LIVED SYSTEM bif_timer_table
-type SL_BIF_TIMER SHORT_LIVED PROCESSES bif_timer_sl
-type LL_BIF_TIMER STANDARD PROCESSES bif_timer_ll
+type TIMER_SERVICE LONG_LIVED SYSTEM timer_service
+type LL_PTIMER FIXED_SIZE PROCESSES ll_ptimer
+type HL_PTIMER FIXED_SIZE PROCESSES hl_ptimer
+type BIF_TIMER FIXED_SIZE PROCESSES bif_timer
+type TIMER_REQUEST SHORT_LIVED PROCESSES timer_request
+type BTM_YIELD_STATE SHORT_LIVED PROCESSES btm_yield_state
type REG_TABLE STANDARD SYSTEM reg_tab
type FUN_TABLE STANDARD CODE fun_tab
type DIST_TABLE STANDARD SYSTEM dist_tab
@@ -222,6 +226,7 @@ type DB_DMC_ERROR ETS ETS db_dmc_error
type DB_DMC_ERR_INFO ETS ETS db_dmc_error_info
type DB_TERM ETS ETS db_term
type DB_PROC_CLEANUP SHORT_LIVED ETS db_proc_cleanup_state
+type ETS_ALL_REQ SHORT_LIVED ETS ets_all_request
type INSTR_INFO LONG_LIVED SYSTEM instr_info
type LOGGER_DSBUF TEMPORARY SYSTEM logger_dsbuf
type TMP_DSBUF TEMPORARY SYSTEM tmp_dsbuf
@@ -259,7 +264,6 @@ type PRTSD STANDARD SYSTEM port_specific_data
type CPUDATA LONG_LIVED SYSTEM cpu_data
type TMP_CPU_IDS SHORT_LIVED SYSTEM tmp_cpu_ids
type EXT_TERM_DATA SHORT_LIVED PROCESSES external_term_data
-type ZLIB STANDARD SYSTEM zlib
type CPU_GRPS_MAP LONG_LIVED SYSTEM cpu_groups_map
type AUX_WORK_TMO LONG_LIVED SYSTEM aux_work_timeouts
type MISC_AUX_WORK_Q LONG_LIVED SYSTEM misc_aux_work_q
@@ -267,9 +271,21 @@ type CODE_IX_LOCK_Q SHORT_LIVED SYSTEM code_ix_lock_q
type PROC_INTERVAL LONG_LIVED SYSTEM process_interval
type BUSY_CALLER_TAB SHORT_LIVED SYSTEM busy_caller_table
type BUSY_CALLER SHORT_LIVED SYSTEM busy_caller
-type PORT_DATA_HEAP STANDARD SYSTEM port_data_heap
type PROC_SYS_TSK SHORT_LIVED PROCESSES proc_sys_task
type PROC_SYS_TSK_QS SHORT_LIVED PROCESSES proc_sys_task_queues
+type NEW_TIME_OFFSET SHORT_LIVED SYSTEM new_time_offset
+type IOB_REQ SHORT_LIVED SYSTEM io_bytes_request
+type TRACER_NIF LONG_LIVED SYSTEM tracer_nif
+type TRACE_MSG_QUEUE SHORT_LIVED SYSTEM trace_message_queue
+type SCHED_ASYNC_JOB SHORT_LIVED SYSTEM async_calls
+type DIRTY_START STANDARD PROCESSES dirty_start
+type DIRTY_SL SHORT_LIVED SYSTEM dirty_short_lived
+type MREF_NSCHED_ENT FIXED_SIZE SYSTEM nsched_magic_ref_entry
+type MREF_ENT STANDARD SYSTEM magic_ref_entry
+type MREF_TAB_BKTS STANDARD SYSTEM magic_ref_table_buckets
+type MREF_TAB LONG_LIVED SYSTEM magic_ref_table
+type MINDIRECTION FIXED_SIZE SYSTEM magic_indirection
+type CRASH_DUMP STANDARD SYSTEM crash_dump
+if threads_no_smp
# Need thread safe allocs, but std_alloc and fix_alloc are not;
@@ -288,8 +304,10 @@ type THR_Q_LL LONG_LIVED SYSTEM long_lived_thr_queue
+if smp
type ASYNC SHORT_LIVED SYSTEM async
+type ZLIB STANDARD SYSTEM zlib
+else
-# sl_alloc is not thread safe in non smp build; therefore, we use driver_alloc
+# sl/std_alloc is not thread safe in non smp build; therefore, we use driver_alloc
+type ZLIB DRIVER SYSTEM zlib
type ASYNC DRIVER SYSTEM async
+endif
@@ -302,6 +320,7 @@ type RUNQ_BLNS LONG_LIVED SYSTEM run_queue_balancing
type THR_PRGR_IDATA LONG_LIVED SYSTEM thr_prgr_internal_data
type THR_PRGR_DATA LONG_LIVED SYSTEM thr_prgr_data
type T_THR_PRGR_DATA SHORT_LIVED SYSTEM temp_thr_prgr_data
+type RELEASE_LAREA SHORT_LIVED SYSTEM release_literal_area
+endif
#
@@ -324,8 +343,6 @@ type ACTIVE_PROCS STANDARD PROCESSES active_procs
+endif
+if smp
-type SL_PTIMER SHORT_LIVED SYSTEM ptimer_sl
-type LL_PTIMER STANDARD SYSTEM ptimer_ll
type SYS_MSG_Q SHORT_LIVED PROCESSES system_messages_queue
type FP_EXCEPTION LONG_LIVED SYSTEM fp_exception
type LL_MPATHS LONG_LIVED SYSTEM ll_migration_paths
@@ -334,56 +351,56 @@ type SL_MPATHS SHORT_LIVED SYSTEM sl_migration_paths
+if hipe
-# Currently most hipe code use this type.
-type HIPE SYSTEM SYSTEM hipe_data
+type HIPE_LL LONG_LIVED SYSTEM hipe_long_lived
+type HIPE_SL SHORT_LIVED SYSTEM hipe_short_lived
+type HIPE_STK STANDARD SYSTEM hipe_nstack
++if exec_alloc
+type HIPE_EXEC EXEC CODE hipe_code
+endif
++endif
+
+
+
+if heap_frag_elim_test
type SSB SHORT_LIVED PROCESSES ssb
+endif
++if lcnt
-+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 LCNT_CARRIER STANDARD SYSTEM lcnt_lock_info_carrier
+type LCNT_VECTOR SHORT_LIVED SYSTEM lcnt_sample_vector
-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
++endif
-+else # "fullword"
+type DEBUG SHORT_LIVED SYSTEM debugging
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 LITERAL_REF SHORT_LIVED CODE literal_area_ref
+type PURGE_DATA SHORT_LIVED CODE purge_data
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
type LL_TEMP_TERM LONG_LIVED SYSTEM ll_temp_term
+type NIF_TRAP_EXPORT STANDARD PROCESSES nif_trap_export_entry
+type NIF_EXP_TRACE FIXED_SIZE PROCESSES nif_export_trace
type EXPORT LONG_LIVED CODE export_entry
type MONITOR_SH FIXED_SIZE PROCESSES monitor_sh
type NLINK_SH FIXED_SIZE PROCESSES nlink_sh
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
-
-+endif
-
+type PORT_DATA_HEAP STANDARD SYSTEM port_data_heap
+type MSACC DRIVER SYSTEM microstate_accounting
+type SYS_CHECK_REQ SHORT_LIVED SYSTEM system_check_request
#
# Types used by system specific code
@@ -394,7 +411,9 @@ type DRV_TAB LONG_LIVED SYSTEM drv_tab
type DRV_EV_STATE LONG_LIVED SYSTEM driver_event_state
type DRV_EV_D_STATE FIXED_SIZE SYSTEM driver_event_data_state
type DRV_SEL_D_STATE FIXED_SIZE SYSTEM driver_select_data_state
+type NIF_SEL_D_STATE FIXED_SIZE SYSTEM enif_select_data_state
type FD_LIST SHORT_LIVED SYSTEM fd_list
+type ACTIVE_FD_ARR SHORT_LIVED SYSTEM active_fd_array
type POLLSET LONG_LIVED SYSTEM pollset
type POLLSET_UPDREQ SHORT_LIVED SYSTEM pollset_update_req
type POLL_FDS LONG_LIVED SYSTEM poll_fds
@@ -411,24 +430,16 @@ 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
+type SYS_BLOCKING STANDARD SYSTEM sys_blocking
++if smp
+type SYS_WRITE_BUF TEMPORARY SYSTEM sys_write_buf
++else
+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
@@ -440,4 +451,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 45f0cc4312..af86ad0548 100644
--- a/erts/emulator/beam/erl_alloc_util.c
+++ b/erts/emulator/beam/erl_alloc_util.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2002-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2002-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -51,6 +52,7 @@
#ifdef ERTS_ENABLE_LOCK_COUNT
#include "erl_lock_count.h"
#endif
+#include "lttng-wrapper.h"
#if defined(ERTS_ALLOC_UTIL_HARD_DEBUG) && defined(__GNUC__)
#warning "* * * * * * * * * *"
@@ -205,7 +207,7 @@ MBC after deallocating first block:
ASSERT(((UWord)(F) & (~FLG_MASK|THIS_FREE_BLK_HDR_FLG|PREV_FREE_BLK_HDR_FLG)) == THIS_FREE_BLK_HDR_FLG), \
(B)->bhdr = ((Sz) | (F)), \
(B)->u.carrier = (C))
-
+
# define IS_MBC_FIRST_ABLK(AP,B) \
((((UWord)(B) & ~ERTS_SACRR_UNIT_MASK) == MBC_HEADER_SIZE(AP)) \
&& ((B)->bhdr & MBC_ABLK_OFFSET_MASK) == 0)
@@ -378,9 +380,8 @@ do { \
#ifdef ERTS_SMP
#define SBC_HEADER_SIZE \
- (UNIT_CEILING(sizeof(Carrier_t) \
- - sizeof(ErtsAlcCPoolData_t) \
- + ABLK_HDR_SZ) \
+ (UNIT_CEILING(offsetof(Carrier_t, cpool) \
+ + ABLK_HDR_SZ) \
- ABLK_HDR_SZ)
#else
#define SBC_HEADER_SIZE \
@@ -719,7 +720,7 @@ static void make_name_atoms(Allctr_t *allctr);
static Block_t *create_carrier(Allctr_t *, Uint, UWord);
static void destroy_carrier(Allctr_t *, Block_t *, Carrier_t **);
static void mbc_free(Allctr_t *allctr, void *p, Carrier_t **busy_pcrr_pp);
-static void dealloc_block(Allctr_t *, void *, int);
+static void dealloc_block(Allctr_t *, void *, ErtsAlcFixList_t *, int);
/* internal data... */
@@ -751,12 +752,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)
+static void*
+erts_alcu_mseg_alloc(Allctr_t *allctr, Uint *size_p, Uint flags)
{
void *res;
UWord size = (UWord) *size_p;
@@ -766,8 +832,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)
+static 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,19 +845,162 @@ 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)
+static 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;
+ Uint sz = ERTS_SUPERALIGNED_CEILING(*size_p);
+ ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL &&
+ allctr->t == 0);
+ ERTS_SMP_LC_ASSERT(allctr->thread_safe);
+
+ res = erts_alcu_mseg_alloc(allctr, &sz, flags);
+ if (res) {
+ set_literal_range(res, sz);
+ *size_p = sz;
+ }
+ return res;
+}
+
+void*
+erts_alcu_literal_32_mseg_realloc(Allctr_t *allctr, void *seg,
+ Uint old_size, Uint *new_size_p)
+{
+ void* res;
+ Uint new_sz = ERTS_SUPERALIGNED_CEILING(*new_size_p);
+ ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL &&
+ allctr->t == 0);
+ ERTS_SMP_LC_ASSERT(allctr->thread_safe);
+
+ if (seg && old_size)
+ clear_literal_range(seg, old_size);
+ res = erts_alcu_mseg_realloc(allctr, seg, old_size, &new_sz);
+ if (res) {
+ set_literal_range(res, new_sz);
+ *new_size_p = new_sz;
+ }
+ 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 == 0);
+ ERTS_SMP_LC_ASSERT(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)
+
+/* For allocators that have their own mmapper (super carrier),
+ * like literal_alloc and exec_alloc on amd64
+ */
+void*
+erts_alcu_mmapper_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(allctr->mseg_mmapper, mmap_flags, &size);
+ *size_p = (Uint)size;
+ INC_CC(allctr->calls.mseg_alloc);
+ return res;
+}
+
+void*
+erts_alcu_mmapper_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(allctr->mseg_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_mmapper_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(allctr->mseg_mmapper, mmap_flags, seg, (UWord)size);
+ INC_CC(allctr->calls.mseg_dealloc);
+}
+#endif /* ARCH_64 && ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION */
+
+#if defined(ERTS_ALC_A_EXEC) && !defined(ERTS_HAVE_EXEC_MMAPPER)
+
+/*
+ * For exec_alloc on non-amd64 that just need memory with PROT_EXEC
+ */
+void*
+erts_alcu_exec_mseg_alloc(Allctr_t *allctr, Uint *size_p, Uint flags)
+{
+ void* res = erts_alcu_mseg_alloc(allctr, size_p, flags);
+
+ if (res) {
+ int r = mprotect(res, *size_p, PROT_EXEC | PROT_READ | PROT_WRITE);
+ ASSERT(r == 0); (void)r;
+ }
+ return res;
+}
+
+void*
+erts_alcu_exec_mseg_realloc(Allctr_t *allctr, void *seg,
+ Uint old_size, Uint *new_size_p)
+{
+ void *res;
+
+ if (seg && old_size) {
+ int r = mprotect(seg, old_size, PROT_READ | PROT_WRITE);
+ ASSERT(r == 0); (void)r;
+ }
+ res = erts_alcu_mseg_realloc(allctr, seg, old_size, new_size_p);
+ if (res) {
+ int r = mprotect(res, *new_size_p, PROT_EXEC | PROT_READ | PROT_WRITE);
+ ASSERT(r == 0); (void)r;
+ }
+ return res;
+}
+
+void
+erts_alcu_exec_mseg_dealloc(Allctr_t *allctr, void *seg, Uint size, Uint flags)
+{
+ int r = mprotect(seg, size, PROT_READ | PROT_WRITE);
+ ASSERT(r == 0); (void)r;
+ erts_alcu_mseg_dealloc(allctr, seg, size, flags);
+}
+#endif /* ERTS_ALC_A_EXEC && !ERTS_HAVE_EXEC_MMAPPER */
+
+#endif /* HAVE_ERTS_MSEG */
+
+static void*
+erts_alcu_sys_alloc(Allctr_t *allctr, Uint* size_p, int superalign)
{
void *res;
+ const Uint size = *size_p;
#if ERTS_SA_MB_CARRIERS && ERTS_HAVE_ERTS_SYS_ALIGNED_ALLOC
if (superalign)
res = erts_sys_aligned_alloc(ERTS_SACRR_UNIT_SZ, size);
@@ -803,10 +1013,11 @@ 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)
+static void*
+erts_alcu_sys_realloc(Allctr_t *allctr, void *ptr, Uint *size_p, Uint old_size, int superalign)
{
void *res;
+ const Uint size = *size_p;
#if ERTS_SA_MB_CARRIERS && ERTS_HAVE_ERTS_SYS_ALIGNED_ALLOC
if (superalign)
@@ -824,8 +1035,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)
+static 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 +1049,59 @@ 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_p, int superalign)
+{
+ void* res;
+ Uint size = ERTS_SUPERALIGNED_CEILING(*size_p);
+ ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL &&
+ allctr->t == 0);
+ ERTS_SMP_LC_ASSERT(allctr->thread_safe);
+
+ res = erts_alcu_sys_alloc(allctr, &size, 1);
+ if (res) {
+ set_literal_range(res, size);
+ *size_p = size;
+ }
+ return res;
+}
+
+void*
+erts_alcu_literal_32_sys_realloc(Allctr_t *allctr, void *ptr, Uint* size_p, Uint old_size, int superalign)
+{
+ void* res;
+ Uint size = ERTS_SUPERALIGNED_CEILING(*size_p);
+
+ ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL &&
+ allctr->t == 0);
+ ERTS_SMP_LC_ASSERT(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);
+ *size_p = 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 == 0);
+ ERTS_SMP_LC_ASSERT(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)
{
@@ -929,6 +1193,88 @@ unlink_carrier(CarrierList_t *cl, Carrier_t *crr)
#ifdef ERTS_SMP
+#ifdef DEBUG
+static int is_in_list(ErtsDoubleLink_t* sentinel, ErtsDoubleLink_t* node)
+{
+ ErtsDoubleLink_t* p;
+
+ ASSERT(node != sentinel);
+ for (p = sentinel->next; p != sentinel; p = p->next) {
+ if (p == node)
+ return 1;
+ }
+ return 0;
+}
+#endif /* DEBUG */
+
+static ERTS_INLINE void
+link_edl_after(ErtsDoubleLink_t* after_me, ErtsDoubleLink_t* node)
+{
+ ErtsDoubleLink_t* before_me = after_me->next;
+ ASSERT(node != after_me && node != before_me);
+ node->next = before_me;
+ node->prev = after_me;
+ before_me->prev = node;
+ after_me->next = node;
+}
+
+static ERTS_INLINE void
+link_edl_before(ErtsDoubleLink_t* before_me, ErtsDoubleLink_t* node)
+{
+ ErtsDoubleLink_t* after_me = before_me->prev;
+ ASSERT(node != before_me && node != after_me);
+ node->next = before_me;
+ node->prev = after_me;
+ before_me->prev = node;
+ after_me->next = node;
+}
+
+static ERTS_INLINE void
+unlink_edl(ErtsDoubleLink_t* node)
+{
+ node->next->prev = node->prev;
+ node->prev->next = node->next;
+}
+
+static ERTS_INLINE void
+relink_edl_before(ErtsDoubleLink_t* before_me, ErtsDoubleLink_t* node)
+{
+ if (node != before_me && node != before_me->prev) {
+ unlink_edl(node);
+ link_edl_before(before_me, node);
+ }
+}
+
+static ERTS_INLINE int is_abandoned(Carrier_t *crr)
+{
+ return crr->cpool.abandoned.next != NULL;
+}
+
+static ERTS_INLINE void
+link_abandoned_carrier(ErtsDoubleLink_t* list, Carrier_t *crr)
+{
+ ASSERT(!is_abandoned(crr));
+
+ link_edl_after(list, &crr->cpool.abandoned);
+
+ ASSERT(crr->cpool.abandoned.next != &crr->cpool.abandoned);
+ ASSERT(crr->cpool.abandoned.prev != &crr->cpool.abandoned);
+}
+
+static ERTS_INLINE void
+unlink_abandoned_carrier(Carrier_t *crr)
+{
+ ASSERT(is_in_list(&crr->cpool.orig_allctr->cpool.pooled_list,
+ &crr->cpool.abandoned) ||
+ is_in_list(&crr->cpool.orig_allctr->cpool.traitor_list,
+ &crr->cpool.abandoned));
+
+ unlink_edl(&crr->cpool.abandoned);
+
+ crr->cpool.abandoned.next = NULL;
+ crr->cpool.abandoned.prev = NULL;
+}
+
static ERTS_INLINE void
clear_busy_pool_carrier(Allctr_t *allctr, Carrier_t *crr)
{
@@ -955,7 +1301,7 @@ clear_busy_pool_carrier(Allctr_t *allctr, Carrier_t *crr)
}
}
-#endif
+#endif /* ERTS_SMP */
#if 0
#define ERTS_DBG_CHK_FIX_LIST(A, FIX, IX, B) \
@@ -986,17 +1332,21 @@ typedef struct {
} ErtsAllctrFixDDBlock_t;
#endif
+#define ERTS_ALC_FIX_NO_UNUSE (((ErtsAlcType_t) 1) << ERTS_ALC_N_BITS)
+
static ERTS_INLINE void
dealloc_fix_block(Allctr_t *allctr,
ErtsAlcType_t type,
void *ptr,
+ ErtsAlcFixList_t *fix,
int dec_cc_on_redirect)
{
#ifdef ERTS_SMP
/* May be redirected... */
- ((ErtsAllctrFixDDBlock_t *) ptr)->fix_type = type;
+ ASSERT((type & ERTS_ALC_FIX_NO_UNUSE) == 0);
+ ((ErtsAllctrFixDDBlock_t *) ptr)->fix_type = type | ERTS_ALC_FIX_NO_UNUSE;
#endif
- dealloc_block(allctr, ptr, dec_cc_on_redirect);
+ dealloc_block(allctr, ptr, fix, dec_cc_on_redirect);
}
static ERTS_INLINE void
@@ -1042,8 +1392,7 @@ fix_cpool_check_shrink(Allctr_t *allctr,
if (fix->u.cpool.min_list_size > fix->list_size)
fix->u.cpool.min_list_size = fix->list_size;
- fix->u.cpool.allocated--;
- dealloc_fix_block(allctr, type, p, 0);
+ dealloc_fix_block(allctr, type, p, fix, 0);
}
}
}
@@ -1058,6 +1407,7 @@ fix_cpool_alloc(Allctr_t *allctr, ErtsAlcType_t type, Uint size)
&& type <= ERTS_ALC_N_MAX_A_FIXED_SIZE);
fix = &allctr->fix[type - ERTS_ALC_N_MIN_A_FIXED_SIZE];
+ ASSERT(size == fix->type_size);
res = fix->list;
if (res) {
@@ -1069,8 +1419,6 @@ fix_cpool_alloc(Allctr_t *allctr, ErtsAlcType_t type, Uint size)
fix_cpool_check_shrink(allctr, type, fix, NULL);
return res;
}
- if (size < 2*sizeof(UWord))
- size += sizeof(UWord);
if (size >= allctr->sbc_threshold) {
Block_t *blk;
blk = create_carrier(allctr, size, CFLG_SBC);
@@ -1089,7 +1437,8 @@ static ERTS_INLINE void
fix_cpool_free(Allctr_t *allctr,
ErtsAlcType_t type,
void *p,
- Carrier_t **busy_pcrr_pp)
+ Carrier_t **busy_pcrr_pp,
+ int unuse)
{
ErtsAlcFixList_t *fix;
@@ -1097,8 +1446,9 @@ fix_cpool_free(Allctr_t *allctr,
&& type <= ERTS_ALC_N_MAX_A_FIXED_SIZE);
fix = &allctr->fix[type - ERTS_ALC_N_MIN_A_FIXED_SIZE];
-
- fix->u.cpool.used--;
+
+ if (unuse)
+ fix->u.cpool.used--;
if ((!busy_pcrr_pp || !*busy_pcrr_pp)
&& !fix->u.cpool.shrink_list
@@ -1156,8 +1506,7 @@ fix_cpool_alloc_shrink(Allctr_t *allctr, erts_aint32_t flgs)
fix->list = *((void **) ptr);
fix->list_size--;
fix->u.cpool.shrink_list--;
- fix->u.cpool.allocated--;
- dealloc_fix_block(allctr, type, ptr, 0);
+ dealloc_fix_block(allctr, type, ptr, fix, 0);
}
if (fix->u.cpool.min_list_size > fix->list_size)
fix->u.cpool.min_list_size = fix->list_size;
@@ -1189,6 +1538,7 @@ fix_nocpool_alloc(Allctr_t *allctr, ErtsAlcType_t type, Uint size)
&& type <= ERTS_ALC_N_MAX_A_FIXED_SIZE);
fix = &allctr->fix[type - ERTS_ALC_N_MIN_A_FIXED_SIZE];
+ ASSERT(size == fix->type_size);
ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 1);
fix->u.nocpool.used++;
@@ -1211,8 +1561,6 @@ fix_nocpool_alloc(Allctr_t *allctr, ErtsAlcType_t type, Uint size)
ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0);
return res;
}
- if (size < 2*sizeof(UWord))
- size += sizeof(UWord);
if (fix->u.nocpool.limit < fix->u.nocpool.used)
fix->u.nocpool.limit = fix->u.nocpool.used;
if (fix->u.nocpool.max_used < fix->u.nocpool.used)
@@ -1318,7 +1666,7 @@ fix_nocpool_alloc_shrink(Allctr_t *allctr, erts_aint32_t flgs)
ptr = fix->list;
fix->list = *((void **) ptr);
fix->list_size--;
- dealloc_block(allctr, ptr, 0);
+ dealloc_block(allctr, ptr, NULL, 0);
fix->u.nocpool.allocated--;
}
if (fix->list_size != 0) {
@@ -1351,6 +1699,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*
@@ -1361,7 +1719,7 @@ get_pref_allctr(void *extra)
pref_ix = ERTS_ALC_GET_THR_IX();
- ASSERT(sizeof(UWord) == sizeof(Allctr_t *));
+ ERTS_CT_ASSERT(sizeof(UWord) == sizeof(Allctr_t *));
ASSERT(0 <= pref_ix && pref_ix < tspec->size);
return tspec->allctr[pref_ix];
@@ -1665,11 +2023,13 @@ handle_delayed_fix_dealloc(Allctr_t *allctr, void *ptr)
type = ((ErtsAllctrFixDDBlock_t *) ptr)->fix_type;
- ASSERT(ERTS_ALC_N_MIN_A_FIXED_SIZE <= type
- && type <= ERTS_ALC_N_MAX_A_FIXED_SIZE);
+ ASSERT(ERTS_ALC_N_MIN_A_FIXED_SIZE
+ <= (type & ~ERTS_ALC_FIX_NO_UNUSE));
+ ASSERT((type & ~ERTS_ALC_FIX_NO_UNUSE)
+ <= ERTS_ALC_N_MAX_A_FIXED_SIZE);
if (!ERTS_ALC_IS_CPOOL_ENABLED(allctr))
- fix_nocpool_free(allctr, type, ptr);
+ fix_nocpool_free(allctr, (type & ~ERTS_ALC_FIX_NO_UNUSE), ptr);
else {
Block_t *blk = UMEM2BLK(ptr);
Carrier_t *busy_pcrr_p;
@@ -1684,7 +2044,9 @@ handle_delayed_fix_dealloc(Allctr_t *allctr, void *ptr)
NULL, &busy_pcrr_p);
if (used_allctr == allctr) {
doit:
- fix_cpool_free(allctr, type, ptr, &busy_pcrr_p);
+ fix_cpool_free(allctr, (type & ~ERTS_ALC_FIX_NO_UNUSE),
+ ptr, &busy_pcrr_p,
+ !(type & ERTS_ALC_FIX_NO_UNUSE));
clear_busy_pool_carrier(allctr, busy_pcrr_p);
}
else {
@@ -1775,6 +2137,18 @@ handle_delayed_dealloc(Allctr_t *allctr,
* data has been overwritten by the queue.
*/
Carrier_t *crr = FIRST_BLK_TO_MBC(allctr, blk);
+
+ /* Restore word overwritten by the dd-queue as it will be read
+ * if this carrier is pulled from dc_list by cpool_fetch()
+ */
+ ERTS_ALC_CPOOL_ASSERT(FBLK_TO_MBC(blk) != crr);
+ ERTS_CT_ASSERT(sizeof(ErtsAllctrDDBlock_t) == sizeof(void*));
+#ifdef MBC_ABLK_OFFSET_BITS
+ blk->u.carrier = crr;
+#else
+ blk->carrier = crr;
+#endif
+
ERTS_ALC_CPOOL_ASSERT(ERTS_ALC_IS_CPOOL_ENABLED(allctr));
ERTS_ALC_CPOOL_ASSERT(allctr == crr->cpool.orig_allctr);
ERTS_ALC_CPOOL_ASSERT(((erts_aint_t) allctr)
@@ -1792,7 +2166,7 @@ handle_delayed_dealloc(Allctr_t *allctr,
if (fix)
handle_delayed_fix_dealloc(allctr, ptr);
else
- dealloc_block(allctr, ptr, 1);
+ dealloc_block(allctr, ptr, NULL, 1);
}
}
@@ -1898,15 +2272,24 @@ erts_alcu_check_delayed_dealloc(Allctr_t *allctr,
ERTS_ALCU_DD_OPS_LIM_LOW, NULL, NULL, NULL)
static void
-dealloc_block(Allctr_t *allctr, void *ptr, int dec_cc_on_redirect)
+dealloc_block(Allctr_t *allctr, void *ptr, ErtsAlcFixList_t *fix, int dec_cc_on_redirect)
{
Block_t *blk = UMEM2BLK(ptr);
ERTS_SMP_LC_ASSERT(!allctr->thread_safe
|| erts_lc_mtx_is_locked(&allctr->mutex));
- if (IS_SBC_BLK(blk))
+ if (IS_SBC_BLK(blk)) {
destroy_carrier(allctr, blk, NULL);
+#ifdef ERTS_SMP
+ if (fix && ERTS_ALC_IS_CPOOL_ENABLED(allctr)) {
+ ErtsAlcType_t type = ((ErtsAllctrFixDDBlock_t *) ptr)->fix_type;
+ if (!(type & ERTS_ALC_FIX_NO_UNUSE))
+ fix->u.cpool.used--;
+ fix->u.cpool.allocated--;
+ }
+#endif
+ }
#ifndef ERTS_SMP
else
mbc_free(allctr, ptr, NULL);
@@ -1919,6 +2302,12 @@ dealloc_block(Allctr_t *allctr, void *ptr, int dec_cc_on_redirect)
used_allctr = get_used_allctr(allctr, ERTS_ALC_TS_PREF_LOCK_NO, ptr,
NULL, &busy_pcrr_p);
if (used_allctr == allctr) {
+ if (fix) {
+ ErtsAlcType_t type = ((ErtsAllctrFixDDBlock_t *) ptr)->fix_type;
+ if (!(type & ERTS_ALC_FIX_NO_UNUSE))
+ fix->u.cpool.used--;
+ fix->u.cpool.allocated--;
+ }
mbc_free(allctr, ptr, &busy_pcrr_p);
clear_busy_pool_carrier(allctr, busy_pcrr_p);
}
@@ -1957,7 +2346,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. */
@@ -2563,10 +2952,9 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs,
#ifdef ERTS_SMP
#define ERTS_ALC_MAX_DEALLOC_CARRIER 10
-#define ERTS_ALC_CPOOL_MAX_FETCH_INSPECT 10
+#define ERTS_ALC_CPOOL_MAX_FETCH_INSPECT 20
+#define ERTS_ALC_CPOOL_MAX_TRAITOR_INSPECT 10
#define ERTS_ALC_CPOOL_CHECK_LIMIT_COUNT 100
-#define ERTS_ALC_CPOOL_MAX_NO_CARRIERS 5
-#define ERTS_ALC_CPOOL_INSERT_ALLOWED_OFFSET 100
#define ERTS_ALC_CPOOL_MAX_FAILED_STAT_READS 3
#define ERTS_ALC_CPOOL_PTR_MOD_MRK (((erts_aint_t) 1) << 0)
@@ -2743,9 +3131,6 @@ cpool_insert(Allctr_t *allctr, Carrier_t *crr)
(erts_aint_t) CARRIER_SZ(crr));
erts_atomic_inc_nob(&allctr->cpool.stat.no_carriers);
- erts_smp_atomic_set_nob(&crr->allctr,
- ((erts_aint_t) allctr)|ERTS_CRR_ALCTR_FLG_IN_POOL);
-
/*
* We search in 'next' direction and begin by passing
* one element before trying to insert. This in order to
@@ -2804,6 +3189,10 @@ cpool_insert(Allctr_t *allctr, Carrier_t *crr)
cpool_set_mod_marked(&cpd2p->prev,
(erts_aint_t) &crr->cpool,
(erts_aint_t) cpd1p);
+
+ erts_smp_atomic_set_wb(&crr->allctr,
+ ((erts_aint_t) allctr)|ERTS_CRR_ALCTR_FLG_IN_POOL);
+ LTTNG3(carrier_pool_put, ERTS_ALC_A2AD(allctr->alloc_no), allctr->ix, CARRIER_SZ(crr));
}
static void
@@ -2904,59 +3293,164 @@ cpool_delete(Allctr_t *allctr, Allctr_t *prev_allctr, Carrier_t *crr)
static Carrier_t *
cpool_fetch(Allctr_t *allctr, UWord size)
{
- int i;
+ int i, i_stop, has_passed_sentinel;
Carrier_t *crr;
ErtsAlcCPoolData_t *cpdp;
- ErtsAlcCPoolData_t *sentinel = &carrier_pool[allctr->alloc_no].sentinel;
+ ErtsAlcCPoolData_t *cpool_entrance;
+ ErtsAlcCPoolData_t *sentinel;
+ ErtsDoubleLink_t* dl;
+ ErtsDoubleLink_t* first_old_traitor;
ERTS_ALC_CPOOL_ASSERT(allctr->alloc_no == ERTS_ALC_A_INVALID /* testcase */
|| erts_thr_progress_is_managed_thread());
- i = 0;
+ i = ERTS_ALC_CPOOL_MAX_FETCH_INSPECT;
+ first_old_traitor = allctr->cpool.traitor_list.next;
+ cpool_entrance = NULL;
- /* First; check our own pending dealloc carrier list... */
- crr = allctr->cpool.dc_list.last;
- while (crr && i < ERTS_ALC_CPOOL_MAX_FETCH_INSPECT) {
- if (erts_atomic_read_nob(&crr->cpool.max_size) >= size) {
- unlink_carrier(&allctr->cpool.dc_list, crr);
-#ifdef ERTS_ALC_CPOOL_DEBUG
- ERTS_ALC_CPOOL_ASSERT(erts_smp_atomic_xchg_nob(&crr->allctr,
- ((erts_aint_t) allctr))
- == (((erts_aint_t) allctr) & ~ERTS_CRR_ALCTR_FLG_MASK));
-#else
- erts_smp_atomic_set_nob(&crr->allctr, ((erts_aint_t) allctr));
-#endif
- return crr;
+ LTTNG3(carrier_pool_get, ERTS_ALC_A2AD(allctr->alloc_no), allctr->ix, (unsigned long)size);
+ /*
+ * Search my own pooled_list,
+ * i.e my abandoned carriers that were in the pool last time I checked.
+ */
+
+ dl = allctr->cpool.pooled_list.next;
+ while(dl != &allctr->cpool.pooled_list) {
+ erts_aint_t exp, act;
+ crr = (Carrier_t *) (((char *) dl) - offsetof(Carrier_t, cpool.abandoned));
+
+ ASSERT(!is_in_list(&allctr->cpool.traitor_list, dl));
+ ASSERT(crr->cpool.orig_allctr == allctr);
+ dl = dl->next;
+ exp = erts_smp_atomic_read_rb(&crr->allctr);
+ if ((exp & ERTS_CRR_ALCTR_FLG_MASK) == ERTS_CRR_ALCTR_FLG_IN_POOL
+ && erts_atomic_read_nob(&crr->cpool.max_size) >= size) {
+ /* Try to fetch it... */
+ act = erts_smp_atomic_cmpxchg_mb(&crr->allctr,
+ (erts_aint_t) allctr,
+ exp);
+ if (act == exp) {
+ cpool_delete(allctr, ((Allctr_t *) (act & ~ERTS_CRR_ALCTR_FLG_MASK)), crr);
+ unlink_abandoned_carrier(crr);
+
+ /* Move sentinel to continue next search from here */
+ relink_edl_before(dl, &allctr->cpool.pooled_list);
+ return crr;
+ }
+ exp = act;
+ }
+ if (exp & ERTS_CRR_ALCTR_FLG_IN_POOL) {
+ if (!cpool_entrance)
+ cpool_entrance = &crr->cpool;
+ }
+ else { /* Not in pool, move to traitor_list */
+ unlink_abandoned_carrier(crr);
+ link_abandoned_carrier(&allctr->cpool.traitor_list, crr);
+ }
+ if (--i <= 0) {
+ /* Move sentinel to continue next search from here */
+ relink_edl_before(dl, &allctr->cpool.pooled_list);
+ return NULL;
}
- crr = crr->prev;
- i++;
}
- /* ... then the pool ... */
+ /* Now search traitor_list.
+ * i.e carriers employed by other allocators last time I checked.
+ * They might have been abandoned since then.
+ */
+
+ i_stop = (i < ERTS_ALC_CPOOL_MAX_TRAITOR_INSPECT ?
+ 0 : i - ERTS_ALC_CPOOL_MAX_TRAITOR_INSPECT);
+ dl = first_old_traitor;
+ while(dl != &allctr->cpool.traitor_list) {
+ erts_aint_t exp, act;
+ crr = (Carrier_t *) (((char *) dl) - offsetof(Carrier_t, cpool.abandoned));
+ ASSERT(dl != &allctr->cpool.pooled_list);
+ ASSERT(crr->cpool.orig_allctr == allctr);
+ dl = dl->next;
+ exp = erts_smp_atomic_read_rb(&crr->allctr);
+ if (exp & ERTS_CRR_ALCTR_FLG_IN_POOL) {
+ if (!(exp & ERTS_CRR_ALCTR_FLG_BUSY)
+ && erts_atomic_read_nob(&crr->cpool.max_size) >= size) {
+ /* Try to fetch it... */
+ act = erts_smp_atomic_cmpxchg_mb(&crr->allctr,
+ (erts_aint_t) allctr,
+ exp);
+ if (act == exp) {
+ cpool_delete(allctr, ((Allctr_t *) (act & ~ERTS_CRR_ALCTR_FLG_MASK)), crr);
+ unlink_abandoned_carrier(crr);
+
+ /* Move sentinel to continue next search from here */
+ relink_edl_before(dl, &allctr->cpool.traitor_list);
+ return crr;
+ }
+ exp = act;
+ }
+ if (exp & ERTS_CRR_ALCTR_FLG_IN_POOL) {
+ if (!cpool_entrance)
+ cpool_entrance = &crr->cpool;
+
+ /* Move to pooled_list */
+ unlink_abandoned_carrier(crr);
+ link_abandoned_carrier(&allctr->cpool.pooled_list, crr);
+ }
+ }
+ if (--i <= i_stop) {
+ /* Move sentinel to continue next search from here */
+ relink_edl_before(dl, &allctr->cpool.traitor_list);
+ if (i > 0)
+ break;
+ else
+ return NULL;
+ }
+ }
/*
- * We search in 'prev' direction and begin by passing
- * one element before trying to fetch. This in order to
- * avoid contention with threads inserting elements.
+ * Finally search the shared pool and try employ foreign carriers
*/
- cpdp = cpool_aint2cpd(cpool_read(&sentinel->prev));
- if (cpdp == sentinel)
- return NULL;
+ sentinel = &carrier_pool[allctr->alloc_no].sentinel;
+ if (cpool_entrance) {
+ /* We saw a pooled carried above, use it as entrance into the pool
+ */
+ cpdp = cpool_entrance;
+ }
+ else {
+ /* No pooled carried seen above. Start search at cpool sentinel,
+ * but begin by passing one element before trying to fetch.
+ * This in order to avoid contention with threads inserting elements.
+ */
+ cpool_entrance = sentinel;
+ cpdp = cpool_aint2cpd(cpool_read(&cpool_entrance->prev));
+ if (cpdp == sentinel)
+ goto check_dc_list;
+ }
- while (i < ERTS_ALC_CPOOL_MAX_FETCH_INSPECT) {
+ has_passed_sentinel = 0;
+ while (1) {
erts_aint_t exp;
cpdp = cpool_aint2cpd(cpool_read(&cpdp->prev));
- if (cpdp == sentinel) {
+ if (cpdp == cpool_entrance) {
+ if (cpool_entrance == sentinel) {
+ cpdp = cpool_aint2cpd(cpool_read(&cpdp->prev));
+ if (cpdp == sentinel)
+ 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 */
+ break;
+ }
cpdp = cpool_aint2cpd(cpool_read(&cpdp->prev));
if (cpdp == sentinel)
- return NULL;
- i = ERTS_ALC_CPOOL_MAX_FETCH_INSPECT; /* Last one to inspect */
+ break;
+ has_passed_sentinel = 1;
}
- crr = (Carrier_t *) (((char *) cpdp) - offsetof(Carrier_t, cpool));
+ crr = (Carrier_t *)(((char *)cpdp) - offsetof(Carrier_t, cpool));
exp = erts_smp_atomic_read_rb(&crr->allctr);
- if (((exp & (ERTS_CRR_ALCTR_FLG_IN_POOL|ERTS_CRR_ALCTR_FLG_BUSY))
- == ERTS_CRR_ALCTR_FLG_IN_POOL)
+ if (((exp & (ERTS_CRR_ALCTR_FLG_MASK)) == ERTS_CRR_ALCTR_FLG_IN_POOL)
&& (erts_atomic_read_nob(&cpdp->max_size) >= size)) {
erts_aint_t act;
/* Try to fetch it... */
@@ -2965,11 +3459,40 @@ cpool_fetch(Allctr_t *allctr, UWord size)
exp);
if (act == exp) {
cpool_delete(allctr, ((Allctr_t *) (act & ~ERTS_CRR_ALCTR_FLG_MASK)), crr);
+ if (crr->cpool.orig_allctr == allctr) {
+ unlink_abandoned_carrier(crr);
+ }
return crr;
}
}
- i++;
+ if (--i <= 0)
+ 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,
+ ((erts_aint_t) allctr))
+ == (((erts_aint_t) allctr) & ~ERTS_CRR_ALCTR_FLG_MASK));
+#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;
+ if (--i <= 0)
+ return NULL;
+ }
+
return NULL;
}
@@ -2993,7 +3516,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);
@@ -3024,18 +3547,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;
/*
@@ -3052,6 +3577,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));
@@ -3066,13 +3592,18 @@ schedule_dealloc_carrier(Allctr_t *allctr, Carrier_t *crr)
return;
}
+ if (is_abandoned(crr))
+ unlink_abandoned_carrier(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;
@@ -3112,6 +3643,8 @@ cpool_init_carrier_data(Allctr_t *allctr, Carrier_t *crr)
limit = (csz/100)*allctr->cpool.util_limit;
crr->cpool.abandon_limit = limit;
}
+ crr->cpool.abandoned.next = NULL;
+ crr->cpool.abandoned.prev = NULL;
}
static void
@@ -3142,6 +3675,9 @@ abandon_carrier(Allctr_t *allctr, Carrier_t *crr)
STAT_MBC_CPOOL_INSERT(allctr, crr);
unlink_carrier(&allctr->mbc_list, crr);
+ if (crr->cpool.orig_allctr == allctr) {
+ link_abandoned_carrier(&allctr->cpool.pooled_list, crr);
+ }
allctr->remove_mbc(allctr, crr);
@@ -3259,8 +3795,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;
@@ -3268,13 +3803,38 @@ 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)));
ASSERT(!(flags & CFLG_FORCE_MSEG && flags & CFLG_FORCE_SYS_ALLOC));
- blk_sz = UMEMSZ2BLKSZ(allctr, umem_sz);
+ if (umem_sz > (ERTS_UINT_MAX - ERTS_UINT_MAX/100)) {
+ /* Do an overly conservative _overflow_ check here so we don't
+ * have to deal with it from here on. I guess we could be more accurate
+ * but I don't think the need to allocate over 99% of the address space
+ * will ever arise on any machine, neither 32 nor 64 bit.
+ */
+ return NULL;
+ }
+
+ 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;
@@ -3320,13 +3880,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))
@@ -3358,23 +3920,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
@@ -3433,6 +3994,21 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags)
}
+#ifdef USE_LTTNG_VM_TRACEPOINTS
+ if (LTTNG_ENABLED(carrier_create)) {
+ lttng_decl_carrier_stats(mbc_stats);
+ lttng_decl_carrier_stats(sbc_stats);
+ LTTNG_CARRIER_STATS_TO_LTTNG_STATS(&(allctr->mbcs), mbc_stats);
+ LTTNG_CARRIER_STATS_TO_LTTNG_STATS(&(allctr->sbcs), sbc_stats);
+ LTTNG5(carrier_create,
+ ERTS_ALC_A2AD(allctr->alloc_no),
+ allctr->ix,
+ crr_sz,
+ mbc_stats,
+ sbc_stats);
+ }
+#endif
+
DEBUG_SAVE_ALIGNMENT(crr);
return blk;
}
@@ -3473,7 +4049,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);
@@ -3488,11 +4064,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 */
}
@@ -3503,7 +4074,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 */
@@ -3520,9 +4091,9 @@ 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,
+ &new_crr_sz,
old_crr_sz,
0);
if (new_crr) {
@@ -3541,9 +4112,9 @@ 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,
+ &new_crr_sz,
old_crr_sz,
0);
if (new_crr)
@@ -3564,7 +4135,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... */
@@ -3580,13 +4151,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
@@ -3626,20 +4197,22 @@ destroy_carrier(Allctr_t *allctr, Block_t *blk, Carrier_t **busy_pcrr_pp)
ASSERT(IS_LAST_BLK(blk));
#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG
- (*allctr->link_free_block)(allctr, blk, 0);
+ (*allctr->link_free_block)(allctr, blk);
HARD_CHECK_BLK_CARRIER(allctr, blk);
- (*allctr->unlink_free_block)(allctr, blk, 0);
+ (*allctr->unlink_free_block)(allctr, blk);
#endif
}
#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);
*busy_pcrr_pp = NULL;
+ ERTS_ALC_CPOOL_ASSERT(erts_smp_atomic_read_nob(&crr->allctr)
+ == (((erts_aint_t) allctr)
+ | ERTS_CRR_ALCTR_FLG_IN_POOL
+ | ERTS_CRR_ALCTR_FLG_BUSY));
+ erts_smp_atomic_set_nob(&crr->allctr, ((erts_aint_t) allctr));
cpool_delete(allctr, allctr, crr);
}
else
@@ -3654,12 +4227,30 @@ 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 USE_LTTNG_VM_TRACEPOINTS
+ if (LTTNG_ENABLED(carrier_destroy)) {
+ lttng_decl_carrier_stats(mbc_stats);
+ lttng_decl_carrier_stats(sbc_stats);
+ LTTNG_CARRIER_STATS_TO_LTTNG_STATS(&(allctr->mbcs), mbc_stats);
+ LTTNG_CARRIER_STATS_TO_LTTNG_STATS(&(allctr->sbcs), sbc_stats);
+ LTTNG5(carrier_destroy,
+ ERTS_ALC_A2AD(allctr->alloc_no),
+ allctr->ix,
+ crr_sz,
+ mbc_stats,
+ sbc_stats);
+ }
+#endif
+
#ifdef ERTS_SMP
schedule_dealloc_carrier(allctr, crr);
#else
- dealloc_carrier(allctr, crr, 1);
+ dealloc_mbc(allctr, crr);
#endif
}
}
@@ -3676,9 +4267,6 @@ static struct {
Eterm e;
Eterm t;
Eterm ramv;
-#if HALFWORD_HEAP
- Eterm low;
-#endif
Eterm sbct;
#if HAVE_ERTS_MSEG
Eterm asbcst;
@@ -3769,9 +4357,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);
@@ -3932,7 +4517,7 @@ add_fix_types(Allctr_t *allctr, int internal, Uint **hpp, Uint *szp,
static Eterm
sz_info_fix(Allctr_t *allctr,
int internal,
- int *print_to_p,
+ fmtfn_t *print_to_p,
void *print_to_arg,
Uint **hpp,
Uint *szp)
@@ -3953,7 +4538,7 @@ sz_info_fix(Allctr_t *allctr,
UWord used = fix->type_size * fix->u.cpool.used;
if (print_to_p) {
- int to = *print_to_p;
+ fmtfn_t to = *print_to_p;
void *arg = print_to_arg;
erts_print(to,
arg,
@@ -3981,7 +4566,7 @@ sz_info_fix(Allctr_t *allctr,
UWord used = fix->type_size*fix->u.nocpool.used;
if (print_to_p) {
- int to = *print_to_p;
+ fmtfn_t to = *print_to_p;
void *arg = print_to_arg;
erts_print(to,
arg,
@@ -4007,7 +4592,7 @@ static Eterm
sz_info_carriers(Allctr_t *allctr,
CarriersStats_t *cs,
char *prefix,
- int *print_to_p,
+ fmtfn_t *print_to_p,
void *print_to_arg,
Uint **hpp,
Uint *szp)
@@ -4016,7 +4601,7 @@ sz_info_carriers(Allctr_t *allctr,
UWord curr_size = cs->curr.norm.mseg.size + cs->curr.norm.sys_alloc.size;
if (print_to_p) {
- int to = *print_to_p;
+ fmtfn_t to = *print_to_p;
void *arg = print_to_arg;
erts_print(to,
arg,
@@ -4057,7 +4642,7 @@ static Eterm
info_cpool(Allctr_t *allctr,
int sz_only,
char *prefix,
- int *print_to_p,
+ fmtfn_t *print_to_p,
void *print_to_arg,
Uint **hpp,
Uint *szp)
@@ -4074,7 +4659,7 @@ info_cpool(Allctr_t *allctr,
}
if (print_to_p) {
- int to = *print_to_p;
+ fmtfn_t to = *print_to_p;
void *arg = print_to_arg;
if (!sz_only)
erts_print(to, arg, "%sblocks: %bpu\n", prefix, nob);
@@ -4111,7 +4696,7 @@ static Eterm
info_carriers(Allctr_t *allctr,
CarriersStats_t *cs,
char *prefix,
- int *print_to_p,
+ fmtfn_t *print_to_p,
void *print_to_arg,
Uint **hpp,
Uint *szp)
@@ -4123,7 +4708,7 @@ info_carriers(Allctr_t *allctr,
curr_size = cs->curr.norm.mseg.size + cs->curr.norm.sys_alloc.size;
if (print_to_p) {
- int to = *print_to_p;
+ fmtfn_t to = *print_to_p;
void *arg = print_to_arg;
erts_print(to,
arg,
@@ -4232,7 +4817,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);
@@ -4249,7 +4834,7 @@ make_name_atoms(Allctr_t *allctr)
static Eterm
info_calls(Allctr_t *allctr,
- int *print_to_p,
+ fmtfn_t *print_to_p,
void *print_to_arg,
Uint **hpp,
Uint *szp)
@@ -4266,7 +4851,7 @@ info_calls(Allctr_t *allctr,
erts_print(TO, TOA, "%s%s calls: %b64u\n",PRFX,NAME,CC)
char *prefix = allctr->name_prefix;
- int to = *print_to_p;
+ fmtfn_t to = *print_to_p;
void *arg = print_to_arg;
PRINT_CC_5(to, arg, prefix, "alloc", allctr->calls.this_alloc);
@@ -4342,7 +4927,7 @@ info_calls(Allctr_t *allctr,
static Eterm
info_options(Allctr_t *allctr,
- int *print_to_p,
+ fmtfn_t *print_to_p,
void *print_to_arg,
Uint **hpp,
Uint *szp)
@@ -4377,9 +4962,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"
@@ -4398,9 +4980,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,
@@ -4463,9 +5042,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);
@@ -4503,7 +5079,7 @@ reset_max_values(CarriersStats_t *cs)
\* */
Eterm
-erts_alcu_au_info_options(int *print_to_p, void *print_to_arg,
+erts_alcu_au_info_options(fmtfn_t *print_to_p, void *print_to_arg,
Uint **hpp, Uint *szp)
{
Eterm res = THE_NON_VALUE;
@@ -4546,7 +5122,7 @@ erts_alcu_au_info_options(int *print_to_p, void *print_to_arg,
Eterm
erts_alcu_info_options(Allctr_t *allctr,
- int *print_to_p,
+ fmtfn_t *print_to_p,
void *print_to_arg,
Uint **hpp,
Uint *szp)
@@ -4578,7 +5154,7 @@ Eterm
erts_alcu_sz_info(Allctr_t *allctr,
int internal,
int begin_max_period,
- int *print_to_p,
+ fmtfn_t *print_to_p,
void *print_to_arg,
Uint **hpp,
Uint *szp)
@@ -4610,7 +5186,7 @@ erts_alcu_sz_info(Allctr_t *allctr,
ERTS_ALCU_DBG_CHK_THR_ACCESS(allctr);
- /* Update sbc values not continously updated */
+ /* Update sbc values not continuously updated */
allctr->sbcs.blocks.curr.no
= allctr->sbcs.curr.norm.mseg.no + allctr->sbcs.curr.norm.sys_alloc.no;
allctr->sbcs.blocks.max.no = allctr->sbcs.max.no;
@@ -4664,7 +5240,7 @@ Eterm
erts_alcu_info(Allctr_t *allctr,
int internal,
int begin_max_period,
- int *print_to_p,
+ fmtfn_t *print_to_p,
void *print_to_arg,
Uint **hpp,
Uint *szp)
@@ -4696,7 +5272,7 @@ erts_alcu_info(Allctr_t *allctr,
ERTS_ALCU_DBG_CHK_THR_ACCESS(allctr);
- /* Update sbc values not continously updated */
+ /* Update sbc values not continuously updated */
allctr->sbcs.blocks.curr.no
= allctr->sbcs.curr.norm.mseg.no + allctr->sbcs.curr.norm.sys_alloc.no;
allctr->sbcs.blocks.max.no = allctr->sbcs.max.no;
@@ -4860,6 +5436,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;
@@ -4973,7 +5554,7 @@ do_erts_alcu_free(ErtsAlcType_t type, void *extra, void *p,
if (allctr->fix) {
if (ERTS_ALC_IS_CPOOL_ENABLED(allctr))
- fix_cpool_free(allctr, type, p, busy_pcrr_pp);
+ fix_cpool_free(allctr, type, p, busy_pcrr_pp, 1);
else
fix_nocpool_free(allctr, type, p);
}
@@ -5150,11 +5731,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)
@@ -5434,7 +6011,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__);
}
@@ -5448,11 +6025,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)
@@ -5509,7 +6083,7 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
goto error;
allctr->min_block_size = UNIT_CEILING(allctr->min_block_size
+ sizeof(FreeBlkFtr_t));
-#if ERTS_SMP
+#ifdef ERTS_SMP
if (init->tpref) {
Uint sz = ABLK_HDR_SZ;
sz += (init->fix ?
@@ -5519,6 +6093,10 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
allctr->min_block_size = sz;
}
+ allctr->cpool.pooled_list.next = &allctr->cpool.pooled_list;
+ allctr->cpool.pooled_list.prev = &allctr->cpool.pooled_list;
+ allctr->cpool.traitor_list.next = &allctr->cpool.traitor_list;
+ allctr->cpool.traitor_list.prev = &allctr->cpool.traitor_list;
allctr->cpool.dc_list.first = NULL;
allctr->cpool.dc_list.last = NULL;
allctr->cpool.abandon_limit = 0;
@@ -5556,18 +6134,10 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
#ifdef USE_THREADS
if (init->ts) {
allctr->thread_safe = 1;
-
-#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_mtx_init_x_opt(&allctr->mutex,
- "alcu_allocator",
- make_small(allctr->alloc_no),
- ERTS_LCNT_LT_ALLOC,1);
-#else
- erts_mtx_init_x(&allctr->mutex,
- "alcu_allocator",
- make_small(allctr->alloc_no),1);
-#endif /*ERTS_ENABLE_LOCK_COUNT*/
-
+
+ erts_mtx_init(&allctr->mutex, "alcu_allocator", make_small(allctr->alloc_no),
+ ERTS_LOCK_FLAGS_CATEGORY_ALLOCATOR);
+
#ifdef DEBUG
allctr->debug.saved_tid = 0;
#endif
@@ -5597,24 +6167,60 @@ 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;
+ allctr->mseg_mmapper = init->mseg_mmapper;
+ }
+ 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);
}
@@ -5696,7 +6302,7 @@ erts_alcu_init(AlcUInit_t *init)
erts_atomic_init_nob(&sentinel->prev, (erts_aint_t) sentinel);
}
#endif
- ASSERT(SBC_BLK_SZ_MASK == MBC_FBLK_SZ_MASK); /* see BLK_SZ */
+ ERTS_CT_ASSERT(SBC_BLK_SZ_MASK == MBC_FBLK_SZ_MASK); /* see BLK_SZ */
#if HAVE_ERTS_MSEG
ASSERT(erts_mseg_unit_size() == ERTS_SACRR_UNIT_SZ);
max_mseg_carriers = init->mmc;
@@ -5710,7 +6316,8 @@ erts_alcu_init(AlcUInit_t *init)
carrier_alignment = sizeof(Unit_t);
#endif
- erts_mtx_init(&init_atoms_mtx, "alcu_init_atoms");
+ erts_mtx_init(&init_atoms_mtx, "alcu_init_atoms", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_ALLOCATOR);
atoms_initialized = 0;
initialized = 1;
@@ -5759,7 +6366,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
@@ -5784,6 +6391,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);
}
@@ -5820,7 +6437,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",
@@ -5860,11 +6477,6 @@ check_blk_carrier(Allctr_t *allctr, Block_t *iblk)
ASSERT(SBC2BLK(allctr, sbc) == iblk);
ASSERT(CARRIER_SZ(sbc) - SBC_HEADER_SIZE >= SBC_BLK_SZ(iblk));
-#if HAVE_ERTS_MSEG
- if (IS_MSEG_CARRIER(sbc)) {
- ASSERT(CARRIER_SZ(sbc) % ERTS_SACRR_UNIT_SZ == 0);
- }
-#endif
crr = sbc;
cl = &allctr->sbc_list;
}
@@ -5973,3 +6585,45 @@ check_blk_carrier(Allctr_t *allctr, Block_t *iblk)
#endif /* ERTS_ALLOC_UTIL_HARD_DEBUG */
+#ifdef ERTS_ENABLE_LOCK_COUNT
+
+static void lcnt_enable_allocator_lock_count(Allctr_t *allocator, int enable) {
+ if(!allocator->thread_safe) {
+ return;
+ }
+
+ if(enable) {
+ erts_lcnt_install_new_lock_info(&allocator->mutex.lcnt,
+ "alcu_allocator", make_small(allocator->alloc_no),
+ ERTS_LOCK_TYPE_MUTEX | ERTS_LOCK_FLAGS_CATEGORY_ALLOCATOR);
+ } else {
+ erts_lcnt_uninstall(&allocator->mutex.lcnt);
+ }
+}
+
+static void lcnt_update_thread_spec_locks(ErtsAllocatorThrSpec_t *tspec, int enable) {
+ if(tspec->enabled) {
+ int i;
+
+ for(i = 0; i < tspec->size; i++) {
+ lcnt_enable_allocator_lock_count(tspec->allctr[i], enable);
+ }
+ }
+}
+
+void erts_lcnt_update_allocator_locks(int enable) {
+ int i;
+
+ for(i = ERTS_ALC_A_MIN; i < ERTS_ALC_A_MAX; i++) {
+ ErtsAllocatorInfo_t *ai = &erts_allctrs_info[i];
+
+ if(ai->enabled && ai->alloc_util) {
+ if(ai->thr_spec) {
+ lcnt_update_thread_spec_locks((ErtsAllocatorThrSpec_t*)ai->extra, enable);
+ } else {
+ lcnt_enable_allocator_lock_count((Allctr_t*)ai->extra, enable);
+ }
+ }
+ }
+}
+#endif /* ERTS_ENABLE_LOCK_COUNT */
diff --git a/erts/emulator/beam/erl_alloc_util.h b/erts/emulator/beam/erl_alloc_util.h
index 7be6b1ed9d..aa13cda9fb 100644
--- a/erts/emulator/beam/erl_alloc_util.h
+++ b/erts/emulator/beam/erl_alloc_util.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2002-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2002-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -23,6 +24,13 @@
#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"
+#include "lttng-wrapper.h"
#define ERTS_AU_PREF_ALLOC_BITS 11
#define ERTS_AU_MAX_PREF_ALLOC_INSTANCES (1 << ERTS_AU_PREF_ALLOC_BITS)
@@ -44,7 +52,6 @@ typedef struct {
int tspec;
int tpref;
int ramv;
- int low_mem; /* HALFWORD only */
UWord sbct;
UWord asbcst;
UWord rsbcst;
@@ -60,6 +67,16 @@ 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);
+ ErtsMemMapper *mseg_mmapper;
+#endif
+ void* (*sys_alloc)(Allctr_t *allctr, Uint *size_p, int superalign);
+ void* (*sys_realloc)(Allctr_t *allctr, void *ptr, Uint *size_p, Uint old_size, int superalign);
+ void (*sys_dealloc)(Allctr_t *allctr, void *ptr, Uint size, int superalign);
} AllctrInit_t;
typedef struct {
@@ -89,7 +106,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 */\
@@ -124,7 +140,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 */\
@@ -163,10 +178,10 @@ void * erts_alcu_realloc_mv_thr_pref(ErtsAlcType_t, void *, void *, Uint);
void erts_alcu_free_thr_pref(ErtsAlcType_t, void *, void *);
#endif
#endif
-Eterm erts_alcu_au_info_options(int *, void *, Uint **, Uint *);
-Eterm erts_alcu_info_options(Allctr_t *, int *, void *, Uint **, Uint *);
-Eterm erts_alcu_sz_info(Allctr_t *, int, int, int *, void *, Uint **, Uint *);
-Eterm erts_alcu_info(Allctr_t *, int, int, int *, void *, Uint **, Uint *);
+Eterm erts_alcu_au_info_options(fmtfn_t *, void *, Uint **, Uint *);
+Eterm erts_alcu_info_options(Allctr_t *, fmtfn_t *, void *, Uint **, Uint *);
+Eterm erts_alcu_sz_info(Allctr_t *, int, int, fmtfn_t *, void *, Uint **, Uint *);
+Eterm erts_alcu_info(Allctr_t *, int, int, fmtfn_t *, void *, Uint **, Uint *);
void erts_alcu_init(AlcUInit_t *);
void erts_alcu_current_size(Allctr_t *, AllctrSize_t *,
ErtsAlcUFixInfo_t *, int);
@@ -175,20 +190,47 @@ 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
+
+#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_mmapper_mseg_alloc(Allctr_t*, Uint *size_p, Uint flags);
+void* erts_alcu_mmapper_mseg_realloc(Allctr_t*, void *seg, Uint old_size, Uint *new_size_p);
+void erts_alcu_mmapper_mseg_dealloc(Allctr_t*, void *seg, Uint size, Uint flags);
+# endif
+
+# if defined(ERTS_ALC_A_EXEC) && !defined(ERTS_HAVE_EXEC_MMAPPER)
+void* erts_alcu_exec_mseg_alloc(Allctr_t*, Uint *size_p, Uint flags);
+void* erts_alcu_exec_mseg_realloc(Allctr_t*, void *seg, Uint old_size, Uint *new_size_p);
+void erts_alcu_exec_mseg_dealloc(Allctr_t*, void *seg, Uint size, Uint flags);
+# endif
+#endif /* HAVE_ERTS_MSEG */
+
+#ifdef ARCH_32
+void* erts_alcu_literal_32_sys_alloc(Allctr_t*, Uint *size_p, int superalign);
+void* erts_alcu_literal_32_sys_realloc(Allctr_t*, void *ptr, Uint *size_p, Uint old_size, int superalign);
+void erts_alcu_literal_32_sys_dealloc(Allctr_t*, void *ptr, Uint size, int superalign);
+#endif
+
+#ifdef ERTS_ENABLE_LOCK_COUNT
+void erts_lcnt_update_allocator_locks(int enable);
#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
@@ -196,10 +238,6 @@ erts_aint32_t erts_alcu_fix_alloc_shrink(Allctr_t *, erts_aint32_t);
# endif
#endif
-#undef MIN
-#undef MAX
-#define MIN(X, Y) ((X) < (Y) ? (X) : (Y))
-#define MAX(X, Y) ((X) > (Y) ? (X) : (Y))
#define FLOOR(X, I) (((X)/(I))*(I))
#define CEILING(X, I) ((((X) - 1)/(I) + 1)*(I))
@@ -222,7 +260,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
@@ -268,15 +306,21 @@ typedef union {char c[ERTS_ALLOC_ALIGN_BYTES]; long l; double d;} Unit_t;
#ifdef ERTS_SMP
+typedef struct ErtsDoubleLink_t_ {
+ struct ErtsDoubleLink_t_ *next;
+ struct ErtsDoubleLink_t_ *prev;
+}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;
UWord blocks;
UWord blocks_size;
+ ErtsDoubleLink_t abandoned; /* node in pooled_list or traitor_list */
} ErtsAlcCPoolData_t;
#endif
@@ -374,6 +418,18 @@ typedef struct {
} blocks;
} CarriersStats_t;
+#ifdef USE_LTTNG_VM_TRACEPOINTS
+#define LTTNG_CARRIER_STATS_TO_LTTNG_STATS(CSP, LSP) \
+ do { \
+ (LSP)->carriers.size = (CSP)->curr.norm.mseg.size \
+ + (CSP)->curr.norm.sys_alloc.size; \
+ (LSP)->carriers.no = (CSP)->curr.norm.mseg.no \
+ + (CSP)->curr.norm.sys_alloc.no; \
+ (LSP)->blocks.size = (CSP)->blocks.curr.size; \
+ (LSP)->blocks.no = (CSP)->blocks.curr.no; \
+ } while (0)
+#endif
+
#ifdef ERTS_SMP
typedef union ErtsAllctrDDBlock_t_ ErtsAllctrDDBlock_t;
@@ -494,13 +550,20 @@ 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;
CarrierList_t sbc_list;
#ifdef ERTS_SMP
struct {
- CarrierList_t dc_list;
+ /* pooled_list, traitor list and dc_list contain only
+ carriers _created_ by this allocator */
+ ErtsDoubleLink_t pooled_list;
+ ErtsDoubleLink_t traitor_list;
+ CarrierList_t dc_list;
+
UWord abandon_limit;
int disable_abandon;
int check_limit_count;
@@ -522,7 +585,7 @@ struct Allctr_t_ {
Block_t *, Uint);
void (*link_free_block) (Allctr_t *, Block_t *);
void (*unlink_free_block) (Allctr_t *, Block_t *);
- Eterm (*info_options) (Allctr_t *, char *, int *,
+ Eterm (*info_options) (Allctr_t *, char *, fmtfn_t *,
void *, Uint **, Uint *);
Uint (*get_next_mbc_size) (Allctr_t *);
@@ -534,6 +597,16 @@ 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);
+ ErtsMemMapper *mseg_mmapper;
+#endif
+ void* (*sys_alloc)(Allctr_t *allctr, Uint *size_p, int superalign);
+ void* (*sys_realloc)(Allctr_t *allctr, void *ptr, Uint *size_p, 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
@@ -600,7 +673,6 @@ void erts_alcu_assert_failed(char* expr, char* file, int line, char *func);
int is_sbc_blk(Block_t*);
#endif
-
#endif /* #if defined(GET_ERL_ALLOC_UTIL_IMPL)
&& !defined(ERL_ALLOC_UTIL_IMPL__) */
diff --git a/erts/emulator/beam/erl_ao_firstfit_alloc.c b/erts/emulator/beam/erl_ao_firstfit_alloc.c
index 396aa88e0b..05ba1f9891 100644
--- a/erts/emulator/beam/erl_ao_firstfit_alloc.c
+++ b/erts/emulator/beam/erl_ao_firstfit_alloc.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2003-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2003-2016. 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.
+ * 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%
*/
@@ -122,7 +123,7 @@ struct AOFF_Carrier_t_ {
AOFF_RBTree_t rbt_node; /* My node in the carrier tree */
AOFF_RBTree_t* root; /* Root of my block tree */
};
-#define RBT_NODE_TO_MBC(PTR) ((AOFF_Carrier_t*)((char*)(PTR) - offsetof(AOFF_Carrier_t, rbt_node)))
+#define RBT_NODE_TO_MBC(PTR) ErtsContainerStruct((PTR), AOFF_Carrier_t, rbt_node)
/*
To support carrier migration we keep two kinds of rb-trees:
@@ -208,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*);
@@ -221,7 +224,7 @@ static AOFF_RBTree_t* rbt_search(AOFF_RBTree_t* root, Uint size);
static int rbt_assert_is_member(AOFF_RBTree_t* root, AOFF_RBTree_t* node);
#endif
-static Eterm info_options(Allctr_t *, char *, int *, void *, Uint **, Uint *);
+static Eterm info_options(Allctr_t *, char *, fmtfn_t *, void *, Uint **, Uint *);
static void init_atoms(void);
@@ -270,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;
@@ -884,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)
{
@@ -902,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
@@ -918,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);
@@ -1001,7 +1014,7 @@ add_2tup(Uint **hpp, Uint *szp, Eterm *lp, Eterm el1, Eterm el2)
static Eterm
info_options(Allctr_t *allctr,
char *prefix,
- int *print_to_p,
+ fmtfn_t *print_to_p,
void *print_to_arg,
Uint **hpp,
Uint *szp)
@@ -1022,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_ao_firstfit_alloc.h b/erts/emulator/beam/erl_ao_firstfit_alloc.h
index 25b344c6a8..7349c6ab19 100644
--- a/erts/emulator/beam/erl_ao_firstfit_alloc.h
+++ b/erts/emulator/beam/erl_ao_firstfit_alloc.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2003-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2003-2016. 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.
+ * 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%
*/
diff --git a/erts/emulator/beam/erl_arith.c b/erts/emulator/beam/erl_arith.c
index 5150a8a507..861532f241 100644
--- a/erts/emulator/beam/erl_arith.c
+++ b/erts/emulator/beam/erl_arith.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1999-2010. All Rights Reserved.
+ * Copyright Ericsson AB 1999-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -41,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);
@@ -2048,3 +2042,8 @@ Eterm erts_gc_bnot(Process* p, Eterm* reg, Uint live)
}
return result;
}
+
+/* Needed to remove compiler optimization */
+double erts_get_positive_zero_float() {
+ return 0.0f;
+}
diff --git a/erts/emulator/beam/erl_async.c b/erts/emulator/beam/erl_async.c
index decae6b2ca..9a93034fcb 100644
--- a/erts/emulator/beam/erl_async.c
+++ b/erts/emulator/beam/erl_async.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2000-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2000-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -27,6 +28,7 @@
#include "erl_thr_queue.h"
#include "erl_async.h"
#include "dtrace-wrapper.h"
+#include "lttng-wrapper.h"
#define ERTS_MAX_ASYNC_READY_CALLS_IN_SEQ 20
@@ -166,7 +168,6 @@ async_ready_q(Uint sched_id)
#endif
-
void
erts_init_async(void)
{
@@ -176,7 +177,7 @@ erts_init_async(void)
ErtsThrQInit_t qinit = ERTS_THR_Q_INIT_DEFAULT;
#endif
erts_thr_opts_t thr_opts = ERTS_THR_OPTS_DEFAULT_INITER;
- char *ptr;
+ char *ptr, thr_name[16];
size_t tot_size = 0;
int i;
@@ -193,7 +194,8 @@ erts_init_async(void)
ptr += ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsAsyncData));
async->init.data.no_initialized = 0;
- erts_mtx_init(&async->init.data.mtx, "async_init_mtx");
+ erts_mtx_init(&async->init.data.mtx, "async_init_mtx", NIL,
+ ERTS_LOCK_FLAGS_CATEGORY_SCHEDULER);
erts_cnd_init(&async->init.data.cnd);
erts_atomic_init_nob(&async->init.data.id, 0);
@@ -212,7 +214,8 @@ erts_init_async(void)
for (i = 1; i <= erts_no_schedulers; i++) {
ErtsAsyncReadyQ *arq = async_ready_q(i);
#if ERTS_USE_ASYNC_READY_ENQ_MTX
- erts_mtx_init(&arq->x.data.enq_mtx, "async_enq_mtx");
+ erts_mtx_init(&arq->x.data.enq_mtx, "async_enq_mtx", make_small(i),
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_SCHEDULER);
#endif
erts_thr_q_finalize_dequeue_state_init(&arq->fin_deq);
qinit.arg = (void *) (SWord) i;
@@ -227,23 +230,16 @@ erts_init_async(void)
thr_opts.suggested_stack_size
= erts_async_thread_suggested_stack_size;
-#ifdef ETHR_HAVE_THREAD_NAMES
- thr_opts.name = malloc(sizeof(char)*(strlen("async_XXXX")+1));
-#endif
+ thr_opts.name = thr_name;
for (i = 0; i < erts_async_max_threads; i++) {
ErtsAsyncQ *aq = async_q(i);
-#ifdef ETHR_HAVE_THREAD_NAMES
- sprintf(thr_opts.name, "async_%d", i+1);
-#endif
+ erts_snprintf(thr_opts.name, 16, "async_%d", i+1);
erts_thr_create(&aq->thr_id, async_main, (void*) aq, &thr_opts);
}
-#ifdef ETHR_HAVE_THREAD_NAMES
- free(thr_opts.name);
-#endif
/* Wait for async threads to initialize... */
erts_mtx_lock(&async->init.data.mtx);
@@ -288,6 +284,13 @@ static ERTS_INLINE void async_add(ErtsAsync *a, ErtsAsyncQ* q)
#endif
erts_thr_q_enqueue(&q->thr_q, a);
+#ifdef USE_LTTNG_VM_TRACEPOINTS
+ if (LTTNG_ENABLED(aio_pool_put)) {
+ lttng_decl_portbuf(port_str);
+ lttng_portid_to_str(a->port, port_str);
+ LTTNG2(aio_pool_put, port_str, -1);
+ }
+#endif
#ifdef USE_VM_PROBES
if (DTRACE_ENABLED(aio_pool_add)) {
DTRACE_CHARBUF(port_str, 16);
@@ -324,6 +327,14 @@ static ERTS_INLINE ErtsAsync *async_get(ErtsThrQ_t *q,
if (saved_fin_deq)
erts_thr_q_append_finalize_dequeue_data(&a->q.fin_deq, &fin_deq);
#endif
+#ifdef USE_LTTNG_VM_TRACEPOINTS
+ if (LTTNG_ENABLED(aio_pool_get)) {
+ lttng_decl_portbuf(port_str);
+ int length = erts_thr_q_length_dirty(q);
+ lttng_portid_to_str(a->port, port_str);
+ LTTNG2(aio_pool_get, port_str, length);
+ }
+#endif
#ifdef USE_VM_PROBES
if (DTRACE_ENABLED(aio_pool_get)) {
DTRACE_CHARBUF(port_str, 16);
@@ -407,13 +418,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);
@@ -467,6 +484,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;
@@ -490,10 +509,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;
}
@@ -501,6 +522,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;
@@ -508,11 +530,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);
}
@@ -635,10 +660,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);
@@ -691,12 +719,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_async.h b/erts/emulator/beam/erl_async.h
index 95374a8fc9..4b470e7679 100644
--- a/erts/emulator/beam/erl_async.h
+++ b/erts/emulator/beam/erl_async.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2011. All Rights Reserved.
+ * Copyright Ericsson AB 2011-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -26,7 +27,6 @@ extern int erts_async_max_threads;
#define ERTS_ASYNC_THREAD_MAX_STACK_SIZE 8192 /* Kilo words */
extern int erts_async_thread_suggested_stack_size;
-#ifdef USE_THREADS
#ifdef ERTS_SMP
/*
@@ -46,6 +46,10 @@ extern int erts_async_thread_suggested_stack_size;
# define ERTS_USE_ASYNC_READY_Q 0
#endif
+#ifndef USE_THREADS
+# undef ERTS_USE_ASYNC_READY_Q
+# define ERTS_USE_ASYNC_READY_Q 0
+#endif /* !USE_THREADS */
#if ERTS_USE_ASYNC_READY_Q
int erts_check_async_ready(void *);
int erts_async_ready_clean(void *, void *);
@@ -57,10 +61,7 @@ void *erts_get_async_ready_queue(Uint sched_id);
#endif
#endif /* ERTS_USE_ASYNC_READY_Q */
-#endif /* USE_THREADS */
-
void erts_init_async(void);
void erts_exit_flush_async(void);
-
#endif /* ERL_ASYNC_H__ */
diff --git a/erts/emulator/beam/erl_bestfit_alloc.c b/erts/emulator/beam/erl_bestfit_alloc.c
index 59c14899a2..6173c408e1 100644
--- a/erts/emulator/beam/erl_bestfit_alloc.c
+++ b/erts/emulator/beam/erl_bestfit_alloc.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2003-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2003-2016. 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.
+ * 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%
*/
@@ -103,7 +104,7 @@ static void bf_link_free_block (Allctr_t *, Block_t *);
static ERTS_INLINE void bf_unlink_free_block (Allctr_t *, Block_t *);
-static Eterm info_options (Allctr_t *, char *, int *,
+static Eterm info_options (Allctr_t *, char *, fmtfn_t *,
void *, Uint **, Uint *);
static void init_atoms (void);
@@ -920,7 +921,7 @@ add_2tup(Uint **hpp, Uint *szp, Eterm *lp, Eterm el1, Eterm el2)
static Eterm
info_options(Allctr_t *allctr,
char *prefix,
- int *print_to_p,
+ fmtfn_t *print_to_p,
void *print_to_arg,
Uint **hpp,
Uint *szp)
@@ -939,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_bestfit_alloc.h b/erts/emulator/beam/erl_bestfit_alloc.h
index 870439e886..3a5f51f5dc 100644
--- a/erts/emulator/beam/erl_bestfit_alloc.h
+++ b/erts/emulator/beam/erl_bestfit_alloc.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2003-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2003-2016. 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.
+ * 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%
*/
diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c
index ff775691b3..dcffde5777 100644
--- a/erts/emulator/beam/erl_bif_binary.c
+++ b/erts/emulator/beam/erl_bif_binary.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2010-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2010-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -32,10 +33,13 @@
#include "global.h"
#include "erl_process.h"
#include "error.h"
+#define ERL_WANT_HIPE_BIF_WRAPPER__
#include "bif.h"
+#undef ERL_WANT_HIPE_BIF_WRAPPER__
#include "big.h"
#include "erl_binary.h"
#include "erl_bits.h"
+#include "erl_bif_unique.h"
/*
@@ -51,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;
@@ -66,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,
@@ -231,23 +229,16 @@ static void dump_ac_node(ACNode *node, int indent, int ch);
MYALIGN(sizeof(ACTrie))) /* Structure */
-#ifndef MAX
-#define MAX(A,B) (((A) > (B)) ? (A) : (B))
-#endif
-
-#ifndef MIN
-#define MIN(A,B) (((A) > (B)) ? (B) : (A))
-#endif
/*
* Callback for the magic binary
*/
-static void cleanup_my_data_ac(Binary *bp)
+static int cleanup_my_data_ac(Binary *bp)
{
- return;
+ return 1;
}
-static void cleanup_my_data_bm(Binary *bp)
+static int cleanup_my_data_bm(Binary *bp)
{
- return;
+ return 1;
}
/*
@@ -310,8 +301,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
*/
@@ -382,7 +373,7 @@ static void ac_compute_failure_functions(ACTrie *act, ACNode **qbuff)
qbuff[qt++] = child;
/* Search for correct failure function, follow the parent's
failure function until you find a similar transition
- funtion to this child's */
+ function to this child's */
r = parent->h;
while (r != NULL && r->g[i] == NULL) {
r = r->h;
@@ -533,21 +524,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)
@@ -561,9 +554,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.
@@ -810,24 +800,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)
@@ -841,9 +831,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.
@@ -1016,8 +1003,8 @@ BIF_RETTYPE binary_compile_pattern_1(BIF_ALIST_1)
if (do_binary_match_compile(BIF_ARG_1,&tag,&bin)) {
BIF_ERROR(BIF_P,BADARG);
}
- hp = HAlloc(BIF_P, PROC_BIN_SIZE+3);
- ret = erts_mk_magic_binary_term(&hp, &MSO(BIF_P), bin);
+ hp = HAlloc(BIF_P, ERTS_MAGIC_REF_THING_SIZE+3);
+ ret = erts_mk_magic_ref(&hp, &MSO(BIF_P), bin);
ret = TUPLE2(hp, tag, ret);
BIF_RET(ret);
}
@@ -1026,283 +1013,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;
+#define BINARY_FIND_ALL 0x01
+#define BINARY_SPLIT_TRIM 0x02
+#define BINARY_SPLIT_TRIM_ALL 0x04
- 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;
-
- 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;
}
@@ -1324,9 +1170,9 @@ static int parse_match_opts_list(Eterm l, Eterm bin, Uint *posp, Uint *endp)
goto badarg;
}
if (len < 0) {
- Sint lentmp = -len;
+ Uint lentmp = -(Uint)len;
/* overflow */
- if (lentmp == len || lentmp < 0 || -lentmp != len) {
+ if ((Sint)lentmp < 0) {
goto badarg;
}
len = lentmp;
@@ -1351,48 +1197,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;
@@ -1401,11 +1406,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);
@@ -1413,27 +1419,30 @@ binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
goto badarg;
}
if (((tp[1] != am_bm) && (tp[1] != am_ac)) ||
- !ERTS_TERM_IS_MAGIC_BINARY(tp[2])) {
+ !is_internal_magic_ref(tp[2])) {
goto badarg;
}
- type = tp[1];
- bin = ((ProcBin *) binary_val(tp[2]))->val;
- if (type == am_bm &&
+ bfs.type = tp[1];
+ bin = erts_magic_ref2bin(tp[2]);
+ 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);
+ Eterm *hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE);
+ bin_term = erts_mk_magic_ref(&hp, &MSO(p), bin);
} else if (bin_term == NIL) {
erts_bin_free(bin);
}
@@ -1442,7 +1451,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;
}
@@ -1450,17 +1459,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;
@@ -1469,11 +1492,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);
@@ -1481,57 +1505,271 @@ binary_matches(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
goto badarg;
}
if (((tp[1] != am_bm) && (tp[1] != am_ac)) ||
- !ERTS_TERM_IS_MAGIC_BINARY(tp[2])) {
+ !is_internal_magic_ref(tp[2])) {
goto badarg;
}
- type = tp[1];
- bin = ((ProcBin *) binary_val(tp[2]))->val;
- if (type == am_bm &&
+ bfs.type = tp[1];
+ bin = erts_magic_ref2bin(tp[2]);
+ 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);
+ Eterm *hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE);
+ bin_term = erts_mk_magic_ref(&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_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)
{
- return binary_match(BIF_P,BIF_ARG_1,BIF_ARG_2,((Eterm) 0));
+ 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;
+
+ erlen = erts_make_integer((Uint)(len), p);
+ ret = erts_make_integer(pos, p);
+ hp = HAlloc(p, 3);
+ ret = TUPLE2(hp, ret, erlen);
-BIF_RETTYPE binary_matches_2(BIF_ALIST_2)
+ 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 = erts_magic_ref2bin(BIF_ARG_3);
+
+ 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)
{
@@ -1555,9 +1793,9 @@ BIF_RETTYPE erts_binary_part(Process *p, Eterm binary, Eterm epos, Eterm elen)
goto badarg;
}
if (len < 0) {
- Sint lentmp = -len;
+ Uint lentmp = -(Uint)len;
/* overflow */
- if (lentmp == len || lentmp < 0 || -lentmp != len) {
+ if ((Sint)lentmp < 0) {
goto badarg;
}
len = lentmp;
@@ -1644,9 +1882,9 @@ BIF_RETTYPE erts_gc_binary_part(Process *p, Eterm *reg, Eterm live, int range_is
goto badarg;
}
if (len < 0) {
- Sint lentmp = -len;
+ Uint lentmp = -(Uint)len;
/* overflow */
- if (lentmp == len || lentmp < 0 || -lentmp != len) {
+ if ((Sint)lentmp < 0) {
goto badarg;
}
len = lentmp;
@@ -1822,7 +2060,7 @@ static int do_search_backward(CommonData *cd, Uint *posp, Uint *redsp)
}
}
-static void cleanup_common_data(Binary *bp)
+static int cleanup_common_data(Binary *bp)
{
int i;
CommonData *cd;
@@ -1839,7 +2077,7 @@ static void cleanup_common_data(Binary *bp)
break;
}
}
- return;
+ return 1;
}
static BIF_RETTYPE do_longest_common(Process *p, Eterm list, int direction)
@@ -1942,8 +2180,8 @@ static BIF_RETTYPE do_longest_common(Process *p, Eterm list, int direction)
cd[i].type = CL_TYPE_HEAP;
}
}
- hp = HAlloc(p, PROC_BIN_SIZE);
- bin_term = erts_mk_magic_binary_term(&hp, &MSO(p), mb);
+ hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE);
+ bin_term = erts_mk_magic_ref(&hp, &MSO(p), mb);
BUMP_ALL_REDS(p);
BIF_TRAP3(trapper, p, bin_term, epos,list);
}
@@ -1970,8 +2208,7 @@ static BIF_RETTYPE do_longest_common_trap(Process *p, Eterm bin_term, Eterm curr
#else
term_to_Uint(current_pos, &pos);
#endif
- ASSERT(ERTS_TERM_IS_MAGIC_BINARY(bin_term));
- bin = ((ProcBin *) binary_val(bin_term))->val;
+ bin = erts_magic_ref2bin(bin_term);
cd = (CommonData *) ERTS_MAGIC_BIN_DATA(bin);
if (direction == DIRECTION_PREFIX) {
trapper = &binary_longest_prefix_trap_export;
@@ -2213,9 +2450,9 @@ static BIF_RETTYPE binary_bin_to_list_common(Process *p,
goto badarg;
}
if (len < 0) {
- Sint lentmp = -len;
+ Uint lentmp = -(Uint)len;
/* overflow */
- if (lentmp == len || lentmp < 0 || -lentmp != len) {
+ if ((Sint)lentmp < 0) {
goto badarg;
}
len = lentmp;
@@ -2294,18 +2531,11 @@ BIF_RETTYPE binary_bin_to_list_1(BIF_ALIST_1)
BIF_ERROR(BIF_P,BADARG);
}
-/*
- * Ok, erlang:list_to_binary does not interrupt, and we really don't want
- * an alternative implementation for the exact same thing, why we
- * have descided to use the old non-restarting implementation for now.
- * In reality, there are seldom many iterations involved in doing this, so the
- * problem of long-running bifs is not really that big in this case.
- * So, for now we use the old implementation also in the module binary.
- */
+HIPE_WRAPPER_BIF_DISABLE_GC(binary_list_to_bin, 1)
BIF_RETTYPE binary_list_to_bin_1(BIF_ALIST_1)
{
- return erts_list_to_binary_bif(BIF_P, BIF_ARG_1);
+ return erts_list_to_binary_bif(BIF_P, BIF_ARG_1, bif_export[BIF_binary_list_to_bin_1]);
}
typedef struct {
@@ -2326,7 +2556,7 @@ typedef struct {
#define BINARY_COPY_LOOP_FACTOR 100
-static void cleanup_copy_bin_state(Binary *bp)
+static int cleanup_copy_bin_state(Binary *bp)
{
CopyBinState *cbs = (CopyBinState *) ERTS_MAGIC_BIN_DATA(bp);
if (cbs->result != NULL) {
@@ -2346,6 +2576,7 @@ static void cleanup_copy_bin_state(Binary *bp)
break;
}
cbs->source_type = BC_TYPE_EMPTY;
+ return 1;
}
/*
@@ -2431,9 +2662,6 @@ static BIF_RETTYPE do_binary_copy(Process *p, Eterm bin, Eterm en)
}
cbs->result = erts_bin_nrml_alloc(target_size); /* Always offheap
if trapping */
- cbs->result->flags = 0;
- cbs->result->orig_size = target_size;
- erts_refc_init(&(cbs->result->refc), 1);
t = (byte *) cbs->result->orig_bytes; /* No offset or anything */
pos = 0;
i = 0;
@@ -2445,8 +2673,8 @@ static BIF_RETTYPE do_binary_copy(Process *p, Eterm bin, Eterm en)
cbs->source_size = size;
cbs->result_pos = pos;
cbs->times_left = n-i;
- hp = HAlloc(p,PROC_BIN_SIZE);
- trap_term = erts_mk_magic_binary_term(&hp, &MSO(p), mb);
+ hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE);
+ trap_term = erts_mk_magic_ref(&hp, &MSO(p), mb);
BUMP_ALL_REDS(p);
BIF_TRAP2(&binary_copy_trap_export, p, bin, trap_term);
} else {
@@ -2481,7 +2709,7 @@ BIF_RETTYPE binary_copy_trap(BIF_ALIST_2)
Uint reds = get_reds(BIF_P, BINARY_COPY_LOOP_FACTOR);
byte *t;
Uint pos;
- Binary *mb = ((ProcBin *) binary_val(BIF_ARG_2))->val;
+ Binary *mb = erts_magic_ref2bin(BIF_ARG_2);
CopyBinState *cbs = (CopyBinState *) ERTS_MAGIC_BIN_DATA(mb);
Uint opos;
@@ -2555,7 +2783,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);
@@ -2573,7 +2800,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_chksum.c b/erts/emulator/beam/erl_bif_chksum.c
index 4302fe8f79..9417803e14 100644
--- a/erts/emulator/beam/erl_bif_chksum.c
+++ b/erts/emulator/beam/erl_bif_chksum.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2008-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2008-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/beam/erl_bif_ddll.c b/erts/emulator/beam/erl_bif_ddll.c
index 56cd2ba04f..e9bfb39035 100644
--- a/erts/emulator/beam/erl_bif_ddll.c
+++ b/erts/emulator/beam/erl_bif_ddll.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2006-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2006-2017. 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.
+ * 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%
*/
@@ -45,7 +46,9 @@
#include "big.h"
#include "dist.h"
#include "erl_version.h"
+#include "erl_bif_unique.h"
#include "dtrace-wrapper.h"
+#include "lttng-wrapper.h"
#ifdef ERTS_SMP
#define DDLL_SMP 1
@@ -1096,7 +1099,7 @@ void erts_ddll_increment_port_count(DE_Handle *dh)
void erts_ddll_decrement_port_count(DE_Handle *dh)
{
assert_drv_list_locked();
-#if DEBUG
+#ifdef DEBUG
ASSERT(erts_smp_atomic32_dec_read_nob(&dh->port_count) >= 0);
#else
erts_smp_atomic32_dec_nob(&dh->port_count);
@@ -1106,25 +1109,25 @@ void erts_ddll_decrement_port_count(DE_Handle *dh)
static void first_ddll_reference(DE_Handle *dh)
{
assert_drv_list_rwlocked();
- erts_refc_init(&(dh->refc),1);
+ erts_smp_refc_init(&(dh->refc),1);
}
void erts_ddll_reference_driver(DE_Handle *dh)
{
assert_drv_list_locked();
- if (erts_refc_inctest(&(dh->refc),1) == 1) {
- erts_refc_inc(&(dh->refc),2); /* add a reference for the scheduled operation */
+ if (erts_smp_refc_inctest(&(dh->refc),1) == 1) {
+ erts_smp_refc_inc(&(dh->refc),2); /* add a reference for the scheduled operation */
}
}
void erts_ddll_reference_referenced_driver(DE_Handle *dh)
{
- erts_refc_inc(&(dh->refc),2);
+ erts_smp_refc_inc(&(dh->refc),2);
}
void erts_ddll_dereference_driver(DE_Handle *dh)
{
- if (erts_refc_dectest(&(dh->refc),0) == 0) {
+ if (erts_smp_refc_dectest(&(dh->refc),0) == 0) {
/* No lock here, but if the driver is referenced again,
the scheduled deletion is added as a reference too, see above */
erts_schedule_misc_op(ddll_no_more_references, (void *) dh);
@@ -1147,11 +1150,11 @@ static void restore_process_references(DE_Handle *dh)
{
DE_ProcEntry *p;
assert_drv_list_rwlocked();
- ASSERT(erts_refc_read(&(dh->refc),0) == 0);
+ ASSERT(erts_smp_refc_read(&(dh->refc),0) == 0);
for(p = dh->procs;p != NULL; p = p->next) {
if (p->awaiting_status == ERL_DE_PROC_LOADED) {
ASSERT(p->flags & ERL_DE_FL_DEREFERENCED);
- erts_refc_inc(&(dh->refc),1);
+ erts_smp_refc_inc(&(dh->refc),1);
p->flags &= ~ERL_DE_FL_DEREFERENCED;
}
}
@@ -1173,9 +1176,9 @@ static void ddll_no_more_references(void *vdh)
lock_drv_list();
- x = erts_refc_read(&(dh->refc),0);
+ x = erts_smp_refc_read(&(dh->refc),0);
if (x > 0) {
- x = erts_refc_dectest(&(dh->refc),0); /* delete the reference added for me */
+ x = erts_smp_refc_dectest(&(dh->refc),0); /* delete the reference added for me */
}
@@ -1307,7 +1310,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);
@@ -1473,8 +1476,10 @@ static void add_proc_loaded_deref(DE_Handle *dh, Process *proc)
static Eterm copy_ref(Eterm ref, Eterm *hp)
{
- RefThing *ptr = ref_thing_ptr(ref);
- memcpy(hp, ptr, sizeof(RefThing));
+ ErtsORefThing *ptr;
+ ASSERT(is_internal_ordinary_ref(ref));
+ ptr = ordinary_ref_thing_ptr(ref);
+ memcpy(hp, ptr, sizeof(ErtsORefThing));
return (make_internal_ref(hp));
}
@@ -1617,6 +1622,7 @@ static int do_unload_driver_entry(DE_Handle *dh, Eterm *save_name)
if (q->finish) {
int fpe_was_unmasked = erts_block_fpe();
DTRACE1(driver_finish, q->name);
+ LTTNG1(driver_finish, q->name);
(*(q->finish))();
erts_unblock_fpe(fpe_was_unmasked);
}
@@ -1639,7 +1645,7 @@ static int load_driver_entry(DE_Handle **dhp, char *path, char *name)
dh->handle = NULL;
dh->procs = NULL;
erts_smp_atomic32_init_nob(&dh->port_count, 0);
- erts_refc_init(&(dh->refc), (erts_aint_t) 0);
+ erts_smp_refc_init(&(dh->refc), (erts_aint_t) 0);
dh->status = -1;
dh->reload_full_path = NULL;
dh->reload_driver_name = NULL;
@@ -1677,7 +1683,7 @@ static int reload_driver_entry(DE_Handle *dh)
dh->reload_full_path = NULL;
dh->reload_driver_name = NULL;
- ASSERT(erts_refc_read(&(dh->refc),0) == 0);
+ ASSERT(erts_smp_refc_read(&(dh->refc),0) == 0);
ASSERT(dh->full_path != NULL);
erts_free(ERTS_ALC_T_DDLL_HANDLE, (void *) dh->full_path);
dh->full_path = NULL;
@@ -1705,36 +1711,35 @@ 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 */ +
+ ERTS_REF_THING_SIZE + need),
+ &hp, &ohp);
r = copy_ref(ref,hp);
- hp += REF_THING_SIZE;
+ hp += ERTS_REF_THING_SIZE;
e = build_load_error_hp(hp, errcode);
hp += need;
mess = TUPLE2(hp,tag,e);
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 */ + ERTS_REF_THING_SIZE,
+ &hp, &ohp);
r = copy_ref(ref,hp);
- hp += REF_THING_SIZE;
+ hp += ERTS_REF_THING_SIZE;
mess = TUPLE5(hp,type,r,am_driver,driver_name,tag);
}
- erts_queue_message(proc, &rp_locks, bp, mess, am_undefined
-#ifdef USE_VM_PROBES
- , NIL
-#endif
- );
+ erts_queue_message(proc, rp_locks, mp, mess, am_system);
erts_smp_proc_unlock(proc, rp_locks);
ERTS_SMP_CHK_NO_PROC_LOCKS;
}
diff --git a/erts/emulator/beam/erl_bif_guard.c b/erts/emulator/beam/erl_bif_guard.c
index bbd8aa31d9..8a5c6ada6c 100644
--- a/erts/emulator/beam/erl_bif_guard.c
+++ b/erts/emulator/beam/erl_bif_guard.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2006-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2006-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -140,6 +141,39 @@ BIF_RETTYPE trunc_1(BIF_ALIST_1)
BIF_RET(res);
}
+BIF_RETTYPE floor_1(BIF_ALIST_1)
+{
+ Eterm res;
+ FloatDef f;
+
+ if (is_not_float(BIF_ARG_1)) {
+ if (is_integer(BIF_ARG_1))
+ BIF_RET(BIF_ARG_1);
+ BIF_ERROR(BIF_P, BADARG);
+ }
+ GET_DOUBLE(BIF_ARG_1, f);
+ res = double_to_integer(BIF_P, floor(f.fd));
+ BIF_RET(res);
+}
+
+BIF_RETTYPE ceil_1(BIF_ALIST_1)
+{
+ Eterm res;
+ FloatDef f;
+
+ /* check arg */
+ if (is_not_float(BIF_ARG_1)) {
+ if (is_integer(BIF_ARG_1))
+ BIF_RET(BIF_ARG_1);
+ BIF_ERROR(BIF_P, BADARG);
+ }
+ /* get the float */
+ GET_DOUBLE(BIF_ARG_1, f);
+
+ res = double_to_integer(BIF_P, ceil(f.fd));
+ BIF_RET(res);
+}
+
BIF_RETTYPE round_1(BIF_ALIST_1)
{
Eterm res;
@@ -156,7 +190,7 @@ BIF_RETTYPE round_1(BIF_ALIST_1)
GET_DOUBLE(BIF_ARG_1, f);
/* round it and return the resultant integer */
- res = double_to_integer(BIF_P, (f.fd > 0.0) ? f.fd + 0.5 : f.fd - 0.5);
+ res = double_to_integer(BIF_P, round(f.fd));
BIF_RET(res);
}
@@ -459,23 +493,25 @@ Eterm erts_gc_byte_size_1(Process* p, Eterm* reg, Uint live)
Eterm erts_gc_map_size_1(Process* p, Eterm* reg, Uint live)
{
Eterm arg = reg[live];
- if (is_map(arg)) {
- map_t *mp = (map_t*)map_val(arg);
- Uint size = map_get_size(mp);
- if (IS_USMALL(0, size)) {
- return make_small(size);
- } else {
- Eterm* hp;
- if (ERTS_NEED_GC(p, BIG_UINT_HEAP_SIZE)) {
- erts_garbage_collect(p, BIG_UINT_HEAP_SIZE, reg, live);
- }
- hp = p->htop;
- p->htop += BIG_UINT_HEAP_SIZE;
- return uint_to_big(size, hp);
- }
- } else {
- BIF_ERROR(p, BADARG);
- }
+ if (is_flatmap(arg)) {
+ flatmap_t *mp = (flatmap_t*)flatmap_val(arg);
+ return make_small(flatmap_get_size(mp));
+ } else if (is_hashmap(arg)) {
+ Eterm* hp;
+ Uint size;
+ size = hashmap_size(arg);
+ if (IS_USMALL(0, size)) {
+ return make_small(size);
+ }
+ if (ERTS_NEED_GC(p, BIG_UINT_HEAP_SIZE)) {
+ erts_garbage_collect(p, BIG_UINT_HEAP_SIZE, reg, live);
+ }
+ hp = p->htop;
+ p->htop += BIG_UINT_HEAP_SIZE;
+ return uint_to_big(size, hp);
+ }
+ p->fvalue = arg;
+ BIF_ERROR(p, BADMAP);
}
Eterm erts_gc_abs_1(Process* p, Eterm* reg, Uint live)
@@ -594,8 +630,7 @@ Eterm erts_gc_round_1(Process* p, Eterm* reg, Uint live)
}
GET_DOUBLE(arg, f);
- return gc_double_to_integer(p, (f.fd > 0.0) ? f.fd + 0.5 : f.fd - 0.5,
- reg, live);
+ return gc_double_to_integer(p, round(f.fd), reg, live);
}
Eterm erts_gc_trunc_1(Process* p, Eterm* reg, Uint live)
@@ -618,6 +653,38 @@ Eterm erts_gc_trunc_1(Process* p, Eterm* reg, Uint live)
reg, live);
}
+Eterm erts_gc_floor_1(Process* p, Eterm* reg, Uint live)
+{
+ Eterm arg;
+ FloatDef f;
+
+ arg = reg[live];
+ if (is_not_float(arg)) {
+ if (is_integer(arg)) {
+ return arg;
+ }
+ BIF_ERROR(p, BADARG);
+ }
+ GET_DOUBLE(arg, f);
+ return gc_double_to_integer(p, floor(f.fd), reg, live);
+}
+
+Eterm erts_gc_ceil_1(Process* p, Eterm* reg, Uint live)
+{
+ Eterm arg;
+ FloatDef f;
+
+ arg = reg[live];
+ if (is_not_float(arg)) {
+ if (is_integer(arg)) {
+ return arg;
+ }
+ BIF_ERROR(p, BADARG);
+ }
+ GET_DOUBLE(arg, f);
+ return gc_double_to_integer(p, ceil(f.fd), reg, live);
+}
+
static Eterm
gc_double_to_integer(Process* p, double x, Eterm* reg, Uint live)
{
diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c
index 2adba9b240..0547b4d75c 100755..100644
--- a/erts/emulator/beam/erl_bif_info.c
+++ b/erts/emulator/beam/erl_bif_info.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1999-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1999-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -21,12 +22,14 @@
# include "config.h"
#endif
+#define ERTS_WANT_MEM_MAPPERS
#include "sys.h"
#include "erl_vm.h"
#include "global.h"
#include "erl_process.h"
#include "error.h"
#include "erl_driver.h"
+#include "erl_nif.h"
#include "bif.h"
#include "big.h"
#include "erl_version.h"
@@ -41,8 +44,11 @@
#include "erl_cpu_topology.h"
#include "erl_async.h"
#include "erl_thr_progress.h"
+#include "erl_bif_unique.h"
+#include "erl_map.h"
#define ERTS_PTAB_WANT_DEBUG_FUNCS__
#include "erl_ptab.h"
+#include "erl_time.h"
#ifdef HIPE
#include "hipe_arch.h"
#endif
@@ -58,9 +64,12 @@
static Export* alloc_info_trap = NULL;
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)
@@ -69,9 +78,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 "]"
@@ -80,19 +86,18 @@ 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
#ifdef USE_THREADS
-#ifdef ERTS_DIRTY_SCHEDULERS
+#if defined(ERTS_DIRTY_SCHEDULERS) && defined(ERTS_SMP)
" [ds:%beu:%beu:%beu]"
#endif
+#if defined(ERTS_DIRTY_SCHEDULERS_TEST)
+ " [dirty-schedulers-TEST]"
+#endif
" [async-threads:%d]"
#endif
#ifdef HIPE
@@ -115,6 +120,9 @@ static char erts_system_version[] = ("Erlang/OTP " ERLANG_OTP_RELEASE
#ifdef ERTS_ENABLE_LOCK_COUNT
" [lock-counting]"
#endif
+#ifdef ERTS_OPCODE_COUNTER_SUPPORT
+ " [instruction-counting]"
+#endif
#ifdef PURIFY
" [purify-compiled]"
#endif
@@ -124,12 +132,18 @@ static char erts_system_version[] = ("Erlang/OTP " ERLANG_OTP_RELEASE
#ifdef ERTS_FRMPTR
" [frame-pointer]"
#endif
+#ifdef USE_LTTNG
+ " [lttng]"
+#endif
#ifdef USE_DTRACE
" [dtrace]"
#endif
#ifdef USE_SYSTEMTAP
" [systemtap]"
#endif
+#ifdef SHCOPY
+ " [sharing-preserving]"
+#endif
"\n");
#define ASIZE(a) (sizeof(a)/sizeof(a[0]))
@@ -164,7 +178,33 @@ bld_bin_list(Uint **hpp, Uint *szp, ErlOffHeap* oh)
if (szp)
*szp += 4+2;
if (hpp) {
- Uint refc = (Uint) erts_smp_atomic_read_nob(&pb->val->refc);
+ Uint refc = (Uint) erts_refc_read(&pb->val->intern.refc, 1);
+ tuple = TUPLE3(*hpp, val, orig_size, make_small(refc));
+ res = CONS(*hpp + 4, tuple, res);
+ *hpp += 4+2;
+ }
+ }
+ }
+ return res;
+}
+
+static Eterm
+bld_magic_ref_bin_list(Uint **hpp, Uint *szp, ErlOffHeap* oh)
+{
+ struct erl_off_heap_header* ohh;
+ Eterm res = NIL;
+ Eterm tuple;
+
+ for (ohh = oh->first; ohh; ohh = ohh->next) {
+ if (is_ref_thing_header((*((Eterm *) ohh)))) {
+ ErtsMRefThing *mrtp = (ErtsMRefThing *) ohh;
+ Eterm val = erts_bld_uword(hpp, szp, (UWord) mrtp->mb);
+ Eterm orig_size = erts_bld_uint(hpp, szp, mrtp->mb->orig_size);
+
+ if (szp)
+ *szp += 4+2;
+ if (hpp) {
+ Uint refc = (Uint) erts_refc_read(&mrtp->mb->intern.refc, 1);
tuple = TUPLE3(*hpp, val, orig_size, make_small(refc));
res = CONS(*hpp + 4, tuple, res);
*hpp += 4+2;
@@ -189,8 +229,10 @@ bld_bin_list(Uint **hpp, Uint *szp, ErlOffHeap* oh)
static void do_calc_mon_size(ErtsMonitor *mon, void *vpsz)
{
Uint *psz = vpsz;
- *psz += IS_CONST(mon->ref) ? 0 : NC_HEAP_SIZE(mon->ref);
- *psz += IS_CONST(mon->pid) ? 0 : NC_HEAP_SIZE(mon->pid);
+ *psz += NC_HEAP_SIZE(mon->ref);
+ *psz += (mon->type == MON_NIF_TARGET ?
+ erts_resource_ref_size(mon->u.resource) :
+ (is_immed(mon->u.pid) ? 0 : NC_HEAP_SIZE(mon->u.pid)));
*psz += 8; /* CONS + 5-tuple */
}
@@ -205,12 +247,11 @@ static void do_make_one_mon_element(ErtsMonitor *mon, void * vpmlc)
{
MonListContext *pmlc = vpmlc;
Eterm tup;
- Eterm r = (IS_CONST(mon->ref)
- ? mon->ref
- : STORE_NC(&(pmlc->hp), &MSO(pmlc->p), mon->ref));
- Eterm p = (IS_CONST(mon->pid)
- ? mon->pid
- : STORE_NC(&(pmlc->hp), &MSO(pmlc->p), mon->pid));
+ Eterm r = STORE_NC(&(pmlc->hp), &MSO(pmlc->p), mon->ref);
+ Eterm p = (mon->type == MON_NIF_TARGET ?
+ erts_bld_resource_ref(&(pmlc->hp), &MSO(pmlc->p), mon->u.resource)
+ : (is_immed(mon->u.pid) ? mon->u.pid
+ : STORE_NC(&(pmlc->hp), &MSO(pmlc->p), mon->u.pid)));
tup = TUPLE5(pmlc->hp, pmlc->tag, make_small(mon->type), r, p, mon->name);
pmlc->hp += 6;
pmlc->res = CONS(pmlc->hp, tup, pmlc->res);
@@ -249,7 +290,7 @@ make_monitor_list(Process *p, ErtsMonitor *root)
static void do_calc_lnk_size(ErtsLink *lnk, void *vpsz)
{
Uint *psz = vpsz;
- *psz += IS_CONST(lnk->pid) ? 0 : NC_HEAP_SIZE(lnk->pid);
+ *psz += is_immed(lnk->pid) ? 0 : NC_HEAP_SIZE(lnk->pid);
if (lnk->type != LINK_NODE && ERTS_LINK_ROOT(lnk) != NULL) {
/* Node links use this pointer as ref counter... */
erts_doforall_links(ERTS_LINK_ROOT(lnk),&do_calc_lnk_size,vpsz);
@@ -269,7 +310,7 @@ static void do_make_one_lnk_element(ErtsLink *lnk, void * vpllc)
LnkListContext *pllc = vpllc;
Eterm tup;
Eterm old_res, targets = NIL;
- Eterm p = (IS_CONST(lnk->pid)
+ Eterm p = (is_immed(lnk->pid)
? lnk->pid
: STORE_NC(&(pllc->hp), &MSO(pllc->p), lnk->pid));
if (lnk->type == LINK_NODE) {
@@ -307,7 +348,7 @@ make_link_list(Process *p, ErtsLink *root, Eterm tail)
}
int
-erts_print_system_version(int to, void *arg, Process *c_p)
+erts_print_system_version(fmtfn_t to, void *arg, Process *c_p)
{
int i, rc = -1;
char *rc_str = "";
@@ -315,13 +356,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')
@@ -353,8 +392,17 @@ erts_print_system_version(int to, void *arg, Process *c_p)
}
typedef struct {
- Eterm entity;
+ /* {Entity,Node} = {monitor.Name,monitor.Pid} for external by name
+ * {Entity,Node} = {monitor.Pid,NIL} for external/external by pid
+ * {Entity,Node} = {monitor.Name,erlang:node()} for internal by name
+ * {Entity,Node} = {monitor.resource,MON_NIF_TARGET}*/
+ union {
+ Eterm term;
+ ErtsResource* resource;
+ }entity;
Eterm node;
+ /* pid is actual target being monitored, no matter pid/port or name */
+ Eterm pid;
} MonitorInfo;
typedef struct {
@@ -397,7 +445,7 @@ static void collect_one_link(ErtsLink *lnk, void *vmicp)
if (!(lnk->type == LINK_PID)) {
return;
}
- micp->mi[micp->mi_i].entity = lnk->pid;
+ micp->mi[micp->mi_i].entity.term = lnk->pid;
micp->sz += 2 + NC_HEAP_SIZE(lnk->pid);
micp->mi_i++;
}
@@ -410,23 +458,29 @@ static void collect_one_origin_monitor(ErtsMonitor *mon, void *vmicp)
return;
}
EXTEND_MONITOR_INFOS(micp);
- if (is_atom(mon->pid)) { /* external by name */
- micp->mi[micp->mi_i].entity = mon->name;
- micp->mi[micp->mi_i].node = mon->pid;
- micp->sz += 3; /* need one 2-tuple */
- } else if (is_external_pid(mon->pid)) { /* external by pid */
- micp->mi[micp->mi_i].entity = mon->pid;
- micp->mi[micp->mi_i].node = NIL;
- micp->sz += NC_HEAP_SIZE(mon->pid);
+ if (is_atom(mon->u.pid)) { /* external by name */
+ micp->mi[micp->mi_i].entity.term = mon->name;
+ micp->mi[micp->mi_i].node = mon->u.pid;
+ micp->sz += 3; /* need one 2-tuple */
+ } else if (is_external_pid(mon->u.pid)) { /* external by pid */
+ micp->mi[micp->mi_i].entity.term = mon->u.pid;
+ micp->mi[micp->mi_i].node = NIL;
+ micp->sz += NC_HEAP_SIZE(mon->u.pid);
} else if (!is_nil(mon->name)) { /* internal by name */
- micp->mi[micp->mi_i].entity = mon->name;
- micp->mi[micp->mi_i].node = erts_this_dist_entry->sysname;
- micp->sz += 3; /* need one 2-tuple */
+ micp->mi[micp->mi_i].entity.term = mon->name;
+ micp->mi[micp->mi_i].node = erts_this_dist_entry->sysname;
+ micp->sz += 3; /* need one 2-tuple */
} else { /* internal by pid */
- micp->mi[micp->mi_i].entity = mon->pid;
- micp->mi[micp->mi_i].node = NIL;
+ micp->mi[micp->mi_i].entity.term = mon->u.pid;
+ micp->mi[micp->mi_i].node = NIL;
/* no additional heap space needed */
}
+
+ /* have always pid at hand, to assist with figuring out if its a port or
+ * a process, when we monitored by name and process_info is requested.
+ * See: erl_bif_info.c:process_info_aux section for am_monitors */
+ micp->mi[micp->mi_i].pid = mon->u.pid;
+
micp->mi_i++;
micp->sz += 2 + 3; /* For a cons cell and a 2-tuple */
}
@@ -435,15 +489,24 @@ static void collect_one_target_monitor(ErtsMonitor *mon, void *vmicp)
{
MonitorInfoCollection *micp = vmicp;
- if (mon->type != MON_TARGET) {
- return;
+ if (mon->type != MON_TARGET && mon->type != MON_NIF_TARGET) {
+ return;
}
EXTEND_MONITOR_INFOS(micp);
- micp->mi[micp->mi_i].node = NIL;
- micp->mi[micp->mi_i].entity = mon->pid;
- micp->sz += (NC_HEAP_SIZE(mon->pid) + 2 /* cons */);
+
+ if (mon->type == MON_NIF_TARGET) {
+ micp->mi[micp->mi_i].entity.resource = mon->u.resource;
+ micp->mi[micp->mi_i].node = make_small(MON_NIF_TARGET);
+ micp->sz += erts_resource_ref_size(mon->u.resource);
+ }
+ else {
+ micp->mi[micp->mi_i].entity.term = mon->u.pid;
+ micp->mi[micp->mi_i].node = NIL;
+ micp->sz += NC_HEAP_SIZE(mon->u.pid);
+ }
+ micp->sz += 2; /* cons */;
micp->mi_i++;
}
@@ -536,6 +599,7 @@ pi_locks(Eterm info)
switch (info) {
case am_status:
case am_priority:
+ case am_trap_exit:
return ERTS_PROC_LOCK_STATUS;
case am_links:
case am_monitors:
@@ -586,9 +650,13 @@ static Eterm pi_args[] = {
am_suspending,
am_min_heap_size,
am_min_bin_vheap_size,
+ am_max_heap_size,
am_current_location,
am_current_stacktrace,
-};
+ am_message_queue_data,
+ am_garbage_collection_info,
+ am_magic_ref
+};
#define ERTS_PI_ARGS ((int) (sizeof(pi_args)/sizeof(Eterm)))
@@ -633,8 +701,12 @@ pi_arg2ix(Eterm arg)
case am_suspending: return 26;
case am_min_heap_size: return 27;
case am_min_bin_vheap_size: return 28;
- case am_current_location: return 29;
- case am_current_stacktrace: return 30;
+ case am_max_heap_size: return 29;
+ case am_current_location: return 30;
+ case am_current_stacktrace: return 31;
+ case am_message_queue_data: return 32;
+ case am_garbage_collection_info: return 33;
+ case am_magic_ref: return 34;
default: return -1;
}
}
@@ -663,18 +735,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;
@@ -723,9 +789,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);
@@ -816,10 +883,32 @@ 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
@@ -831,7 +920,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);
}
@@ -839,7 +928,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);
}
}
@@ -906,7 +995,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__);
}
}
@@ -946,7 +1035,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__);
}
}
@@ -970,9 +1059,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));
@@ -990,6 +1101,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)
@@ -1048,174 +1160,68 @@ process_info_aux(Process *BIF_P,
case am_initial_call:
hp = HAlloc(BIF_P, 3+4);
res = TUPLE3(hp,
- rp->initial[INITIAL_MOD],
- rp->initial[INITIAL_FUN],
- make_small(rp->initial[INITIAL_ARI]));
+ rp->u.initial.module,
+ rp->u.initial.function,
+ make_small(rp->u.initial.arity));
hp += 4;
break;
case am_status:
- res = erts_process_status(BIF_P, ERTS_PROC_LOCK_MAIN, rp, rpid);
+ res = erts_process_status(rp, rpid);
ASSERT(res != am_undefined);
hp = HAlloc(BIF_P, 3);
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 = 0;
- if (mp->data.attached)
- heap_need += erts_msg_attached_data_size(mp);
- }
- i++;
- }
+ mip = erts_alloc(ERTS_ALC_T_TMP,
+ rp->msg.len*sizeof(ErtsMessageInfo));
- hp = HAlloc(BIF_P, heap_need);
+ /*
+ * 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;
- ASSERT(i == n);
- for (i--; i >= 0; i--) {
- Eterm msg = ERL_MESSAGE_TERM(mq[i].msgp);
- if (rp != BIF_P) {
- 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) == hfp->used_size);
- msg = copy_struct(msg,
- hfp->used_size,
- &hp,
- &MSO(BIF_P));
- }
- }
- else {
- /* Bad distribution message; ignore */
- remove_bad_messages = 1;
- continue;
- }
- }
- else {
- if (mq[i].msgp->data.attached) {
- /* Decode it on the heap */
- erts_move_msg_attached_data_to_heap(&hp,
- &MSO(BIF_P),
- mq[i].msgp);
- msg = ERL_MESSAGE_TERM(mq[i].msgp);
- ASSERT(!mq[i].msgp->data.attached);
- if (is_non_value(msg)) {
- /* Bad distribution message; ignore */
- remove_bad_messages = 1;
- continue;
- }
- }
- }
-
+#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;
}
- HRelease(BIF_P, hp_end, hp+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);
- }
- }
- }
+
+ 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;
@@ -1231,7 +1237,7 @@ process_info_aux(Process *BIF_P,
hp = HAlloc(BIF_P, 3 + mic.sz);
res = NIL;
for (i = 0; i < mic.mi_i; i++) {
- item = STORE_NC(&hp, &MSO(BIF_P), mic.mi[i].entity);
+ item = STORE_NC(&hp, &MSO(BIF_P), mic.mi[i].entity.term);
res = CONS(hp, item, res);
hp += 2;
}
@@ -1241,37 +1247,49 @@ process_info_aux(Process *BIF_P,
case am_monitors: {
MonitorInfoCollection mic;
- int i;
+ int i;
INIT_MONITOR_INFOS(mic);
- erts_doforall_monitors(ERTS_P_MONITORS(rp),&collect_one_origin_monitor,&mic);
- hp = HAlloc(BIF_P, 3 + mic.sz);
+ erts_doforall_monitors(ERTS_P_MONITORS(rp),
+ &collect_one_origin_monitor, &mic);
+ hp = HAlloc(BIF_P, 3 + mic.sz);
res = NIL;
for (i = 0; i < mic.mi_i; i++) {
- if (is_atom(mic.mi[i].entity)) {
+ if (is_atom(mic.mi[i].entity.term)) {
/* Monitor by name.
- * Build {process, {Name, Node}} and cons it.
+ * Build {process|port, {Name, Node}} and cons it.
*/
Eterm t1, t2;
-
- t1 = TUPLE2(hp, mic.mi[i].entity, mic.mi[i].node);
+ /* If pid is an atom, then it is a remote named monitor, which
+ has to be a process */
+ Eterm m_type = is_port(mic.mi[i].pid) ? am_port : am_process;
+ ASSERT(is_pid(mic.mi[i].pid)
+ || is_port(mic.mi[i].pid)
+ || is_atom(mic.mi[i].pid));
+
+ t1 = TUPLE2(hp, mic.mi[i].entity.term, mic.mi[i].node);
hp += 3;
- t2 = TUPLE2(hp, am_process, t1);
+ t2 = TUPLE2(hp, m_type, t1);
hp += 3;
res = CONS(hp, t2, res);
- hp += 2;
+ hp += 2;
}
else {
- /* Monitor by pid. Build {process, Pid} and cons it. */
+ /* Monitor by pid. Build {process|port, Pid} and cons it. */
Eterm t;
- Eterm pid = STORE_NC(&hp, &MSO(BIF_P), mic.mi[i].entity);
- t = TUPLE2(hp, am_process, pid);
+ Eterm pid = STORE_NC(&hp, &MSO(BIF_P), mic.mi[i].entity.term);
+
+ Eterm m_type = is_port(mic.mi[i].pid) ? am_port : am_process;
+ ASSERT(is_pid(mic.mi[i].pid)
+ || is_port(mic.mi[i].pid));
+
+ t = TUPLE2(hp, m_type, pid);
hp += 3;
res = CONS(hp, t, res);
- hp += 2;
+ hp += 2;
}
}
- DESTROY_MONITOR_INFOS(mic);
+ DESTROY_MONITOR_INFOS(mic);
break;
}
@@ -1286,7 +1304,12 @@ process_info_aux(Process *BIF_P,
res = NIL;
for (i = 0; i < mic.mi_i; ++i) {
- item = STORE_NC(&hp, &MSO(BIF_P), mic.mi[i].entity);
+ if (mic.mi[i].node == make_small(MON_NIF_TARGET)) {
+ item = erts_bld_resource_ref(&hp, &MSO(BIF_P), mic.mi[i].entity.resource);
+ }
+ else {
+ item = STORE_NC(&hp, &MSO(BIF_P), mic.mi[i].entity.term);
+ }
res = CONS(hp, item, res);
hp += 2;
}
@@ -1402,8 +1425,20 @@ process_info_aux(Process *BIF_P,
break;
}
+ case am_max_heap_size: {
+ Uint hsz = 3;
+ (void) erts_max_heap_size_map(MAX_HEAP_SIZE_GET(rp),
+ MAX_HEAP_SIZE_FLAGS_GET(rp),
+ NULL, &hsz);
+ hp = HAlloc(BIF_P, hsz);
+ res = erts_max_heap_size_map(MAX_HEAP_SIZE_GET(rp),
+ MAX_HEAP_SIZE_FLAGS_GET(rp),
+ &hp, NULL);
+ break;
+ }
+
case am_total_heap_size: {
- ErlMessage *mp;
+ ErtsMessage *mp;
Uint total_heap_size;
Uint hsz = 3;
@@ -1413,11 +1448,10 @@ 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);
+ if (rp->flags & F_ON_HEAP_MSGQ)
+ for (mp = rp->msg.first; mp; mp = mp->next)
+ if (mp->data.attached)
+ total_heap_size += erts_msg_attached_data_size(mp);
(void) erts_bld_uint(NULL, &hsz, total_heap_size);
hp = HAlloc(BIF_P, hsz);
@@ -1436,7 +1470,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);
@@ -1446,8 +1480,12 @@ process_info_aux(Process *BIF_P,
case am_garbage_collection: {
DECL_AM(minor_gcs);
Eterm t;
+ Uint map_sz = 0;
+
+ erts_max_heap_size_map(MAX_HEAP_SIZE_GET(rp), MAX_HEAP_SIZE_FLAGS_GET(rp), NULL, &map_sz);
- hp = HAlloc(BIF_P, 3+2 + 3+2 + 3+2 + 3+2 + 3); /* last "3" is for outside tuple */
+ hp = HAlloc(BIF_P, 3+2 + 3+2 + 3+2 + 3+2 + 3+2 + map_sz + 3);
+ /* last "3" is for outside tuple */
t = TUPLE2(hp, AM_minor_gcs, make_small(GEN_GCS(rp))); hp += 3;
res = CONS(hp, t, NIL); hp += 2;
@@ -1458,9 +1496,40 @@ process_info_aux(Process *BIF_P,
res = CONS(hp, t, res); hp += 2;
t = TUPLE2(hp, am_min_bin_vheap_size, make_small(MIN_VHEAP_SIZE(rp))); hp += 3;
res = CONS(hp, t, res); hp += 2;
+
+ t = erts_max_heap_size_map(MAX_HEAP_SIZE_GET(rp), MAX_HEAP_SIZE_FLAGS_GET(rp), &hp, NULL);
+
+ t = TUPLE2(hp, am_max_heap_size, t); hp += 3;
+ res = CONS(hp, t, res); hp += 2;
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, 0, 0);
+ sz += 3;
+ }
+
+ hp = HAlloc(BIF_P, sz);
+ res = erts_process_gc_info(rp, &actual_sz, &hp, 0, 0);
+
+ /* 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);
@@ -1515,7 +1584,7 @@ process_info_aux(Process *BIF_P,
}
case am_last_calls: {
- struct saved_calls *scb = ERTS_PROC_GET_SAVED_CALLS_BUF(BIF_P);
+ struct saved_calls *scb = ERTS_PROC_GET_SAVED_CALLS_BUF(rp);
if (!scb) {
hp = HAlloc(BIF_P, 3);
res = am_false;
@@ -1545,9 +1614,9 @@ process_info_aux(Process *BIF_P,
term = am_timeout;
else {
term = TUPLE3(hp,
- scb->ct[j]->code[0],
- scb->ct[j]->code[1],
- make_small(scb->ct[j]->code[2]));
+ scb->ct[j]->info.mfa.module,
+ scb->ct[j]->info.mfa.function,
+ make_small(scb->ct[j]->info.mfa.arity));
hp += 4;
}
list = CONS(hp, term, list);
@@ -1562,6 +1631,30 @@ 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;
+ default:
+ res = am_error;
+ ERTS_INTERNAL_ERROR("Inconsistent message queue management state");
+ break;
+ }
+ hp = HAlloc(BIF_P, 3);
+ break;
+
+ case am_magic_ref: {
+ Uint sz = 3;
+ (void) bld_magic_ref_bin_list(NULL, &sz, &MSO(rp));
+ hp = HAlloc(BIF_P, sz);
+ res = bld_magic_ref_bin_list(&hp, NULL, &MSO(rp));
+ break;
+ }
+
default:
return THE_NON_VALUE; /* will produce badarg */
@@ -1580,10 +1673,10 @@ current_function(Process* BIF_P, Process* rp, Eterm** hpp, int full_info)
if (rp->current == NULL) {
erts_lookup_function_info(&fi, rp->i, full_info);
- rp->current = fi.current;
+ rp->current = fi.mfa;
} else if (full_info) {
erts_lookup_function_info(&fi, rp->i, full_info);
- if (fi.current == NULL) {
+ if (fi.mfa == NULL) {
/* Use the current function without location info */
erts_set_current_function(&fi, rp->current);
}
@@ -1599,9 +1692,9 @@ current_function(Process* BIF_P, Process* rp, Eterm** hpp, int full_info)
* instead if it can be looked up.
*/
erts_lookup_function_info(&fi2, rp->cp, full_info);
- if (fi2.current) {
+ if (fi2.mfa) {
fi = fi2;
- rp->current = fi2.current;
+ rp->current = fi2.mfa;
}
}
@@ -1616,8 +1709,9 @@ current_function(Process* BIF_P, Process* rp, Eterm** hpp, int full_info)
hp = erts_build_mfa_item(&fi, hp, am_true, &res);
} else {
hp = HAlloc(BIF_P, 3+4);
- res = TUPLE3(hp, rp->current[0],
- rp->current[1], make_small(rp->current[2]));
+ res = TUPLE3(hp, rp->current->module,
+ rp->current->function,
+ make_small(rp->current->arity));
hp += 4;
}
*hpp = hp;
@@ -1638,11 +1732,11 @@ current_stacktrace(Process* p, Process* rp, Eterm** hpp)
Eterm mfa;
Eterm res = NIL;
- depth = 8;
+ depth = erts_backtrace_depth;
sz = offsetof(struct StackTrace, trace) + sizeof(BeamInstr *)*depth;
s = (struct StackTrace *) erts_alloc(ERTS_ALC_T_TMP, sz);
s->depth = 0;
- if (rp->i) {
+ if (depth > 0 && rp->i) {
s->trace[s->depth++] = rp->i;
depth--;
}
@@ -1658,7 +1752,7 @@ current_stacktrace(Process* p, Process* rp, Eterm** hpp)
heap_size = 3;
for (i = 0; i < depth; i++) {
erts_lookup_function_info(stkp, s->trace[i], 1);
- if (stkp->current) {
+ if (stkp->mfa) {
heap_size += stkp->needed + 2;
stkp++;
}
@@ -1736,12 +1830,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);
@@ -1755,12 +1849,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);
@@ -2045,12 +2139,8 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
Uint arity = *tp++;
return info_1_tuple(BIF_P, tp, arityval(arity));
} else if (BIF_ARG_1 == am_scheduler_id) {
-#ifdef ERTS_SMP
- ASSERT(BIF_P->scheduler_data);
- BIF_RET(make_small(BIF_P->scheduler_data->no));
-#else
- BIF_RET(make_small(1));
-#endif
+ ErtsSchedulerData *esdp = erts_proc_sched_data(BIF_P);
+ BIF_RET(make_small(esdp->no));
} else if (BIF_ARG_1 == am_compat_rel) {
ASSERT(erts_compat_rel > 0);
BIF_RET(make_small(erts_compat_rel));
@@ -2058,12 +2148,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) {
@@ -2098,6 +2194,50 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
BIF_RET(am_opt);
#endif
BIF_RET(res);
+ } else if (BIF_ARG_1 == am_time_offset) {
+ switch (erts_time_offset_state()) {
+ case ERTS_TIME_OFFSET_PRELIMINARY: {
+ ERTS_DECL_AM(preliminary);
+ BIF_RET(AM_preliminary);
+ }
+ case ERTS_TIME_OFFSET_FINAL: {
+ ERTS_DECL_AM(final);
+ BIF_RET(AM_final);
+ }
+ case ERTS_TIME_OFFSET_VOLATILE: {
+ ERTS_DECL_AM(volatile);
+ BIF_RET(AM_volatile);
+ }
+ default:
+ ERTS_INTERNAL_ERROR("Invalid time offset state");
+ }
+ } else if (ERTS_IS_ATOM_STR("os_monotonic_time_source", BIF_ARG_1)) {
+ BIF_RET(erts_monotonic_time_source(BIF_P));
+ } else if (ERTS_IS_ATOM_STR("os_system_time_source", BIF_ARG_1)) {
+ BIF_RET(erts_system_time_source(BIF_P));
+ } else if (ERTS_IS_ATOM_STR("time_correction", BIF_ARG_1)) {
+ BIF_RET(erts_has_time_correction() ? am_true : am_false);
+ } else if (ERTS_IS_ATOM_STR("start_time", BIF_ARG_1)) {
+ BIF_RET(erts_get_monotonic_start_time(BIF_P));
+ } else if (ERTS_IS_ATOM_STR("end_time", BIF_ARG_1)) {
+ BIF_RET(erts_get_monotonic_end_time(BIF_P));
+ } else if (ERTS_IS_ATOM_STR("time_warp_mode", BIF_ARG_1)) {
+ switch (erts_time_warp_mode()) {
+ case ERTS_NO_TIME_WARP_MODE: {
+ ERTS_DECL_AM(no_time_warp);
+ BIF_RET(AM_no_time_warp);
+ }
+ case ERTS_SINGLE_TIME_WARP_MODE: {
+ ERTS_DECL_AM(single_time_warp);
+ BIF_RET(AM_single_time_warp);
+ }
+ case ERTS_MULTI_TIME_WARP_MODE: {
+ ERTS_DECL_AM(multi_time_warp);
+ BIF_RET(AM_multi_time_warp);
+ }
+ default:
+ ERTS_INTERNAL_ERROR("Invalid time warp mode");
+ }
} else if (BIF_ARG_1 == am_allocated_areas) {
res = erts_allocated_areas(NULL, NULL, BIF_P);
BIF_RET(res);
@@ -2125,15 +2265,15 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
res = build_snifs_term(&hp, NULL, NIL);
BIF_RET(res);
} else if (BIF_ARG_1 == am_sequential_tracer) {
- val = erts_get_system_seq_tracer();
- ASSERT(is_internal_pid(val) || is_internal_port(val) || val==am_false);
+ ErtsTracer seq_tracer = erts_get_system_seq_tracer();
+ val = erts_tracer_to_term(BIF_P, seq_tracer);
hp = HAlloc(BIF_P, 3);
res = TUPLE2(hp, am_sequential_tracer, val);
BIF_RET(res);
} else if (BIF_ARG_1 == am_garbage_collection){
Uint val = (Uint) erts_smp_atomic32_read_nob(&erts_max_gen_gcs);
Eterm tup;
- hp = HAlloc(BIF_P, 3+2 + 3+2 + 3+2);
+ hp = HAlloc(BIF_P, 3+2 + 3+2 + 3+2 + 3+2);
tup = TUPLE2(hp, am_fullsweep_after, make_small(val)); hp += 3;
res = CONS(hp, tup, NIL); hp += 2;
@@ -2144,6 +2284,9 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
tup = TUPLE2(hp, am_min_bin_vheap_size, make_small(BIN_VH_MIN_SIZE)); hp += 3;
res = CONS(hp, tup, res); hp += 2;
+ tup = TUPLE2(hp, am_max_heap_size, make_small(H_MAX_SIZE)); hp += 3;
+ res = CONS(hp, tup, res); hp += 2;
+
BIF_RET(res);
} else if (BIF_ARG_1 == am_fullsweep_after){
Uint val = (Uint) erts_smp_atomic32_read_nob(&erts_max_gen_gcs);
@@ -2154,6 +2297,12 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
hp = HAlloc(BIF_P, 3);
res = TUPLE2(hp, am_min_heap_size,make_small(H_MIN_SIZE));
BIF_RET(res);
+ } else if (BIF_ARG_1 == am_max_heap_size) {
+ Uint sz = 0;
+ erts_max_heap_size_map(H_MAX_SIZE, H_MAX_FLAGS, NULL, &sz);
+ hp = HAlloc(BIF_P, sz);
+ res = erts_max_heap_size_map(H_MAX_SIZE, H_MAX_FLAGS, &hp, NULL);
+ BIF_RET(res);
} else if (BIF_ARG_1 == am_min_bin_vheap_size) {
hp = HAlloc(BIF_P, 3);
res = TUPLE2(hp, am_min_bin_vheap_size,make_small(BIN_VH_MIN_SIZE));
@@ -2195,9 +2344,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
} else if (ERTS_IS_ATOM_STR("dist_ctrl", BIF_ARG_1)) {
DistEntry *dep;
i = 0;
- /* Need to be the only thread running... */
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_thr_progress_block();
+ erts_smp_rwmtx_rlock(&erts_dist_table_rwmtx);
for (dep = erts_visible_dist_entries; dep; dep = dep->next)
++i;
for (dep = erts_hidden_dist_entries; dep; dep = dep->next)
@@ -2220,8 +2367,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
res = CONS(hp, tpl, res);
hp += 2;
}
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_smp_rwmtx_runlock(&erts_dist_table_rwmtx);
BIF_RET(res);
} else if (BIF_ARG_1 == am_system_version) {
erts_dsprintf_buf_t *dsbufp = erts_create_tmp_dsbuf(0);
@@ -2300,12 +2446,12 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
for (i = num_instructions-1; i >= 0; i--) {
res = erts_bld_cons(hpp, hszp,
erts_bld_tuple(hpp, hszp, 2,
- erts_atom_put(opc[i].name,
+ erts_atom_put((byte *)opc[i].name,
strlen(opc[i].name),
ERTS_ATOM_ENC_LATIN1,
1),
erts_bld_uint(hpp, hszp,
- opc[i].count)),
+ erts_instr_count[i])),
res);
}
@@ -2459,6 +2605,13 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
ERL_DRV_EXTENDED_MINOR_VERSION);
hp = HAlloc(BIF_P, 2*n);
BIF_RET(buf_to_intlist(&hp, buf, n, NIL));
+ } else if (ERTS_IS_ATOM_STR("nif_version", BIF_ARG_1)) {
+ char buf[42];
+ int n = erts_snprintf(buf, 42, "%d.%d",
+ ERL_NIF_MAJOR_VERSION,
+ ERL_NIF_MINOR_VERSION);
+ hp = HAlloc(BIF_P, 2*n);
+ BIF_RET(buf_to_intlist(&hp, buf, n, NIL));
} else if (ERTS_IS_ATOM_STR("smp_support", BIF_ARG_1)) {
#ifdef ERTS_SMP
BIF_RET(am_true);
@@ -2481,79 +2634,132 @@ 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);
+#ifdef ERTS_DIRTY_SCHEDULERS
+ erts_schedulers_state(NULL, NULL, NULL, &dirty_cpu, NULL, NULL, NULL, NULL);
+#else
+ dirty_cpu = 0;
+#endif
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);
+#ifdef ERTS_DIRTY_SCHEDULERS
+ erts_schedulers_state(NULL, NULL, NULL, NULL, &dirty_cpu_onln, NULL, NULL, NULL);
+#else
+ dirty_cpu_onln = 0;
+#endif
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);
- BIF_RET(make_small(dirty_io));
+#ifdef ERTS_DIRTY_SCHEDULERS
+ erts_schedulers_state(NULL, NULL, NULL, NULL, NULL, NULL, &dirty_io, NULL);
+#else
+ dirty_io = 0;
#endif
+ BIF_RET(make_small(dirty_io));
} else if (ERTS_IS_ATOM_STR("run_queues", BIF_ARG_1)) {
res = make_small(erts_no_run_queues);
BIF_RET(res);
@@ -2605,7 +2811,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()
@@ -2630,6 +2845,15 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
hp = hsz ? HAlloc(BIF_P, hsz) : NULL;
res = erts_bld_uint(&hp, NULL, erts_dist_buf_busy_limit);
BIF_RET(res);
+ } else if (ERTS_IS_ATOM_STR("delayed_node_table_gc", BIF_ARG_1)) {
+ Uint hsz = 0;
+ Uint dntgc = erts_delayed_node_table_gc();
+ if (dntgc == ERTS_NODE_TAB_DELAY_GC_INFINITY)
+ BIF_RET(am_infinity);
+ (void) erts_bld_uint(NULL, &hsz, dntgc);
+ hp = hsz ? HAlloc(BIF_P, hsz) : NULL;
+ res = erts_bld_uint(&hp, NULL, dntgc);
+ BIF_RET(res);
} else if (ERTS_IS_ATOM_STR("ethread_info", BIF_ARG_1)) {
BIF_RET(erts_get_ethread_info(BIF_P));
}
@@ -2646,6 +2870,9 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
#elif defined(USE_SYSTEMTAP)
DECL_AM(systemtap);
BIF_RET(AM_systemtap);
+#elif defined(USE_LTTNG)
+ DECL_AM(lttng);
+ BIF_RET(AM_lttng);
#else
BIF_RET(am_none);
#endif
@@ -2663,6 +2890,17 @@ 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);
+ 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;
@@ -2691,6 +2929,36 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
else if (ERTS_IS_ATOM_STR("ets_limit",BIF_ARG_1)) {
BIF_RET(make_small(erts_db_get_max_tabs()));
}
+ else if (ERTS_IS_ATOM_STR("atom_limit",BIF_ARG_1)) {
+ BIF_RET(make_small(erts_get_atom_limit()));
+ }
+ else if (ERTS_IS_ATOM_STR("atom_count",BIF_ARG_1)) {
+ BIF_RET(make_small(atom_table_size()));
+ }
+ else if (ERTS_IS_ATOM_STR("tolerant_timeofday",BIF_ARG_1)) {
+ if (erts_has_time_correction()
+ && erts_time_offset_state() == ERTS_TIME_OFFSET_FINAL) {
+ BIF_RET(am_enabled);
+ }
+ BIF_RET(am_disabled);
+ }
+ 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);
}
@@ -2708,7 +2976,8 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
*/
Eterm
-erts_bld_port_info(Eterm **hpp, ErlOffHeap *ohp, Uint *szp, Port *prt, Eterm item)
+erts_bld_port_info(Eterm **hpp, ErlOffHeap *ohp, Uint *szp, Port *prt,
+ Eterm item)
{
Eterm res = THE_NON_VALUE;
@@ -2737,7 +3006,7 @@ erts_bld_port_info(Eterm **hpp, ErlOffHeap *ohp, Uint *szp, Port *prt, Eterm ite
if (hpp) {
res = NIL;
for (i = 0; i < mic.mi_i; i++) {
- item = STORE_NC(hpp, ohp, mic.mi[i].entity);
+ item = STORE_NC(hpp, ohp, mic.mi[i].entity.term);
res = CONS(*hpp, item, res);
*hpp += 2;
}
@@ -2756,8 +3025,8 @@ erts_bld_port_info(Eterm **hpp, ErlOffHeap *ohp, Uint *szp, Port *prt, Eterm ite
Eterm item;
INIT_MONITOR_INFOS(mic);
-
- erts_doforall_monitors(ERTS_P_MONITORS(prt), &collect_one_origin_monitor, &mic);
+ erts_doforall_monitors(ERTS_P_MONITORS(prt),
+ &collect_one_origin_monitor, &mic);
if (szp)
*szp += mic.sz;
@@ -2766,14 +3035,16 @@ erts_bld_port_info(Eterm **hpp, ErlOffHeap *ohp, Uint *szp, Port *prt, Eterm ite
res = NIL;
for (i = 0; i < mic.mi_i; i++) {
Eterm t;
- item = STORE_NC(hpp, ohp, mic.mi[i].entity);
- t = TUPLE2(*hpp, am_process, item);
+ Eterm m_type;
+
+ item = STORE_NC(hpp, ohp, mic.mi[i].entity.term);
+ m_type = is_port(item) ? am_port : am_process;
+ t = TUPLE2(*hpp, m_type, item);
*hpp += 3;
res = CONS(*hpp, t, res);
*hpp += 2;
}
- }
-
+ } // hpp
DESTROY_MONITOR_INFOS(mic);
if (szp) {
@@ -2781,6 +3052,33 @@ erts_bld_port_info(Eterm **hpp, ErlOffHeap *ohp, Uint *szp, Port *prt, Eterm ite
goto done;
}
}
+ else if (item == am_monitored_by) {
+ MonitorInfoCollection mic;
+ int i;
+ Eterm item;
+
+ INIT_MONITOR_INFOS(mic);
+ erts_doforall_monitors(ERTS_P_MONITORS(prt),
+ &collect_one_target_monitor, &mic);
+ if (szp)
+ *szp += mic.sz;
+
+ if (hpp) {
+ res = NIL;
+ for (i = 0; i < mic.mi_i; ++i) {
+ ASSERT(mic.mi[i].node == NIL);
+ item = STORE_NC(hpp, ohp, mic.mi[i].entity.term);
+ res = CONS(*hpp, item, res);
+ *hpp += 2;
+ }
+ } // hpp
+ DESTROY_MONITOR_INFOS(mic);
+
+ if (szp) {
+ res = am_true;
+ goto done;
+ }
+ }
else if (item == am_name) {
int count = sys_strlen(prt->name);
@@ -3006,7 +3304,7 @@ fun_info_2(BIF_ALIST_2)
break;
case am_module:
hp = HAlloc(p, 3);
- val = exp->code[0];
+ val = exp->info.mfa.module;
break;
case am_new_index:
hp = HAlloc(p, 3);
@@ -3034,11 +3332,11 @@ fun_info_2(BIF_ALIST_2)
break;
case am_arity:
hp = HAlloc(p, 3);
- val = make_small(exp->code[2]);
+ val = make_small(exp->info.mfa.arity);
break;
case am_name:
hp = HAlloc(p, 3);
- val = exp->code[1];
+ val = exp->info.mfa.function;
break;
default:
goto error;
@@ -3050,6 +3348,27 @@ fun_info_2(BIF_ALIST_2)
return TUPLE2(hp, what, val);
}
+BIF_RETTYPE
+fun_info_mfa_1(BIF_ALIST_1)
+{
+ Process* p = BIF_P;
+ Eterm fun = BIF_ARG_1;
+ Eterm* hp;
+
+ if (is_fun(fun)) {
+ ErlFunThing* funp = (ErlFunThing *) fun_val(fun);
+ hp = HAlloc(p, 4);
+ BIF_RET(TUPLE3(hp,funp->fe->module,funp->fe->address[-2],make_small(funp->arity)));
+ } else if (is_export(fun)) {
+ Export* exp = (Export *) ((UWord) (export_val(fun))[1]);
+ hp = HAlloc(p, 4);
+ BIF_RET(TUPLE3(hp,exp->info.mfa.module,
+ exp->info.mfa.function,
+ make_small(exp->info.mfa.arity)));
+ }
+ BIF_ERROR(p, BADARG);
+}
+
BIF_RETTYPE is_process_alive_1(BIF_ALIST_1)
{
if(is_internal_pid(BIF_ARG_1)) {
@@ -3115,7 +3434,6 @@ BIF_RETTYPE process_display_2(BIF_ALIST_2)
BIF_RET(am_true);
}
-
/* this is a general call which return some possibly useful information */
BIF_RETTYPE statistics_1(BIF_ALIST_1)
@@ -3124,10 +3442,70 @@ BIF_RETTYPE statistics_1(BIF_ALIST_1)
Eterm* hp;
if (BIF_ARG_1 == am_scheduler_wall_time) {
- res = erts_sched_wall_time_request(BIF_P, 0, 0);
+ res = erts_sched_wall_time_request(BIF_P, 0, 0, 1, 0);
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_scheduler_wall_time_all) {
+ res = erts_sched_wall_time_request(BIF_P, 0, 0, 1, 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)
+ | (BIF_ARG_1 == am_total_active_tasks_all)
+ | (BIF_ARG_1 == am_total_run_queue_lengths_all)) {
+ Uint no = erts_run_queues_len(NULL, 0,
+ ((BIF_ARG_1 == am_total_active_tasks)
+ | (BIF_ARG_1 == am_total_active_tasks_all)),
+ ((BIF_ARG_1 == am_total_active_tasks_all)
+ | (BIF_ARG_1 == am_total_run_queue_lengths_all)));
+ 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)
+ | (BIF_ARG_1 == am_active_tasks_all)
+ | (BIF_ARG_1 == am_run_queue_lengths_all)) {
+ Eterm res, *hp, **hpp;
+ Uint sz, *szp;
+ int incl_dirty_io = ((BIF_ARG_1 == am_active_tasks_all)
+ | (BIF_ARG_1 == am_run_queue_lengths_all));
+ int no_qs = (erts_no_run_queues + ERTS_NUM_DIRTY_CPU_RUNQS +
+ (incl_dirty_io ? ERTS_NUM_DIRTY_IO_RUNQS : 0));
+ 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)
+ | (BIF_ARG_1 == am_active_tasks_all)),
+ incl_dirty_io);
+ 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);
@@ -3167,51 +3545,44 @@ BIF_RETTYPE statistics_1(BIF_ALIST_1)
res = TUPLE2(hp, b1, b2);
BIF_RET(res);
} else if (BIF_ARG_1 == am_runtime) {
- UWord u1, u2, dummy;
+ ErtsMonotonicTime u1, u2;
Eterm b1, b2;
- elapsed_time_both(&u1,&dummy,&u2,&dummy);
- b1 = erts_make_integer(u1,BIF_P);
- b2 = erts_make_integer(u2,BIF_P);
- hp = HAlloc(BIF_P,3);
+ Uint hsz;
+ erts_runtime_elapsed_both(&u1, NULL, &u2, NULL);
+ hsz = 3; /* 2-tuple */
+ (void) erts_bld_monotonic_time(NULL, &hsz, u1);
+ (void) erts_bld_monotonic_time(NULL, &hsz, u2);
+ hp = HAlloc(BIF_P, hsz);
+ b1 = erts_bld_monotonic_time(&hp, NULL, u1);
+ b2 = erts_bld_monotonic_time(&hp, NULL, u2);
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, 0);
BIF_RET(make_small(res));
} else if (BIF_ARG_1 == am_wall_clock) {
- UWord w1, w2;
+ ErtsMonotonicTime w1, w2;
Eterm b1, b2;
- wall_clock_elapsed_time_both(&w1, &w2);
- b1 = erts_make_integer((Uint) w1,BIF_P);
- b2 = erts_make_integer((Uint) w2,BIF_P);
- hp = HAlloc(BIF_P,3);
+ Uint hsz;
+ erts_wall_clock_elapsed_both(&w1, &w2);
+ hsz = 3; /* 2-tuple */
+ (void) erts_bld_monotonic_time(NULL, &hsz, w1);
+ (void) erts_bld_monotonic_time(NULL, &hsz, w2);
+ hp = HAlloc(BIF_P, hsz);
+ b1 = erts_bld_monotonic_time(&hp, NULL, w1);
+ b2 = erts_bld_monotonic_time(&hp, NULL, w2);
res = TUPLE2(hp, b1, b2);
BIF_RET(res);
} else if (BIF_ARG_1 == am_io) {
- Eterm r1, r2;
- Eterm in, out;
- Uint hsz = 9;
- Uint bytes_in = (Uint) erts_smp_atomic_read_nob(&erts_bytes_in);
- Uint bytes_out = (Uint) erts_smp_atomic_read_nob(&erts_bytes_out);
-
- (void) erts_bld_uint(NULL, &hsz, bytes_in);
- (void) erts_bld_uint(NULL, &hsz, bytes_out);
- hp = HAlloc(BIF_P, hsz);
- in = erts_bld_uint(&hp, NULL, bytes_in);
- out = erts_bld_uint(&hp, NULL, bytes_out);
-
- r1 = TUPLE2(hp, am_input, in);
- hp += 3;
- r2 = TUPLE2(hp, am_output, out);
- hp += 3;
- BIF_RET(TUPLE2(hp, r1, r2));
+ Eterm ref = erts_request_io_bytes(BIF_P);
+ BIF_TRAP2(gather_io_bytes_trap, BIF_P, ref, make_small(erts_no_schedulers));
}
else if (ERTS_IS_ATOM_STR("run_queues", BIF_ARG_1)) {
Eterm res, *hp, **hpp;
Uint sz, *szp;
- int no_qs = erts_no_run_queues;
+ int no_qs = erts_no_run_queues + ERTS_NUM_DIRTY_RUNQS;
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, 1);
sz = 0;
szp = &sz;
hpp = NULL;
@@ -3239,6 +3610,11 @@ BIF_RETTYPE error_logger_warning_map_0(BIF_ALIST_0)
static erts_smp_atomic_t available_internal_state;
+static int empty_magic_ref_destructor(Binary *bin)
+{
+ return 1;
+}
+
BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1)
{
/*
@@ -3277,20 +3653,43 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1)
else if (ERTS_IS_ATOM_STR("DbTable_words", BIF_ARG_1)) {
/* Used by ets_SUITE (stdlib) */
size_t words = (sizeof(DbTable) + sizeof(Uint) - 1)/sizeof(Uint);
- BIF_RET(make_small((Uint) words));
+ Eterm* hp = HAlloc(BIF_P ,3);
+ BIF_RET(TUPLE2(hp, make_small((Uint) words),
+ erts_ets_hash_sizeof_ext_segtab()));
}
else if (ERTS_IS_ATOM_STR("check_io_debug", BIF_ARG_1)) {
- /* Used by (emulator) */
- int res;
+ /* Used by driver_SUITE (emulator) */
+ Uint sz, *szp;
+ Eterm res, *hp, **hpp;
+ int no_errors;
+ ErtsCheckIoDebugInfo ciodi = {0};
#ifdef HAVE_ERTS_CHECK_IO_DEBUG
erts_smp_proc_unlock(BIF_P,ERTS_PROC_LOCK_MAIN);
- res = erts_check_io_debug();
+ no_errors = erts_check_io_debug(&ciodi);
erts_smp_proc_lock(BIF_P,ERTS_PROC_LOCK_MAIN);
#else
- res = 0;
+ no_errors = 0;
#endif
- ASSERT(res >= 0);
- BIF_RET(erts_make_integer((Uint) res, BIF_P));
+ sz = 0;
+ szp = &sz;
+ hpp = NULL;
+ while (1) {
+ res = erts_bld_tuple(hpp, szp, 4,
+ erts_bld_uint(hpp, szp,
+ (Uint) no_errors),
+ erts_bld_uint(hpp, szp,
+ (Uint) ciodi.no_used_fds),
+ erts_bld_uint(hpp, szp,
+ (Uint) ciodi.no_driver_select_structs),
+ erts_bld_uint(hpp, szp,
+ (Uint) ciodi.no_driver_event_structs));
+ if (hpp)
+ break;
+ hp = HAlloc(BIF_P, sz);
+ szp = NULL;
+ hpp = &hp;
+ }
+ BIF_RET(res);
}
else if (ERTS_IS_ATOM_STR("process_info_args", BIF_ARG_1)) {
/* Used by process_SUITE (emulator) */
@@ -3344,6 +3743,44 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1)
else if (ERTS_IS_ATOM_STR("mmap", BIF_ARG_1)) {
BIF_RET(erts_mmap_debug_info(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));
+ }
+ else if (ERTS_IS_ATOM_STR("min_unique_monotonic_integer", BIF_ARG_1)) {
+ Sint64 value = erts_get_min_unique_monotonic_integer();
+ if (IS_SSMALL(value))
+ BIF_RET(make_small(value));
+ else {
+ Uint hsz = ERTS_SINT64_HEAP_SIZE(value);
+ Eterm *hp = HAlloc(BIF_P, hsz);
+ BIF_RET(erts_sint64_to_big(value, &hp));
+ }
+ }
+ else if (ERTS_IS_ATOM_STR("min_unique_integer", BIF_ARG_1)) {
+ Sint64 value = erts_get_min_unique_integer();
+ if (IS_SSMALL(value))
+ BIF_RET(make_small(value));
+ else {
+ Uint hsz = ERTS_SINT64_HEAP_SIZE(value);
+ Eterm *hp = HAlloc(BIF_P, hsz);
+ BIF_RET(erts_sint64_to_big(value, &hp));
+ }
+ }
+ else if (ERTS_IS_ATOM_STR("stack_check", BIF_ARG_1)) {
+ UWord size;
+ char c;
+ if (erts_is_above_stack_limit(&c))
+ size = erts_check_stack_recursion_downwards(&c);
+ else
+ size = erts_check_stack_recursion_upwards(&c);
+ if (IS_SSMALL(size))
+ BIF_RET(make_small(size));
+ else {
+ Uint hsz = BIG_UWORD_HEAP_SIZE(size);
+ Eterm *hp = HAlloc(BIF_P, hsz);
+ BIF_RET(uword_to_big(size, hp));
+ }
+ }
}
else if (is_tuple(BIF_ARG_1)) {
Eterm* tp = tuple_val(BIF_ARG_1);
@@ -3353,10 +3790,7 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1)
/* Used by timer process_SUITE, timer_bif_SUITE, and
node_container_SUITE (emulator) */
if (is_internal_pid(tp[2])) {
- BIF_RET(erts_process_status(BIF_P,
- ERTS_PROC_LOCK_MAIN,
- NULL,
- tp[2]));
+ BIF_RET(erts_process_status(NULL, tp[2]));
}
}
else if (ERTS_IS_ATOM_STR("link_list", tp[1])) {
@@ -3538,6 +3972,86 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1)
BIF_RET(erts_debug_reader_groups_map(BIF_P, (int) groups));
}
+ else if (ERTS_IS_ATOM_STR("internal_hash", tp[1])) {
+ Uint hash = (Uint) make_internal_hash(tp[2], 0);
+ Uint hsz = 0;
+ Eterm* hp;
+ erts_bld_uint(NULL, &hsz, hash);
+ hp = HAlloc(BIF_P,hsz);
+ return erts_bld_uint(&hp, NULL, hash);
+ }
+ else if (ERTS_IS_ATOM_STR("atom", tp[1])) {
+ Uint ix;
+ if (!term_to_Uint(tp[2], &ix))
+ BIF_ERROR(BIF_P, BADARG);
+ while (ix >= atom_table_size()) {
+ char tmp[20];
+ erts_snprintf(tmp, sizeof(tmp), "am%x", atom_table_size());
+ erts_atom_put((byte *) tmp, strlen(tmp), ERTS_ATOM_ENC_LATIN1, 1);
+ }
+ return make_atom(ix);
+ }
+ else if (ERTS_IS_ATOM_STR("magic_ref", tp[1])) {
+ Binary *bin;
+ UWord bin_addr, refc;
+ Eterm bin_addr_term, refc_term, test_type;
+ Uint sz;
+ Eterm *hp;
+ if (!is_internal_magic_ref(tp[2])) {
+ if (is_internal_ordinary_ref(tp[2])) {
+ ErtsORefThing *rtp;
+ rtp = (ErtsORefThing *) internal_ref_val(tp[2]);
+ if (erts_is_ref_numbers_magic(rtp->num))
+ BIF_RET(am_true);
+ }
+ BIF_RET(am_false);
+ }
+ bin = erts_magic_ref2bin(tp[2]);
+ refc = erts_refc_read(&bin->intern.refc, 1);
+ bin_addr = (UWord) bin;
+ sz = 4;
+ erts_bld_uword(NULL, &sz, bin_addr);
+ erts_bld_uword(NULL, &sz, refc);
+ hp = HAlloc(BIF_P, sz);
+ bin_addr_term = erts_bld_uword(&hp, NULL, bin_addr);
+ refc_term = erts_bld_uword(&hp, NULL, refc);
+ test_type = (ERTS_MAGIC_BIN_DESTRUCTOR(bin) == empty_magic_ref_destructor
+ ? am_true : am_false);
+ BIF_RET(TUPLE3(hp, bin_addr_term, refc_term, test_type));
+ }
+
+ break;
+ }
+ case 3: {
+ if (ERTS_IS_ATOM_STR("check_time_config", tp[1])) {
+ int res, time_correction;
+ ErtsTimeWarpMode time_warp_mode;
+ if (tp[2] == am_true)
+ time_correction = !0;
+ else if (tp[2] == am_false)
+ time_correction = 0;
+ else
+ break;
+ if (ERTS_IS_ATOM_STR("no_time_warp", tp[3]))
+ time_warp_mode = ERTS_NO_TIME_WARP_MODE;
+ else if (ERTS_IS_ATOM_STR("single_time_warp", tp[3]))
+ time_warp_mode = ERTS_SINGLE_TIME_WARP_MODE;
+ else if (ERTS_IS_ATOM_STR("multi_time_warp", tp[3]))
+ time_warp_mode = ERTS_MULTI_TIME_WARP_MODE;
+ else
+ break;
+ res = erts_check_time_adj_support(time_correction,
+ time_warp_mode);
+ BIF_RET(res ? am_true : am_false);
+ }
+ else if (ERTS_IS_ATOM_STR("make_unique_integer", tp[1])) {
+ Eterm res = erts_debug_make_unique_integer(BIF_P,
+ tp[2],
+ tp[3]);
+ if (is_non_value(res))
+ break;
+ BIF_RET(res);
+ }
break;
}
default:
@@ -3547,8 +4061,51 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1)
BIF_ERROR(BIF_P, BADARG);
}
+BIF_RETTYPE erts_internal_is_system_process_1(BIF_ALIST_1)
+{
+ if (is_internal_pid(BIF_ARG_1)) {
+ Process *rp = erts_proc_lookup(BIF_ARG_1);
+ if (rp && (rp->static_flags & ERTS_STC_FLG_SYSTEM_PROC))
+ BIF_RET(am_true);
+ BIF_RET(am_false);
+ }
+
+ if (is_external_pid(BIF_ARG_1)
+ && external_pid_dist_entry(BIF_ARG_1) == erts_this_dist_entry) {
+ BIF_RET(am_false);
+ }
+
+ 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;
+#if defined(VALGRIND) && defined(__GNUC__)
+/* Force noinline for valgrind suppression */
+static void broken_halt_test(Eterm bif_arg_2) __attribute__((noinline));
+#endif
+
+static void broken_halt_test(Eterm bif_arg_2)
+{
+ /* Ugly ugly code used by bif_SUITE:erlang_halt/1 */
+#if defined(ERTS_HAVE_TRY_CATCH)
+ erts_get_scheduler_data()->run_queue = NULL;
+#endif
+ erts_exit(ERTS_DUMP_EXIT, "%T", bif_arg_2);
+}
BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2)
{
@@ -3645,9 +4202,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);
}
}
@@ -3793,7 +4348,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);
@@ -3836,258 +4391,450 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2)
}
else if (ERTS_IS_ATOM_STR("wait", BIF_ARG_1)) {
if (ERTS_IS_ATOM_STR("deallocations", BIF_ARG_2)) {
- if (erts_debug_wait_deallocations(BIF_P)) {
+ int flag = ERTS_DEBUG_WAIT_COMPLETED_DEALLOCATIONS;
+ if (erts_debug_wait_completed(BIF_P, flag)) {
ERTS_BIF_YIELD_RETURN(BIF_P, am_ok);
}
}
+ if (ERTS_IS_ATOM_STR("timer_cancellations", BIF_ARG_2)) {
+ int flag = ERTS_DEBUG_WAIT_COMPLETED_TIMER_CANCELLATIONS;
+ if (erts_debug_wait_completed(BIF_P, flag)) {
+ ERTS_BIF_YIELD_RETURN(BIF_P, am_ok);
+ }
+ }
+ }
+ else if (ERTS_IS_ATOM_STR("broken_halt", BIF_ARG_1)) {
+ broken_halt_test(BIF_ARG_2);
+ }
+ else if (ERTS_IS_ATOM_STR("unique_monotonic_integer_state", BIF_ARG_1)) {
+ int res = erts_debug_set_unique_monotonic_integer_state(BIF_ARG_2);
+ BIF_RET(res ? am_true : am_false);
}
+ else if (ERTS_IS_ATOM_STR("node_tab_delayed_delete", BIF_ARG_1)) {
+ /* node_container_SUITE */
+ Sint64 msecs;
+ if (term_to_Sint64(BIF_ARG_2, &msecs)) {
+ /* Negative value restore original value... */
+ erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_debug_test_node_tab_delayed_delete(msecs);
+ erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ 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);
+ }
+ else if (ERTS_IS_ATOM_STR("make", BIF_ARG_1)) {
+ if (ERTS_IS_ATOM_STR("magic_ref", BIF_ARG_2)) {
+ Binary *bin = erts_create_magic_binary(0, empty_magic_ref_destructor);
+ UWord bin_addr = (UWord) bin;
+ Eterm bin_addr_term, magic_ref, res;
+ Eterm *hp;
+ Uint sz = ERTS_MAGIC_REF_THING_SIZE + 3;
+ erts_bld_uword(NULL, &sz, bin_addr);
+ hp = HAlloc(BIF_P, sz);
+ bin_addr_term = erts_bld_uword(&hp, NULL, bin_addr);
+ magic_ref = erts_mk_magic_ref(&hp, &BIF_P->off_heap, bin);
+ res = TUPLE2(hp, magic_ref, bin_addr_term);
+ BIF_RET(res);
+ }
+ }
}
BIF_ERROR(BIF_P, BADARG);
}
#ifdef ERTS_ENABLE_LOCK_COUNT
+
+typedef struct {
+ /* info->location_count may increase between size calculation and term
+ * building, so we cap it at the value sampled in lcnt_build_result_vector.
+ *
+ * Shrinking is safe though. */
+ int max_location_count;
+ erts_lcnt_lock_info_t *info;
+} lcnt_sample_t;
+
+typedef struct lcnt_sample_vector_ {
+ lcnt_sample_t *elements;
+ size_t size;
+} lcnt_sample_vector_t;
+
+static lcnt_sample_vector_t lcnt_build_sample_vector(erts_lcnt_lock_info_list_t *list) {
+ erts_lcnt_lock_info_t *iterator;
+ lcnt_sample_vector_t result;
+ size_t allocated_entries;
+
+ allocated_entries = 64;
+ result.size = 0;
+
+ result.elements = erts_alloc(ERTS_ALC_T_LCNT_VECTOR,
+ allocated_entries * sizeof(lcnt_sample_t));
+
+ iterator = NULL;
+ while(erts_lcnt_iterate_list(list, &iterator)) {
+ erts_lcnt_retain_lock_info(iterator);
+
+ result.elements[result.size].max_location_count = iterator->location_count;
+ result.elements[result.size].info = iterator;
+
+ result.size++;
+
+ if(result.size >= allocated_entries) {
+ allocated_entries *= 2;
+
+ result.elements = erts_realloc(ERTS_ALC_T_LCNT_VECTOR, result.elements,
+ allocated_entries * sizeof(lcnt_sample_t));
+ }
+ }
+
+ return result;
+}
+
+static void lcnt_destroy_sample_vector(lcnt_sample_vector_t *vector) {
+ size_t i;
+
+ for(i = 0; i < vector->size; i++) {
+ erts_lcnt_release_lock_info(vector->elements[i].info);
+ }
+
+ erts_free(ERTS_ALC_T_LCNT_VECTOR, vector->elements);
+}
+
+/* The size of an integer is not guaranteed to be constant since we're walking
+ * over live data, and may cross over into bignum territory between size calc
+ * and the actual build. This takes care of that through always assuming the
+ * worst, but needs to be fixed up with HRelease once the final term has been
+ * built. */
+static ERTS_INLINE Eterm bld_unstable_uint64(Uint **hpp, Uint *szp, Uint64 ui) {
+ Eterm res = THE_NON_VALUE;
+
+ if(szp) {
+ *szp += ERTS_UINT64_HEAP_SIZE(~((Uint64) 0));
+ }
+
+ if(hpp) {
+ if (IS_USMALL(0, ui)) {
+ res = make_small(ui);
+ } else {
+ res = erts_uint64_to_big(ui, hpp);
+ }
+ }
+
+ return res;
+}
+
static Eterm lcnt_build_lock_stats_term(Eterm **hpp, Uint *szp, erts_lcnt_lock_stats_t *stats, Eterm res) {
- Uint tries = 0, colls = 0;
- unsigned long timer_s = 0, timer_ns = 0, timer_n = 0;
- unsigned int line = 0;
-
+ unsigned int i;
+ const char *file;
+
Eterm af, uil;
Eterm uit, uic;
Eterm uits, uitns, uitn;
Eterm tt, tstat, tloc, t;
-
+ Eterm thist, vhist[ERTS_LCNT_HISTOGRAM_SLOT_SIZE];
+
/* term:
- * [{{file, line}, {tries, colls, {seconds, nanoseconds, n_blocks}}}]
- */
-
- tries = (Uint) ethr_atomic_read(&stats->tries);
- colls = (Uint) ethr_atomic_read(&stats->colls);
-
- line = stats->line;
- timer_s = stats->timer.s;
- timer_ns = stats->timer.ns;
- timer_n = stats->timer_n;
-
- af = erts_atom_put(stats->file, strlen(stats->file), ERTS_ATOM_ENC_LATIN1, 1);
- uil = erts_bld_uint( hpp, szp, line);
+ * [{{file, line},
+ {tries, colls, {seconds, nanoseconds, n_blocks}},
+ * { .. histogram .. }] */
+
+ file = stats->file ? stats->file : "undefined";
+
+ af = erts_atom_put((byte *)file, strlen(file), ERTS_ATOM_ENC_LATIN1, 1);
+ uil = erts_bld_uint( hpp, szp, stats->line);
tloc = erts_bld_tuple(hpp, szp, 2, af, uil);
-
- uit = erts_bld_uint( hpp, szp, tries);
- uic = erts_bld_uint( hpp, szp, colls);
-
- uits = erts_bld_uint( hpp, szp, timer_s);
- uitns = erts_bld_uint( hpp, szp, timer_ns);
- uitn = erts_bld_uint( hpp, szp, timer_n);
+
+ uit = bld_unstable_uint64(hpp, szp, (Uint)ethr_atomic_read(&stats->attempts));
+ uic = bld_unstable_uint64(hpp, szp, (Uint)ethr_atomic_read(&stats->collisions));
+
+ uits = bld_unstable_uint64(hpp, szp, stats->total_time_waited.s);
+ uitns = bld_unstable_uint64(hpp, szp, stats->total_time_waited.ns);
+ uitn = bld_unstable_uint64(hpp, szp, stats->times_waited);
tt = erts_bld_tuple(hpp, szp, 3, uits, uitns, uitn);
tstat = erts_bld_tuple(hpp, szp, 3, uit, uic, tt);
-
- t = erts_bld_tuple(hpp, szp, 2, tloc, tstat);
-
- res = erts_bld_cons( hpp, szp, t, res);
+
+ for(i = 0; i < ERTS_LCNT_HISTOGRAM_SLOT_SIZE; i++) {
+ vhist[i] = bld_unstable_uint64(hpp, szp, stats->wait_time_histogram.ns[i]);
+ }
+
+ thist = erts_bld_tuplev(hpp, szp, ERTS_LCNT_HISTOGRAM_SLOT_SIZE, vhist);
+
+ t = erts_bld_tuple(hpp, szp, 3, tloc, tstat, thist);
+ res = erts_bld_cons( hpp, szp, t, res);
return res;
}
-static Eterm lcnt_build_lock_term(Eterm **hpp, Uint *szp, erts_lcnt_lock_t *lock, Eterm res) {
+static Eterm lcnt_pretty_print_lock_id(erts_lcnt_lock_info_t *info) {
+ Eterm id = info->id;
+
+ if((info->flags & ERTS_LOCK_FLAGS_MASK_TYPE) == ERTS_LOCK_TYPE_PROCLOCK) {
+ /* Use registered names as id's for process locks if available. Thread
+ * progress is delayed since we may be running on a dirty scheduler. */
+ ErtsThrPrgrDelayHandle delay_handle;
+ Process *process;
+
+ delay_handle = erts_thr_progress_unmanaged_delay();
+
+ process = erts_proc_lookup(info->id);
+ if (process && process->common.u.alive.reg) {
+ id = process->common.u.alive.reg->name;
+ }
+
+ erts_thr_progress_unmanaged_continue(delay_handle);
+ } else if(info->flags & ERTS_LOCK_FLAGS_CATEGORY_ALLOCATOR) {
+ if(is_small(id) && !sys_strcmp(info->name, "alcu_allocator")) {
+ const char *name = (const char*)ERTS_ALC_A2AD(signed_val(id));
+ id = erts_atom_put((byte*)name, strlen(name), ERTS_ATOM_ENC_LATIN1, 1);
+ }
+ }
+
+ return id;
+}
+
+static Eterm lcnt_build_lock_term(Eterm **hpp, Uint *szp, lcnt_sample_t *sample, Eterm res) {
+ erts_lcnt_lock_info_t *info = sample->info;
+
Eterm name, type, id, stats = NIL, t;
- Process *proc = NULL;
- char *ltype;
+ const char *lock_desc;
int i;
+
+ /* term: [{name, id, type, stats()}] */
+
+ ASSERT(info->name);
- /* term:
- * [{name, id, type, stats()}]
- */
-
- ASSERT(lock->name);
-
- ltype = erts_lcnt_lock_type(lock->flag);
-
- ASSERT(ltype);
-
- type = erts_atom_put(ltype, strlen(ltype), ERTS_ATOM_ENC_LATIN1, 1);
- name = erts_atom_put(lock->name, strlen(lock->name), ERTS_ATOM_ENC_LATIN1, 1);
-
- if (lock->flag & ERTS_LCNT_LT_ALLOC) {
- /* use allocator types names as id's for allocator locks */
- ltype = (char *) ERTS_ALC_A2AD(signed_val(lock->id));
- id = erts_atom_put(ltype, strlen(ltype), ERTS_ATOM_ENC_LATIN1, 1);
- } else if (lock->flag & ERTS_LCNT_LT_PROCLOCK) {
- /* use registered names as id's for process locks if available */
- proc = erts_proc_lookup(lock->id);
- if (proc && proc->common.u.alive.reg) {
- id = proc->common.u.alive.reg->name;
- } else {
- /* otherwise use process id */
- id = lock->id;
- }
+ lock_desc = erts_lock_flags_get_type_name(info->flags);
+
+ type = erts_atom_put((byte*)lock_desc, strlen(lock_desc), ERTS_ATOM_ENC_LATIN1, 1);
+ name = erts_atom_put((byte*)info->name, strlen(info->name), ERTS_ATOM_ENC_LATIN1, 1);
+
+ /* Only attempt to resolve ids when actually emitting the term. This ought
+ * to be safe since all immediates are the same size. */
+ if(hpp != NULL) {
+ id = lcnt_pretty_print_lock_id(info);
} else {
- id = lock->id;
+ id = NIL;
}
-
- for (i = 0; i < lock->n_stats; i++) {
- stats = lcnt_build_lock_stats_term(hpp, szp, &(lock->stats[i]), stats);
+
+ for(i = 0; i < MIN(info->location_count, sample->max_location_count); i++) {
+ stats = lcnt_build_lock_stats_term(hpp, szp, &(info->location_stats[i]), stats);
}
-
- t = erts_bld_tuple(hpp, szp, 4, name, id, type, stats);
-
- res = erts_bld_cons( hpp, szp, t, res);
+
+ t = erts_bld_tuple(hpp, szp, 4, name, id, type, stats);
+ res = erts_bld_cons(hpp, szp, t, res);
return res;
}
-static Eterm lcnt_build_result_term(Eterm **hpp, Uint *szp, erts_lcnt_data_t *data, Eterm res) {
+static Eterm lcnt_build_result_term(Eterm **hpp, Uint *szp, erts_lcnt_time_t *duration,
+ lcnt_sample_vector_t *current_locks,
+ lcnt_sample_vector_t *deleted_locks, Eterm res) {
+ const char *str_duration = "duration";
+ const char *str_locks = "locks";
+
Eterm dts, dtns, tdt, adur, tdur, aloc, lloc = NIL, tloc;
- erts_lcnt_lock_t *lock = NULL;
- char *str_duration = "duration";
- char *str_locks = "locks";
-
- /* term:
- * [{'duration', {seconds, nanoseconds}}, {'locks', locks()}]
- */
-
+ size_t i;
+
+ /* term: [{'duration', {seconds, nanoseconds}}, {'locks', locks()}] */
+
/* duration tuple */
- dts = erts_bld_uint( hpp, szp, data->duration.s);
- dtns = erts_bld_uint( hpp, szp, data->duration.ns);
+ dts = bld_unstable_uint64(hpp, szp, duration->s);
+ dtns = bld_unstable_uint64(hpp, szp, duration->ns);
tdt = erts_bld_tuple(hpp, szp, 2, dts, dtns);
-
- adur = erts_atom_put(str_duration, strlen(str_duration), ERTS_ATOM_ENC_LATIN1, 1);
+
+ adur = erts_atom_put((byte *)str_duration, strlen(str_duration), ERTS_ATOM_ENC_LATIN1, 1);
tdur = erts_bld_tuple(hpp, szp, 2, adur, tdt);
/* lock tuple */
-
- aloc = erts_atom_put(str_locks, strlen(str_locks), ERTS_ATOM_ENC_LATIN1, 1);
-
- for (lock = data->current_locks->head; lock != NULL ; lock = lock->next ) {
- lloc = lcnt_build_lock_term(hpp, szp, lock, lloc);
+ aloc = erts_atom_put((byte *)str_locks, strlen(str_locks), ERTS_ATOM_ENC_LATIN1, 1);
+
+ for(i = 0; i < current_locks->size; i++) {
+ lloc = lcnt_build_lock_term(hpp, szp, &current_locks->elements[i], lloc);
}
-
- for (lock = data->deleted_locks->head; lock != NULL ; lock = lock->next ) {
- lloc = lcnt_build_lock_term(hpp, szp, lock, lloc);
+
+ for(i = 0; i < deleted_locks->size; i++) {
+ lloc = lcnt_build_lock_term(hpp, szp, &deleted_locks->elements[i], lloc);
}
-
+
tloc = erts_bld_tuple(hpp, szp, 2, aloc, lloc);
-
- res = erts_bld_cons( hpp, szp, tloc, res);
- res = erts_bld_cons( hpp, szp, tdur, res);
+
+ res = erts_bld_cons(hpp, szp, tloc, res);
+ res = erts_bld_cons(hpp, szp, tdur, res);
return res;
-}
+}
+
+static struct {
+ const char *name;
+ erts_lock_flags_t flag;
+} lcnt_category_map[] = {
+ {"allocator", ERTS_LOCK_FLAGS_CATEGORY_ALLOCATOR},
+ {"db", ERTS_LOCK_FLAGS_CATEGORY_DB},
+ {"debug", ERTS_LOCK_FLAGS_CATEGORY_DEBUG},
+ {"distribution", ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION},
+ {"generic", ERTS_LOCK_FLAGS_CATEGORY_GENERIC},
+ {"io", ERTS_LOCK_FLAGS_CATEGORY_IO},
+ {"process", ERTS_LOCK_FLAGS_CATEGORY_PROCESS},
+ {"scheduler", ERTS_LOCK_FLAGS_CATEGORY_SCHEDULER},
+ {NULL, 0}
+ };
+
+static erts_lock_flags_t lcnt_atom_to_lock_category(Eterm atom) {
+ int i = 0;
+
+ for(i = 0; lcnt_category_map[i].name != NULL; i++) {
+ if(erts_is_atom_str(lcnt_category_map[i].name, atom, 0)) {
+ return lcnt_category_map[i].flag;
+ }
+ }
+
+ return 0;
+}
+
+static Eterm lcnt_build_category_list(Eterm **hpp, Uint *szp, erts_lock_flags_t mask) {
+ Eterm res;
+ int i;
+
+ res = NIL;
+
+ for(i = 0; lcnt_category_map[i].name != NULL; i++) {
+ if(mask & lcnt_category_map[i].flag) {
+ Eterm category = erts_atom_put((byte*)lcnt_category_map[i].name,
+ strlen(lcnt_category_map[i].name),
+ ERTS_ATOM_ENC_UTF8, 0);
+
+ res = erts_bld_cons(hpp, szp, category, res);
+ }
+ }
+
+ return res;
+}
+
#endif
-BIF_RETTYPE erts_debug_lock_counters_1(BIF_ALIST_1)
+BIF_RETTYPE erts_debug_lcnt_clear_0(BIF_ALIST_0)
{
-#ifdef ERTS_ENABLE_LOCK_COUNT
- Eterm res = NIL;
-#endif
+#ifndef ERTS_ENABLE_LOCK_COUNT
+ BIF_RET(am_error);
+#else
+ erts_lcnt_clear_counters();
+ BIF_RET(am_ok);
+#endif
+}
- if (BIF_ARG_1 == am_enabled) {
-#ifdef ERTS_ENABLE_LOCK_COUNT
- BIF_RET(am_true);
+BIF_RETTYPE erts_debug_lcnt_collect_0(BIF_ALIST_0)
+{
+#ifndef ERTS_ENABLE_LOCK_COUNT
+ BIF_RET(am_error);
#else
- BIF_RET(am_false);
+ lcnt_sample_vector_t current_locks, deleted_locks;
+ erts_lcnt_data_t data;
+
+ Eterm *term_heap_start, *term_heap_end;
+ Uint term_heap_size = 0;
+ Eterm result;
+
+ data = erts_lcnt_get_data();
+
+ current_locks = lcnt_build_sample_vector(data.current_locks);
+ deleted_locks = lcnt_build_sample_vector(data.deleted_locks);
+
+ lcnt_build_result_term(NULL, &term_heap_size, &data.duration,
+ &current_locks, &deleted_locks, NIL);
+
+ term_heap_start = HAlloc(BIF_P, term_heap_size);
+ term_heap_end = term_heap_start;
+
+ result = lcnt_build_result_term(&term_heap_end, NULL,
+ &data.duration, &current_locks, &deleted_locks, NIL);
+
+ HRelease(BIF_P, term_heap_start + term_heap_size, term_heap_end);
+
+ lcnt_destroy_sample_vector(&current_locks);
+ lcnt_destroy_sample_vector(&deleted_locks);
+
+ BIF_RET(result);
#endif
- }
+}
+
+BIF_RETTYPE erts_debug_lcnt_control_1(BIF_ALIST_1)
+{
#ifdef ERTS_ENABLE_LOCK_COUNT
+ if(ERTS_IS_ATOM_STR("mask", BIF_ARG_1)) {
+ erts_lock_flags_t mask;
+ Eterm *term_heap_block;
+ Uint term_heap_size;
- else if (BIF_ARG_1 == am_info) {
- erts_lcnt_data_t *data;
- Uint hsize = 0;
- Uint *szp;
- Eterm* hp;
+ mask = erts_lcnt_get_category_mask();
+ term_heap_size = 0;
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_thr_progress_block();
+ lcnt_build_category_list(NULL, &term_heap_size, mask);
- erts_lcnt_set_rt_opt(ERTS_LCNT_OPT_SUSPEND);
- data = erts_lcnt_get_data();
+ term_heap_block = HAlloc(BIF_P, term_heap_size);
- /* calculate size */
+ BIF_RET(lcnt_build_category_list(&term_heap_block, NULL, mask));
+ } else if(ERTS_IS_ATOM_STR("copy_save", BIF_ARG_1)) {
+ if(erts_lcnt_get_preserve_info()) {
+ BIF_RET(am_true);
+ }
- szp = &hsize;
- lcnt_build_result_term(NULL, szp, data, NIL);
+ BIF_RET(am_false);
+ }
+#endif
+ BIF_ERROR(BIF_P, BADARG);
+}
- /* alloc and build */
+BIF_RETTYPE erts_debug_lcnt_control_2(BIF_ALIST_2)
+{
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ if(ERTS_IS_ATOM_STR("mask", BIF_ARG_1)) {
+ erts_lock_flags_t category_mask = 0;
+ Eterm categories = BIF_ARG_2;
- hp = HAlloc(BIF_P, hsize);
+ if(!(is_list(categories) || is_nil(categories))) {
+ BIF_ERROR(BIF_P, BADARG);
+ }
- res = lcnt_build_result_term(&hp, NULL, data, res);
-
- erts_lcnt_clear_rt_opt(ERTS_LCNT_OPT_SUSPEND);
+ while(is_list(categories)) {
+ Eterm *cell = list_val(categories);
+ erts_lock_flags_t category;
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
-
- BIF_RET(res);
- } else if (BIF_ARG_1 == am_clear) {
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_thr_progress_block();
+ category = lcnt_atom_to_lock_category(CAR(cell));
- erts_lcnt_clear_counters();
+ if(!category) {
+ Eterm *hp = HAlloc(BIF_P, 4);
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ BIF_RET(TUPLE3(hp, am_error, am_badarg, CAR(cell)));
+ }
- BIF_RET(am_ok);
- } else if (is_tuple(BIF_ARG_1)) {
- Eterm* tp = tuple_val(BIF_ARG_1);
+ category_mask |= category;
+ categories = CDR(cell);
+ }
- switch (arityval(tp[0])) {
- case 2: {
- int opt = 0;
- int val = 0;
- if (ERTS_IS_ATOM_STR("copy_save", tp[1])) {
- opt = ERTS_LCNT_OPT_COPYSAVE;
- } else if (ERTS_IS_ATOM_STR("process_locks", tp[1])) {
- opt = ERTS_LCNT_OPT_PROCLOCK;
- } else if (ERTS_IS_ATOM_STR("port_locks", tp[1])) {
- opt = ERTS_LCNT_OPT_PORTLOCK;
- } else if (ERTS_IS_ATOM_STR("suspend", tp[1])) {
- opt = ERTS_LCNT_OPT_SUSPEND;
- } else if (ERTS_IS_ATOM_STR("location", tp[1])) {
- opt = ERTS_LCNT_OPT_LOCATION;
- } else {
- BIF_ERROR(BIF_P, BADARG);
- }
- if (tp[2] == am_true) {
- val = 1;
- } else if (tp[2] == am_false) {
- val = 0;
- } else {
- BIF_ERROR(BIF_P, BADARG);
- }
+ erts_lcnt_set_category_mask(category_mask);
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_thr_progress_block();
-
- if (val) {
- res = erts_lcnt_set_rt_opt(opt) ? am_true : am_false;
- } else {
- res = erts_lcnt_clear_rt_opt(opt) ? am_true : am_false;
- }
-#ifdef ERTS_SMP
- if (res != tp[2]) {
- if (opt == ERTS_LCNT_OPT_PORTLOCK) {
- erts_lcnt_enable_io_lock_count(val);
- } else if (opt == ERTS_LCNT_OPT_PROCLOCK) {
- erts_lcnt_enable_proc_lock_count(val);
- }
- }
-#endif
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
- BIF_RET(res);
- break;
- }
-
- default:
- break;
- }
- }
+ BIF_RET(am_ok);
+ } else if(BIF_ARG_2 == am_true || BIF_ARG_2 == am_false) {
+ int enabled = (BIF_ARG_2 == am_true);
+
+ if(ERTS_IS_ATOM_STR("copy_save", BIF_ARG_1)) {
+ erts_lcnt_set_preserve_info(enabled);
-#endif
+ BIF_RET(am_ok);
+ }
+ }
+#endif
BIF_ERROR(BIF_P, BADARG);
}
@@ -4102,14 +4849,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
@@ -4124,6 +4874,12 @@ erts_bif_info_init(void)
= erts_export_put(am_erlang, am_gather_sched_wall_time_result, 1);
gather_gc_info_res_trap
= 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 820ed2385d..73d327da3e 100644
--- a/erts/emulator/beam/erl_bif_lists.c
+++ b/erts/emulator/beam/erl_bif_lists.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1999-2011. All Rights Reserved.
+ * Copyright Ericsson AB 1999-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -39,32 +40,93 @@ static BIF_RETTYPE append(Process* p, Eterm A, Eterm B)
Eterm list;
Eterm copy;
Eterm last;
- size_t need;
- Eterm* hp;
- int i;
+ Eterm* hp = NULL;
+ Sint i;
- if ((i = erts_list_length(A)) < 0) {
- BIF_ERROR(p, BADARG);
+ list = A;
+
+ if (is_nil(list)) {
+ BIF_RET(B);
}
- if (i == 0) {
- BIF_RET(B);
- } else if (is_nil(B)) {
- BIF_RET(A);
+
+ if (is_not_list(list)) {
+ BIF_ERROR(p, BADARG);
}
- need = 2*i;
- hp = HAlloc(p, need);
- list = A;
+ /* optimistic append on heap first */
+
+ if ((i = HeapWordsLeft(p) / 2) < 4) {
+ goto list_tail;
+ }
+
+ hp = HEAP_TOP(p);
copy = last = CONS(hp, CAR(list_val(list)), make_list(hp+2));
list = CDR(list_val(list));
- hp += 2;
+ hp += 2;
+ i -= 2; /* don't use the last 2 words (extra i--;) */
+
+ while(i-- && is_list(list)) {
+ Eterm* listp = list_val(list);
+ last = CONS(hp, CAR(listp), make_list(hp+2));
+ list = CDR(listp);
+ hp += 2;
+ }
+
+ /* A is proper and B is NIL return A as-is, don't update HTOP */
+
+ if (is_nil(list) && is_nil(B)) {
+ BIF_RET(A);
+ }
+
+ if (is_nil(list)) {
+ HEAP_TOP(p) = hp;
+ CDR(list_val(last)) = B;
+ BIF_RET(copy);
+ }
+
+list_tail:
+
+ if ((i = erts_list_length(list)) < 0) {
+ BIF_ERROR(p, BADARG);
+ }
+
+ /* remaining list was proper and B is NIL */
+ if (is_nil(B)) {
+ BIF_RET(A);
+ }
+
+ if (hp) {
+ /* Note: fall through case, already written
+ * on the heap.
+ * The last 2 words of the heap is not written yet
+ */
+ Eterm *hp_save = hp;
+ ASSERT(i != 0);
+ HEAP_TOP(p) = hp + 2;
+ if (i == 1) {
+ hp[0] = CAR(list_val(list));
+ hp[1] = B;
+ BIF_RET(copy);
+ }
+ hp = HAlloc(p, 2*(i - 1));
+ last = CONS(hp_save, CAR(list_val(list)), make_list(hp));
+ } else {
+ hp = HAlloc(p, 2*i);
+ copy = last = CONS(hp, CAR(list_val(list)), make_list(hp+2));
+ hp += 2;
+ }
+
+ list = CDR(list_val(list));
i--;
+
+ ASSERT(i > -1);
while(i--) {
- Eterm* listp = list_val(list);
- last = CONS(hp, CAR(listp), make_list(hp+2));
- list = CDR(listp);
- hp += 2;
+ Eterm* listp = list_val(list);
+ last = CONS(hp, CAR(listp), make_list(hp+2));
+ list = CDR(listp);
+ hp += 2;
}
+
CDR(list_val(last)) = B;
BIF_RET(copy);
}
@@ -98,9 +160,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);
@@ -390,7 +452,7 @@ keyfind(int Bif, Process* p, Eterm Key, Eterm Pos, Eterm List)
Eterm *tuple_ptr = tuple_val(term);
if (pos <= arityval(*tuple_ptr)) {
Eterm element = tuple_ptr[pos];
- if (CMP(Key, element) == 0) {
+ if (CMP_EQ(Key, element)) {
return term;
}
}
diff --git a/erts/emulator/beam/erl_bif_op.c b/erts/emulator/beam/erl_bif_op.c
index 37dd6457db..a594ec1493 100644
--- a/erts/emulator/beam/erl_bif_op.c
+++ b/erts/emulator/beam/erl_bif_op.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1999-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1999-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -88,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)
@@ -113,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)
@@ -123,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)
@@ -257,9 +258,9 @@ 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) {
+ if (exp->info.mfa.arity == (Uint) arity) {
BIF_RET(am_true);
}
}
diff --git a/erts/emulator/beam/erl_bif_os.c b/erts/emulator/beam/erl_bif_os.c
index e07c622928..5cd172c26f 100644
--- a/erts/emulator/beam/erl_bif_os.c
+++ b/erts/emulator/beam/erl_bif_os.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1999-2012. All Rights Reserved.
+ * Copyright Ericsson AB 1999-2017. 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.
+ * 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%
*/
@@ -202,3 +203,17 @@ BIF_RETTYPE os_unsetenv_1(BIF_ALIST_1)
}
BIF_RET(am_true);
}
+
+BIF_RETTYPE os_set_signal_2(BIF_ALIST_2) {
+ if (is_atom(BIF_ARG_1) && ((BIF_ARG_2 == am_ignore) ||
+ (BIF_ARG_2 == am_default) ||
+ (BIF_ARG_2 == am_handle))) {
+ if (!erts_set_signal(BIF_ARG_1, BIF_ARG_2))
+ goto error;
+
+ BIF_RET(am_ok);
+ }
+
+error:
+ BIF_ERROR(BIF_P, BADARG);
+}
diff --git a/erts/emulator/beam/erl_bif_port.c b/erts/emulator/beam/erl_bif_port.c
index afb33c1cdb..ff03151619 100644
--- a/erts/emulator/beam/erl_bif_port.c
+++ b/erts/emulator/beam/erl_bif_port.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -40,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);
@@ -49,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;
@@ -60,27 +62,63 @@ 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);
}
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK);
+ 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_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);
+
+ if (IS_TRACED_FL(BIF_P, F_TRACE_PROCS))
+ trace_proc(BIF_P, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_LINK, BIF_P,
+ am_link, 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 *
@@ -101,6 +139,12 @@ sig_lookup_port(Process *c_p, Eterm id_or_name)
return lookup_port(c_p, id_or_name, ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP);
}
+/* Non-inline copy of sig_lookup_port to be exported */
+Port *erts_sig_lookup_port(Process *c_p, Eterm id_or_name)
+{
+ return lookup_port(c_p, id_or_name, ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP);
+}
+
static ERTS_INLINE Port *
data_lookup_port(Process *c_p, Eterm id_or_name)
{
@@ -170,7 +214,7 @@ BIF_RETTYPE erts_internal_port_command_3(BIF_ALIST_3)
ASSERT(!(flags & ERTS_PORT_SIG_FLG_FORCE));
/* Fall through... */
case ERTS_PORT_OP_SCHEDULED:
- ASSERT(is_internal_ref(ref));
+ ASSERT(is_internal_ordinary_ref(ref));
ERTS_BIF_PREP_RET(res, ref);
break;
case ERTS_PORT_OP_DONE:
@@ -216,7 +260,7 @@ BIF_RETTYPE erts_internal_port_call_3(BIF_ALIST_3)
retval = am_badarg;
break;
case ERTS_PORT_OP_SCHEDULED:
- ASSERT(is_internal_ref(retval));
+ ASSERT(is_internal_ordinary_ref(retval));
break;
case ERTS_PORT_OP_DONE:
ASSERT(is_not_internal_ref(retval));
@@ -266,7 +310,7 @@ BIF_RETTYPE erts_internal_port_control_3(BIF_ALIST_3)
retval = am_badarg;
break;
case ERTS_PORT_OP_SCHEDULED:
- ASSERT(is_internal_ref(retval));
+ ASSERT(is_internal_ordinary_ref(retval));
break;
case ERTS_PORT_OP_DONE:
ASSERT(is_not_internal_ref(retval));
@@ -306,14 +350,13 @@ BIF_RETTYPE erts_internal_port_close_1(BIF_ALIST_1)
if (!prt)
BIF_RET(am_badarg);
-
- switch (erts_port_exit(BIF_P, 0, prt, prt->common.id, am_normal, &ref)) {
+ switch (erts_port_exit(BIF_P, 0, prt, BIF_P->common.id, am_normal, &ref)) {
case ERTS_PORT_OP_CALLER_EXIT:
case ERTS_PORT_OP_BADARG:
case ERTS_PORT_OP_DROPPED:
BIF_RET(am_badarg);
case ERTS_PORT_OP_SCHEDULED:
- ASSERT(is_internal_ref(ref));
+ ASSERT(is_internal_ordinary_ref(ref));
BIF_RET(ref);
case ERTS_PORT_OP_DONE:
BIF_RET(am_true);
@@ -340,13 +383,13 @@ BIF_RETTYPE erts_internal_port_connect_2(BIF_ALIST_2)
ref = NIL;
#endif
- switch (erts_port_connect(BIF_P, 0, prt, prt->common.id, BIF_ARG_2, &ref)) {
+ switch (erts_port_connect(BIF_P, 0, prt, BIF_P->common.id, BIF_ARG_2, &ref)) {
case ERTS_PORT_OP_CALLER_EXIT:
case ERTS_PORT_OP_BADARG:
case ERTS_PORT_OP_DROPPED:
BIF_RET(am_badarg);
case ERTS_PORT_OP_SCHEDULED:
- ASSERT(is_internal_ref(ref));
+ ASSERT(is_internal_ordinary_ref(ref));
BIF_RET(ref);
break;
case ERTS_PORT_OP_DONE:
@@ -385,7 +428,7 @@ BIF_RETTYPE erts_internal_port_info_1(BIF_ALIST_1)
case ERTS_PORT_OP_DROPPED:
BIF_RET(am_undefined);
case ERTS_PORT_OP_SCHEDULED:
- ASSERT(is_internal_ref(retval));
+ ASSERT(is_internal_ordinary_ref(retval));
BIF_RET(retval);
case ERTS_PORT_OP_DONE:
ASSERT(is_not_internal_ref(retval));
@@ -424,7 +467,7 @@ BIF_RETTYPE erts_internal_port_info_2(BIF_ALIST_2)
case ERTS_PORT_OP_DROPPED:
BIF_RET(am_undefined);
case ERTS_PORT_OP_SCHEDULED:
- ASSERT(is_internal_ref(retval));
+ ASSERT(is_internal_ordinary_ref(retval));
BIF_RET(retval);
case ERTS_PORT_OP_DONE:
ASSERT(is_not_internal_ref(retval));
@@ -472,7 +515,7 @@ cleanup_old_port_data(erts_aint_t data)
ErtsPortDataHeap *pdhp = (ErtsPortDataHeap *) data;
size_t size;
ERTS_SMP_DATA_DEPENDENCY_READ_MEMORY_BARRIER;
- size = sizeof(ErtsPortDataHeap) + pdhp->hsize*(sizeof(Eterm) - 1);
+ size = sizeof(ErtsPortDataHeap) + (pdhp->hsize-1)*sizeof(Eterm);
erts_schedule_thr_prgr_later_cleanup_op(free_port_data_heap,
(void *) pdhp,
&pdhp->later_op,
@@ -493,8 +536,8 @@ void
erts_cleanup_port_data(Port *prt)
{
ASSERT(erts_atomic32_read_nob(&prt->state) & ERTS_PORT_SFLGS_INVALID_LOOKUP);
- cleanup_old_port_data(erts_smp_atomic_read_nob(&prt->data));
- erts_smp_atomic_set_nob(&prt->data, (erts_aint_t) THE_NON_VALUE);
+ cleanup_old_port_data(erts_smp_atomic_xchg_nob(&prt->data,
+ (erts_aint_t) NULL));
}
Uint
@@ -508,7 +551,7 @@ erts_port_data_size(Port *prt)
}
else {
ErtsPortDataHeap *pdhp = (ErtsPortDataHeap *) data;
- return (Uint) sizeof(ErtsPortDataHeap) + pdhp->hsize*(sizeof(Eterm)-1);
+ return (Uint) sizeof(ErtsPortDataHeap) + (pdhp->hsize-1)*sizeof(Eterm);
}
}
@@ -550,10 +593,11 @@ BIF_RETTYPE port_set_data_2(BIF_ALIST_2)
hsize = size_object(BIF_ARG_2);
pdhp = erts_alloc(ERTS_ALC_T_PORT_DATA_HEAP,
- sizeof(ErtsPortDataHeap) + hsize*(sizeof(Eterm)-1));
+ sizeof(ErtsPortDataHeap) + (hsize-1)*sizeof(Eterm));
hp = &pdhp->heap[0];
pdhp->off_heap.first = NULL;
pdhp->off_heap.overhead = 0;
+ pdhp->hsize = hsize;
pdhp->data = copy_struct(BIF_ARG_2, hsize, &hp, &pdhp->off_heap);
data = (erts_aint_t) pdhp;
ASSERT((data & 0x3) == 0);
@@ -561,8 +605,14 @@ BIF_RETTYPE port_set_data_2(BIF_ALIST_2)
data = erts_smp_atomic_xchg_wb(&prt->data, data);
+ if (data == (erts_aint_t)NULL) {
+ /* Port terminated by racing thread */
+ data = erts_smp_atomic_xchg_wb(&prt->data, data);
+ ASSERT(data != (erts_aint_t)NULL);
+ cleanup_old_port_data(data);
+ BIF_ERROR(BIF_P, BADARG);
+ }
cleanup_old_port_data(data);
-
BIF_RET(am_true);
}
@@ -581,6 +631,8 @@ BIF_RETTYPE port_get_data_1(BIF_ALIST_1)
BIF_ERROR(BIF_P, BADARG);
data = erts_smp_atomic_read_ddrb(&prt->data);
+ if (data == (erts_aint_t)NULL)
+ BIF_ERROR(BIF_P, BADARG); /* Port terminated by racing thread */
if ((data & 0x3) != 0) {
res = (Eterm) (UWord) data;
@@ -607,7 +659,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;
@@ -781,7 +833,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;
@@ -869,7 +921,7 @@ open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump)
}
if (IS_TRACED_FL(p, F_TRACE_SCHED_PROCS)) {
- trace_virtual_sched(p, am_out);
+ trace_sched(p, ERTS_PROC_LOCK_MAIN, am_out);
}
@@ -886,21 +938,22 @@ open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump)
DTRACE3(port_open, process_str, name_buf, port_str);
}
#endif
+
+ if (port && IS_TRACED_FL(port, F_TRACE_PORTS))
+ trace_port(port, am_getting_linked, p->common.id);
+
erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
+ if (IS_TRACED_FL(p, F_TRACE_SCHED_PROCS)) {
+ trace_sched(p, ERTS_PROC_LOCK_MAIN, am_in);
+ }
+
if (!port) {
DEBUGF(("open_driver returned (%d:%d)\n",
err_typep ? *err_typep : 4711,
err_nump ? *err_nump : 4711));
- if (IS_TRACED_FL(p, F_TRACE_SCHED_PROCS)) {
- trace_virtual_sched(p, am_in);
- }
goto do_return;
}
-
- if (IS_TRACED_FL(p, F_TRACE_SCHED_PROCS)) {
- trace_virtual_sched(p, am_in);
- }
if (linebuf && port->linebuf == NULL){
port->linebuf = allocate_linebuf(linebuf);
@@ -935,14 +988,16 @@ 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;
}
n = erts_list_length(l);
+ if (n < 0)
+ return NULL;
/* We require at least one element in argv[0] + NULL at end */
pp = erts_alloc(ERTS_ALC_T_TMP, (n + 2) * sizeof(char **));
pp[i++] = erts_default_arg0;
@@ -982,7 +1037,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();
@@ -1159,7 +1214,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);
}
}
@@ -1319,7 +1374,8 @@ BIF_RETTYPE decode_packet_3(BIF_ALIST_3)
ErlSubBin* rest;
Eterm res;
Eterm options;
- int code;
+ int code;
+ char delimiter = '\n';
if (!is_binary(BIF_ARG_2) ||
(!is_list(BIF_ARG_3) && !is_nil(BIF_ARG_3))) {
@@ -1360,6 +1416,11 @@ BIF_RETTYPE decode_packet_3(BIF_ALIST_3)
case am_line_length:
trunc_len = val;
goto next_option;
+ case am_line_delimiter:
+ if (type == TCP_PB_LINE_LF && val <= 255) {
+ delimiter = (char)val;
+ goto next_option;
+ }
}
}
}
@@ -1380,7 +1441,7 @@ BIF_RETTYPE decode_packet_3(BIF_ALIST_3)
pca.aligned_ptr = bin_ptr;
}
packet_sz = packet_get_length(type, (char*)pca.aligned_ptr, pca.bin_sz,
- max_plen, trunc_len, &http_state);
+ max_plen, trunc_len, delimiter, &http_state);
if (!(packet_sz > 0 && packet_sz <= pca.bin_sz)) {
if (packet_sz < 0) {
goto error;
diff --git a/erts/emulator/beam/erl_bif_re.c b/erts/emulator/beam/erl_bif_re.c
index 448c6f6f6d..ad124fd979 100644
--- a/erts/emulator/beam/erl_bif_re.c
+++ b/erts/emulator/beam/erl_bif_re.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2008-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2008-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -63,12 +64,47 @@ static void erts_erts_pcre_stack_free(void *ptr) {
erts_free(ERTS_ALC_T_RE_STACK,ptr);
}
+#define ERTS_PCRE_STACK_MARGIN (10*1024)
+
+#ifdef ERTS_SMP
+# define ERTS_STACK_LIMIT ((char *) ethr_get_stacklimit())
+#else
+# define ERTS_STACK_LIMIT ((char *) erts_scheduler_stack_limit)
+#endif
+
+static int
+stack_guard_downwards(void)
+{
+ char *limit = ERTS_STACK_LIMIT;
+ char c;
+
+ ASSERT(limit);
+
+ return erts_check_below_limit(&c, limit + ERTS_PCRE_STACK_MARGIN);
+}
+
+static int
+stack_guard_upwards(void)
+{
+ char *limit = ERTS_STACK_LIMIT;
+ char c;
+
+ ASSERT(limit);
+
+ return erts_check_above_limit(&c, limit - ERTS_PCRE_STACK_MARGIN);
+}
+
void erts_init_bif_re(void)
{
+ char c;
erts_pcre_malloc = &erts_erts_pcre_malloc;
erts_pcre_free = &erts_erts_pcre_free;
erts_pcre_stack_malloc = &erts_erts_pcre_stack_malloc;
erts_pcre_stack_free = &erts_erts_pcre_stack_free;
+ if ((char *) erts_ptr_id(&c) > ERTS_STACK_LIMIT)
+ erts_pcre_stack_guard = stack_guard_downwards;
+ else
+ erts_pcre_stack_guard = stack_guard_upwards;
default_table = NULL; /* ISO8859-1 default, forced into pcre */
max_loop_limit = CONTEXT_REDS * LOOP_FACTOR;
@@ -99,7 +135,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);
@@ -150,7 +186,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;
@@ -476,6 +512,17 @@ build_compile_result(Process *p, Eterm error_tag, pcre *result, int errcode, con
* Compile BIFs
*/
+BIF_RETTYPE
+re_version_0(BIF_ALIST_0)
+{
+ Eterm ret;
+ size_t version_size = 0;
+ byte *version = (byte *) erts_pcre_version();
+ version_size = strlen((const char *) version);
+ ret = new_binary(BIF_P, version, version_size);
+ BIF_RET(ret);
+}
+
static BIF_RETTYPE
re_compile(Process* p, Eterm arg1, Eterm arg2)
{
@@ -599,10 +646,11 @@ static void cleanup_restart_context(RestartContext *rc)
}
}
-static void cleanup_restart_context_bin(Binary *bp)
+static int cleanup_restart_context_bin(Binary *bp)
{
RestartContext *rc = ERTS_MAGIC_BIN_DATA(bp);
cleanup_restart_context(rc);
+ return 1;
}
/*
@@ -629,9 +677,15 @@ static Eterm build_exec_return(Process *p, int rc, RestartContext *restartp, Ete
}
} else {
ReturnInfo *ri;
- ReturnInfo defri = {RetIndex,0,{0}};
+ ReturnInfo defri;
if (restartp->ret_info == NULL) {
+ /* OpenBSD 5.8 gcc compiler for some reason creates
+ bad code if the above initialization is done
+ inline with the struct. So don't do that. */
+ defri.type = RetIndex;
+ defri.num_spec = 0;
+ defri.v[0] = 0;
ri = &defri;
} else {
ri = restartp->ret_info;
@@ -1312,17 +1366,17 @@ handle_iolist:
Binary *mbp = erts_create_magic_binary(sizeof(RestartContext),
cleanup_restart_context_bin);
RestartContext *restartp = ERTS_MAGIC_BIN_DATA(mbp);
- Eterm magic_bin;
+ Eterm magic_ref;
Eterm *hp;
memcpy(restartp,&restart,sizeof(RestartContext));
BUMP_ALL_REDS(p);
- hp = HAlloc(p, PROC_BIN_SIZE);
- magic_bin = erts_mk_magic_binary_term(&hp, &MSO(p), mbp);
+ hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE);
+ magic_ref = erts_mk_magic_ref(&hp, &MSO(p), mbp);
BIF_TRAP3(&re_exec_trap_export,
p,
arg1,
arg2 /* To avoid GC of precompiled code, XXX: not utilized yet */,
- magic_bin);
+ magic_ref);
}
res = build_exec_return(p, rc, &restart, arg1);
@@ -1359,9 +1413,7 @@ static BIF_RETTYPE re_exec_trap(BIF_ALIST_3)
Uint loop_limit_tmp;
Eterm res;
- ASSERT(ERTS_TERM_IS_MAGIC_BINARY(BIF_ARG_3));
-
- mbp = ((ProcBin *) binary_val(BIF_ARG_3))->val;
+ mbp = erts_magic_ref2bin(BIF_ARG_3);
ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(mbp)
== cleanup_restart_context_bin);
diff --git a/erts/emulator/beam/erl_bif_timer.c b/erts/emulator/beam/erl_bif_timer.c
deleted file mode 100644
index 03ac97283c..0000000000
--- a/erts/emulator/beam/erl_bif_timer.c
+++ /dev/null
@@ -1,705 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2005-2012. 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%
- */
-
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include "erl_bif_timer.h"
-#include "global.h"
-#include "bif.h"
-#include "error.h"
-#include "big.h"
-#include "erl_thr_progress.h"
-
-/****************************************************************************
-** BIF Timer support
-****************************************************************************/
-
-#define BTM_FLG_SL_TIMER (((Uint32) 1) << 0)
-#define BTM_FLG_CANCELED (((Uint32) 1) << 1)
-#define BTM_FLG_HEAD (((Uint32) 1) << 2)
-#define BTM_FLG_BYNAME (((Uint32) 1) << 3)
-#define BTM_FLG_WRAP (((Uint32) 1) << 4)
-
-struct ErtsBifTimer_ {
- struct {
- union {
- ErtsBifTimer **head;
- ErtsBifTimer *prev;
- } u;
- ErtsBifTimer *next;
- } tab;
- union {
- Eterm name;
- struct {
- ErtsBifTimer *prev;
- ErtsBifTimer *next;
- Process *ess;
- } proc;
- } receiver;
- ErlTimer tm;
- ErlHeapFragment* bp;
- Uint32 flags;
- Eterm message;
- Uint32 ref_numbers[ERTS_REF_NUMBERS];
-};
-
-#ifdef SMALL_MEMORY
-#define TIMER_HASH_VEC_SZ 3331
-#define BTM_PREALC_SZ 10
-#else
-#define TIMER_HASH_VEC_SZ 10007
-#define BTM_PREALC_SZ 100
-#endif
-static ErtsBifTimer **bif_timer_tab;
-static Uint no_bif_timers;
-
-
-static erts_smp_rwmtx_t bif_timer_lock;
-
-#define erts_smp_safe_btm_rwlock(P, L) \
- safe_btm_lock((P), (L), 1)
-#define erts_smp_safe_btm_rlock(P, L) \
- safe_btm_lock((P), (L), 0)
-#define erts_smp_btm_rwlock() \
- erts_smp_rwmtx_rwlock(&bif_timer_lock)
-#define erts_smp_btm_tryrwlock() \
- erts_smp_rwmtx_tryrwlock(&bif_timer_lock)
-#define erts_smp_btm_rwunlock() \
- erts_smp_rwmtx_rwunlock(&bif_timer_lock)
-#define erts_smp_btm_rlock() \
- erts_smp_rwmtx_rlock(&bif_timer_lock)
-#define erts_smp_btm_tryrlock() \
- erts_smp_rwmtx_tryrlock(&bif_timer_lock)
-#define erts_smp_btm_runlock() \
- erts_smp_rwmtx_runlock(&bif_timer_lock)
-#define erts_smp_btm_lock_init() \
- erts_smp_rwmtx_init(&bif_timer_lock, "bif_timers")
-
-
-static ERTS_INLINE int
-safe_btm_lock(Process *c_p, ErtsProcLocks c_p_locks, int rw_lock)
-{
- ASSERT(c_p && c_p_locks);
-#ifdef ERTS_SMP
- if ((rw_lock ? erts_smp_btm_tryrwlock() : erts_smp_btm_tryrlock()) != EBUSY)
- return 0;
- erts_smp_proc_unlock(c_p, c_p_locks);
- if (rw_lock)
- erts_smp_btm_rwlock();
- else
- erts_smp_btm_rlock();
- erts_smp_proc_lock(c_p, c_p_locks);
- if (ERTS_PROC_IS_EXITING(c_p)) {
- if (rw_lock)
- erts_smp_btm_rwunlock();
- else
- erts_smp_btm_runlock();
- return 1;
- }
-#endif
- return 0;
-}
-
-ERTS_SCHED_PREF_PALLOC_IMPL(btm_pre, ErtsBifTimer, BTM_PREALC_SZ)
-
-static ERTS_INLINE int
-get_index(Uint32 *ref_numbers, Uint32 len)
-{
- Uint32 hash;
- /* len can potentially be larger than ERTS_REF_NUMBERS
- if it has visited another node... */
- if (len > ERTS_REF_NUMBERS)
- len = ERTS_REF_NUMBERS;
-
-#if ERTS_REF_NUMBERS != 3
-#error "ERTS_REF_NUMBERS changed. Update me..."
-#endif
- switch (len) {
- case 3: if (!ref_numbers[2]) len = 2;
- case 2: if (!ref_numbers[1]) len = 1;
- default: break;
- }
-
- ASSERT(1 <= len && len <= ERTS_REF_NUMBERS);
-
- hash = block_hash((byte *) ref_numbers, len * sizeof(Uint32), 0x08d12e65);
- return (int) (hash % ((Uint32) TIMER_HASH_VEC_SZ));
-}
-
-static Eterm
-create_ref(Uint *hp, Uint32 *ref_numbers, Uint32 len)
-{
- Uint32 *datap;
- int i;
-
-
- if (len > ERTS_MAX_REF_NUMBERS) {
- /* Such large refs should no be able to appear in the emulator */
- erl_exit(1, "%s:%d: Internal error\n", __FILE__, __LINE__);
- }
-
-#if defined(ARCH_64) && !HALFWORD_HEAP
- hp[0] = make_ref_thing_header(len/2 + 1);
- datap = (Uint32 *) &hp[1];
- *(datap++) = len;
-#else
- hp[0] = make_ref_thing_header(len);
- datap = (Uint32 *) &hp[1];
-#endif
-
- for (i = 0; i < len; i++)
- datap[i] = ref_numbers[i];
-
- return make_internal_ref(hp);
-}
-
-static int
-eq_non_standard_ref_numbers(Uint32 *rn1, Uint32 len1, Uint32 *rn2, Uint32 len2)
-{
-#if defined(ARCH_64) && !HALFWORD_HEAP
-#define MAX_REF_HEAP_SZ (1+(ERTS_MAX_REF_NUMBERS/2+1))
-#else
-#define MAX_REF_HEAP_SZ (1+ERTS_MAX_REF_NUMBERS)
-#endif
- DeclareTmpHeapNoproc(r1_hp,(MAX_REF_HEAP_SZ * 2));
- Eterm *r2_hp = r1_hp +MAX_REF_HEAP_SZ;
-
- return eq(create_ref(r1_hp, rn1, len1), create_ref(r2_hp, rn2, len2));
-#undef MAX_REF_HEAP_SZ
-}
-
-static ERTS_INLINE int
-eq_ref_numbers(Uint32 *rn1, Uint32 len1, Uint32 *rn2, Uint32 len2)
-{
- int res;
- if (len1 != ERTS_REF_NUMBERS || len2 != ERTS_REF_NUMBERS) {
- /* Can potentially happen, but will never... */
- return eq_non_standard_ref_numbers(rn1, len1, rn2, len2);
- }
-
-#if ERTS_REF_NUMBERS != 3
-#error "ERTS_REF_NUMBERS changed. Update me..."
-#endif
- res = rn1[0] == rn2[0] && rn1[1] == rn2[1] && rn1[2] == rn2[2];
-
- ASSERT(res
- ? eq_non_standard_ref_numbers(rn1, len1, rn2, len2)
- : !eq_non_standard_ref_numbers(rn1, len1, rn2, len2));
-
- return res;
-}
-
-static ERTS_INLINE ErtsBifTimer *
-tab_find(Eterm ref)
-{
- Uint32 *ref_numbers = internal_ref_numbers(ref);
- Uint32 ref_numbers_len = internal_ref_no_of_numbers(ref);
- int ix = get_index(ref_numbers, ref_numbers_len);
- ErtsBifTimer* btm;
-
- for (btm = bif_timer_tab[ix]; btm; btm = btm->tab.next)
- if (eq_ref_numbers(ref_numbers, ref_numbers_len,
- btm->ref_numbers, ERTS_REF_NUMBERS))
- return btm;
- return NULL;
-}
-
-static ERTS_INLINE void
-tab_remove(ErtsBifTimer* btm)
-{
- if (btm->flags & BTM_FLG_HEAD) {
- *btm->tab.u.head = btm->tab.next;
- if (btm->tab.next) {
- btm->tab.next->flags |= BTM_FLG_HEAD;
- btm->tab.next->tab.u.head = btm->tab.u.head;
- }
- }
- else {
- btm->tab.u.prev->tab.next = btm->tab.next;
- if (btm->tab.next)
- btm->tab.next->tab.u.prev = btm->tab.u.prev;
- }
- btm->flags |= BTM_FLG_CANCELED;
- ASSERT(no_bif_timers > 0);
- no_bif_timers--;
-}
-
-static ERTS_INLINE void
-tab_insert(ErtsBifTimer* btm)
-{
- int ix = get_index(btm->ref_numbers, ERTS_REF_NUMBERS);
- ErtsBifTimer* btm_list = bif_timer_tab[ix];
-
- if (btm_list) {
- btm_list->flags &= ~BTM_FLG_HEAD;
- btm_list->tab.u.prev = btm;
- }
-
- btm->flags |= BTM_FLG_HEAD;
- btm->tab.u.head = &bif_timer_tab[ix];
- btm->tab.next = btm_list;
- bif_timer_tab[ix] = btm;
- no_bif_timers++;
-}
-
-static ERTS_INLINE void
-link_proc(Process *p, ErtsBifTimer* btm)
-{
- btm->receiver.proc.ess = p;
- btm->receiver.proc.prev = NULL;
- btm->receiver.proc.next = p->u.bif_timers;
- if (p->u.bif_timers)
- p->u.bif_timers->receiver.proc.prev = btm;
- p->u.bif_timers = btm;
-}
-
-static ERTS_INLINE void
-unlink_proc(ErtsBifTimer* btm)
-{
- if (btm->receiver.proc.prev)
- btm->receiver.proc.prev->receiver.proc.next = btm->receiver.proc.next;
- else
- btm->receiver.proc.ess->u.bif_timers = btm->receiver.proc.next;
- if (btm->receiver.proc.next)
- btm->receiver.proc.next->receiver.proc.prev = btm->receiver.proc.prev;
-}
-
-static void
-bif_timer_cleanup(ErtsBifTimer* btm)
-{
- ASSERT(btm);
-
- if (btm->bp)
- free_message_buffer(btm->bp);
-
- if (!btm_pre_free(btm)) {
- if (btm->flags & BTM_FLG_SL_TIMER)
- erts_free(ERTS_ALC_T_SL_BIF_TIMER, (void *) btm);
- else
- erts_free(ERTS_ALC_T_LL_BIF_TIMER, (void *) btm);
- }
-}
-
-static void
-bif_timer_timeout(ErtsBifTimer* btm)
-{
- ASSERT(btm);
-
-
- erts_smp_btm_rwlock();
-
- if (btm->flags & BTM_FLG_CANCELED) {
- /*
- * A concurrent cancel is ongoing. Do not send the timeout message,
- * but cleanup here since the cancel call-back won't be called.
- */
-#ifndef ERTS_SMP
- ASSERT(0);
-#endif
- }
- else {
- ErtsProcLocks rp_locks = 0;
- Process* rp;
-
- tab_remove(btm);
-
- ASSERT(!erts_get_current_process());
-
- if (btm->flags & BTM_FLG_BYNAME)
- rp = erts_whereis_process(NULL, 0, btm->receiver.name, 0, 0);
- else {
- rp = btm->receiver.proc.ess;
- unlink_proc(btm);
- }
-
- if (rp) {
- Eterm message;
- ErlHeapFragment *bp;
-
- bp = btm->bp;
- btm->bp = NULL; /* Prevent cleanup of message buffer... */
-
- if (!(btm->flags & BTM_FLG_WRAP))
- message = btm->message;
- else {
-#if ERTS_REF_NUMBERS != 3
-#error "ERTS_REF_NUMBERS changed. Update me..."
-#endif
- Eterm ref;
- Uint *hp;
- Uint wrap_size = REF_THING_SIZE + 4;
- message = btm->message;
-
- if (!bp) {
- ErlOffHeap *ohp;
- ASSERT(is_immed(message));
- hp = erts_alloc_message_heap(wrap_size,
- &bp,
- &ohp,
- rp,
- &rp_locks);
- } else {
- Eterm old_size = bp->used_size;
- bp = erts_resize_message_buffer(bp, old_size + wrap_size,
- &message, 1);
- hp = &bp->mem[0] + old_size;
- }
-
- write_ref_thing(hp,
- btm->ref_numbers[0],
- btm->ref_numbers[1],
- btm->ref_numbers[2]);
- ref = make_internal_ref(hp);
- hp += REF_THING_SIZE;
- message = TUPLE3(hp, am_timeout, ref, message);
- }
-
- erts_queue_message(rp, &rp_locks, bp, message, NIL
-#ifdef USE_VM_PROBES
- , NIL
-#endif
- );
- erts_smp_proc_unlock(rp, rp_locks);
- }
- }
-
- erts_smp_btm_rwunlock();
-
- bif_timer_cleanup(btm);
-}
-
-static Eterm
-setup_bif_timer(Uint32 xflags,
- Process *c_p,
- Eterm time,
- Eterm receiver,
- Eterm message)
-{
- Process *rp;
- ErtsBifTimer* btm;
- Uint timeout;
- Eterm ref;
- Uint32 *ref_numbers;
-
- if (!term_to_Uint(time, &timeout))
- return THE_NON_VALUE;
-#if defined(ARCH_64) && !HALFWORD_HEAP
- if ((timeout >> 32) != 0)
- return THE_NON_VALUE;
-#endif
- if (is_not_internal_pid(receiver) && is_not_atom(receiver))
- return THE_NON_VALUE;
-
- ref = erts_make_ref(c_p);
-
- if (is_atom(receiver))
- rp = NULL;
- else {
- rp = erts_pid2proc(c_p, ERTS_PROC_LOCK_MAIN,
- receiver, ERTS_PROC_LOCK_MSGQ);
- if (!rp)
- return ref;
- }
-
- if (timeout < ERTS_ALC_MIN_LONG_LIVED_TIME) {
- if (timeout < 1000) {
- btm = btm_pre_alloc();
- if (!btm)
- goto sl_timer_alloc;
- btm->flags = 0;
- }
- else {
- sl_timer_alloc:
- btm = (ErtsBifTimer *) erts_alloc(ERTS_ALC_T_SL_BIF_TIMER,
- sizeof(ErtsBifTimer));
- btm->flags = BTM_FLG_SL_TIMER;
- }
- }
- else {
- btm = (ErtsBifTimer *) erts_alloc(ERTS_ALC_T_LL_BIF_TIMER,
- sizeof(ErtsBifTimer));
- btm->flags = 0;
- }
-
- if (rp) {
- link_proc(rp, btm);
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MSGQ);
- }
- else {
- ASSERT(is_atom(receiver));
- btm->receiver.name = receiver;
- btm->flags |= BTM_FLG_BYNAME;
- }
-
- btm->flags |= xflags;
-
- ref_numbers = internal_ref_numbers(ref);
- ASSERT(internal_ref_no_of_numbers(ref) == 3);
-#if ERTS_REF_NUMBERS != 3
-#error "ERTS_REF_NUMBERS changed. Update me..."
-#endif
- btm->ref_numbers[0] = ref_numbers[0];
- btm->ref_numbers[1] = ref_numbers[1];
- btm->ref_numbers[2] = ref_numbers[2];
-
- ASSERT(eq_ref_numbers(btm->ref_numbers, ERTS_REF_NUMBERS,
- ref_numbers, ERTS_REF_NUMBERS));
-
- if (is_immed(message)) {
- btm->bp = NULL;
- btm->message = message;
- }
- else {
- ErlHeapFragment* bp;
- Eterm* hp;
- Uint size;
-
- size = size_object(message);
- btm->bp = bp = new_message_buffer(size);
- hp = bp->mem;
- btm->message = copy_struct(message, size, &hp, &bp->off_heap);
- }
-
- tab_insert(btm);
- ASSERT(btm == tab_find(ref));
- btm->tm.active = 0; /* MUST be initalized */
- erts_set_timer(&btm->tm,
- (ErlTimeoutProc) bif_timer_timeout,
- (ErlCancelProc) bif_timer_cleanup,
- (void *) btm,
- timeout);
- return ref;
-}
-
-/* send_after(Time, Pid, Message) -> Ref */
-BIF_RETTYPE send_after_3(BIF_ALIST_3)
-{
- Eterm res;
-
- if (erts_smp_safe_btm_rwlock(BIF_P, ERTS_PROC_LOCK_MAIN))
- ERTS_BIF_EXITED(BIF_P);
-
- res = setup_bif_timer(0, BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
-
- erts_smp_btm_rwunlock();
-
- if (is_non_value(res)) {
- BIF_ERROR(BIF_P, BADARG);
- }
- else {
- ASSERT(is_internal_ref(res));
- BIF_RET(res);
- }
-}
-
-/* start_timer(Time, Pid, Message) -> Ref */
-BIF_RETTYPE start_timer_3(BIF_ALIST_3)
-{
- Eterm res;
-
- if (erts_smp_safe_btm_rwlock(BIF_P, ERTS_PROC_LOCK_MAIN))
- ERTS_BIF_EXITED(BIF_P);
-
- res = setup_bif_timer(BTM_FLG_WRAP, BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
-
- erts_smp_btm_rwunlock();
-
- if (is_non_value(res)) {
- BIF_ERROR(BIF_P, BADARG);
- }
- else {
- ASSERT(is_internal_ref(res));
- BIF_RET(res);
- }
-}
-
-/* cancel_timer(Ref) -> false | RemainingTime */
-BIF_RETTYPE cancel_timer_1(BIF_ALIST_1)
-{
- Eterm res;
- ErtsBifTimer *btm;
-
- if (is_not_internal_ref(BIF_ARG_1)) {
- if (is_ref(BIF_ARG_1)) {
- BIF_RET(am_false);
- }
- BIF_ERROR(BIF_P, BADARG);
- }
-
- if (erts_smp_safe_btm_rwlock(BIF_P, ERTS_PROC_LOCK_MAIN))
- ERTS_BIF_EXITED(BIF_P);
-
- btm = tab_find(BIF_ARG_1);
- if (!btm || btm->flags & BTM_FLG_CANCELED) {
- erts_smp_btm_rwunlock();
- res = am_false;
- }
- else {
- Uint left = erts_time_left(&btm->tm);
- if (!(btm->flags & BTM_FLG_BYNAME)) {
- erts_smp_proc_lock(btm->receiver.proc.ess, ERTS_PROC_LOCK_MSGQ);
- unlink_proc(btm);
- erts_smp_proc_unlock(btm->receiver.proc.ess, ERTS_PROC_LOCK_MSGQ);
- }
- tab_remove(btm);
- ASSERT(!tab_find(BIF_ARG_1));
- erts_cancel_timer(&btm->tm);
- erts_smp_btm_rwunlock();
- res = erts_make_integer(left, BIF_P);
- }
-
- BIF_RET(res);
-}
-
-/* read_timer(Ref) -> false | RemainingTime */
-BIF_RETTYPE read_timer_1(BIF_ALIST_1)
-{
- Eterm res;
- ErtsBifTimer *btm;
-
- if (is_not_internal_ref(BIF_ARG_1)) {
- if (is_ref(BIF_ARG_1)) {
- BIF_RET(am_false);
- }
- BIF_ERROR(BIF_P, BADARG);
- }
-
- if (erts_smp_safe_btm_rlock(BIF_P, ERTS_PROC_LOCK_MAIN))
- ERTS_BIF_EXITED(BIF_P);
-
- btm = tab_find(BIF_ARG_1);
- if (!btm || btm->flags & BTM_FLG_CANCELED) {
- res = am_false;
- }
- else {
- Uint left = erts_time_left(&btm->tm);
- res = erts_make_integer(left, BIF_P);
- }
-
- erts_smp_btm_runlock();
-
- BIF_RET(res);
-}
-
-void
-erts_print_bif_timer_info(int to, void *to_arg)
-{
- int i;
- int lock = !ERTS_IS_CRASH_DUMPING;
-
- if (lock)
- erts_smp_btm_rlock();
-
- for (i = 0; i < TIMER_HASH_VEC_SZ; i++) {
- ErtsBifTimer *btm;
- for (btm = bif_timer_tab[i]; btm; btm = btm->tab.next) {
- Eterm receiver = (btm->flags & BTM_FLG_BYNAME
- ? btm->receiver.name
- : btm->receiver.proc.ess->common.id);
- erts_print(to, to_arg, "=timer:%T\n", receiver);
- erts_print(to, to_arg, "Message: %T\n", btm->message);
- erts_print(to, to_arg, "Time left: %u\n",
- erts_time_left(&btm->tm));
- }
- }
-
- if (lock)
- erts_smp_btm_runlock();
-}
-
-
-void
-erts_cancel_bif_timers(Process *p, ErtsProcLocks plocks)
-{
- ErtsBifTimer *btm;
-
- if (erts_smp_btm_tryrwlock() == EBUSY) {
- erts_smp_proc_unlock(p, plocks);
- erts_smp_btm_rwlock();
- erts_smp_proc_lock(p, plocks);
- }
-
- btm = p->u.bif_timers;
- while (btm) {
- ErtsBifTimer *tmp_btm;
- ASSERT(!(btm->flags & BTM_FLG_CANCELED));
- tab_remove(btm);
- tmp_btm = btm;
- btm = btm->receiver.proc.next;
- erts_cancel_timer(&tmp_btm->tm);
- }
-
- p->u.bif_timers = NULL;
-
- erts_smp_btm_rwunlock();
-}
-
-void erts_bif_timer_init(void)
-{
- int i;
- no_bif_timers = 0;
- init_btm_pre_alloc();
- erts_smp_btm_lock_init();
- bif_timer_tab = erts_alloc(ERTS_ALC_T_BIF_TIMER_TABLE,
- sizeof(ErtsBifTimer *)*TIMER_HASH_VEC_SZ);
- for (i = 0; i < TIMER_HASH_VEC_SZ; ++i)
- bif_timer_tab[i] = NULL;
-}
-
-Uint
-erts_bif_timer_memory_size(void)
-{
- Uint res;
- int lock = !ERTS_IS_CRASH_DUMPING;
-
- if (lock)
- erts_smp_btm_rlock();
-
- res = (sizeof(ErtsBifTimer *)*TIMER_HASH_VEC_SZ
- + no_bif_timers*sizeof(ErtsBifTimer));
-
- if (lock)
- erts_smp_btm_runlock();
-
- return res;
-}
-
-
-void
-erts_bif_timer_foreach(void (*func)(Eterm, Eterm, ErlHeapFragment *, void *),
- void *arg)
-{
- int i;
-
- ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
-
- for (i = 0; i < TIMER_HASH_VEC_SZ; i++) {
- ErtsBifTimer *btm;
- for (btm = bif_timer_tab[i]; btm; btm = btm->tab.next) {
- (*func)((btm->flags & BTM_FLG_BYNAME
- ? btm->receiver.name
- : btm->receiver.proc.ess->common.id),
- btm->message,
- btm->bp,
- arg);
- }
- }
-}
diff --git a/erts/emulator/beam/erl_bif_timer.h b/erts/emulator/beam/erl_bif_timer.h
deleted file mode 100644
index 1197c176f5..0000000000
--- a/erts/emulator/beam/erl_bif_timer.h
+++ /dev/null
@@ -1,36 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2005-2009. 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%
- */
-
-
-#ifndef ERL_BIF_TIMER_H__
-#define ERL_BIF_TIMER_H__
-
-typedef struct ErtsBifTimer_ ErtsBifTimer;
-
-#include "sys.h"
-#include "erl_process.h"
-#include "erl_message.h"
-
-Uint erts_bif_timer_memory_size(void);
-void erts_print_bif_timer_info(int to, void *to_arg);
-void erts_cancel_bif_timers(Process *p, ErtsProcLocks plocks);
-void erts_bif_timer_init(void);
-void erts_bif_timer_foreach(void (*func)(Eterm,Eterm,ErlHeapFragment *,void *),
- void *arg);
-#endif
diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c
index 06fbbea123..45159c4392 100644
--- a/erts/emulator/beam/erl_bif_trace.c
+++ b/erts/emulator/beam/erl_bif_trace.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1999-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1999-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -38,6 +39,7 @@
#include "beam_bp.h"
#include "erl_binary.h"
#include "erl_thr_progress.h"
+#include "erl_bif_unique.h"
#define DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1)
@@ -50,7 +52,7 @@ static int erts_default_trace_pattern_is_on;
static Binary *erts_default_match_spec;
static Binary *erts_default_meta_match_spec;
static struct trace_pattern_flags erts_default_trace_pattern_flags;
-static Eterm erts_default_meta_tracer_pid;
+static ErtsTracer erts_default_meta_tracer;
static struct { /* Protected by code write permission */
int current;
@@ -66,6 +68,9 @@ static struct { /* Protected by code write permission */
static Eterm
trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist);
+static int
+erts_set_tracing_event_pattern(Eterm event, Binary*, int on);
+
#ifdef ERTS_SMP
static void smp_bp_finisher(void* arg);
#endif
@@ -73,11 +78,11 @@ static BIF_RETTYPE
system_monitor(Process *p, Eterm monitor_pid, Eterm list);
static void new_seq_trace_token(Process* p); /* help func for seq_trace_2*/
-static int already_traced(Process *p, Process *tracee_p, Eterm tracer);
-static int port_already_traced(Process *p, Port *tracee_port, Eterm tracer);
static Eterm trace_info_pid(Process* p, Eterm pid_spec, Eterm key);
static Eterm trace_info_func(Process* p, Eterm pid_spec, Eterm key);
static Eterm trace_info_on_load(Process* p, Eterm key);
+static Eterm trace_info_event(Process* p, Eterm event, Eterm key);
+
static void reset_bif_trace(void);
static void setup_bif_trace(void);
@@ -85,28 +90,34 @@ static void install_exp_breakpoints(BpFunctions* f);
static void uninstall_exp_breakpoints(BpFunctions* f);
static void clean_export_entries(BpFunctions* f);
+ErtsTracingEvent erts_send_tracing[ERTS_NUM_BP_IX];
+ErtsTracingEvent erts_receive_tracing[ERTS_NUM_BP_IX];
+
void
erts_bif_trace_init(void)
{
+ int i;
+
erts_default_trace_pattern_is_on = 0;
erts_default_match_spec = NULL;
erts_default_meta_match_spec = NULL;
erts_default_trace_pattern_flags = erts_trace_pattern_flags_off;
- erts_default_meta_tracer_pid = NIL;
+ erts_default_meta_tracer = erts_tracer_nil;
+
+ for (i=0; i<ERTS_NUM_BP_IX; i++) {
+ erts_send_tracing[i].on = 1;
+ erts_send_tracing[i].match_spec = NULL;
+ erts_receive_tracing[i].on = 1;
+ erts_receive_tracing[i].match_spec = NULL;
+ }
}
/*
* Turn on/off call tracing for the given function(s).
*/
-
-Eterm
-trace_pattern_2(BIF_ALIST_2)
-{
- return trace_pattern(BIF_P, BIF_ARG_1, BIF_ARG_2, NIL);
-}
Eterm
-trace_pattern_3(BIF_ALIST_3)
+erts_internal_trace_pattern_3(BIF_ALIST_3)
{
return trace_pattern(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
}
@@ -114,7 +125,6 @@ trace_pattern_3(BIF_ALIST_3)
static Eterm
trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist)
{
- DeclareTmpHeap(mfa,3,p); /* Not really heap here, but might be when setting pattern */
int i;
int matches = -1;
int specified = 0;
@@ -123,11 +133,10 @@ trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist)
Eterm l;
struct trace_pattern_flags flags = erts_trace_pattern_flags_off;
int is_global;
- Process *meta_tracer_proc = p;
- Eterm meta_tracer_pid = p->common.id;
+ ErtsTracer meta_tracer = erts_tracer_nil;
if (!erts_try_seize_code_write_permission(p)) {
- ERTS_BIF_YIELD3(bif_export[BIF_trace_pattern_3], p, MFA, Pattern, flaglist);
+ ERTS_BIF_YIELD3(bif_export[BIF_erts_internal_trace_pattern_3], p, MFA, Pattern, flaglist);
}
finish_bp.current = -1;
@@ -144,45 +153,28 @@ trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist)
on = 1;
} else if (Pattern == am_restart) {
match_prog_set = NULL;
- on = erts_break_reset;
+ on = ERTS_BREAK_RESTART;
} else if (Pattern == am_pause) {
match_prog_set = NULL;
- on = erts_break_stop;
- } else if ((match_prog_set = erts_match_set_compile(p, Pattern)) != NULL) {
- MatchSetRef(match_prog_set);
- on = 1;
- } else{
- goto error;
+ on = ERTS_BREAK_PAUSE;
+ } else {
+ match_prog_set = erts_match_set_compile(p, Pattern, MFA);
+ if (match_prog_set) {
+ MatchSetRef(match_prog_set);
+ on = 1;
+ } else{
+ goto error;
+ }
}
is_global = 0;
for(l = flaglist; is_list(l); l = CDR(list_val(l))) {
if (is_tuple(CAR(list_val(l)))) {
- Eterm *tp = tuple_val(CAR(list_val(l)));
-
- if (arityval(tp[0]) != 2 || tp[1] != am_meta) {
- goto error;
- }
- meta_tracer_pid = tp[2];
- if (is_internal_pid(meta_tracer_pid)) {
- meta_tracer_proc = erts_pid2proc(NULL, 0, meta_tracer_pid, 0);
- if (!meta_tracer_proc) {
- goto error;
- }
- } else if (is_internal_port(meta_tracer_pid)) {
- Port *meta_tracer_port;
- meta_tracer_proc = NULL;
- meta_tracer_port = (erts_port_lookup(
- meta_tracer_pid,
- ERTS_PORT_SFLGS_INVALID_TRACER_LOOKUP));
- if (!meta_tracer_port)
- goto error;
- } else {
- goto error;
- }
- if (is_global) {
- goto error;
- }
+ meta_tracer = erts_term_to_tracer(am_meta, CAR(list_val(l)));
+ if (meta_tracer == THE_NON_VALUE) {
+ meta_tracer = erts_tracer_nil;
+ goto error;
+ }
flags.breakpoint = 1;
flags.meta = 1;
} else {
@@ -200,6 +192,8 @@ trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist)
}
flags.breakpoint = 1;
flags.meta = 1;
+ if (ERTS_TRACER_IS_NIL(meta_tracer))
+ meta_tracer = erts_term_to_tracer(THE_NON_VALUE, p->common.id);
break;
case am_global:
if (flags.breakpoint) {
@@ -250,14 +244,11 @@ trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist)
MatchSetUnref(erts_default_meta_match_spec);
erts_default_meta_match_spec = match_prog_set;
MatchSetRef(erts_default_meta_match_spec);
- erts_default_meta_tracer_pid = meta_tracer_pid;
- if (meta_tracer_proc) {
- ERTS_TRACE_FLAGS(meta_tracer_proc) |= F_TRACER;
- }
+ erts_tracer_update(&erts_default_meta_tracer, meta_tracer);
} else if (! flags.breakpoint) {
MatchSetUnref(erts_default_meta_match_spec);
erts_default_meta_match_spec = NULL;
- erts_default_meta_tracer_pid = NIL;
+ ERTS_TRACER_CLEAR(&erts_default_meta_tracer);
}
if (erts_default_trace_pattern_flags.breakpoint &&
flags.breakpoint) {
@@ -316,41 +307,43 @@ trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist)
}
matches = 0;
} else if (is_tuple(MFA)) {
+ ErtsCodeMFA mfa;
Eterm *tp = tuple_val(MFA);
if (tp[0] != make_arityval(3)) {
goto error;
}
- mfa[0] = tp[1];
- mfa[1] = tp[2];
- mfa[2] = tp[3];
- if (!is_atom(mfa[0]) || !is_atom(mfa[1]) ||
- (!is_small(mfa[2]) && mfa[2] != am_Underscore)) {
+ if (!is_atom(tp[1]) || !is_atom(tp[2]) ||
+ (!is_small(tp[3]) && tp[3] != am_Underscore)) {
goto error;
}
- for (i = 0; i < 3 && mfa[i] != am_Underscore; i++, specified++) {
+ for (i = 0; i < 3 && tp[i+1] != am_Underscore; i++, specified++) {
/* Empty loop body */
}
for (i = specified; i < 3; i++) {
- if (mfa[i] != am_Underscore) {
+ if (tp[i+1] != am_Underscore) {
goto error;
}
}
- if (is_small(mfa[2])) {
- mfa[2] = signed_val(mfa[2]);
- }
-
- if (meta_tracer_proc) {
- ERTS_TRACE_FLAGS(meta_tracer_proc) |= F_TRACER;
+ mfa.module = tp[1];
+ mfa.function = tp[2];
+ if (specified == 3) {
+ mfa.arity = signed_val(tp[3]);
}
- matches = erts_set_trace_pattern(p, mfa, specified,
+ matches = erts_set_trace_pattern(p, &mfa, specified,
match_prog_set, match_prog_set,
- on, flags, meta_tracer_pid, 0);
+ on, flags, meta_tracer, 0);
+ } else if (is_atom(MFA)) {
+ if (is_global || flags.breakpoint || on > ERTS_BREAK_SET) {
+ goto error;
+ }
+ matches = erts_set_tracing_event_pattern(MFA, match_prog_set, on);
}
error:
MatchSetUnref(match_prog_set);
- UnUseTmpHeap(3,p);
+
+ ERTS_TRACER_CLEAR(&meta_tracer);
#ifdef ERTS_SMP
if (finish_bp.current >= 0) {
@@ -358,7 +351,7 @@ trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist)
ASSERT(finish_bp.stager == NULL);
finish_bp.stager = p;
erts_schedule_thr_prgr_later_op(smp_bp_finisher, NULL, &finish_bp.lop);
- erts_smp_proc_inc_refc(p);
+ erts_proc_inc_refc(p);
erts_suspend(p, ERTS_PROC_LOCK_MAIN, NULL);
ERTS_BIF_YIELD_RETURN(p, make_small(matches));
}
@@ -392,7 +385,7 @@ static void smp_bp_finisher(void* null)
erts_resume(p, ERTS_PROC_LOCK_STATUS);
}
erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
- erts_smp_proc_dec_refc(p);
+ erts_proc_dec_refc(p);
}
}
#endif /* ERTS_SMP */
@@ -402,7 +395,7 @@ erts_get_default_trace_pattern(int *trace_pattern_is_on,
Binary **match_spec,
Binary **meta_match_spec,
struct trace_pattern_flags *trace_pattern_flags,
- Eterm *meta_tracer_pid)
+ ErtsTracer *meta_tracer)
{
ERTS_SMP_LC_ASSERT(erts_has_code_write_permission() ||
erts_smp_thr_progress_is_blocking());
@@ -414,8 +407,8 @@ erts_get_default_trace_pattern(int *trace_pattern_is_on,
*meta_match_spec = erts_default_meta_match_spec;
if (trace_pattern_flags)
*trace_pattern_flags = erts_default_trace_pattern_flags;
- if (meta_tracer_pid)
- *meta_tracer_pid = erts_default_meta_tracer_pid;
+ if (meta_tracer)
+ *meta_tracer = erts_default_meta_tracer;
}
int erts_is_default_trace_enabled(void)
@@ -429,6 +422,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;
@@ -437,7 +433,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;
@@ -461,12 +456,12 @@ erts_trace_flag2bit(Eterm flag)
** occurred in the argument list.
*/
int
-erts_trace_flags(Eterm List,
- Uint *pMask, Eterm *pTracer, int *pCpuTimestamp)
+erts_trace_flags(Eterm List,
+ Uint *pMask, ErtsTracer *pTracer, int *pCpuTimestamp)
{
Eterm list = List;
Uint mask = 0;
- Eterm tracer = NIL;
+ ErtsTracer tracer = erts_tracer_nil;
int cpu_timestamp = 0;
while (is_list(list)) {
@@ -479,33 +474,72 @@ erts_trace_flags(Eterm List,
cpu_timestamp = !0;
#endif
} else if (is_tuple(item)) {
- Eterm* tp = tuple_val(item);
-
- if (arityval(tp[0]) != 2 || tp[1] != am_tracer) goto error;
- if (is_internal_pid(tp[2]) || is_internal_port(tp[2])) {
- tracer = tp[2];
- } else goto error;
+ tracer = erts_term_to_tracer(am_tracer, item);
+ if (tracer == THE_NON_VALUE)
+ goto error;
} else goto error;
list = CDR(list_val(list));
}
if (is_not_nil(list)) goto error;
- if (pMask && mask) *pMask = mask;
- if (pTracer && tracer != NIL) *pTracer = tracer;
- if (pCpuTimestamp && cpu_timestamp) *pCpuTimestamp = cpu_timestamp;
+ if (pMask && mask) *pMask = mask;
+ if (pTracer && !ERTS_TRACER_IS_NIL(tracer)) *pTracer = tracer;
+ if (pCpuTimestamp && cpu_timestamp) *pCpuTimestamp = cpu_timestamp;
return !0;
error:
return 0;
}
-Eterm trace_3(BIF_ALIST_3)
+static ERTS_INLINE int
+start_trace(Process *c_p, ErtsTracer tracer,
+ ErtsPTabElementCommon *common,
+ int on, int mask)
+{
+ /* We can use the common part of both port+proc without checking what it is
+ In the code below port is used for both proc and port */
+ Port *port = (Port*)common;
+
+ /*
+ * SMP build assumes that either system is blocked or:
+ * * main lock is held on c_p
+ * * all locks are held on port common
+ */
+
+ if (!ERTS_TRACER_IS_NIL(tracer)) {
+ if ((ERTS_TRACE_FLAGS(port) & TRACEE_FLAGS)
+ && !ERTS_TRACER_COMPARE(ERTS_TRACER(port), tracer)) {
+ /* This tracee is already being traced, and not by the
+ * tracer to be */
+ if (erts_is_tracer_enabled(ERTS_TRACER(port), common)) {
+ /* The tracer is still in use */
+ return 1;
+ }
+ /* Current tracer now invalid */
+ }
+ }
+
+ if (on)
+ ERTS_TRACE_FLAGS(port) |= mask;
+ else
+ ERTS_TRACE_FLAGS(port) &= ~mask;
+
+ if ((ERTS_TRACE_FLAGS(port) & TRACEE_FLAGS) == 0) {
+ tracer = erts_tracer_nil;
+ erts_tracer_replace(common, erts_tracer_nil);
+ } else if (!ERTS_TRACER_IS_NIL(tracer))
+ erts_tracer_replace(common, tracer);
+
+ return 0;
+}
+
+Eterm erts_internal_trace_3(BIF_ALIST_3)
{
Process* p = BIF_P;
Eterm pid_spec = BIF_ARG_1;
Eterm how = BIF_ARG_2;
Eterm list = BIF_ARG_3;
int on;
- Eterm tracer = NIL;
+ ErtsTracer tracer = erts_tracer_nil;
int matches = 0;
Uint mask = 0;
int cpu_ts = 0;
@@ -518,41 +552,24 @@ Eterm trace_3(BIF_ALIST_3)
}
if (!erts_try_seize_code_write_permission(BIF_P)) {
- ERTS_BIF_YIELD3(bif_export[BIF_trace_3], BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+ ERTS_BIF_YIELD3(bif_export[BIF_erts_internal_trace_3],
+ BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
}
- if (is_nil(tracer) || is_internal_pid(tracer)) {
- Process *tracer_proc = erts_pid2proc(p,
- ERTS_PROC_LOCK_MAIN,
- is_nil(tracer) ? p->common.id : tracer,
- ERTS_PROC_LOCKS_ALL);
- if (!tracer_proc)
- goto error;
- ERTS_TRACE_FLAGS(tracer_proc) |= F_TRACER;
- erts_smp_proc_unlock(tracer_proc,
- (tracer_proc == p
- ? ERTS_PROC_LOCKS_ALL_MINOR
- : ERTS_PROC_LOCKS_ALL));
- } else if (is_internal_port(tracer)) {
- Port *tracer_port = erts_id2port_sflgs(tracer,
- p,
- ERTS_PROC_LOCK_MAIN,
- ERTS_PORT_SFLGS_INVALID_TRACER_LOOKUP);
- if (!tracer_port)
- goto error;
- ERTS_TRACE_FLAGS(tracer_port) |= F_TRACER;
- erts_port_release(tracer_port);
- } else
- goto error;
-
switch (how) {
case am_false:
on = 0;
break;
case am_true:
on = 1;
- if (is_nil(tracer))
- tracer = p->common.id;
+ if (ERTS_TRACER_IS_NIL(tracer))
+ tracer = erts_term_to_tracer(am_tracer, p->common.id);
+
+ if (tracer == THE_NON_VALUE) {
+ tracer = erts_tracer_nil;
+ goto error;
+ }
+
break;
default:
goto error;
@@ -571,34 +588,20 @@ Eterm trace_3(BIF_ALIST_3)
}
#endif
- if (pid_spec == tracer)
- goto error;
-
tracee_port = erts_id2port_sflgs(pid_spec,
p,
ERTS_PROC_LOCK_MAIN,
ERTS_PORT_SFLGS_INVALID_LOOKUP);
+
if (!tracee_port)
goto error;
-
- if (tracer != NIL && port_already_traced(p, tracee_port, tracer)) {
+
+ if (start_trace(p, tracer, &tracee_port->common, on, mask)) {
erts_port_release(tracee_port);
goto already_traced;
- }
-
- if (on)
- 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)
- ERTS_TRACER_PROC(tracee_port) = tracer;
-
- erts_port_release(tracee_port);
-
- matches = 1;
+ }
+ erts_port_release(tracee_port);
+ matches = 1;
} else if (is_pid(pid_spec)) {
Process *tracee_p;
@@ -611,33 +614,19 @@ Eterm trace_3(BIF_ALIST_3)
* and not about to be tracing.
*/
- if (pid_spec == tracer)
- goto error;
-
tracee_p = erts_pid2proc(p, ERTS_PROC_LOCK_MAIN,
pid_spec, ERTS_PROC_LOCKS_ALL);
if (!tracee_p)
goto error;
- if (tracer != NIL && already_traced(p, tracee_p, tracer)) {
+ if (start_trace(tracee_p, tracer, &tracee_p->common, on, mask)) {
erts_smp_proc_unlock(tracee_p,
(tracee_p == p
? ERTS_PROC_LOCKS_ALL_MINOR
: ERTS_PROC_LOCKS_ALL));
goto already_traced;
- }
-
- if (on)
- ERTS_TRACE_FLAGS(tracee_p) |= mask;
- else
- ERTS_TRACE_FLAGS(tracee_p) &= ~mask;
-
- if ((ERTS_TRACE_FLAGS(tracee_p) & TRACEE_FLAGS) == 0)
- ERTS_TRACER_PROC(tracee_p) = NIL;
- else if (tracer != NIL)
- ERTS_TRACER_PROC(tracee_p) = tracer;
-
- erts_smp_proc_unlock(tracee_p,
+ }
+ erts_smp_proc_unlock(tracee_p,
(tracee_p == p
? ERTS_PROC_LOCKS_ALL_MINOR
: ERTS_PROC_LOCKS_ALL));
@@ -651,7 +640,7 @@ Eterm trace_3(BIF_ALIST_3)
if (pid_spec == am_all) {
if (on) {
if (!erts_cpu_timestamp) {
-#ifdef HAVE_CLOCK_GETTIME
+#ifdef HAVE_CLOCK_GETTIME_CPU_TIME
/*
Perhaps clock_gettime was found during config
on a different machine than this. We check
@@ -678,7 +667,7 @@ Eterm trace_3(BIF_ALIST_3)
if (erts_start_now_cpu() < 0) {
goto error;
}
-#endif /* HAVE_CLOCK_GETTIME */
+#endif /* HAVE_CLOCK_GETTIME_CPU_TIME */
erts_cpu_timestamp = !0;
}
}
@@ -688,18 +677,27 @@ Eterm trace_3(BIF_ALIST_3)
}
#endif
- if (pid_spec == am_all || pid_spec == am_existing) {
+ if (pid_spec == am_all || pid_spec == am_existing ||
+ pid_spec == am_ports || pid_spec == am_processes ||
+ pid_spec == am_existing_ports || pid_spec == am_existing_processes
+ ) {
int i;
int procs = 0;
int ports = 0;
int mods = 0;
if (mask & (ERTS_PROC_TRACEE_FLAGS & ~ERTS_TRACEE_MODIFIER_FLAGS))
- procs = 1;
+ procs = pid_spec != am_ports && pid_spec != am_existing_ports;
if (mask & (ERTS_PORT_TRACEE_FLAGS & ~ERTS_TRACEE_MODIFIER_FLAGS))
- ports = 1;
- if (mask & ERTS_TRACEE_MODIFIER_FLAGS)
- mods = 1;
+ ports = pid_spec != am_processes && pid_spec != am_existing_processes;
+ if (mask & ERTS_TRACEE_MODIFIER_FLAGS) {
+ if (pid_spec == am_ports || pid_spec == am_existing_ports)
+ ports = 1;
+ else if (pid_spec == am_processes || pid_spec == am_existing_processes)
+ procs = 1;
+ else
+ mods = 1;
+ }
#ifdef ERTS_SMP
erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN);
@@ -715,23 +713,8 @@ Eterm trace_3(BIF_ALIST_3)
Process* tracee_p = erts_pix2proc(i);
if (! tracee_p)
continue;
- if (tracer != NIL) {
- if (tracee_p->common.id == tracer)
- continue;
- if (already_traced(NULL, tracee_p, tracer))
- continue;
- }
- if (on) {
- ERTS_TRACE_FLAGS(tracee_p) |= mask;
- } else {
- ERTS_TRACE_FLAGS(tracee_p) &= ~mask;
- }
- if(!(ERTS_TRACE_FLAGS(tracee_p) & TRACEE_FLAGS)) {
- ERTS_TRACER_PROC(tracee_p) = NIL;
- } else if (tracer != NIL) {
- ERTS_TRACER_PROC(tracee_p) = tracer;
- }
- matches++;
+ if (!start_trace(p, tracer, &tracee_p->common, on, mask))
+ matches++;
}
}
if (ports || mods) {
@@ -745,33 +728,26 @@ Eterm trace_3(BIF_ALIST_3)
state = erts_atomic32_read_nob(&tracee_port->state);
if (state & ERTS_PORT_SFLGS_DEAD)
continue;
- if (tracer != NIL) {
- if (tracee_port->common.id == tracer)
- continue;
- if (port_already_traced(NULL, tracee_port, tracer))
- continue;
- }
-
- if (on) ERTS_TRACE_FLAGS(tracee_port) |= mask;
- else ERTS_TRACE_FLAGS(tracee_port) &= ~mask;
-
- if (!(ERTS_TRACE_FLAGS(tracee_port) & TRACEE_FLAGS)) {
- ERTS_TRACER_PROC(tracee_port) = NIL;
- } else if (tracer != NIL) {
- ERTS_TRACER_PROC(tracee_port) = tracer;
- }
- /* matches are not counted for ports since it would violate compatibility */
- /* This could be a reason to modify this function or make a new one. */
+ if (!start_trace(p, tracer, &tracee_port->common, on, mask))
+ matches++;
}
}
}
- if (pid_spec == am_all || pid_spec == am_new) {
- Uint def_flags = mask;
- Eterm def_tracer = tracer;
+ if (pid_spec == am_all || pid_spec == am_new
+ || pid_spec == am_ports || pid_spec == am_processes
+ || pid_spec == am_new_ports || pid_spec == am_new_processes
+ ) {
ok = 1;
- erts_change_default_tracing(on, &def_flags, &def_tracer);
+ if (mask & ERTS_PROC_TRACEE_FLAGS &&
+ pid_spec != am_ports && pid_spec != am_new_ports)
+ erts_change_default_proc_tracing(
+ on, mask & ERTS_PROC_TRACEE_FLAGS, tracer);
+ if (mask & ERTS_PORT_TRACEE_FLAGS &&
+ pid_spec != am_processes && pid_spec != am_new_processes)
+ erts_change_default_port_tracing(
+ on, mask & ERTS_PORT_TRACEE_FLAGS, tracer);
#ifdef HAVE_ERTS_NOW_CPU
if (cpu_ts && !on) {
@@ -797,6 +773,7 @@ Eterm trace_3(BIF_ALIST_3)
}
#endif
erts_release_code_write_permission();
+ ERTS_TRACER_CLEAR(&tracer);
BIF_RET(make_small(matches));
@@ -806,6 +783,8 @@ Eterm trace_3(BIF_ALIST_3)
error:
+ ERTS_TRACER_CLEAR(&tracer);
+
#ifdef ERTS_SMP
if (system_blocked) {
erts_smp_thr_progress_unblock();
@@ -817,88 +796,6 @@ Eterm trace_3(BIF_ALIST_3)
BIF_ERROR(p, BADARG);
}
-/* Check that the process to be traced is not already traced
- * by a valid other tracer than the tracer to be.
- */
-static int port_already_traced(Process *c_p, Port *tracee_port, Eterm tracer)
-{
- /*
- * SMP build assumes that either system is blocked or:
- * * main lock is held on c_p
- * * all locks are held on port tracee_p
- */
- if ((ERTS_TRACE_FLAGS(tracee_port) & TRACEE_FLAGS)
- && ERTS_TRACER_PROC(tracee_port) != tracer) {
- /* This tracee is already being traced, and not by the
- * tracer to be */
- if (is_internal_port(ERTS_TRACER_PROC(tracee_port))) {
- if (!erts_is_valid_tracer_port(ERTS_TRACER_PROC(tracee_port))) {
- /* Current trace port now invalid
- * - discard it and approve the new. */
- goto remove_tracer;
- } else
- return 1;
- }
- else if(is_internal_pid(ERTS_TRACER_PROC(tracee_port))) {
- Process *tracer_p = erts_proc_lookup(ERTS_TRACER_PROC(tracee_port));
- if (!tracer_p) {
- /* Current trace process now invalid
- * - discard it and approve the new. */
- goto remove_tracer;
- } else
- return 1;
- }
- else {
- remove_tracer:
- ERTS_TRACE_FLAGS(tracee_port) &= ~TRACEE_FLAGS;
- ERTS_TRACER_PROC(tracee_port) = NIL;
- }
- }
- return 0;
-}
-
-/* Check that the process to be traced is not already traced
- * by a valid other tracer than the tracer to be.
- */
-static int already_traced(Process *c_p, Process *tracee_p, Eterm tracer)
-{
- /*
- * SMP build assumes that either system is blocked or:
- * * main lock is held on c_p
- * * all locks multiple are held on tracee_p
- */
- if ((ERTS_TRACE_FLAGS(tracee_p) & TRACEE_FLAGS)
- && ERTS_TRACER_PROC(tracee_p) != tracer) {
- /* This tracee is already being traced, and not by the
- * tracer to be */
- if (is_internal_port(ERTS_TRACER_PROC(tracee_p))) {
- if (!erts_is_valid_tracer_port(ERTS_TRACER_PROC(tracee_p))) {
- /* Current trace port now invalid
- * - discard it and approve the new. */
- goto remove_tracer;
- } else
- return 1;
- }
- else if(is_internal_pid(ERTS_TRACER_PROC(tracee_p))) {
- Process *tracer_p;
-
- tracer_p = erts_proc_lookup(ERTS_TRACER_PROC(tracee_p));
- if (!tracer_p) {
- /* Current trace process now invalid
- * - discard it and approve the new. */
- goto remove_tracer;
- } else
- return 1;
- }
- else {
- remove_tracer:
- ERTS_TRACE_FLAGS(tracee_p) &= ~TRACEE_FLAGS;
- ERTS_TRACER_PROC(tracee_p) = NIL;
- }
- }
- return 0;
-}
-
/*
* Return information about a process or an external function being traced.
*/
@@ -916,7 +813,9 @@ Eterm trace_info_2(BIF_ALIST_2)
if (What == am_on_load) {
res = trace_info_on_load(p, Key);
- } else if (is_atom(What) || is_pid(What)) {
+ } else if (What == am_send || What == am_receive) {
+ res = trace_info_event(p, What, Key);
+ } else if (is_atom(What) || is_pid(What) || is_port(What)) {
res = trace_info_pid(p, What, Key);
} else if (is_tuple(What)) {
res = trace_info_func(p, What, Key);
@@ -932,41 +831,54 @@ static Eterm
trace_info_pid(Process* p, Eterm pid_spec, Eterm key)
{
Eterm tracer;
- Uint trace_flags;
+ Uint trace_flags = am_false;
Eterm* hp;
- if (pid_spec == am_new) {
- erts_get_default_tracing(&trace_flags, &tracer);
+ if (pid_spec == am_new || pid_spec == am_new_processes) {
+ ErtsTracer def_tracer;
+ erts_get_default_proc_tracing(&trace_flags, &def_tracer);
+ tracer = erts_tracer_to_term(p, def_tracer);
+ ERTS_TRACER_CLEAR(&def_tracer);
+ } else if (pid_spec == am_new_ports) {
+ ErtsTracer def_tracer;
+ erts_get_default_port_tracing(&trace_flags, &def_tracer);
+ tracer = erts_tracer_to_term(p, def_tracer);
+ ERTS_TRACER_CLEAR(&def_tracer);
+ } else if (is_internal_port(pid_spec)) {
+ Port *tracee;
+ tracee = erts_id2port_sflgs(pid_spec, p, ERTS_PROC_LOCK_MAIN,
+ ERTS_PORT_SFLGS_INVALID_LOOKUP);
+
+ if (!tracee)
+ return am_undefined;
+
+ if (!ERTS_TRACER_IS_NIL(ERTS_TRACER(tracee)))
+ erts_is_tracer_proc_enabled(NULL, 0, &tracee->common);
+
+ tracer = erts_tracer_to_term(p, ERTS_TRACER(tracee));
+ trace_flags = ERTS_TRACE_FLAGS(tracee);
+
+ erts_port_release(tracee);
+
} else if (is_internal_pid(pid_spec)) {
- Process *tracee;
- tracee = erts_pid2proc(p, ERTS_PROC_LOCK_MAIN,
- pid_spec, ERTS_PROC_LOCKS_ALL);
+ Process *tracee = erts_pid2proc_not_running(p, ERTS_PROC_LOCK_MAIN,
+ pid_spec, ERTS_PROC_LOCK_MAIN);
- if (!tracee) {
+ if (tracee == ERTS_PROC_LOCK_BUSY)
+ ERTS_BIF_YIELD2(bif_export[BIF_trace_info_2], p, pid_spec, key);
+
+ if (!tracee)
return am_undefined;
- } else {
- tracer = ERTS_TRACER_PROC(tracee);
- trace_flags = ERTS_TRACE_FLAGS(tracee);
- }
- if (is_internal_pid(tracer)) {
- if (!erts_proc_lookup(tracer)) {
- reset_tracer:
- ERTS_TRACE_FLAGS(tracee) &= ~TRACEE_FLAGS;
- trace_flags = ERTS_TRACE_FLAGS(tracee);
- tracer = ERTS_TRACER_PROC(tracee) = NIL;
- }
- }
- else if (is_internal_port(tracer)) {
- if (!erts_is_valid_tracer_port(tracer))
- goto reset_tracer;
- }
-#ifdef ERTS_SMP
- erts_smp_proc_unlock(tracee,
- (tracee == p
- ? ERTS_PROC_LOCKS_ALL_MINOR
- : ERTS_PROC_LOCKS_ALL));
-#endif
+ if (!ERTS_TRACER_IS_NIL(ERTS_TRACER(tracee)))
+ erts_is_tracer_proc_enabled(tracee, ERTS_PROC_LOCK_MAIN,
+ &tracee->common);
+
+ tracer = erts_tracer_to_term(p, ERTS_TRACER(tracee));
+ trace_flags = ERTS_TRACE_FLAGS(tracee);
+
+ if (tracee != p)
+ erts_smp_proc_unlock(tracee, ERTS_PROC_LOCK_MAIN);
} else if (is_external_pid(pid_spec)
&& external_pid_dist_entry(pid_spec) == erts_this_dist_entry) {
return am_undefined;
@@ -976,7 +888,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;
@@ -994,6 +906,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);
@@ -1005,7 +920,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);
@@ -1018,8 +932,10 @@ trace_info_pid(Process* p, Eterm pid_spec, Eterm key)
HRelease(p,limit,hp+3);
return TUPLE2(hp, key, flag_list);
} else if (key == am_tracer) {
- hp = HAlloc(p, 3);
- return TUPLE2(hp, key, tracer); /* Local pid or port */
+ if (tracer == am_false)
+ tracer = NIL;
+ hp = HAlloc(p, 3);
+ return TUPLE2(hp, key, tracer);
} else {
goto error;
}
@@ -1048,22 +964,23 @@ trace_info_pid(Process* p, Eterm pid_spec, Eterm key)
*/
static int function_is_traced(Process *p,
Eterm mfa[3],
- Binary **ms, /* out */
- Binary **ms_meta, /* out */
- Eterm *tracer_pid_meta, /* out */
- Uint *count, /* out */
- Eterm *call_time) /* out */
+ Binary **ms, /* out */
+ Binary **ms_meta, /* out */
+ ErtsTracer *tracer_pid_meta, /* out */
+ Uint *count, /* out */
+ Eterm *call_time) /* out */
{
Export e;
Export* ep;
BeamInstr* pc;
+ ErtsCodeInfo *ci;
/* First look for an export entry */
- e.code[0] = mfa[0];
- e.code[1] = mfa[1];
- e.code[2] = mfa[2];
+ e.info.mfa.module = mfa[0];
+ e.info.mfa.function = mfa[1];
+ e.info.mfa.arity = mfa[2];
if ((ep = export_get(&e)) != NULL) {
- pc = ep->code+3;
+ pc = ep->beam;
if (ep->addressv[erts_active_code_ix()] == pc &&
*pc != (BeamInstr) em_call_error_handler) {
@@ -1072,17 +989,17 @@ static int function_is_traced(Process *p,
ASSERT(*pc == (BeamInstr) em_apply_bif ||
*pc == (BeamInstr) BeamOp(op_i_generic_breakpoint));
- if (erts_is_trace_break(pc, ms, 0)) {
+ if (erts_is_trace_break(&ep->info, ms, 0)) {
return FUNC_TRACE_GLOBAL_TRACE;
}
- if (erts_is_trace_break(pc, ms, 1)) {
+ if (erts_is_trace_break(&ep->info, ms, 1)) {
r |= FUNC_TRACE_LOCAL_TRACE;
}
- if (erts_is_mtrace_break(pc, ms_meta, tracer_pid_meta)) {
+ if (erts_is_mtrace_break(&ep->info, ms_meta, tracer_pid_meta)) {
r |= FUNC_TRACE_META_TRACE;
}
- if (erts_is_time_break(p, pc, call_time)) {
+ if (erts_is_time_break(p, &ep->info, call_time)) {
r |= FUNC_TRACE_TIME_TRACE;
}
return r ? r : FUNC_TRACE_UNTRACED;
@@ -1090,15 +1007,15 @@ static int function_is_traced(Process *p,
}
/* OK, now look for breakpoint tracing */
- if ((pc = erts_find_local_func(mfa)) != NULL) {
+ if ((ci = erts_find_local_func(&e.info.mfa)) != NULL) {
int r =
- (erts_is_trace_break(pc, ms, 1)
+ (erts_is_trace_break(ci, ms, 1)
? FUNC_TRACE_LOCAL_TRACE : 0)
- | (erts_is_mtrace_break(pc, ms_meta, tracer_pid_meta)
+ | (erts_is_mtrace_break(ci, ms_meta, tracer_pid_meta)
? FUNC_TRACE_META_TRACE : 0)
- | (erts_is_count_break(pc, count)
+ | (erts_is_count_break(ci, count)
? FUNC_TRACE_COUNT_TRACE : 0)
- | (erts_is_time_break(p, pc, call_time)
+ | (erts_is_time_break(p, ci, call_time)
? FUNC_TRACE_TIME_TRACE : 0);
return r ? r : FUNC_TRACE_UNTRACED;
@@ -1117,7 +1034,7 @@ trace_info_func(Process* p, Eterm func_spec, Eterm key)
Eterm traced = am_false;
Eterm match_spec = am_false;
Eterm retval = am_false;
- Eterm meta = am_false;
+ ErtsTracer meta = erts_tracer_nil;
Eterm call_time = NIL;
int r;
@@ -1144,9 +1061,16 @@ trace_info_func(Process* p, Eterm func_spec, Eterm key)
erts_smp_thr_progress_block();
}
#endif
+#ifdef ERTS_DIRTY_SCHEDULERS
+ erts_smp_mtx_lock(&erts_dirty_bp_ix_mtx);
+#endif
+
r = function_is_traced(p, mfa, &ms, &ms_meta, &meta, &count, &call_time);
+#ifdef ERTS_DIRTY_SCHEDULERS
+ erts_smp_mtx_unlock(&erts_dirty_bp_ix_mtx);
+#endif
#ifdef ERTS_SMP
if ( (key == am_call_time) || (key == am_all)) {
erts_smp_thr_progress_unblock();
@@ -1187,7 +1111,10 @@ trace_info_func(Process* p, Eterm func_spec, Eterm key)
retval = match_spec;
break;
case am_meta:
- retval = meta;
+ retval = erts_tracer_to_term(p, meta);
+ if (retval == am_false)
+ /* backwards compatibility */
+ retval = NIL;
break;
case am_meta_match_spec:
if (r & FUNC_TRACE_META_TRACE) {
@@ -1210,7 +1137,8 @@ trace_info_func(Process* p, Eterm func_spec, Eterm key)
}
break;
case am_all: {
- Eterm match_spec_meta = am_false, c = am_false, t, ct = am_false;
+ Eterm match_spec_meta = am_false, c = am_false, t, ct = am_false,
+ m = am_false;
if (ms) {
match_spec = MatchSetGetSource(ms);
@@ -1229,6 +1157,9 @@ trace_info_func(Process* p, Eterm func_spec, Eterm key)
if (r & FUNC_TRACE_TIME_TRACE) {
ct = call_time;
}
+
+ m = erts_tracer_to_term(p, meta);
+
hp = HAlloc(p, (3+2)*6);
retval = NIL;
t = TUPLE2(hp, am_call_count, c); hp += 3;
@@ -1237,7 +1168,7 @@ trace_info_func(Process* p, Eterm func_spec, Eterm key)
retval = CONS(hp, t, retval); hp += 2;
t = TUPLE2(hp, am_meta_match_spec, match_spec_meta); hp += 3;
retval = CONS(hp, t, retval); hp += 2;
- t = TUPLE2(hp, am_meta, meta); hp += 3;
+ t = TUPLE2(hp, am_meta, m); hp += 3;
retval = CONS(hp, t, retval); hp += 2;
t = TUPLE2(hp, am_match_spec, match_spec); hp += 3;
retval = CONS(hp, t, retval); hp += 2;
@@ -1300,7 +1231,8 @@ trace_info_on_load(Process* p, Eterm key)
case am_meta:
hp = HAlloc(p, 3);
if (erts_default_trace_pattern_flags.meta) {
- return TUPLE2(hp, key, erts_default_meta_tracer_pid);
+ ASSERT(!ERTS_TRACER_IS_NIL(erts_default_meta_tracer));
+ return TUPLE2(hp, key, erts_tracer_to_term(p, erts_default_meta_tracer));
} else {
return TUPLE2(hp, key, am_false);
}
@@ -1339,7 +1271,7 @@ trace_info_on_load(Process* p, Eterm key)
}
case am_all:
{
- Eterm match_spec = am_false, meta_match_spec = am_false, r = NIL, t;
+ Eterm match_spec = am_false, meta_match_spec = am_false, r = NIL, t, m;
if (erts_default_trace_pattern_flags.local ||
(! erts_default_trace_pattern_flags.breakpoint)) {
@@ -1357,6 +1289,8 @@ trace_info_on_load(Process* p, Eterm key)
MatchSetGetSource(erts_default_meta_match_spec);
meta_match_spec = copy_object(meta_match_spec, p);
}
+ m = (erts_default_trace_pattern_flags.meta
+ ? erts_tracer_to_term(p, erts_default_meta_tracer) : am_false);
hp = HAlloc(p, (3+2)*5 + 3);
t = TUPLE2(hp, am_call_count,
(erts_default_trace_pattern_flags.call_count
@@ -1364,9 +1298,7 @@ trace_info_on_load(Process* p, Eterm key)
r = CONS(hp, t, r); hp += 2;
t = TUPLE2(hp, am_meta_match_spec, meta_match_spec); hp += 3;
r = CONS(hp, t, r); hp += 2;
- t = TUPLE2(hp, am_meta,
- (erts_default_trace_pattern_flags.meta
- ? erts_default_meta_tracer_pid : am_false)); hp += 3;
+ t = TUPLE2(hp, am_meta, m); hp += 3;
r = CONS(hp, t, r); hp += 2;
t = TUPLE2(hp, am_match_spec, match_spec); hp += 3;
r = CONS(hp, t, r); hp += 2;
@@ -1382,16 +1314,52 @@ trace_info_on_load(Process* p, Eterm key)
}
}
+static Eterm
+trace_info_event(Process* p, Eterm event, Eterm key)
+{
+ ErtsTracingEvent* te;
+ Eterm retval;
+ Eterm* hp;
+
+ switch (event) {
+ case am_send: te = erts_send_tracing; break;
+ case am_receive: te = erts_receive_tracing; break;
+ default:
+ goto error;
+ }
+
+ if (key != am_match_spec)
+ goto error;
+
+ te = &te[erts_active_bp_ix()];
+
+ if (te->on) {
+ if (!te->match_spec)
+ retval = am_true;
+ else
+ retval = copy_object(MatchSetGetSource(te->match_spec), p);
+ }
+ else
+ retval = am_false;
+
+ hp = HAlloc(p, 3);
+ return TUPLE2(hp, key, retval);
+
+ error:
+ BIF_ERROR(p, BADARG);
+}
+
+
#undef FUNC_TRACE_NOEXIST
#undef FUNC_TRACE_UNTRACED
#undef FUNC_TRACE_GLOBAL_TRACE
#undef FUNC_TRACE_LOCAL_TRACE
int
-erts_set_trace_pattern(Process*p, Eterm* mfa, int specified,
+erts_set_trace_pattern(Process*p, ErtsCodeMFA *mfa, int specified,
Binary* match_prog_set, Binary *meta_match_prog_set,
int on, struct trace_pattern_flags flags,
- Eterm meta_tracer_pid, int is_blocking)
+ ErtsTracer meta_tracer, int is_blocking)
{
const ErtsCodeIndex code_ix = erts_active_code_ix();
int matches = 0;
@@ -1408,22 +1376,23 @@ erts_set_trace_pattern(Process*p, Eterm* mfa, int specified,
n = finish_bp.e.matched;
for (i = 0; i < n; i++) {
- BeamInstr* pc = fp[i].pc;
- Export* ep = (Export *)(((char *)(pc-3)) - offsetof(Export, code));
+ ErtsCodeInfo *ci = fp[i].ci;
+ BeamInstr* pc = erts_codeinfo_to_code(ci);
+ Export* ep = ErtsContainerStruct(ci, Export, info);
if (on && !flags.breakpoint) {
/* Turn on global call tracing */
if (ep->addressv[code_ix] != pc) {
fp[i].mod->curr.num_traced_exports++;
#ifdef DEBUG
- pc[-5] = (BeamInstr) BeamOp(op_i_func_info_IaaI);
+ ep->info.op = (BeamInstr) BeamOp(op_i_func_info_IaaI);
#endif
- pc[0] = (BeamInstr) BeamOp(op_jump_f);
- pc[1] = (BeamInstr) ep->addressv[code_ix];
+ ep->beam[0] = (BeamInstr) BeamOp(op_jump_f);
+ ep->beam[1] = (BeamInstr) ep->addressv[code_ix];
}
- erts_set_call_trace_bif(pc, match_prog_set, 0);
+ erts_set_call_trace_bif(ci, match_prog_set, 0);
if (ep->addressv[code_ix] != pc) {
- pc[0] = (BeamInstr) BeamOp(op_i_generic_breakpoint);
+ ep->beam[0] = (BeamInstr) BeamOp(op_i_generic_breakpoint);
}
} else if (!on && flags.breakpoint) {
/* Turn off breakpoint tracing -- nothing to do here. */
@@ -1432,9 +1401,9 @@ erts_set_trace_pattern(Process*p, Eterm* mfa, int specified,
* Turn off global tracing, either explicitly or implicitly
* before turning on breakpoint tracing.
*/
- erts_clear_call_trace_bif(pc, 0);
- if (pc[0] == (BeamInstr) BeamOp(op_i_generic_breakpoint)) {
- pc[0] = (BeamInstr) BeamOp(op_jump_f);
+ erts_clear_call_trace_bif(ci, 0);
+ if (ep->beam[0] == (BeamInstr) BeamOp(op_i_generic_breakpoint)) {
+ ep->beam[0] = (BeamInstr) BeamOp(op_jump_f);
}
}
}
@@ -1444,68 +1413,76 @@ erts_set_trace_pattern(Process*p, Eterm* mfa, int specified,
*/
for (i = 0; i < BIF_SIZE; ++i) {
Export *ep = bif_export[i];
- int j;
-
+
if (!ExportIsBuiltIn(ep)) {
continue;
}
-
+
if (bif_table[i].f == bif_table[i].traced) {
/* Trace wrapper same as regular function - untraceable */
continue;
}
-
- for (j = 0; j < specified && mfa[j] == ep->code[j]; j++) {
- /* Empty loop body */
- }
- if (j == specified) {
- BeamInstr* pc = (BeamInstr *)bif_export[i]->code + 3;
- if (! flags.breakpoint) { /* Export entry call trace */
- if (on) {
- erts_clear_call_trace_bif(pc, 1);
- erts_clear_mtrace_bif(pc);
- erts_set_call_trace_bif(pc, match_prog_set, 0);
- } else { /* off */
- erts_clear_call_trace_bif(pc, 0);
- }
- matches++;
- } else { /* Breakpoint call trace */
- int m = 0;
-
- if (on) {
- if (flags.local) {
- erts_clear_call_trace_bif(pc, 0);
- erts_set_call_trace_bif(pc, match_prog_set, 1);
- m = 1;
- }
- if (flags.meta) {
- erts_set_mtrace_bif(pc, meta_match_prog_set,
- meta_tracer_pid);
- m = 1;
- }
- if (flags.call_time) {
- erts_set_time_trace_bif(pc, on);
- /* I don't want to remove any other tracers */
- m = 1;
- }
- } else { /* off */
- if (flags.local) {
- erts_clear_call_trace_bif(pc, 1);
- m = 1;
- }
- if (flags.meta) {
- erts_clear_mtrace_bif(pc);
- m = 1;
- }
- if (flags.call_time) {
- erts_clear_time_trace_bif(pc);
- m = 1;
- }
- }
- matches += m;
- }
- }
+ switch (specified) {
+ case 3:
+ if (mfa->arity != ep->info.mfa.arity)
+ continue;
+ case 2:
+ if (mfa->function != ep->info.mfa.function)
+ continue;
+ case 1:
+ if (mfa->module != ep->info.mfa.module)
+ continue;
+ case 0:
+ break;
+ default:
+ ASSERT(0);
+ }
+
+ if (! flags.breakpoint) { /* Export entry call trace */
+ if (on) {
+ erts_clear_call_trace_bif(&ep->info, 1);
+ erts_clear_mtrace_bif(&ep->info);
+ erts_set_call_trace_bif(&ep->info, match_prog_set, 0);
+ } else { /* off */
+ erts_clear_call_trace_bif(&ep->info, 0);
+ }
+ matches++;
+ } else { /* Breakpoint call trace */
+ int m = 0;
+
+ if (on) {
+ if (flags.local) {
+ erts_clear_call_trace_bif(&ep->info, 0);
+ erts_set_call_trace_bif(&ep->info, match_prog_set, 1);
+ m = 1;
+ }
+ if (flags.meta) {
+ erts_set_mtrace_bif(&ep->info, meta_match_prog_set,
+ meta_tracer);
+ m = 1;
+ }
+ if (flags.call_time) {
+ erts_set_time_trace_bif(&ep->info, on);
+ /* I don't want to remove any other tracers */
+ m = 1;
+ }
+ } else { /* off */
+ if (flags.local) {
+ erts_clear_call_trace_bif(&ep->info, 1);
+ m = 1;
+ }
+ if (flags.meta) {
+ erts_clear_mtrace_bif(&ep->info);
+ m = 1;
+ }
+ if (flags.call_time) {
+ erts_clear_time_trace_bif(&ep->info);
+ m = 1;
+ }
+ }
+ matches += m;
+ }
}
/*
@@ -1521,7 +1498,7 @@ erts_set_trace_pattern(Process*p, Eterm* mfa, int specified,
}
if (flags.meta) {
erts_set_mtrace_break(&finish_bp.f, meta_match_prog_set,
- meta_tracer_pid);
+ meta_tracer);
}
if (flags.call_count) {
erts_set_count_break(&finish_bp.f, on);
@@ -1570,12 +1547,57 @@ erts_set_trace_pattern(Process*p, Eterm* mfa, int specified,
}
int
+erts_set_tracing_event_pattern(Eterm event, Binary* match_spec, int on)
+{
+ ErtsBpIndex ix = erts_staging_bp_ix();
+ ErtsTracingEvent* st;
+
+ switch (event) {
+ case am_send: st = &erts_send_tracing[ix]; break;
+ case am_receive: st = &erts_receive_tracing[ix]; break;
+ default: return -1;
+ }
+
+ MatchSetUnref(st->match_spec);
+
+ st->on = on;
+ st->match_spec = match_spec;
+ MatchSetRef(match_spec);
+
+ finish_bp.current = 1; /* prepare phase not needed for event trace */
+ finish_bp.install = on;
+ finish_bp.e.matched = 0;
+ finish_bp.e.matching = NULL;
+ finish_bp.f.matched = 0;
+ finish_bp.f.matching = NULL;
+
+#ifndef ERTS_SMP
+ while (erts_finish_breakpointing()) {
+ /* Empty loop body */
+ }
+#endif
+ return 1;
+}
+
+static void
+consolidate_event_tracing(ErtsTracingEvent te[])
+{
+ ErtsTracingEvent* src = &te[erts_active_bp_ix()];
+ ErtsTracingEvent* dst = &te[erts_staging_bp_ix()];
+
+ MatchSetUnref(dst->match_spec);
+ dst->on = src->on;
+ dst->match_spec = src->match_spec;
+ MatchSetRef(dst->match_spec);
+}
+
+int
erts_finish_breakpointing(void)
{
ERTS_SMP_LC_ASSERT(erts_has_code_write_permission());
/*
- * Memory barriers will be issued for all processes *before*
+ * Memory barriers will be issued for all schedulers *before*
* each of the stages below. (Unless the other schedulers
* are blocked, in which case memory barriers will be issued
* when they are awaken.)
@@ -1644,6 +1666,8 @@ erts_finish_breakpointing(void)
erts_consolidate_bp_data(&finish_bp.f, 1);
erts_bp_free_matched_functions(&finish_bp.e);
erts_bp_free_matched_functions(&finish_bp.f);
+ consolidate_event_tracing(erts_send_tracing);
+ consolidate_event_tracing(erts_receive_tracing);
return 0;
default:
ASSERT(0);
@@ -1658,13 +1682,11 @@ install_exp_breakpoints(BpFunctions* f)
BpFunction* fp = f->matching;
Uint ne = f->matched;
Uint i;
- Uint offset = offsetof(Export, code) + 3*sizeof(BeamInstr);
for (i = 0; i < ne; i++) {
- BeamInstr* pc = fp[i].pc;
- Export* ep = (Export *) (((char *)pc)-offset);
+ Export* ep = ErtsContainerStruct(fp[i].ci, Export, info);
- ep->addressv[code_ix] = pc;
+ ep->addressv[code_ix] = ep->beam;
}
}
@@ -1675,17 +1697,15 @@ uninstall_exp_breakpoints(BpFunctions* f)
BpFunction* fp = f->matching;
Uint ne = f->matched;
Uint i;
- Uint offset = offsetof(Export, code) + 3*sizeof(BeamInstr);
for (i = 0; i < ne; i++) {
- BeamInstr* pc = fp[i].pc;
- Export* ep = (Export *) (((char *)pc)-offset);
+ Export* ep = ErtsContainerStruct(fp[i].ci, Export, info);
- if (ep->addressv[code_ix] != pc) {
+ if (ep->addressv[code_ix] != ep->beam) {
continue;
}
- ASSERT(*pc == (BeamInstr) BeamOp(op_jump_f));
- ep->addressv[code_ix] = (BeamInstr *) ep->code[4];
+ ASSERT(ep->beam[0] == (BeamInstr) BeamOp(op_jump_f));
+ ep->addressv[code_ix] = (BeamInstr *) ep->beam[1];
}
}
@@ -1696,18 +1716,16 @@ clean_export_entries(BpFunctions* f)
BpFunction* fp = f->matching;
Uint ne = f->matched;
Uint i;
- Uint offset = offsetof(Export, code) + 3*sizeof(BeamInstr);
for (i = 0; i < ne; i++) {
- BeamInstr* pc = fp[i].pc;
- Export* ep = (Export *) (((char *)pc)-offset);
+ Export* ep = ErtsContainerStruct(fp[i].ci, Export, info);
- if (ep->addressv[code_ix] == pc) {
+ if (ep->addressv[code_ix] == ep->beam) {
continue;
}
- if (*pc == (BeamInstr) BeamOp(op_jump_f)) {
- ep->code[3] = (BeamInstr) 0;
- ep->code[4] = (BeamInstr) 0;
+ if (ep->beam[0] == (BeamInstr) BeamOp(op_jump_f)) {
+ ep->beam[0] = (BeamInstr) 0;
+ ep->beam[1] = (BeamInstr) 0;
}
}
}
@@ -1719,11 +1737,11 @@ setup_bif_trace(void)
for (i = 0; i < BIF_SIZE; ++i) {
Export *ep = bif_export[i];
- GenericBp* g = (GenericBp *) ep->fake_op_func_info_for_hipe[1];
+ GenericBp* g = ep->info.u.gen_bp;
if (g) {
if (ExportIsBuiltIn(ep)) {
- ASSERT(ep->code[4]);
- ep->code[4] = (BeamInstr) bif_table[i].traced;
+ ASSERT(ep->beam[1]);
+ ep->beam[1] = (BeamInstr) bif_table[i].traced;
}
}
}
@@ -1737,12 +1755,11 @@ reset_bif_trace(void)
for (i = 0; i < BIF_SIZE; ++i) {
Export *ep = bif_export[i];
- BeamInstr* pc = ep->code+3;
- GenericBp* g = (GenericBp *) pc[-4];
+ GenericBp* g = ep->info.u.gen_bp;
if (g && g->data[active].flags == 0) {
if (ExportIsBuiltIn(ep)) {
- ASSERT(ep->code[4]);
- ep->code[4] = (BeamInstr) bif_table[i].f;
+ ASSERT(ep->beam[1]);
+ ep->beam[1] = (BeamInstr) bif_table[i].f;
}
}
}
@@ -1796,7 +1813,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;
@@ -1877,11 +1898,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 */
@@ -1901,13 +1918,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);
@@ -1925,7 +1940,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;
}
@@ -1962,11 +1981,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);
@@ -1985,11 +2000,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))) {
@@ -2235,6 +2246,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);
}
}
@@ -2253,6 +2265,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);
@@ -2284,7 +2297,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))) {
@@ -2297,6 +2311,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;
@@ -2309,7 +2329,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);
@@ -2327,50 +2347,86 @@ BIF_RETTYPE system_profile_2(BIF_ALIST_2)
}
/* End: Trace for System Profiling */
-BIF_RETTYPE
-trace_delivered_1(BIF_ALIST_1)
+/* Trace delivered send an aux work message to all schedulers
+ and when all schedulers have acknowledged that they have seen
+ the message the message is sent to the requesting process.
+
+ IMPORTANT: We have to make sure that the all messages sent
+ using enif_send have been delivered before we send the message
+ to the caller.
+
+ There used to be a separate implementation for when only a pid
+ is passed in, but since this is not performance critical code
+ we now use the same approach for both.
+*/
+
+typedef struct {
+ Process *proc;
+ Eterm ref;
+ Eterm ref_heap[ERTS_REF_THING_SIZE];
+ Eterm target;
+ erts_smp_atomic32_t refc;
+} ErtsTraceDeliveredAll;
+
+static void
+reply_trace_delivered_all(void *vtdarp)
{
- DECL_AM(trace_delivered);
-#ifdef ERTS_SMP
- ErlHeapFragment *bp;
-#else
- ErtsProcLocks locks = 0;
-#endif
- Eterm *hp;
- Eterm msg, ref, msg_ref;
- Process *p;
- if (BIF_ARG_1 == am_all) {
- p = NULL;
- } else if (! (p = erts_pid2proc(BIF_P, ERTS_PROC_LOCK_MAIN,
- BIF_ARG_1, ERTS_PROC_LOCKS_ALL))) {
- if (is_not_internal_pid(BIF_ARG_1)) {
- BIF_ERROR(BIF_P, BADARG);
- }
- }
-
- ref = erts_make_ref(BIF_P);
+ ErtsTraceDeliveredAll *tdarp = (ErtsTraceDeliveredAll *) vtdarp;
+ if (erts_smp_atomic32_dec_read_nob(&tdarp->refc) == 0) {
+ Eterm ref_copy, msg;
+ Process *rp = tdarp->proc;
+ Eterm *hp = NULL;
+ ErlOffHeap *ohp;
#ifdef ERTS_SMP
- bp = new_message_buffer(REF_THING_SIZE + 4);
- hp = &bp->mem[0];
- msg_ref = STORE_NC(&hp, &bp->off_heap, ref);
+ ErlHeapFragment *bp;
+ bp = new_message_buffer(4 + NC_HEAP_SIZE(tdarp->ref));
+ hp = &bp->mem[0];
+ ohp = &bp->off_heap;
#else
- hp = HAlloc(BIF_P, 4);
- msg_ref = ref;
+ ErtsProcLocks rp_locks = 0;
+ ErtsMessage *mp;
+ mp = erts_alloc_message_heap(
+ rp, &rp_locks, 4 + NC_HEAP_SIZE(tdarp->ref), &hp, &ohp);
#endif
- msg = TUPLE3(hp, AM_trace_delivered, BIF_ARG_1, msg_ref);
+ ref_copy = STORE_NC(&hp, ohp, tdarp->ref);
+ msg = TUPLE3(hp, am_trace_delivered, tdarp->target, ref_copy);
#ifdef ERTS_SMP
- erts_send_sys_msg_proc(BIF_P->common.id, BIF_P->common.id, msg, bp);
- if (p)
- erts_smp_proc_unlock(p,
- (BIF_P == p
- ? ERTS_PROC_LOCKS_ALL_MINOR
- : ERTS_PROC_LOCKS_ALL));
+ erts_send_sys_msg_proc(rp->common.id, rp->common.id, msg, bp);
#else
- erts_send_message(BIF_P, BIF_P, &locks, msg, ERTS_SND_FLG_NO_SEQ_TRACE);
+ erts_queue_message(rp, rp_locks, mp, msg, am_system);
#endif
- BIF_RET(ref);
+ erts_free(ERTS_ALC_T_MISC_AUX_WORK, vtdarp);
+ erts_proc_dec_refc(rp);
+ }
+}
+
+BIF_RETTYPE
+trace_delivered_1(BIF_ALIST_1)
+{
+
+ if (BIF_ARG_1 == am_all || is_internal_pid(BIF_ARG_1)) {
+ Eterm *hp, ref;
+ ErtsTraceDeliveredAll *tdarp =
+ erts_alloc(ERTS_ALC_T_MISC_AUX_WORK, sizeof(ErtsTraceDeliveredAll));
+
+ tdarp->proc = BIF_P;
+ ref = erts_make_ref(BIF_P);
+ hp = &tdarp->ref_heap[0];
+ tdarp->ref = STORE_NC(&hp, NULL, ref);
+ tdarp->target = BIF_ARG_1;
+ erts_smp_atomic32_init_nob(&tdarp->refc,
+ (erts_aint32_t) erts_no_schedulers);
+ erts_proc_add_refc(BIF_P, 1);
+ erts_schedule_multi_misc_aux_work(0,
+ erts_no_schedulers,
+ reply_trace_delivered_all,
+ (void *) tdarp);
+ BIF_RET(ref);
+ } else {
+ BIF_ERROR(BIF_P, BADARG);
+ }
}
diff --git a/erts/emulator/beam/erl_bif_unique.c b/erts/emulator/beam/erl_bif_unique.c
new file mode 100644
index 0000000000..2f8adc87d5
--- /dev/null
+++ b/erts/emulator/beam/erl_bif_unique.c
@@ -0,0 +1,851 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2014-2017. 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
+
+#define ERL_BIF_UNIQUE_C__
+#include "sys.h"
+#include "erl_vm.h"
+#include "erl_alloc.h"
+#include "export.h"
+#include "bif.h"
+#include "erl_bif_unique.h"
+#include "hash.h"
+#include "erl_binary.h"
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
+ * Reference *
+\* */
+
+static union {
+ erts_atomic64_t count;
+ char align__[ERTS_CACHE_LINE_SIZE];
+} global_reference erts_align_attribute(ERTS_CACHE_LINE_SIZE);
+
+
+/*
+ * ref[0] indicate thread creating reference as follows:
+ *
+ * - ref[0] == 0 => Non-scheduler thread;
+ * - else; ref[0] <= erts_no_schedulers =>
+ * ordinary scheduler with id == ref[0];
+ * - else; ref[0] <= erts_no_schedulers
+ * + erts_no_dirty_cpu_schedulers =>
+ * dirty cpu scheduler with id == 'ref[0] - erts_no_schedulers';
+ * - else =>
+ * dirty io scheduler with id == 'ref[0]
+ * - erts_no_schedulers
+ * - erts_no_dirty_cpu_schedulers'
+ */
+
+#ifdef DEBUG
+static Uint32 max_thr_id;
+#endif
+
+static void init_magic_ref_tables(void);
+
+static Uint64 ref_init_value;
+
+static void
+init_reference(void)
+{
+ SysTimeval tv;
+ sys_gettimeofday(&tv);
+ ref_init_value = 0;
+ ref_init_value |= (Uint64) tv.tv_sec;
+ ref_init_value |= ((Uint64) tv.tv_usec) << 32;
+ ref_init_value *= (Uint64) 268438039;
+ ref_init_value += (Uint64) tv.tv_usec;
+#ifdef DEBUG
+ max_thr_id = (Uint32) erts_no_schedulers;
+#ifdef ERTS_DIRTY_SCHEDULERS
+ max_thr_id += (Uint32) erts_no_dirty_cpu_schedulers;
+ max_thr_id += (Uint32) erts_no_dirty_io_schedulers;
+#endif
+#endif
+ erts_atomic64_init_nob(&global_reference.count,
+ (erts_aint64_t) ref_init_value);
+ init_magic_ref_tables();
+}
+
+static ERTS_INLINE void
+global_make_ref_in_array(Uint32 thr_id, Uint32 ref[ERTS_REF_NUMBERS])
+{
+ Uint64 value;
+
+ value = (Uint64) erts_atomic64_inc_read_mb(&global_reference.count);
+
+ erts_set_ref_numbers(ref, thr_id, value);
+}
+
+static ERTS_INLINE void
+make_ref_in_array(Uint32 ref[ERTS_REF_NUMBERS])
+{
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
+ if (esdp)
+ erts_sched_make_ref_in_array(esdp, ref);
+ else
+ global_make_ref_in_array(0, ref);
+}
+
+void
+erts_make_ref_in_array(Uint32 ref[ERTS_REF_NUMBERS])
+{
+ make_ref_in_array(ref);
+}
+
+void
+erts_make_magic_ref_in_array(Uint32 ref[ERTS_REF_NUMBERS])
+{
+ make_ref_in_array(ref);
+ ASSERT(!(ref[1] & ERTS_REF1_MAGIC_MARKER_BIT__));
+ ref[1] |= ERTS_REF1_MAGIC_MARKER_BIT__;
+}
+
+Eterm erts_make_ref_in_buffer(Eterm buffer[ERTS_REF_THING_SIZE])
+{
+ Eterm* hp = buffer;
+ Uint32 ref[ERTS_REF_NUMBERS];
+
+ make_ref_in_array(ref);
+ write_ref_thing(hp, ref[0], ref[1], ref[2]);
+ return make_internal_ref(hp);
+}
+
+Eterm erts_make_ref(Process *c_p)
+{
+ Eterm* hp;
+ Uint32 ref[ERTS_REF_NUMBERS];
+
+ ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(c_p));
+
+ hp = HAlloc(c_p, ERTS_REF_THING_SIZE);
+
+ make_ref_in_array(ref);
+ write_ref_thing(hp, ref[0], ref[1], ref[2]);
+
+ return make_internal_ref(hp);
+}
+
+/*
+ * Magic reference tables
+ */
+
+typedef struct {
+ HashBucket hash;
+ ErtsMagicBinary *mb;
+ Uint64 value;
+ Uint32 thr_id;
+} ErtsMagicRefTableEntry;
+
+typedef struct {
+ erts_rwmtx_t rwmtx;
+ Hash hash;
+ char name[32];
+} ErtsMagicRefTable;
+
+typedef struct {
+ union {
+ ErtsMagicRefTable table;
+ char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsMagicRefTable))];
+ } u;
+} ErtsAlignedMagicRefTable;
+
+ErtsAlignedMagicRefTable *magic_ref_table;
+
+ErtsMagicBinary *
+erts_magic_ref_lookup_bin__(Uint32 refn[ERTS_REF_NUMBERS])
+{
+ ErtsMagicRefTableEntry tmpl;
+ ErtsMagicRefTableEntry *tep;
+ ErtsMagicBinary *mb;
+ ErtsMagicRefTable *tblp;
+
+ ASSERT(erts_is_ref_numbers_magic(refn));
+
+ tmpl.value = erts_get_ref_numbers_value(refn);
+ tmpl.thr_id = erts_get_ref_numbers_thr_id(refn);
+ if (tmpl.thr_id > erts_no_schedulers)
+ tblp = &magic_ref_table[0].u.table;
+ else
+ tblp = &magic_ref_table[tmpl.thr_id].u.table;
+
+ erts_rwmtx_rlock(&tblp->rwmtx);
+
+ tep = (ErtsMagicRefTableEntry *) hash_get(&tblp->hash, &tmpl);
+ if (!tep)
+ mb = NULL;
+ else {
+ erts_aint_t refc;
+ mb = tep->mb;
+ refc = erts_refc_inc_unless(&mb->intern.refc, 0, 0);
+ if (refc == 0)
+ mb = NULL;
+ }
+
+ erts_rwmtx_runlock(&tblp->rwmtx);
+
+ return mb;
+}
+
+void
+erts_magic_ref_save_bin__(Eterm ref)
+{
+ ErtsMagicRefTableEntry tmpl;
+ ErtsMagicRefTableEntry *tep;
+ ErtsMRefThing *mrtp;
+ ErtsMagicRefTable *tblp;
+ Uint32 *refn;
+
+ ASSERT(is_internal_magic_ref(ref));
+
+ mrtp = (ErtsMRefThing *) internal_ref_val(ref);
+ refn = mrtp->mb->refn;
+
+ tmpl.value = erts_get_ref_numbers_value(refn);
+ tmpl.thr_id = erts_get_ref_numbers_thr_id(refn);
+
+ if (tmpl.thr_id > erts_no_schedulers)
+ tblp = &magic_ref_table[0].u.table;
+ else
+ tblp = &magic_ref_table[tmpl.thr_id].u.table;
+
+ erts_rwmtx_rlock(&tblp->rwmtx);
+
+ tep = (ErtsMagicRefTableEntry *) hash_get(&tblp->hash, &tmpl);
+
+ erts_rwmtx_runlock(&tblp->rwmtx);
+
+ if (!tep) {
+ ErtsMagicRefTableEntry *used_tep;
+
+ ASSERT(tmpl.value == erts_get_ref_numbers_value(refn));
+ ASSERT(tmpl.thr_id == erts_get_ref_numbers_thr_id(refn));
+
+ if (tblp != &magic_ref_table[0].u.table) {
+ tep = erts_alloc(ERTS_ALC_T_MREF_NSCHED_ENT,
+ sizeof(ErtsNSchedMagicRefTableEntry));
+ }
+ else {
+ tep = erts_alloc(ERTS_ALC_T_MREF_ENT,
+ sizeof(ErtsMagicRefTableEntry));
+ tep->thr_id = tmpl.thr_id;
+ }
+
+ tep->value = tmpl.value;
+ tep->mb = mrtp->mb;
+
+ erts_rwmtx_rwlock(&tblp->rwmtx);
+
+ used_tep = hash_put(&tblp->hash, tep);
+
+ erts_rwmtx_rwunlock(&tblp->rwmtx);
+
+ if (used_tep != tep) {
+ if (tblp != &magic_ref_table[0].u.table)
+ erts_free(ERTS_ALC_T_MREF_NSCHED_ENT, (void *) tep);
+ else
+ erts_free(ERTS_ALC_T_MREF_ENT, (void *) tep);
+ }
+ }
+}
+
+void
+erts_magic_ref_remove_bin(Uint32 refn[ERTS_REF_NUMBERS])
+{
+ ErtsMagicRefTableEntry tmpl;
+ ErtsMagicRefTableEntry *tep;
+ ErtsMagicRefTable *tblp;
+
+ tmpl.value = erts_get_ref_numbers_value(refn);
+ tmpl.thr_id = erts_get_ref_numbers_thr_id(refn);
+
+ if (tmpl.thr_id > erts_no_schedulers)
+ tblp = &magic_ref_table[0].u.table;
+ else
+ tblp = &magic_ref_table[tmpl.thr_id].u.table;
+
+ erts_rwmtx_rlock(&tblp->rwmtx);
+
+ tep = (ErtsMagicRefTableEntry *) hash_get(&tblp->hash, &tmpl);
+
+ erts_rwmtx_runlock(&tblp->rwmtx);
+
+ if (tep) {
+
+ ASSERT(tmpl.value == erts_get_ref_numbers_value(refn));
+ ASSERT(tmpl.thr_id == erts_get_ref_numbers_thr_id(refn));
+
+ erts_rwmtx_rwlock(&tblp->rwmtx);
+
+ tep = hash_remove(&tblp->hash, &tmpl);
+ ASSERT(tep);
+
+ erts_rwmtx_rwunlock(&tblp->rwmtx);
+
+ if (tblp != &magic_ref_table[0].u.table)
+ erts_free(ERTS_ALC_T_MREF_NSCHED_ENT, (void *) tep);
+ else
+ erts_free(ERTS_ALC_T_MREF_ENT, (void *) tep);
+ }
+}
+
+static int nsched_mreft_cmp(void *ve1, void *ve2)
+{
+ ErtsNSchedMagicRefTableEntry *e1 = ve1;
+ ErtsNSchedMagicRefTableEntry *e2 = ve2;
+ return e1->value != e2->value;
+}
+
+static int non_nsched_mreft_cmp(void *ve1, void *ve2)
+{
+ ErtsMagicRefTableEntry *e1 = ve1;
+ ErtsMagicRefTableEntry *e2 = ve2;
+ return e1->value != e2->value || e1->thr_id != e2->thr_id;
+}
+
+static HashValue nsched_mreft_hash(void *ve)
+{
+ ErtsNSchedMagicRefTableEntry *e = ve;
+ return (HashValue) e->value;
+}
+
+static HashValue non_nsched_mreft_hash(void *ve)
+{
+ ErtsMagicRefTableEntry *e = ve;
+ HashValue h;
+ h = (HashValue) e->thr_id;
+ h *= 268440163;
+ h += (HashValue) e->value;
+ return h;
+}
+
+static void *mreft_alloc(void *ve)
+{
+ /*
+ * We allocate the element before
+ * hash_put() and pass it as
+ * template which we get as
+ * input...
+ */
+ return ve;
+}
+
+static void mreft_free(void *ve)
+{
+ /*
+ * We free the element ourselves
+ * after hash_remove()...
+ */
+}
+
+static void *mreft_meta_alloc(int i, size_t size)
+{
+ return erts_alloc(ERTS_ALC_T_MREF_TAB_BKTS, size);
+}
+
+static void mreft_meta_free(int i, void *ptr)
+{
+ erts_free(ERTS_ALC_T_MREF_TAB_BKTS, ptr);
+}
+
+static void
+init_magic_ref_tables(void)
+{
+ HashFunctions hash_funcs;
+ int i;
+ ErtsMagicRefTable *tblp;
+
+ magic_ref_table = erts_alloc_permanent_cache_aligned(ERTS_ALC_T_MREF_TAB,
+ (sizeof(ErtsAlignedMagicRefTable)
+ * (erts_no_schedulers + 1)));
+
+ hash_funcs.hash = non_nsched_mreft_hash;
+ hash_funcs.cmp = non_nsched_mreft_cmp;
+
+ hash_funcs.alloc = mreft_alloc;
+ hash_funcs.free = mreft_free;
+ hash_funcs.meta_alloc = mreft_meta_alloc;
+ hash_funcs.meta_free = mreft_meta_free;
+ hash_funcs.meta_print = erts_print;
+
+ tblp = &magic_ref_table[0].u.table;
+ erts_snprintf(&tblp->name[0], sizeof(tblp->name),
+ "magic_ref_table_0");
+ hash_init(0, &tblp->hash, &tblp->name[0], 1, hash_funcs);
+ erts_rwmtx_init(&tblp->rwmtx, "magic_ref_table", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
+
+ hash_funcs.hash = nsched_mreft_hash;
+ hash_funcs.cmp = nsched_mreft_cmp;
+
+ for (i = 1; i <= erts_no_schedulers; i++) {
+ ErtsMagicRefTable *tblp = &magic_ref_table[i].u.table;
+ erts_snprintf(&tblp->name[0], sizeof(tblp->name),
+ "magic_ref_table_%d", i);
+ hash_init(0, &tblp->hash, &tblp->name[0], 1, hash_funcs);
+ erts_rwmtx_init(&tblp->rwmtx, "magic_ref_table", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
+ }
+}
+
+void erts_ref_bin_free(ErtsMagicBinary *mb)
+{
+ erts_bin_free((Binary *) mb);
+}
+
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
+ * Unique Integer *
+\* */
+
+static struct {
+ union {
+ struct {
+ int left_shift;
+ int right_shift;
+ Uint64 mask;
+ Uint64 val0_max;
+ } o;
+ char align__[ERTS_CACHE_LINE_SIZE];
+ } r;
+ union {
+ erts_atomic64_t val1;
+ char align__[ERTS_CACHE_LINE_SIZE];
+ } w;
+} unique_data erts_align_attribute(ERTS_CACHE_LINE_SIZE);
+
+static void
+init_unique_integer(void)
+{
+ int bits;
+ unique_data.r.o.val0_max = (Uint64) erts_no_schedulers;
+#ifdef ERTS_DIRTY_SCHEDULERS
+ unique_data.r.o.val0_max += (Uint64) erts_no_dirty_cpu_schedulers;
+ unique_data.r.o.val0_max += (Uint64) erts_no_dirty_io_schedulers;
+#endif
+ bits = erts_fit_in_bits_int64(unique_data.r.o.val0_max);
+ unique_data.r.o.left_shift = bits;
+ unique_data.r.o.right_shift = 64 - bits;
+ unique_data.r.o.mask = (((Uint64) 1) << bits) - 1;
+ erts_atomic64_init_nob(&unique_data.w.val1, -1);
+}
+
+#define ERTS_MAX_UNIQUE_INT_HEAP_SIZE ERTS_UINT64_ARRAY_TO_BIG_MAX_HEAP_SZ(2)
+
+static ERTS_INLINE Eterm
+bld_unique_integer_term(Eterm **hpp, Uint *szp,
+ Uint64 val0, Uint64 val1,
+ int positive)
+{
+ Uint hsz;
+ Uint64 unique_val[2];
+
+ unique_val[0] = ((Uint64) val0);
+ unique_val[0] |= ((Uint64) val1) << unique_data.r.o.left_shift;
+ unique_val[1] = ((Uint64) val1) >> unique_data.r.o.right_shift;
+ unique_val[1] &= unique_data.r.o.mask;
+
+ if (positive) {
+ unique_val[0]++;
+ if (unique_val[0] == 0)
+ unique_val[1]++;
+ }
+ else {
+ ASSERT(MIN_SMALL < 0);
+ if (unique_val[1] == 0
+ && unique_val[0] < ((Uint64) -1*((Sint64) MIN_SMALL))) {
+ Sint64 s_unique_val = (Sint64) unique_val[0];
+ s_unique_val += MIN_SMALL;
+ ASSERT(MIN_SMALL <= s_unique_val && s_unique_val < 0);
+ if (szp)
+ *szp = 0;
+ if (!hpp)
+ return THE_NON_VALUE;
+ return make_small((Sint) s_unique_val);
+ }
+ if (unique_val[0] < ((Uint64) -1*((Sint64) MIN_SMALL))) {
+ ASSERT(unique_val[1] != 0);
+ unique_val[1] -= 1;
+ }
+ unique_val[0] += MIN_SMALL;
+ }
+
+ if (!unique_val[1]) {
+ if (unique_val[0] <= MAX_SMALL) {
+ if (szp)
+ *szp = 0;
+ if (!hpp)
+ return THE_NON_VALUE;
+ return make_small((Uint) unique_val[0]);
+ }
+
+ if (szp)
+ *szp = ERTS_UINT64_HEAP_SIZE(unique_val[0]);
+ if (!hpp)
+ return THE_NON_VALUE;
+ return erts_uint64_to_big(unique_val[0], hpp);
+ }
+ else {
+ Eterm tmp, *tmp_hp, res;
+ DeclareTmpHeapNoproc(local_heap, 2*ERTS_MAX_UNIQUE_INT_HEAP_SIZE);
+
+ UseTmpHeapNoproc(2*ERTS_MAX_UNIQUE_INT_HEAP_SIZE);
+
+ tmp_hp = local_heap;
+
+ tmp = erts_uint64_array_to_big(&tmp_hp, 0, 2, unique_val);
+ ASSERT(is_big(tmp));
+
+ hsz = big_arity(tmp) + 1;
+
+ ASSERT(hsz <= ERTS_MAX_UNIQUE_INT_HEAP_SIZE);
+
+ if (szp)
+ *szp = hsz;
+
+ if (!hpp)
+ res = THE_NON_VALUE;
+ else {
+ int hix;
+ Eterm *hp = *hpp;
+ tmp_hp = big_val(tmp);
+ for (hix = 0; hix < hsz; hix++)
+ hp[hix] = tmp_hp[hix];
+
+ *hpp = hp + hsz;
+ res = make_big(hp);
+ }
+
+ UnUseTmpHeapNoproc(2*ERTS_MAX_UNIQUE_INT_HEAP_SIZE);
+
+ return res;
+ }
+}
+
+static ERTS_INLINE Eterm unique_integer_bif(Process *c_p, int positive)
+{
+ ErtsSchedulerData *esdp;
+ Uint64 thr_id, unique;
+ Uint hsz;
+ Eterm *hp;
+
+ esdp = erts_proc_sched_data(c_p);
+ thr_id = (Uint64) esdp->thr_id;
+ unique = esdp->unique++;
+ bld_unique_integer_term(NULL, &hsz, thr_id, unique, positive);
+ hp = hsz ? HAlloc(c_p, hsz) : NULL;
+ return bld_unique_integer_term(&hp, NULL, thr_id, unique, positive);
+}
+
+Uint
+erts_raw_unique_integer_heap_size(Uint64 val[ERTS_UNIQUE_INT_RAW_VALUES],
+ int positive)
+{
+ Uint sz;
+ bld_unique_integer_term(NULL, &sz, val[0], val[1], positive);
+ return sz;
+}
+
+Eterm
+erts_raw_make_unique_integer(Eterm **hpp, Uint64 val[ERTS_UNIQUE_INT_RAW_VALUES],
+ int positive)
+{
+ return bld_unique_integer_term(hpp, NULL, val[0], val[1], positive);
+}
+
+void
+erts_raw_get_unique_integer(Uint64 val[ERTS_UNIQUE_INT_RAW_VALUES])
+{
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
+ if (esdp) {
+ val[0] = (Uint64) esdp->thr_id;
+ val[1] = esdp->unique++;
+ }
+ else {
+ val[0] = (Uint64) 0;
+ val[1] = (Uint64) erts_atomic64_inc_read_nob(&unique_data.w.val1);
+ }
+}
+
+
+Sint64
+erts_get_min_unique_integer(void)
+{
+ return (Sint64) MIN_SMALL;
+}
+
+/* --- Debug --- */
+
+Eterm
+erts_debug_make_unique_integer(Process *c_p, Eterm etval0, Eterm etval1)
+{
+ Uint64 val0, val1;
+ Uint hsz;
+ Eterm res, *hp, *end_hp;
+
+ if (!term_to_Uint64(etval0, &val0))
+ return THE_NON_VALUE;
+
+ if (!term_to_Uint64(etval1, &val1))
+ return THE_NON_VALUE;
+
+ bld_unique_integer_term(NULL, &hsz, val0, val1, 0);
+
+ hp = HAlloc(c_p, hsz);
+ end_hp = hp + hsz;
+
+ res = bld_unique_integer_term(&hp, NULL, val0, val1, 0);
+ if (hp != end_hp)
+ ERTS_INTERNAL_ERROR("Heap allocation error");
+
+ return res;
+}
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
+ * Strict Monotonic Counter *
+\* */
+
+static struct {
+ union {
+ erts_atomic64_t value;
+ char align__[ERTS_CACHE_LINE_SIZE];
+ } w;
+} raw_unique_monotonic_integer erts_align_attribute(ERTS_CACHE_LINE_SIZE);
+
+#if defined(ARCH_32)
+# define ERTS_UNIQUE_MONOTONIC_OFFSET ERTS_SINT64_MIN
+#else
+# define ERTS_UNIQUE_MONOTONIC_OFFSET MIN_SMALL
+#endif
+
+static void
+init_unique_monotonic_integer(void)
+{
+ erts_atomic64_init_nob(&raw_unique_monotonic_integer.w.value,
+ (erts_aint64_t) -1);
+}
+
+static ERTS_INLINE Uint64
+get_raw_unique_monotonic_integer(void)
+{
+ return (Uint64) erts_atomic64_inc_read_mb(&raw_unique_monotonic_integer.w.value);
+}
+
+static ERTS_INLINE Uint
+get_unique_monotonic_integer_heap_size(Uint64 raw, int positive)
+{
+ if (positive) {
+ Uint64 value = raw+1;
+ return ERTS_UINT64_HEAP_SIZE(value);
+ }
+ else {
+ Sint64 value = ((Sint64) raw) + ERTS_UNIQUE_MONOTONIC_OFFSET;
+ if (IS_SSMALL(value))
+ return 0;
+#if defined(ARCH_32)
+ return ERTS_SINT64_HEAP_SIZE(value);
+#else
+ return ERTS_UINT64_HEAP_SIZE((Uint64) value);
+#endif
+ }
+}
+
+static ERTS_INLINE Eterm
+make_unique_monotonic_integer_value(Eterm *hp, Uint hsz, Uint64 raw, int positive)
+{
+ Eterm res;
+#ifdef DEBUG
+ Eterm *end_hp = hp + hsz;
+#endif
+
+ if (positive) {
+ Uint64 value = raw+1;
+ res = hsz ? erts_uint64_to_big(value, &hp) : make_small(value);
+ }
+ else {
+ Sint64 value = ((Sint64) raw) + ERTS_UNIQUE_MONOTONIC_OFFSET;
+ if (hsz == 0)
+ res = make_small(value);
+ else {
+#if defined(ARCH_32)
+ res = erts_sint64_to_big(value, &hp);
+#else
+ res = erts_uint64_to_big((Uint64) value, &hp);
+#endif
+ }
+ }
+
+ ASSERT(end_hp == hp);
+
+ return res;
+}
+
+static ERTS_INLINE Eterm
+unique_monotonic_integer_bif(Process *c_p, int positive)
+{
+ Uint64 raw;
+ Uint hsz;
+ Eterm *hp;
+
+ raw = get_raw_unique_monotonic_integer();
+ hsz = get_unique_monotonic_integer_heap_size(raw, positive);
+ hp = hsz ? HAlloc(c_p, hsz) : NULL;
+ return make_unique_monotonic_integer_value(hp, hsz, raw, positive);
+}
+
+Sint64
+erts_raw_get_unique_monotonic_integer(void)
+{
+ return get_raw_unique_monotonic_integer();
+}
+
+Uint
+erts_raw_unique_monotonic_integer_heap_size(Sint64 raw, int positive)
+{
+ return get_unique_monotonic_integer_heap_size(raw, positive);
+}
+
+Eterm
+erts_raw_make_unique_monotonic_integer_value(Eterm **hpp, Sint64 raw, int positive)
+{
+ Uint hsz = get_unique_monotonic_integer_heap_size(raw, positive);
+ Eterm res = make_unique_monotonic_integer_value(*hpp, hsz, raw, positive);
+ *hpp += hsz;
+ return res;
+}
+
+Sint64
+erts_get_min_unique_monotonic_integer(void)
+{
+ return ERTS_UNIQUE_MONOTONIC_OFFSET;
+}
+
+/* --- Debug --- */
+
+int
+erts_debug_set_unique_monotonic_integer_state(Eterm et_value)
+{
+ Sint64 value;
+
+ if (!term_to_Sint64(et_value, &value)) {
+ Uint64 uvalue;
+ if (!term_to_Uint64(et_value, &uvalue))
+ return 0;
+ value = (Sint64) uvalue;
+ }
+
+ erts_atomic64_set_mb(&raw_unique_monotonic_integer.w.value,
+ (erts_aint64_t) value);
+ return 1;
+}
+
+Eterm
+erts_debug_get_unique_monotonic_integer_state(Process *c_p)
+{
+ Uint64 value;
+ Eterm hsz, *hp;
+
+ value = (Uint64) erts_atomic64_read_mb(&raw_unique_monotonic_integer.w.value);
+
+ if (IS_USMALL(0, value))
+ return make_small(value);
+ hsz = ERTS_UINT64_HEAP_SIZE(value);
+ hp = HAlloc(c_p, hsz);
+ return erts_uint64_to_big(value, &hp);
+}
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
+ * Initilazation *
+\* */
+
+void
+erts_bif_unique_init(void)
+{
+ init_reference();
+ init_unique_monotonic_integer();
+ init_unique_integer();
+}
+
+void
+erts_sched_bif_unique_init(ErtsSchedulerData *esdp)
+{
+ esdp->unique = (Uint64) 0;
+ esdp->ref = (Uint64) ref_init_value;
+}
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
+ * The BIFs *
+\* */
+
+
+BIF_RETTYPE make_ref_0(BIF_ALIST_0)
+{
+ BIF_RETTYPE res;
+ Eterm* hp;
+
+ ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(BIF_P));
+
+ hp = HAlloc(BIF_P, ERTS_REF_THING_SIZE);
+
+ res = erts_sched_make_ref_in_buffer(erts_proc_sched_data(BIF_P), hp);
+
+ BIF_RET(res);
+}
+
+BIF_RETTYPE unique_integer_0(BIF_ALIST_0)
+{
+ BIF_RET(unique_integer_bif(BIF_P, 0));
+}
+
+BIF_RETTYPE unique_integer_1(BIF_ALIST_1)
+{
+ Eterm modlist = BIF_ARG_1;
+ int monotonic = 0;
+ int positive = 0;
+ BIF_RETTYPE res;
+
+ while (is_list(modlist)) {
+ Eterm *consp = list_val(modlist);
+ switch (CAR(consp)) {
+ case am_monotonic:
+ monotonic = 1;
+ break;
+ case am_positive:
+ positive = 1;
+ break;
+ default:
+ BIF_ERROR(BIF_P, BADARG);
+ }
+ modlist = CDR(consp);
+ }
+
+ if (is_not_nil(modlist))
+ BIF_ERROR(BIF_P, BADARG);
+
+ if (monotonic)
+ res = unique_monotonic_integer_bif(BIF_P, positive);
+ else
+ res = unique_integer_bif(BIF_P, positive);
+
+ BIF_RET(res);
+}
diff --git a/erts/emulator/beam/erl_bif_unique.h b/erts/emulator/beam/erl_bif_unique.h
new file mode 100644
index 0000000000..9aa631fde9
--- /dev/null
+++ b/erts/emulator/beam/erl_bif_unique.h
@@ -0,0 +1,440 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2014-2017. 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 ERTS_BIF_UNIQUE_H__
+#define ERTS_BIF_UNIQUE_H__
+
+#include "erl_term.h"
+#include "erl_process.h"
+#include "big.h"
+#define ERTS_BINARY_TYPES_ONLY__
+#include "erl_binary.h"
+#undef ERTS_BINARY_TYPES_ONLY__
+
+void erts_bif_unique_init(void);
+void erts_sched_bif_unique_init(ErtsSchedulerData *esdp);
+
+/* reference */
+Eterm erts_make_ref(Process *);
+Eterm erts_make_ref_in_buffer(Eterm buffer[ERTS_REF_THING_SIZE]);
+void erts_make_ref_in_array(Uint32 ref[ERTS_REF_NUMBERS]);
+void erts_make_magic_ref_in_array(Uint32 ref[ERTS_REF_NUMBERS]);
+void erts_magic_ref_remove_bin(Uint32 refn[ERTS_REF_NUMBERS]);
+void erts_magic_ref_save_bin__(Eterm ref);
+ErtsMagicBinary *erts_magic_ref_lookup_bin__(Uint32 refn[ERTS_REF_NUMBERS]);
+
+
+/* strict monotonic counter */
+
+#define ERTS_MAX_UNIQUE_MONOTONIC_INTEGER_HEAP_SIZE ERTS_MAX_UINT64_HEAP_SIZE
+
+/*
+ * Note that a raw value is an intermediate value that
+ * not necessarily correspond to the end result.
+ */
+Sint64 erts_raw_get_unique_monotonic_integer(void);
+Uint erts_raw_unique_monotonic_integer_heap_size(Sint64 raw, int positive);
+Eterm erts_raw_make_unique_monotonic_integer_value(Eterm **hpp, Sint64 raw,
+ int positive);
+
+Sint64 erts_get_min_unique_monotonic_integer(void);
+
+int erts_debug_set_unique_monotonic_integer_state(Eterm et_value);
+Eterm erts_debug_get_unique_monotonic_integer_state(Process *c_p);
+
+/* unique integer */
+#define ERTS_UNIQUE_INT_RAW_VALUES 2
+#define ERTS_MAX_UNIQUE_INT_HEAP_SIZE ERTS_UINT64_ARRAY_TO_BIG_MAX_HEAP_SZ(2)
+
+Uint erts_raw_unique_integer_heap_size(Uint64 val[ERTS_UNIQUE_INT_RAW_VALUES],
+ int positive);
+Eterm erts_raw_make_unique_integer(Eterm **hpp,
+ Uint64 val[ERTS_UNIQUE_INT_RAW_VALUES],
+ int postive);
+void erts_raw_get_unique_integer(Uint64 val[ERTS_UNIQUE_INT_RAW_VALUES]);
+Sint64 erts_get_min_unique_integer(void);
+
+Eterm erts_debug_make_unique_integer(Process *c_p,
+ Eterm etval0,
+ Eterm etval1);
+
+
+ERTS_GLB_INLINE void erts_set_ref_numbers(Uint32 ref[ERTS_REF_NUMBERS],
+ Uint32 thr_id, Uint64 value);
+ERTS_GLB_INLINE Uint32 erts_get_ref_numbers_thr_id(Uint32 ref[ERTS_REF_NUMBERS]);
+ERTS_GLB_INLINE int erts_is_ref_numbers_magic(Uint32 ref[ERTS_REF_NUMBERS]);
+ERTS_GLB_INLINE Uint64 erts_get_ref_numbers_value(Uint32 ref[ERTS_REF_NUMBERS]);
+ERTS_GLB_INLINE void erts_sched_make_ref_in_array(ErtsSchedulerData *esdp,
+ Uint32 ref[ERTS_REF_NUMBERS]);
+ERTS_GLB_INLINE void erts_sched_make_magic_ref_in_array(ErtsSchedulerData *esdp,
+ Uint32 ref[ERTS_REF_NUMBERS]);
+ERTS_GLB_INLINE Eterm erts_sched_make_ref_in_buffer(ErtsSchedulerData *esdp,
+ Eterm buffer[ERTS_REF_THING_SIZE]);
+ERTS_GLB_INLINE Eterm erts_mk_magic_ref(Eterm **hpp, ErlOffHeap *ohp, Binary *mbp);
+ERTS_GLB_INLINE Binary *erts_magic_ref2bin(Eterm mref);
+ERTS_GLB_INLINE void erts_magic_ref_save_bin(Eterm ref);
+ERTS_GLB_INLINE ErtsMagicBinary *erts_magic_ref_lookup_bin(Uint32 ref[ERTS_REF_NUMBERS]);
+
+#define ERTS_REF1_MAGIC_MARKER_BIT_NO__ \
+ (_REF_NUM_SIZE-1)
+#define ERTS_REF1_MAGIC_MARKER_BIT__ \
+ (((Uint32) 1) << ERTS_REF1_MAGIC_MARKER_BIT_NO__)
+#define ERTS_REF1_THR_ID_MASK__ \
+ (ERTS_REF1_MAGIC_MARKER_BIT__-1)
+#define ERTS_REF1_NUM_MASK__ \
+ (~(ERTS_REF1_THR_ID_MASK__|ERTS_REF1_MAGIC_MARKER_BIT__))
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_INLINE void
+erts_set_ref_numbers(Uint32 ref[ERTS_REF_NUMBERS], Uint32 thr_id, Uint64 value)
+{
+ /*
+ * We cannot use thread id in the first 18-bit word since
+ * the hash/phash/phash2 BIFs only hash on this word. If
+ * we did, we would get really poor hash values. Instead
+ * we have to shuffle the bits a bit.
+ */
+ ASSERT(thr_id == (thr_id & ((Uint32) ERTS_REF1_THR_ID_MASK__)));
+ ref[0] = (Uint32) (value & ((Uint64) REF_MASK));
+ ref[1] = (((Uint32) (value & ((Uint64) ERTS_REF1_NUM_MASK__)))
+ | (thr_id & ((Uint32) ERTS_REF1_THR_ID_MASK__)));
+ ref[2] = (Uint32) ((value >> 32) & ((Uint64) 0xffffffff));
+}
+
+ERTS_GLB_INLINE Uint32
+erts_get_ref_numbers_thr_id(Uint32 ref[ERTS_REF_NUMBERS])
+{
+ return ref[1] & ((Uint32) ERTS_REF1_THR_ID_MASK__);
+}
+
+ERTS_GLB_INLINE int
+erts_is_ref_numbers_magic(Uint32 ref[ERTS_REF_NUMBERS])
+{
+ return !!(ref[1] & ERTS_REF1_MAGIC_MARKER_BIT__);
+}
+
+ERTS_GLB_INLINE Uint64
+erts_get_ref_numbers_value(Uint32 ref[ERTS_REF_NUMBERS])
+{
+ ERTS_CT_ASSERT((ERTS_REF1_NUM_MASK__ | REF_MASK) == 0xffffffff);
+ ERTS_CT_ASSERT((ERTS_REF1_NUM_MASK__ & REF_MASK) == 0);
+
+ return (((((Uint64) ref[2]) & ((Uint64) 0xffffffff)) << 32)
+ | (((Uint64) ref[1]) & ((Uint64) ERTS_REF1_NUM_MASK__))
+ | (((Uint64) ref[0]) & ((Uint64) REF_MASK)));
+}
+
+ERTS_GLB_INLINE void
+erts_sched_make_ref_in_array(ErtsSchedulerData *esdp,
+ Uint32 ref[ERTS_REF_NUMBERS])
+{
+ Uint64 value;
+
+ ASSERT(esdp);
+ value = esdp->ref++;
+ erts_set_ref_numbers(ref, (Uint32) esdp->thr_id, value);
+}
+
+ERTS_GLB_INLINE void
+erts_sched_make_magic_ref_in_array(ErtsSchedulerData *esdp,
+ Uint32 ref[ERTS_REF_NUMBERS])
+{
+ erts_sched_make_ref_in_array(esdp, ref);
+ ASSERT(!(ref[1] & ERTS_REF1_MAGIC_MARKER_BIT__));
+ ref[1] |= ERTS_REF1_MAGIC_MARKER_BIT__;
+}
+
+ERTS_GLB_INLINE Eterm
+erts_sched_make_ref_in_buffer(ErtsSchedulerData *esdp,
+ Eterm buffer[ERTS_REF_THING_SIZE])
+{
+ Eterm* hp = buffer;
+ Uint32 ref[ERTS_REF_NUMBERS];
+
+ erts_sched_make_ref_in_array(esdp, ref);
+ write_ref_thing(hp, ref[0], ref[1], ref[2]);
+ return make_internal_ref(hp);
+}
+
+ERTS_GLB_INLINE Eterm
+erts_mk_magic_ref(Eterm **hpp, ErlOffHeap *ohp, Binary *bp)
+{
+ Eterm *hp = *hpp;
+ ASSERT(bp->intern.flags & BIN_FLAG_MAGIC);
+ write_magic_ref_thing(hp, ohp, (ErtsMagicBinary *) bp);
+ *hpp += ERTS_MAGIC_REF_THING_SIZE;
+ erts_refc_inc(&bp->intern.refc, 1);
+ OH_OVERHEAD(ohp, bp->orig_size / sizeof(Eterm));
+ return make_internal_ref(hp);
+}
+
+ERTS_GLB_INLINE Binary *
+erts_magic_ref2bin(Eterm mref)
+{
+ ErtsMRefThing *mrtp;
+ ASSERT(is_internal_magic_ref(mref));
+ mrtp = (ErtsMRefThing *) internal_ref_val(mref);
+ return (Binary *) mrtp->mb;
+}
+
+/*
+ * Save the magic binary of a ref when the
+ * ref is exposed to the outside world...
+ */
+ERTS_GLB_INLINE void
+erts_magic_ref_save_bin(Eterm ref)
+{
+ if (is_internal_magic_ref(ref))
+ erts_magic_ref_save_bin__(ref);
+}
+
+/*
+ * Look up the magic binary of a magic ref
+ * when the ref comes from the outside world...
+ */
+ERTS_GLB_INLINE ErtsMagicBinary *
+erts_magic_ref_lookup_bin(Uint32 ref[ERTS_REF_NUMBERS])
+{
+ if (!erts_is_ref_numbers_magic(ref))
+ return NULL;
+ return erts_magic_ref_lookup_bin__(ref);
+}
+
+
+#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
+
+
+/*
+ * Storage of internal refs in misc structures...
+ */
+
+#include "erl_message.h"
+
+#if ERTS_REF_NUMBERS != 3
+# error fix this...
+#endif
+
+ERTS_GLB_INLINE int erts_internal_ref_number_cmp(Uint32 num1[ERTS_REF_NUMBERS],
+ Uint32 num2[ERTS_REF_NUMBERS]);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_INLINE int
+erts_internal_ref_number_cmp(Uint32 num1[ERTS_REF_NUMBERS],
+ Uint32 num2[ERTS_REF_NUMBERS])
+{
+ if (num1[2] != num2[2])
+ return (int) ((Sint64) num1[2] - (Sint64) num2[2]);
+ if (num1[1] != num2[1])
+ return (int) ((Sint64) num1[1] - (Sint64) num2[1]);
+ if (num1[0] != num2[0])
+ return (int) ((Sint64) num1[0] - (Sint64) num2[0]);
+ return 0;
+}
+
+#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
+
+/* Iref storage for all internal references... */
+typedef struct {
+ Uint32 is_magic;
+ union {
+ ErtsMagicBinary *mb;
+ Uint32 num[ERTS_REF_NUMBERS];
+ } u;
+} ErtsIRefStorage;
+
+void erts_ref_bin_free(ErtsMagicBinary *mb);
+
+ERTS_GLB_INLINE void erts_iref_storage_save(ErtsIRefStorage *iref, Eterm ref);
+ERTS_GLB_INLINE void erts_iref_storage_clean(ErtsIRefStorage *iref);
+ERTS_GLB_INLINE Uint erts_iref_storage_heap_size(ErtsIRefStorage *iref);
+ERTS_GLB_INLINE Eterm erts_iref_storage_make_ref(ErtsIRefStorage *iref,
+ Eterm **hpp, ErlOffHeap *ohp,
+ int clean_storage);
+ERTS_GLB_INLINE int erts_iref_storage_cmp(ErtsIRefStorage *iref1,
+ ErtsIRefStorage *iref2);
+
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_INLINE void
+erts_iref_storage_save(ErtsIRefStorage *iref, Eterm ref)
+{
+ Eterm *hp;
+
+ ERTS_CT_ASSERT(ERTS_REF_NUMBERS == 3);
+ ASSERT(is_internal_ref(ref));
+
+ hp = boxed_val(ref);
+
+ if (is_ordinary_ref_thing(hp)) {
+ ErtsORefThing *rtp = (ErtsORefThing *) hp;
+ iref->is_magic = 0;
+ iref->u.num[0] = rtp->num[0];
+ iref->u.num[1] = rtp->num[1];
+ iref->u.num[2] = rtp->num[2];
+ }
+ else {
+ ErtsMRefThing *mrtp = (ErtsMRefThing *) hp;
+ ASSERT(is_magic_ref_thing(hp));
+ iref->is_magic = 1;
+ iref->u.mb = mrtp->mb;
+ erts_refc_inc(&mrtp->mb->intern.refc, 1);
+ }
+}
+
+ERTS_GLB_INLINE void
+erts_iref_storage_clean(ErtsIRefStorage *iref)
+{
+ if (iref->is_magic && erts_refc_dectest(&iref->u.mb->intern.refc, 0) == 0)
+ erts_ref_bin_free(iref->u.mb);
+#ifdef DEBUG
+ memset((void *) iref, 0xf, sizeof(ErtsIRefStorage));
+#endif
+}
+
+ERTS_GLB_INLINE Uint
+erts_iref_storage_heap_size(ErtsIRefStorage *iref)
+{
+ return iref->is_magic ? ERTS_MAGIC_REF_THING_SIZE : ERTS_REF_THING_SIZE;
+}
+
+ERTS_GLB_INLINE Eterm
+erts_iref_storage_make_ref(ErtsIRefStorage *iref,
+ Eterm **hpp, ErlOffHeap *ohp,
+ int clean_storage)
+{
+ Eterm *hp = *hpp;
+ if (!iref->is_magic) {
+ write_ref_thing(hp, iref->u.num[0], iref->u.num[1],
+ iref->u.num[2]);
+ *hpp += ERTS_REF_THING_SIZE;
+ }
+ else {
+ write_magic_ref_thing(hp, ohp, iref->u.mb);
+ OH_OVERHEAD(ohp, iref->u.mb->orig_size / sizeof(Eterm));
+ *hpp += ERTS_MAGIC_REF_THING_SIZE;
+ /*
+ * If we clean storage, the term inherits the
+ * refc increment of the cleaned storage...
+ */
+ if (!clean_storage)
+ erts_refc_inc(&iref->u.mb->intern.refc, 1);
+ }
+
+#ifdef DEBUG
+ if (clean_storage)
+ memset((void *) iref, 0xf, sizeof(ErtsIRefStorage));
+#endif
+
+ return make_internal_ref(hp);
+}
+
+ERTS_GLB_INLINE int
+erts_iref_storage_cmp(ErtsIRefStorage *iref1,
+ ErtsIRefStorage *iref2)
+{
+ Uint32 *num1 = iref1->is_magic ? iref1->u.mb->refn : iref1->u.num;
+ Uint32 *num2 = iref2->is_magic ? iref2->u.mb->refn : iref2->u.num;
+ return erts_internal_ref_number_cmp(num1, num2);
+}
+
+#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
+
+
+/* OIref storage for ordinary internal references only... */
+typedef struct {
+ Uint32 num[ERTS_REF_NUMBERS];
+} ErtsOIRefStorage;
+
+ERTS_GLB_INLINE void erts_oiref_storage_save(ErtsOIRefStorage *oiref,
+ Eterm ref);
+ERTS_GLB_INLINE Eterm erts_oiref_storage_make_ref(ErtsOIRefStorage *oiref,
+ Eterm **hpp);
+ERTS_GLB_INLINE int erts_oiref_storage_cmp(ErtsOIRefStorage *oiref1,
+ ErtsOIRefStorage *oiref2);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_INLINE void
+erts_oiref_storage_save(ErtsOIRefStorage *oiref, Eterm ref)
+{
+ ErtsORefThing *rtp;
+ ERTS_CT_ASSERT(ERTS_REF_NUMBERS == 3);
+ ASSERT(is_internal_ordinary_ref(ref));
+
+ rtp = (ErtsORefThing *) internal_ref_val(ref);
+
+ oiref->num[0] = rtp->num[0];
+ oiref->num[1] = rtp->num[1];
+ oiref->num[2] = rtp->num[2];
+}
+
+ERTS_GLB_INLINE Eterm
+erts_oiref_storage_make_ref(ErtsOIRefStorage *oiref, Eterm **hpp)
+{
+ Eterm *hp = *hpp;
+ ERTS_CT_ASSERT(ERTS_REF_NUMBERS == 3);
+ write_ref_thing(hp, oiref->num[0], oiref->num[1], oiref->num[2]);
+ *hpp += ERTS_REF_THING_SIZE;
+ return make_internal_ref(hp);
+}
+
+ERTS_GLB_INLINE int
+erts_oiref_storage_cmp(ErtsOIRefStorage *oiref1,
+ ErtsOIRefStorage *oiref2)
+{
+ return erts_internal_ref_number_cmp(oiref1->num, oiref2->num);
+}
+
+#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
+
+
+ERTS_GLB_INLINE Eterm
+erts_proc_store_ref(Process *c_p, Uint32 ref[ERTS_MAX_REF_NUMBERS]);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_INLINE Eterm
+erts_proc_store_ref(Process *c_p, Uint32 ref[ERTS_MAX_REF_NUMBERS])
+{
+ Eterm *hp = HAlloc(c_p, ERTS_REF_THING_SIZE);
+ write_ref_thing(hp, ref[0], ref[1], ref[2]);
+ return make_internal_ref(hp);
+}
+
+#endif
+
+#endif /* ERTS_BIF_UNIQUE_H__ */
+
+#if (defined(ERTS_ALLOC_C__) || defined(ERL_BIF_UNIQUE_C__)) \
+ && !defined(ERTS_BIF_UNIQUE_H__FIX_ALLOC_TYPES__)
+#define ERTS_BIF_UNIQUE_H__FIX_ALLOC_TYPES__
+
+#include "hash.h"
+
+typedef struct {
+ HashBucket hash;
+ ErtsMagicBinary *mb;
+ Uint64 value;
+} ErtsNSchedMagicRefTableEntry;
+
+#endif
diff --git a/erts/emulator/beam/erl_binary.h b/erts/emulator/beam/erl_binary.h
index 819b19e566..b036b28dbf 100644
--- a/erts/emulator/beam/erl_binary.h
+++ b/erts/emulator/beam/erl_binary.h
@@ -1,50 +1,170 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2000-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2000-2017. 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/.
+ * 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
*
- * 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.
+ * 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_BINARY_H
-#define __ERL_BINARY_H
+#ifndef ERL_BINARY_H__TYPES__
+#define ERL_BINARY_H__TYPES__
-#include "erl_threads.h"
-#include "bif.h"
+/*
+** Just like the driver binary but with initial flags
+** Note that the two structures Binary and ErlDrvBinary HAVE to
+** be equal except for extra fields in the beginning of the struct.
+** ErlDrvBinary is defined in erl_driver.h.
+** When driver_alloc_binary is called, a Binary is allocated, but
+** the pointer returned is to the address of the first element that
+** also occurs in the ErlDrvBinary struct (driver.*binary takes care if this).
+** The driver need never know about additions to the internal Binary of the
+** emulator. One should however NEVER be sloppy when mixing ErlDrvBinary
+** and Binary, the macros below can convert one type to the other, as they both
+** in reality are equal.
+*/
+
+#ifdef ARCH_32
+ /* *DO NOT USE* only for alignment. */
+#define ERTS_BINARY_STRUCT_ALIGNMENT Uint32 align__;
+#else
+#define ERTS_BINARY_STRUCT_ALIGNMENT
+#endif
+
+/* Add fields in binary_internals, otherwise the drivers crash */
+struct binary_internals {
+ UWord flags;
+ erts_refc_t refc;
+ ERTS_BINARY_STRUCT_ALIGNMENT
+};
+
+
+typedef struct binary {
+ struct binary_internals intern;
+ SWord orig_size;
+ char orig_bytes[1]; /* to be continued */
+} Binary;
+
+#define ERTS_SIZEOF_Binary(Sz) \
+ (offsetof(Binary,orig_bytes) + (Sz))
+
+#if ERTS_REF_NUMBERS != 3
+#error "Update ErtsMagicBinary"
+#endif
+
+typedef struct magic_binary ErtsMagicBinary;
+struct magic_binary {
+ struct binary_internals intern;
+ SWord orig_size;
+ int (*destructor)(Binary *);
+ Uint32 refn[ERTS_REF_NUMBERS];
+ ErtsAlcType_t alloc_type;
+ union {
+ struct {
+ ERTS_BINARY_STRUCT_ALIGNMENT
+ char data[1];
+ } aligned;
+ struct {
+ char data[1];
+ } unaligned;
+ } u;
+};
+
+#define ERTS_MAGIC_BIN_BYTES_TO_ALIGN \
+ (offsetof(ErtsMagicBinary,u.aligned.data) - \
+ offsetof(ErtsMagicBinary,u.unaligned.data))
+
+typedef union {
+ Binary binary;
+ ErtsMagicBinary magic_binary;
+ struct {
+ struct binary_internals intern;
+ ErlDrvBinary binary;
+ } driver;
+} ErtsBinary;
/*
- * Maximum number of bytes to place in a heap binary.
+ * 'Binary' alignment:
+ * Address of orig_bytes[0] of a Binary should always be 8-byte aligned.
+ * It is assumed that the flags, refc, and orig_size fields are 4 bytes on
+ * 32-bits architectures and 8 bytes on 64-bits architectures.
*/
-#define ERL_ONHEAP_BIN_LIMIT 64
+#define ERTS_MAGIC_BIN_REFN(BP) \
+ ((ErtsBinary *) (BP))->magic_binary.refn
+#define ERTS_MAGIC_BIN_ATYPE(BP) \
+ ((ErtsBinary *) (BP))->magic_binary.alloc_type
+#define ERTS_MAGIC_DATA_OFFSET \
+ (offsetof(ErtsMagicBinary,u.aligned.data) - offsetof(Binary,orig_bytes))
+#define ERTS_MAGIC_BIN_DESTRUCTOR(BP) \
+ ((ErtsBinary *) (BP))->magic_binary.destructor
+#define ERTS_MAGIC_BIN_DATA(BP) \
+ ((void *) ((ErtsBinary *) (BP))->magic_binary.u.aligned.data)
+#define ERTS_MAGIC_BIN_DATA_SIZE(BP) \
+ ((BP)->orig_size - ERTS_MAGIC_DATA_OFFSET)
+#define ERTS_MAGIC_DATA_OFFSET \
+ (offsetof(ErtsMagicBinary,u.aligned.data) - offsetof(Binary,orig_bytes))
+#define ERTS_MAGIC_BIN_ORIG_SIZE(Sz) \
+ (ERTS_MAGIC_DATA_OFFSET + (Sz))
+#define ERTS_MAGIC_BIN_SIZE(Sz) \
+ (offsetof(ErtsMagicBinary,u.aligned.data) + (Sz))
+#define ERTS_MAGIC_BIN_FROM_DATA(DATA) \
+ ((ErtsBinary*)((char*)(DATA) - offsetof(ErtsMagicBinary,u.aligned.data)))
+
+/* On 32-bit arch these macro variants will save memory
+ by not forcing 8-byte alignment for the magic payload.
+*/
+#define ERTS_MAGIC_BIN_UNALIGNED_DATA(BP) \
+ ((void *) ((ErtsBinary *) (BP))->magic_binary.u.unaligned.data)
+#define ERTS_MAGIC_UNALIGNED_DATA_OFFSET \
+ (offsetof(ErtsMagicBinary,u.unaligned.data) - offsetof(Binary,orig_bytes))
+#define ERTS_MAGIC_BIN_UNALIGNED_DATA_SIZE(BP) \
+ ((BP)->orig_size - ERTS_MAGIC_UNALIGNED_DATA_OFFSET)
+#define ERTS_MAGIC_BIN_UNALIGNED_ORIG_SIZE(Sz) \
+ (ERTS_MAGIC_UNALIGNED_DATA_OFFSET + (Sz))
+#define ERTS_MAGIC_BIN_UNALIGNED_SIZE(Sz) \
+ (offsetof(ErtsMagicBinary,u.unaligned.data) + (Sz))
+#define ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(DATA) \
+ ((ErtsBinary*)((char*)(DATA) - offsetof(ErtsMagicBinary,u.unaligned.data)))
+
+
+#define Binary2ErlDrvBinary(B) (&((ErtsBinary *) (B))->driver.binary)
+#define ErlDrvBinary2Binary(D) ((Binary *) \
+ (((char *) (D)) \
+ - offsetof(ErtsBinary, driver.binary)))
+
+/* A "magic" binary flag */
+#define BIN_FLAG_MAGIC 1
+#define BIN_FLAG_USR1 2 /* Reserved for use by different modules too mark */
+#define BIN_FLAG_USR2 4 /* certain binaries as special (used by ets) */
+#define BIN_FLAG_DRV 8
+
+#endif /* ERL_BINARY_H__TYPES__ */
+
+#if !defined(ERL_BINARY_H__) && !defined(ERTS_BINARY_TYPES_ONLY__)
+#define ERL_BINARY_H__
+
+#include "erl_threads.h"
+#include "bif.h"
+#include "erl_bif_unique.h"
+#include "erl_bits.h"
/*
- * This structure represents a SUB_BINARY.
- *
- * Note: The last field (orig) is not counted in arityval in the header.
- * This simplifies garbage collection.
+ * Maximum number of bytes to place in a heap binary.
*/
-typedef struct erl_sub_bin {
- Eterm thing_word; /* Subtag SUB_BINARY_SUBTAG. */
- Uint size; /* Binary size in bytes. */
- Uint offs; /* Offset into original binary. */
- byte bitsize;
- byte bitoffs;
- byte is_writable; /* The underlying binary is writable */
- Eterm orig; /* Original binary (REFC or HEAP binary). */
-} ErlSubBin;
+#define ERL_ONHEAP_BIN_LIMIT 64
#define ERL_SUB_BIN_SIZE (sizeof(ErlSubBin)/sizeof(Eterm))
#define HEADER_SUB_BIN _make_header(ERL_SUB_BIN_SIZE-2,_TAG_HEADER_SUB_BIN)
@@ -71,7 +191,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) ? \
@@ -94,12 +213,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) { \
@@ -107,7 +223,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; \
@@ -130,11 +246,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; \
@@ -166,11 +279,22 @@ Eterm erts_bin_bytes_to_list(Eterm previous, Eterm* hp, byte* bytes, Uint size,
* Common implementation for erlang:list_to_binary/1 and binary:list_to_bin/1
*/
-BIF_RETTYPE erts_list_to_binary_bif(Process *p, Eterm arg);
+BIF_RETTYPE erts_list_to_binary_bif(Process *p, Eterm arg, Export *bif);
BIF_RETTYPE erts_gc_binary_part(Process *p, Eterm *reg, Eterm live, int range_is_tuple);
BIF_RETTYPE erts_binary_part(Process *p, Eterm binary, Eterm epos, Eterm elen);
+typedef union {
+ /*
+ * These two are almost always of
+ * the same size, but when fallback
+ * atomics are used they might
+ * differ in size.
+ */
+ erts_smp_atomic_t smp_atomic_word;
+ erts_atomic_t atomic_word;
+} ErtsMagicIndirectionWord;
+
#if defined(__i386__) || !defined(__GNUC__)
/*
* Doubles aren't required to be 8-byte aligned on intel x86.
@@ -194,8 +318,16 @@ ERTS_GLB_INLINE Binary *erts_bin_nrml_alloc(Uint size);
ERTS_GLB_INLINE Binary *erts_bin_realloc_fnf(Binary *bp, Uint size);
ERTS_GLB_INLINE Binary *erts_bin_realloc(Binary *bp, Uint size);
ERTS_GLB_INLINE void erts_bin_free(Binary *bp);
+ERTS_GLB_INLINE void erts_bin_release(Binary *bp);
+ERTS_GLB_INLINE Binary *erts_create_magic_binary_x(Uint size,
+ int (*destructor)(Binary *),
+ ErtsAlcType_t alloc_type,
+ int unaligned);
ERTS_GLB_INLINE Binary *erts_create_magic_binary(Uint size,
- void (*destructor)(Binary *));
+ int (*destructor)(Binary *));
+ERTS_GLB_INLINE Binary *erts_create_magic_indirection(int (*destructor)(Binary *));
+ERTS_GLB_INLINE erts_smp_atomic_t *erts_smp_binary_to_magic_indirection(Binary *bp);
+ERTS_GLB_INLINE erts_atomic_t *erts_binary_to_magic_indirection(Binary *bp);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
@@ -231,35 +363,61 @@ erts_free_aligned_binary_bytes(byte* buf)
# define CHICKEN_PAD (sizeof(void*) - 1)
#endif
+/* Caller must initialize 'refc'
+*/
ERTS_GLB_INLINE Binary *
erts_bin_drv_alloc_fnf(Uint size)
{
Uint bsize = ERTS_SIZEOF_Binary(size) + CHICKEN_PAD;
- void *res;
+ Binary *res;
+
+ if (bsize < size) /* overflow */
+ return NULL;
res = erts_alloc_fnf(ERTS_ALC_T_DRV_BINARY, bsize);
ERTS_CHK_BIN_ALIGNMENT(res);
- return (Binary *) res;
+ if (res) {
+ res->orig_size = size;
+ res->intern.flags = BIN_FLAG_DRV;
+ erts_refc_init(&res->intern.refc, 1);
+ }
+ return res;
}
+/* Caller must initialize 'refc'
+*/
ERTS_GLB_INLINE Binary *
erts_bin_drv_alloc(Uint size)
{
Uint bsize = ERTS_SIZEOF_Binary(size) + CHICKEN_PAD;
- void *res;
+ Binary *res;
+
+ if (bsize < size) /* overflow */
+ erts_alloc_enomem(ERTS_ALC_T_DRV_BINARY, size);
res = erts_alloc(ERTS_ALC_T_DRV_BINARY, bsize);
ERTS_CHK_BIN_ALIGNMENT(res);
- return (Binary *) res;
+ res->orig_size = size;
+ res->intern.flags = BIN_FLAG_DRV;
+ erts_refc_init(&res->intern.refc, 1);
+ return res;
}
+/* Caller must initialize 'refc'
+*/
ERTS_GLB_INLINE Binary *
erts_bin_nrml_alloc(Uint size)
{
Uint bsize = ERTS_SIZEOF_Binary(size) + CHICKEN_PAD;
- void *res;
+ Binary *res;
+
+ if (bsize < size) /* overflow */
+ erts_alloc_enomem(ERTS_ALC_T_BINARY, size);
res = erts_alloc(ERTS_ALC_T_BINARY, bsize);
ERTS_CHK_BIN_ALIGNMENT(res);
- return (Binary *) res;
+ res->orig_size = size;
+ res->intern.flags = 0;
+ erts_refc_init(&res->intern.refc, 1);
+ return res;
}
ERTS_GLB_INLINE Binary *
@@ -267,12 +425,15 @@ erts_bin_realloc_fnf(Binary *bp, Uint size)
{
Binary *nbp;
Uint bsize = ERTS_SIZEOF_Binary(size) + CHICKEN_PAD;
- ASSERT((bp->flags & BIN_FLAG_MAGIC) == 0);
- if (bp->flags & BIN_FLAG_DRV)
- nbp = erts_realloc_fnf(ERTS_ALC_T_DRV_BINARY, (void *) bp, bsize);
- else
- nbp = erts_realloc_fnf(ERTS_ALC_T_BINARY, (void *) bp, bsize);
+ ErtsAlcType_t type = (bp->intern.flags & BIN_FLAG_DRV) ? ERTS_ALC_T_DRV_BINARY
+ : ERTS_ALC_T_BINARY;
+ ASSERT((bp->intern.flags & BIN_FLAG_MAGIC) == 0);
+ if (bsize < size) /* overflow */
+ return NULL;
+ nbp = erts_realloc_fnf(type, (void *) bp, bsize);
ERTS_CHK_BIN_ALIGNMENT(nbp);
+ if (nbp)
+ nbp->orig_size = size;
return nbp;
}
@@ -281,47 +442,103 @@ erts_bin_realloc(Binary *bp, Uint size)
{
Binary *nbp;
Uint bsize = ERTS_SIZEOF_Binary(size) + CHICKEN_PAD;
- ASSERT((bp->flags & BIN_FLAG_MAGIC) == 0);
- if (bp->flags & BIN_FLAG_DRV)
- nbp = erts_realloc_fnf(ERTS_ALC_T_DRV_BINARY, (void *) bp, bsize);
- else
- nbp = erts_realloc_fnf(ERTS_ALC_T_BINARY, (void *) bp, bsize);
+ ErtsAlcType_t type = (bp->intern.flags & BIN_FLAG_DRV) ? ERTS_ALC_T_DRV_BINARY
+ : ERTS_ALC_T_BINARY;
+ ASSERT((bp->intern.flags & BIN_FLAG_MAGIC) == 0);
+ if (bsize < size) /* overflow */
+ erts_realloc_enomem(type, bp, size);
+ nbp = erts_realloc_fnf(type, (void *) bp, bsize);
if (!nbp)
- erts_realloc_n_enomem(ERTS_ALC_T2N(bp->flags & BIN_FLAG_DRV
- ? ERTS_ALC_T_DRV_BINARY
- : ERTS_ALC_T_BINARY),
- bp,
- bsize);
+ erts_realloc_enomem(type, bp, bsize);
ERTS_CHK_BIN_ALIGNMENT(nbp);
+ nbp->orig_size = size;
return nbp;
}
ERTS_GLB_INLINE void
erts_bin_free(Binary *bp)
{
- if (bp->flags & BIN_FLAG_MAGIC)
- ERTS_MAGIC_BIN_DESTRUCTOR(bp)(bp);
- if (bp->flags & BIN_FLAG_DRV)
+ if (bp->intern.flags & BIN_FLAG_MAGIC) {
+ if (!ERTS_MAGIC_BIN_DESTRUCTOR(bp)(bp)) {
+ /* Destructor took control of the deallocation */
+ return;
+ }
+ erts_magic_ref_remove_bin(ERTS_MAGIC_BIN_REFN(bp));
+ erts_free(ERTS_MAGIC_BIN_ATYPE(bp), (void *) bp);
+ }
+ else if (bp->intern.flags & BIN_FLAG_DRV)
erts_free(ERTS_ALC_T_DRV_BINARY, (void *) bp);
else
erts_free(ERTS_ALC_T_BINARY, (void *) bp);
}
+ERTS_GLB_INLINE void
+erts_bin_release(Binary *bp)
+{
+ if (erts_refc_dectest(&bp->intern.refc, 0) == 0) {
+ erts_bin_free(bp);
+ }
+}
+
ERTS_GLB_INLINE Binary *
-erts_create_magic_binary(Uint size, void (*destructor)(Binary *))
+erts_create_magic_binary_x(Uint size, int (*destructor)(Binary *),
+ ErtsAlcType_t alloc_type,
+ int unaligned)
{
- Uint bsize = ERTS_MAGIC_BIN_SIZE(size);
- Binary* bptr = erts_alloc_fnf(ERTS_ALC_T_BINARY, bsize);
+ Uint bsize = unaligned ? ERTS_MAGIC_BIN_UNALIGNED_SIZE(size)
+ : ERTS_MAGIC_BIN_SIZE(size);
+ Binary* bptr = erts_alloc_fnf(alloc_type, bsize);
+ ASSERT(bsize > size);
if (!bptr)
- erts_alloc_n_enomem(ERTS_ALC_T2N(ERTS_ALC_T_BINARY), bsize);
+ erts_alloc_n_enomem(ERTS_ALC_T2N(alloc_type), bsize);
ERTS_CHK_BIN_ALIGNMENT(bptr);
- bptr->flags = BIN_FLAG_MAGIC;
- bptr->orig_size = ERTS_MAGIC_BIN_ORIG_SIZE(size);
- erts_refc_init(&bptr->refc, 0);
+ bptr->intern.flags = BIN_FLAG_MAGIC;
+ bptr->orig_size = unaligned ? ERTS_MAGIC_BIN_UNALIGNED_ORIG_SIZE(size)
+ : ERTS_MAGIC_BIN_ORIG_SIZE(size);
+ erts_refc_init(&bptr->intern.refc, 0);
ERTS_MAGIC_BIN_DESTRUCTOR(bptr) = destructor;
+ ERTS_MAGIC_BIN_ATYPE(bptr) = alloc_type;
+ erts_make_magic_ref_in_array(ERTS_MAGIC_BIN_REFN(bptr));
return bptr;
}
+ERTS_GLB_INLINE Binary *
+erts_create_magic_binary(Uint size, int (*destructor)(Binary *))
+{
+ return erts_create_magic_binary_x(size, destructor,
+ ERTS_ALC_T_BINARY, 0);
+}
+
+ERTS_GLB_INLINE Binary *
+erts_create_magic_indirection(int (*destructor)(Binary *))
+{
+ return erts_create_magic_binary_x(sizeof(ErtsMagicIndirectionWord),
+ destructor,
+ ERTS_ALC_T_MINDIRECTION,
+ 1); /* Not 64-bit aligned,
+ but word aligned */
+}
+
+ERTS_GLB_INLINE erts_smp_atomic_t *
+erts_smp_binary_to_magic_indirection(Binary *bp)
+{
+ ErtsMagicIndirectionWord *mip;
+ ASSERT(bp->intern.flags & BIN_FLAG_MAGIC);
+ ASSERT(ERTS_MAGIC_BIN_ATYPE(bp) == ERTS_ALC_T_MINDIRECTION);
+ mip = ERTS_MAGIC_BIN_UNALIGNED_DATA(bp);
+ return &mip->smp_atomic_word;
+}
+
+ERTS_GLB_INLINE erts_atomic_t *
+erts_binary_to_magic_indirection(Binary *bp)
+{
+ ErtsMagicIndirectionWord *mip;
+ ASSERT(bp->intern.flags & BIN_FLAG_MAGIC);
+ ASSERT(ERTS_MAGIC_BIN_ATYPE(bp) == ERTS_ALC_T_MINDIRECTION);
+ mip = ERTS_MAGIC_BIN_UNALIGNED_DATA(bp);
+ return &mip->atomic_word;
+}
+
#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
-#endif
+#endif /* !ERL_BINARY_H__ */
diff --git a/erts/emulator/beam/erl_bits.c b/erts/emulator/beam/erl_bits.c
index 73765772c8..51d23a8965 100644
--- a/erts/emulator/beam/erl_bits.c
+++ b/erts/emulator/beam/erl_bits.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1999-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1999-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -31,15 +32,6 @@
#include "erl_bits.h"
#include "erl_binary.h"
-#ifdef MAX
-#undef MAX
-#endif
-#define MAX(x,y) (((x)>(y))?(x):(y))
-#ifdef MIN
-#undef MIN
-#endif
-#define MIN(x,y) (((x)<(y))?(x):(y))
-
#if defined(WORDS_BIGENDIAN)
# define BIT_ENDIAN_MACHINE 0
#else
@@ -107,6 +99,11 @@ erts_bits_destroy_state(ERL_BITS_PROTO_0)
void
erts_init_bits(void)
{
+ ERTS_CT_ASSERT(offsetof(Binary,orig_bytes) % 8 == 0);
+ ERTS_CT_ASSERT(offsetof(ErtsMagicBinary,u.aligned.data) % 8 == 0);
+ ERTS_CT_ASSERT(offsetof(ErtsBinary,driver.binary.orig_bytes)
+ == offsetof(Binary,orig_bytes));
+
erts_smp_atomic_init_nob(&bits_bufs_size, 0);
#if defined(ERTS_SMP)
/* erl_process.c calls erts_bits_init_state() on all state instances */
@@ -165,6 +162,26 @@ erts_bs_start_match_2(Process *p, Eterm Binary, Uint Max)
return make_matchstate(ms);
}
+#ifdef DEBUG
+# define CHECK_MATCH_BUFFER(MB) check_match_buffer(MB)
+
+static void check_match_buffer(ErlBinMatchBuffer* mb)
+{
+ Eterm realbin;
+ Uint byteoffs;
+ byte* bytes, bitoffs, bitsz;
+ ProcBin* pb;
+ ERTS_GET_REAL_BIN(mb->orig, realbin, byteoffs, bitoffs, bitsz);
+ bytes = binary_bytes(realbin) + byteoffs;
+ ERTS_ASSERT(mb->base >= bytes && mb->base <= (bytes + binary_size(mb->orig)));
+ pb = (ProcBin *) boxed_val(realbin);
+ if (pb->thing_word == HEADER_PROC_BIN)
+ ERTS_ASSERT(pb->flags == 0);
+}
+#else
+# define CHECK_MATCH_BUFFER(MB)
+#endif
+
Eterm
erts_bs_get_integer_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuffer* mb)
{
@@ -185,6 +202,7 @@ erts_bs_get_integer_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuff
return SMALL_ZERO;
}
+ CHECK_MATCH_BUFFER(mb);
if (mb->size - mb->offset < num_bits) { /* Asked for too many bits. */
return THE_NON_VALUE;
}
@@ -252,7 +270,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++;
@@ -357,7 +375,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)) {
@@ -403,7 +421,10 @@ erts_bs_get_integer_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuff
words_needed = 1+WSIZE(bytes);
hp = HeapOnlyAlloc(p, words_needed);
res = bytes_to_big(LSB, bytes, sgn, hp);
- if (is_small(res)) {
+ if (is_nil(res)) {
+ p->htop = hp;
+ res = THE_NON_VALUE;
+ } else if (is_small(res)) {
p->htop = hp;
} else if ((actual = bignum_header_arity(*hp)+1) < words_needed) {
p->htop = hp + actual;
@@ -422,6 +443,7 @@ erts_bs_get_binary_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuffe
{
ErlSubBin* sb;
+ CHECK_MATCH_BUFFER(mb);
if (mb->size - mb->offset < num_bits) { /* Asked for too many bits. */
return THE_NON_VALUE;
}
@@ -453,6 +475,7 @@ erts_bs_get_float_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuffer
byte* fptr;
FloatDef f;
+ CHECK_MATCH_BUFFER(mb);
if (num_bits == 0) {
f.fd = 0.0;
hp = HeapOnlyAlloc(p, FLOAT_SIZE_OBJECT);
@@ -506,6 +529,8 @@ erts_bs_get_binary_all_2(Process *p, ErlBinMatchBuffer* mb)
{
ErlSubBin* sb;
Uint size;
+
+ CHECK_MATCH_BUFFER(mb);
size = mb->size-mb->offset;
sb = (ErlSubBin *) HeapOnlyAlloc(p, ERL_SUB_BIN_SIZE);
sb->thing_word = HEADER_SUB_BIN;
@@ -1287,7 +1312,14 @@ erts_bs_append(Process* c_p, Eterm* reg, Uint live, Eterm build_size_term,
goto badarg;
}
}
+
+ if((ERTS_UINT_MAX - build_size_in_bits) < erts_bin_offset) {
+ c_p->freason = SYSTEM_LIMIT;
+ return THE_NON_VALUE;
+ }
+
used_size_in_bits = erts_bin_offset + build_size_in_bits;
+
sb->is_writable = 0; /* Make sure that no one else can write. */
pb->size = NBYTES(used_size_in_bits);
pb->flags |= PB_ACTIVE_WRITER;
@@ -1299,7 +1331,6 @@ erts_bs_append(Process* c_p, Eterm* reg, Uint live, Eterm build_size_term,
if (binp->orig_size < pb->size) {
Uint new_size = 2*pb->size;
binp = erts_bin_realloc(binp, new_size);
- binp->orig_size = new_size;
pb->val = binp;
pb->bytes = (byte *) binp->orig_bytes;
}
@@ -1362,18 +1393,27 @@ erts_bs_append(Process* c_p, Eterm* reg, Uint live, Eterm build_size_term,
goto badarg;
}
}
- used_size_in_bits = erts_bin_offset + build_size_in_bits;
- used_size_in_bytes = NBYTES(used_size_in_bits);
- bin_size = 2*used_size_in_bytes;
+
+ if((ERTS_UINT_MAX - build_size_in_bits) < erts_bin_offset) {
+ c_p->freason = SYSTEM_LIMIT;
+ return THE_NON_VALUE;
+ }
+
+ used_size_in_bits = erts_bin_offset + build_size_in_bits;
+ used_size_in_bytes = NBYTES(used_size_in_bits);
+
+ if(used_size_in_bits < (ERTS_UINT_MAX / 2)) {
+ bin_size = 2 * used_size_in_bytes;
+ } else {
+ bin_size = NBYTES(ERTS_UINT_MAX);
+ }
+
bin_size = (bin_size < 256) ? 256 : bin_size;
/*
* Allocate the binary data struct itself.
*/
bptr = erts_bin_nrml_alloc(bin_size);
- bptr->flags = 0;
- bptr->orig_size = bin_size;
- erts_refc_init(&bptr->refc, 1);
erts_current_bin = (byte *) bptr->orig_bytes;
/*
@@ -1457,6 +1497,12 @@ erts_bs_private_append(Process* p, Eterm bin, Eterm build_size_term, Uint unit)
* Calculate new size in bytes.
*/
erts_bin_offset = 8*sb->size + sb->bitsize;
+
+ if((ERTS_UINT_MAX - build_size_in_bits) < erts_bin_offset) {
+ p->freason = SYSTEM_LIMIT;
+ return THE_NON_VALUE;
+ }
+
pos_in_bits_after_build = erts_bin_offset + build_size_in_bits;
pb->size = (pos_in_bits_after_build+7) >> 3;
pb->flags |= PB_ACTIVE_WRITER;
@@ -1475,7 +1521,6 @@ erts_bs_private_append(Process* p, Eterm bin, Eterm build_size_term, Uint unit)
* is safe to reallocate it.
*/
binp = erts_bin_realloc(binp, new_size);
- binp->orig_size = new_size;
pb->val = binp;
pb->bytes = (byte *) binp->orig_bytes;
} else {
@@ -1488,16 +1533,11 @@ erts_bs_private_append(Process* p, Eterm bin, Eterm build_size_term, Uint unit)
* binary and copy the contents of the old binary into it.
*/
Binary* bptr = erts_bin_nrml_alloc(new_size);
- bptr->flags = 0;
- bptr->orig_size = new_size;
- erts_refc_init(&bptr->refc, 1);
sys_memcpy(bptr->orig_bytes, binp->orig_bytes, binp->orig_size);
pb->flags |= PB_IS_WRITABLE | PB_ACTIVE_WRITER;
pb->val = bptr;
pb->bytes = (byte *) bptr->orig_bytes;
- if (erts_refc_dectest(&binp->refc, 0) == 0) {
- erts_bin_free(binp);
- }
+ erts_bin_release(binp);
}
}
erts_current_bin = pb->bytes;
@@ -1537,9 +1577,6 @@ erts_bs_init_writable(Process* p, Eterm sz)
* Allocate the binary data struct itself.
*/
bptr = erts_bin_nrml_alloc(bin_size);
- bptr->flags = 0;
- bptr->orig_size = bin_size;
- erts_refc_init(&bptr->refc, 1);
/*
* Now allocate the ProcBin on the heap.
@@ -1585,9 +1622,7 @@ erts_emasculate_writable_binary(ProcBin* pb)
/* Our allocators are 8 byte aligned, i.e., shrinking with
less than 8 bytes will have no real effect */
if (unused >= 8) {
- Uint new_size = pb->size;
binp = erts_bin_realloc(binp, pb->size);
- binp->orig_size = new_size;
pb->val = binp;
pb->bytes = (byte *) binp->orig_bytes;
}
@@ -1602,6 +1637,7 @@ erts_bs_get_unaligned_uint32(ErlBinMatchBuffer* mb)
byte* LSB;
byte* MSB;
+ CHECK_MATCH_BUFFER(mb);
ASSERT((mb->offset & 7) != 0);
ASSERT(mb->size - mb->offset >= 32);
@@ -1616,7 +1652,7 @@ erts_bs_get_unaligned_uint32(ErlBinMatchBuffer* mb)
return LSB[0] | (LSB[1]<<8) | (LSB[2]<<16) | (LSB[3]<<24);
}
-void
+static void
erts_align_utf8_bytes(ErlBinMatchBuffer* mb, byte* buf)
{
Uint bits = mb->size - mb->offset;
@@ -1661,6 +1697,8 @@ erts_bs_get_utf8(ErlBinMatchBuffer* mb)
2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 3,3,3,3,3,3,3,3,9,9,9,9,9,9,9,9
};
+ CHECK_MATCH_BUFFER(mb);
+
if ((remaining_bits = mb->size - mb->offset) < 8) {
return THE_NON_VALUE;
}
@@ -1745,6 +1783,7 @@ erts_bs_get_utf16(ErlBinMatchBuffer* mb, Uint flags)
return THE_NON_VALUE;
}
+ CHECK_MATCH_BUFFER(mb);
/*
* Set up the pointer to the source bytes.
*/
diff --git a/erts/emulator/beam/erl_bits.h b/erts/emulator/beam/erl_bits.h
index 388d943755..5da2b28a89 100644
--- a/erts/emulator/beam/erl_bits.h
+++ b/erts/emulator/beam/erl_bits.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1999-2011. All Rights Reserved.
+ * Copyright Ericsson AB 1999-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -21,6 +22,23 @@
#define __ERL_BITS_H__
/*
+ * This structure represents a SUB_BINARY.
+ *
+ * Note: The last field (orig) is not counted in arityval in the header.
+ * This simplifies garbage collection.
+ */
+
+typedef struct erl_sub_bin {
+ Eterm thing_word; /* Subtag SUB_BINARY_SUBTAG. */
+ Uint size; /* Binary size in bytes. */
+ Uint offs; /* Offset into original binary. */
+ byte bitsize;
+ byte bitoffs;
+ byte is_writable; /* The underlying binary is writable */
+ Eterm orig; /* Original binary (REFC or HEAP binary). */
+} ErlSubBin;
+
+/*
* This structure represents a binary to be matched.
*/
@@ -82,8 +100,8 @@ typedef struct erl_bin_match_struct{
#ifdef ERTS_SMP
/* the state resides in the current process' scheduler data */
#define ERL_BITS_DECLARE_STATEP struct erl_bits_state *EBS
-#define ERL_BITS_RELOAD_STATEP(P) do{EBS = &(P)->scheduler_data->erl_bits_state;}while(0)
-#define ERL_BITS_DEFINE_STATEP(P) struct erl_bits_state *EBS = &(P)->scheduler_data->erl_bits_state
+#define ERL_BITS_RELOAD_STATEP(P) do{EBS = &erts_proc_sched_data((P))->erl_bits_state;}while(0)
+#define ERL_BITS_DEFINE_STATEP(P) struct erl_bits_state *EBS = &erts_proc_sched_data((P))->erl_bits_state
#else
/* reentrant API but with a hidden single global state, for testing only */
extern struct erl_bits_state ErlBitsState_;
@@ -184,7 +202,6 @@ void erts_new_bs_put_string(ERL_BITS_PROTO_2(byte* iptr, Uint num_bytes));
Uint erts_bits_bufs_size(void);
Uint32 erts_bs_get_unaligned_uint32(ErlBinMatchBuffer* mb);
-void erts_align_utf8_bytes(ErlBinMatchBuffer* mb, byte* buf);
Eterm erts_bs_get_utf8(ErlBinMatchBuffer* mb);
Eterm erts_bs_get_utf16(ErlBinMatchBuffer* mb, Uint flags);
Eterm erts_bs_append(Process* p, Eterm* reg, Uint live, Eterm build_size_term,
diff --git a/erts/emulator/beam/erl_cpu_topology.c b/erts/emulator/beam/erl_cpu_topology.c
index f594cb9392..dfe49ce382 100644
--- a/erts/emulator/beam/erl_cpu_topology.c
+++ b/erts/emulator/beam/erl_cpu_topology.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2010-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2010-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -401,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;
@@ -607,7 +608,7 @@ write_schedulers_bind_change(erts_cpu_topology_t *cpudata, int size)
cpu_bind_order_sort(cpudata, size, cpu_bind_order, 1);
- for (cpu_ix = 0; cpu_ix < size && cpu_ix < erts_no_schedulers; cpu_ix++)
+ for (cpu_ix = 0; cpu_ix < size && s_ix <= erts_no_schedulers; cpu_ix++)
if (erts_is_cpu_available(cpuinfo, cpudata[cpu_ix].logical))
scheduler2cpu_map[s_ix++].bind_id = cpudata[cpu_ix].logical;
}
@@ -826,17 +827,6 @@ erts_sched_bind_atfork_child(int unbind)
return 0;
}
-char *
-erts_sched_bind_atvfork_child(int unbind)
-{
- if (unbind) {
- ERTS_SMP_LC_ASSERT(erts_lc_rwmtx_is_rlocked(&cpuinfo_rwmtx)
- || erts_lc_rwmtx_is_rwlocked(&cpuinfo_rwmtx));
- return erts_get_unbind_from_cpu_str(cpuinfo);
- }
- return "false";
-}
-
void
erts_sched_bind_atfork_parent(int unbind)
{
@@ -1589,7 +1579,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;
}
@@ -1716,7 +1706,8 @@ erts_init_cpu_topology(void)
{
int ix;
- erts_smp_rwmtx_init(&cpuinfo_rwmtx, "cpu_info");
+ erts_smp_rwmtx_init(&cpuinfo_rwmtx, "cpu_info", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
erts_smp_rwmtx_rwlock(&cpuinfo_rwmtx);
scheduler2cpu_map = erts_alloc(ERTS_ALC_T_CPUDATA,
@@ -1966,7 +1957,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");
}
@@ -2253,45 +2244,6 @@ add_cpu_groups(int groups,
return cgm;
}
-static void
-remove_cpu_groups(erts_cpu_groups_callback_t callback, void *arg)
-{
- erts_cpu_groups_map_t *prev_cgm, *cgm;
- erts_cpu_groups_callback_list_t *prev_cgcl, *cgcl;
-
- ERTS_SMP_LC_ASSERT(erts_lc_rwmtx_is_rwlocked(&cpuinfo_rwmtx));
-
- no_cpu_groups_callbacks--;
-
- prev_cgm = NULL;
- for (cgm = cpu_groups_maps; cgm; cgm = cgm->next) {
- prev_cgcl = NULL;
- for (cgcl = cgm->callback_list; cgcl; cgcl = cgcl->next) {
- if (cgcl->callback == callback && cgcl->arg == arg) {
- if (prev_cgcl)
- prev_cgcl->next = cgcl->next;
- else
- cgm->callback_list = cgcl->next;
- erts_free(ERTS_ALC_T_CPU_GRPS_MAP, cgcl);
- if (!cgm->callback_list) {
- if (prev_cgm)
- prev_cgm->next = cgm->next;
- else
- cpu_groups_maps = cgm->next;
- if (cgm->array)
- erts_free(ERTS_ALC_T_CPU_GRPS_MAP, cgm->array);
- erts_free(ERTS_ALC_T_CPU_GRPS_MAP, cgm);
- }
- return;
- }
- prev_cgcl = cgcl;
- }
- prev_cgm = cgm;
- }
-
- erl_exit(ERTS_ABORT_EXIT, "Cpu groups not found\n");
-}
-
static int
cpu_groups_lookup(erts_cpu_groups_map_t *map,
ErtsSchedulerData *esdp)
@@ -2319,7 +2271,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
@@ -2331,21 +2283,3 @@ update_cpu_groups_maps(void)
for (cgm = cpu_groups_maps; cgm; cgm = cgm->next)
make_cpu_groups_map(cgm, 0);
}
-
-void
-erts_add_cpu_groups(int groups,
- erts_cpu_groups_callback_t callback,
- void *arg)
-{
- erts_smp_rwmtx_rwlock(&cpuinfo_rwmtx);
- add_cpu_groups(groups, callback, arg);
- erts_smp_rwmtx_rwunlock(&cpuinfo_rwmtx);
-}
-
-void erts_remove_cpu_groups(erts_cpu_groups_callback_t callback,
- void *arg)
-{
- erts_smp_rwmtx_rwlock(&cpuinfo_rwmtx);
- remove_cpu_groups(callback, arg);
- erts_smp_rwmtx_rwunlock(&cpuinfo_rwmtx);
-}
diff --git a/erts/emulator/beam/erl_cpu_topology.h b/erts/emulator/beam/erl_cpu_topology.h
index b502258dae..c922214702 100644
--- a/erts/emulator/beam/erl_cpu_topology.h
+++ b/erts/emulator/beam/erl_cpu_topology.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2010-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2010-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -84,22 +85,14 @@ void erts_sched_bind_atthrcreate_parent(int unbind);
int erts_sched_bind_atfork_prepare(void);
int erts_sched_bind_atfork_child(int unbind);
-char *erts_sched_bind_atvfork_child(int unbind);
void erts_sched_bind_atfork_parent(int unbind);
Eterm erts_fake_scheduler_bindings(Process *p, Eterm how);
Eterm erts_debug_cpu_groups_map(Process *c_p, int groups);
-
typedef void (*erts_cpu_groups_callback_t)(int,
ErtsSchedulerData *,
int,
void *);
-void erts_add_cpu_groups(int groups,
- erts_cpu_groups_callback_t callback,
- void *arg);
-void erts_remove_cpu_groups(erts_cpu_groups_callback_t callback,
- void *arg);
-
#endif
diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c
index a5d67571e2..6d4a895ef6 100644
--- a/erts/emulator/beam/erl_db.c
+++ b/erts/emulator/beam/erl_db.c
@@ -1,26 +1,25 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2014. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2017. 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/.
+ * 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
*
- * 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.
+ * 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 contains the bif interface functions and
- * the handling of the "meta tables" ie the tables of
- * db tables.
+ * This file contains the 'ets' bif interface functions.
*/
/*
@@ -42,6 +41,7 @@
#include "erl_db.h"
#include "bif.h"
#include "big.h"
+#include "erl_binary.h"
erts_smp_atomic_t erts_ets_misc_mem_size;
@@ -73,62 +73,226 @@ enum DbIterSafety {
#define DID_TRAP(P,Ret) (!is_value(Ret) && ((P)->freason == TRAP))
+/*
+ * "fixed_tabs": list of all fixed tables for a process
+ */
+#ifdef DEBUG
+static int fixed_tabs_find(DbFixation* first, DbFixation* fix);
+#endif
+
+static void fixed_tabs_insert(Process* p, DbFixation* fix)
+{
+ DbFixation* first = erts_psd_get(p, ERTS_PSD_ETS_FIXED_TABLES);
-/*
-** The main meta table, containing all ets tables.
-*/
-#ifdef ERTS_SMP
+ if (!first) {
+ fix->tabs.next = fix->tabs.prev = fix;
+ erts_psd_set(p, ERTS_PSD_ETS_FIXED_TABLES, fix);
+ }
+ else {
+ ASSERT(!fixed_tabs_find(first, fix));
+ fix->tabs.prev = first->tabs.prev;
+ fix->tabs.next = first;
+ fix->tabs.prev->tabs.next = fix;
+ first->tabs.prev = fix;
+ }
+}
-#define ERTS_META_MAIN_TAB_LOCK_TAB_BITS 8
-#define ERTS_META_MAIN_TAB_LOCK_TAB_SIZE (1 << ERTS_META_MAIN_TAB_LOCK_TAB_BITS)
-#define ERTS_META_MAIN_TAB_LOCK_TAB_MASK (ERTS_META_MAIN_TAB_LOCK_TAB_SIZE - 1)
+static void fixed_tabs_delete(Process *p, DbFixation* fix)
+{
+ if (fix->tabs.next == fix) {
+ DbFixation* old;
+ ASSERT(fix->tabs.prev == fix);
+ old = erts_psd_set(p, ERTS_PSD_ETS_FIXED_TABLES, NULL);
+ ASSERT(old == fix); (void)old;
+ }
+ else {
+ DbFixation *first = (DbFixation*) erts_psd_get(p, ERTS_PSD_ETS_FIXED_TABLES);
-typedef union {
- erts_smp_rwmtx_t rwmtx;
- byte cache_line_align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(
- sizeof(erts_smp_rwmtx_t))];
-} erts_meta_main_tab_lock_t;
+ ASSERT(fixed_tabs_find(first, fix));
+ fix->tabs.prev->tabs.next = fix->tabs.next;
+ fix->tabs.next->tabs.prev = fix->tabs.prev;
-static erts_meta_main_tab_lock_t *meta_main_tab_locks;
+ if (fix == first)
+ erts_psd_set(p, ERTS_PSD_ETS_FIXED_TABLES, fix->tabs.next);
+ }
+}
+#ifdef DEBUG
+static int fixed_tabs_find(DbFixation* first, DbFixation* fix)
+{
+ DbFixation* p;
+
+ if (!first) {
+ first = (DbFixation*) erts_psd_get(fix->procs.p, ERTS_PSD_ETS_FIXED_TABLES);
+ }
+ p = first;
+ do {
+ if (p == fix)
+ return 1;
+ ASSERT(p->procs.p == fix->procs.p);
+ ASSERT(p->tabs.next->tabs.prev == p);
+ p = p->tabs.next;
+ } while (p != first);
+ return 0;
+}
#endif
-static struct {
- union {
- DbTable *tb; /* Only directly readable if slot is ALIVE */
- UWord next_free; /* (index<<2)|1 if slot is FREE */
- }u;
-} *meta_main_tab;
-/* A slot in meta_main_tab can have three states:
- * FREE : Free to use for new table. Part of linked free-list.
- * ALIVE: Contains a table
- * DEAD : Contains a table that is being removed.
+
+/*
+ * fixing_procs: tree of all processes fixating a table
*/
-#define IS_SLOT_FREE(i) (meta_main_tab[(i)].u.next_free & 1)
-#define IS_SLOT_DEAD(i) (meta_main_tab[(i)].u.next_free & 2)
-#define IS_SLOT_ALIVE(i) (!(meta_main_tab[(i)].u.next_free & (1|2)))
-#define GET_NEXT_FREE_SLOT(i) (meta_main_tab[(i)].u.next_free >> 2)
-#define SET_NEXT_FREE_SLOT(i,next) (meta_main_tab[(i)].u.next_free = ((next)<<2)|1)
-#define MARK_SLOT_DEAD(i) (meta_main_tab[(i)].u.next_free |= 2)
-#define GET_ANY_SLOT_TAB(i) ((DbTable*)(meta_main_tab[(i)].u.next_free & ~(1|2))) /* dead or alive */
+#define ERTS_RBT_PREFIX fixing_procs
+#define ERTS_RBT_T DbFixation
+#define ERTS_RBT_KEY_T Process*
+#define ERTS_RBT_FLAGS_T int
+#define ERTS_RBT_INIT_EMPTY_TNODE(T) \
+ do { \
+ (T)->procs.parent = NULL; \
+ (T)->procs.right = NULL; \
+ (T)->procs.left = NULL; \
+ } while (0)
+#define ERTS_RBT_IS_RED(T) ((T)->procs.is_red)
+#define ERTS_RBT_SET_RED(T) ((T)->procs.is_red = 1)
+#define ERTS_RBT_IS_BLACK(T) (!(T)->procs.is_red)
+#define ERTS_RBT_SET_BLACK(T) ((T)->procs.is_red = 0)
+#define ERTS_RBT_GET_FLAGS(T) ((T)->procs.is_red)
+#define ERTS_RBT_SET_FLAGS(T, F) ((T)->procs.is_red = (F))
+#define ERTS_RBT_GET_PARENT(T) ((T)->procs.parent)
+#define ERTS_RBT_SET_PARENT(T, P) ((T)->procs.parent = (P))
+#define ERTS_RBT_GET_RIGHT(T) ((T)->procs.right)
+#define ERTS_RBT_SET_RIGHT(T, R) ((T)->procs.right = (R))
+#define ERTS_RBT_GET_LEFT(T) ((T)->procs.left)
+#define ERTS_RBT_SET_LEFT(T, L) ((T)->procs.left = (L))
+#define ERTS_RBT_GET_KEY(T) ((T)->procs.p)
+#define ERTS_RBT_IS_LT(KX, KY) ((KX) < (KY))
+#define ERTS_RBT_IS_EQ(KX, KY) ((KX) == (KY))
+
+#define ERTS_RBT_WANT_INSERT
+#define ERTS_RBT_WANT_LOOKUP
+#define ERTS_RBT_WANT_DELETE
+#define ERTS_RBT_WANT_FOREACH
+#define ERTS_RBT_WANT_FOREACH_DESTROY
+#ifdef DEBUG
+# define ERTS_RBT_WANT_LOOKUP
+#endif
+#define ERTS_RBT_UNDEF
+
+#include "erl_rbtree.h"
+
+#ifdef HARDDEBUG
+# error Do something useful with CHECK_TABLES maybe
+#else
+# define CHECK_TABLES()
+#endif
+
+
+static void
+send_ets_transfer_message(Process *c_p, Process *proc,
+ ErtsProcLocks *locks,
+ DbTable *tb, Eterm heir_data);
+static void schedule_free_dbtable(DbTable* tb);
+static void delete_sched_table(Process *c_p, DbTable *tb);
-static ERTS_INLINE erts_smp_rwmtx_t *
-get_meta_main_tab_lock(unsigned slot)
+static void table_dec_refc(DbTable *tb, erts_aint_t min_val)
+{
+ if (erts_smp_refc_dectest(&tb->common.refc, min_val) == 0)
+ schedule_free_dbtable(tb);
+}
+
+static int
+db_table_tid_destructor(Binary *unused)
+{
+ return 1;
+}
+
+static ERTS_INLINE void
+make_btid(DbTable *tb)
+{
+ Binary *btid = erts_create_magic_indirection(db_table_tid_destructor);
+ erts_smp_atomic_t *tbref = erts_smp_binary_to_magic_indirection(btid);
+ erts_smp_atomic_init_nob(tbref, (erts_aint_t) tb);
+ tb->common.btid = btid;
+ /*
+ * Table and magic indirection refer eachother,
+ * and table is refered once by being alive...
+ */
+ erts_smp_refc_init(&tb->common.refc, 2);
+ erts_refc_inc(&btid->intern.refc, 1);
+}
+
+static ERTS_INLINE DbTable* btid2tab(Binary* btid)
+{
+ erts_smp_atomic_t *tbref = erts_smp_binary_to_magic_indirection(btid);
+ return (DbTable *) erts_smp_atomic_read_nob(tbref);
+}
+
+static DbTable *
+tid2tab(Eterm tid)
+{
+ DbTable *tb;
+ Binary *btid;
+ erts_smp_atomic_t *tbref;
+ if (!is_internal_magic_ref(tid))
+ return NULL;
+
+ btid = erts_magic_ref2bin(tid);
+ if (ERTS_MAGIC_BIN_DESTRUCTOR(btid) != db_table_tid_destructor)
+ return NULL;
+
+ tbref = erts_smp_binary_to_magic_indirection(btid);
+ tb = (DbTable *) erts_smp_atomic_read_nob(tbref);
+
+ ASSERT(!tb || tb->common.btid == btid);
+
+ return tb;
+}
+
+static ERTS_INLINE int
+is_table_alive(DbTable *tb)
+{
+ erts_smp_atomic_t *tbref;
+ DbTable *rtb;
+
+ tbref = erts_smp_binary_to_magic_indirection(tb->common.btid);
+ rtb = (DbTable *) erts_smp_atomic_read_nob(tbref);
+
+ ASSERT(!rtb || rtb == tb);
+
+ return !!rtb;
+}
+
+static ERTS_INLINE int
+is_table_named(DbTable *tb)
{
#ifdef ERTS_SMP
- return &meta_main_tab_locks[slot & ERTS_META_MAIN_TAB_LOCK_TAB_MASK].rwmtx;
+ return tb->common.type & DB_NAMED_TABLE;
#else
- return NULL;
+ return tb->common.status & DB_NAMED_TABLE;
#endif
}
-static erts_smp_spinlock_t meta_main_tab_main_lock;
-static Uint meta_main_tab_first_free; /* Index of first free slot */
-static int meta_main_tab_cnt; /* Number of active tables */
-static int meta_main_tab_top; /* Highest ever used slot + 1 */
-static Uint meta_main_tab_slot_mask; /* The slot index part of an unnamed table id */
-static Uint meta_main_tab_seq_incr;
-static Uint meta_main_tab_seq_cnt = 0; /* To give unique(-ish) table identifiers */
+
+static ERTS_INLINE void
+tid_clear(Process *c_p, DbTable *tb)
+{
+ DbTable *rtb;
+ Binary *btid = tb->common.btid;
+ erts_smp_atomic_t *tbref = erts_smp_binary_to_magic_indirection(btid);
+ rtb = (DbTable *) erts_smp_atomic_xchg_nob(tbref, (erts_aint_t) NULL);
+ ASSERT(!rtb || tb == rtb);
+ if (rtb) {
+ table_dec_refc(tb, 1);
+ delete_sched_table(c_p, tb);
+ }
+}
+
+static ERTS_INLINE Eterm
+make_tid(Process *c_p, DbTable *tb)
+{
+ Eterm *hp = HAlloc(c_p, ERTS_MAGIC_REF_THING_SIZE);
+ return erts_mk_magic_ref(&hp, &c_p->off_heap, tb->common.btid);
+}
+
/*
** The meta hash table of all NAMED ets tables
@@ -180,8 +344,6 @@ int user_requested_db_max_tabs;
int erts_ets_realloc_always_moves;
int erts_ets_always_compress;
static int db_max_tabs;
-static DbTable *meta_pid_to_tab; /* Pid mapped to owned tables */
-static DbTable *meta_pid_to_fixed_tab; /* Pid mapped to fixed tables */
static Eterm ms_delete_all;
static Eterm ms_delete_all_buff[8]; /* To compare with for deletion
of all objects */
@@ -194,15 +356,13 @@ static void fix_table_locked(Process* p, DbTable* tb);
static void unfix_table_locked(Process* p, DbTable* tb, db_lock_kind_t* kind);
static void set_heir(Process* me, DbTable* tb, Eterm heir, UWord heir_data);
static void free_heir_data(DbTable*);
-static void free_fixations_locked(DbTable *tb);
+static SWord free_fixations_locked(Process* p, DbTable *tb);
-static int free_table_cont(Process *p,
- DbTable *tb,
- int first,
- int clean_meta_tab);
-static void print_table(int to, void *to_arg, int show, DbTable* tb);
+static SWord free_table_continue(Process *p, DbTable *tb, SWord reds);
+static void print_table(fmtfn_t to, void *to_arg, int show, DbTable* tb);
static BIF_RETTYPE ets_select_delete_1(BIF_ALIST_1);
static BIF_RETTYPE ets_select_count_1(BIF_ALIST_1);
+static BIF_RETTYPE ets_select_replace_1(BIF_ALIST_1);
static BIF_RETTYPE ets_select_trap_1(BIF_ALIST_1);
static BIF_RETTYPE ets_delete_trap(BIF_ALIST_1);
static Eterm table_info(Process* p, DbTable* tb, Eterm What);
@@ -217,6 +377,7 @@ static BIF_RETTYPE ets_select3(Process* p, Eterm arg1, Eterm arg2, Eterm arg3);
*/
Export ets_select_delete_continue_exp;
Export ets_select_count_continue_exp;
+Export ets_select_replace_continue_exp;
Export ets_select_continue_exp;
/*
@@ -234,23 +395,16 @@ free_dbtable(void *vtb)
erts_smp_atomic_read_nob(&tb->common.memory_size)-sizeof(DbTable),
tb->common.fixations);
}
- erts_fprintf(stderr, "ets: free_dbtable(%T) deleted!!!\r\n",
- tb->common.id);
-
- erts_fprintf(stderr, "ets: free_dbtable: meta_pid_to_tab common.memory_size = %ld\n",
- erts_smp_atomic_read_nob(&meta_pid_to_tab->common.memory_size));
- print_table(ERTS_PRINT_STDOUT, NULL, 1, meta_pid_to_tab);
-
-
- erts_fprintf(stderr, "ets: free_dbtable: meta_pid_to_fixed_tab common.memory_size = %ld\n",
- erts_smp_atomic_read_nob(&meta_pid_to_fixed_tab->common.memory_size));
- print_table(ERTS_PRINT_STDOUT, NULL, 1, meta_pid_to_fixed_tab);
#endif
#ifdef ERTS_SMP
erts_smp_rwmtx_destroy(&tb->common.rwlock);
erts_smp_mtx_destroy(&tb->common.fixlock);
#endif
ASSERT(is_immed(tb->common.heir_data));
+
+ if (tb->common.btid)
+ erts_bin_release(tb->common.btid);
+
erts_db_free(ERTS_ALC_T_DB_TABLE, tb, (void *) tb, sizeof(DbTable));
}
@@ -259,30 +413,182 @@ static void schedule_free_dbtable(DbTable* tb)
/*
* NON-SMP case: Caller is *not* allowed to access the *tb
* structure after this function has returned!
- * SMP case: Caller is allowed to access the *tb structure
- * until the bif has returned (we typically
- * need to unlock the table lock after this
- * function has returned).
+ * SMP case: Caller is allowed to access the *common* part of the *tb
+ * structure until the bif has returned (we typically need to
+ * unlock the table lock after this function has returned).
+ * Caller is *not* allowed to access the specialized part
+ * (hash or tree) of *tb after this function has returned.
*/
- ASSERT(erts_refc_read(&tb->common.ref, 0) == 0);
+ ASSERT(erts_smp_refc_read(&tb->common.refc, 0) == 0);
+ ASSERT(erts_smp_refc_read(&tb->common.fix_count, 0) == 0);
erts_schedule_thr_prgr_later_cleanup_op(free_dbtable,
(void *) tb,
&tb->release.data,
sizeof(DbTable));
}
-static ERTS_INLINE void db_init_lock(DbTable* tb, int use_frequent_read_lock,
- char *rwname, char* fixname)
+static ERTS_INLINE void
+save_sched_table(Process *c_p, DbTable *tb)
+{
+ ErtsSchedulerData *esdp = erts_proc_sched_data(c_p);
+ DbTable *first;
+
+ ASSERT(esdp);
+ esdp->ets_tables.count++;
+ erts_smp_refc_inc(&tb->common.refc, 1);
+
+ first = esdp->ets_tables.clist;
+ if (!first) {
+ tb->common.all.next = tb->common.all.prev = tb;
+ esdp->ets_tables.clist = tb;
+ }
+ else {
+ tb->common.all.prev = first->common.all.prev;
+ tb->common.all.next = first;
+ tb->common.all.prev->common.all.next = tb;
+ first->common.all.prev = tb;
+ }
+}
+
+static ERTS_INLINE void
+remove_sched_table(ErtsSchedulerData *esdp, DbTable *tb)
+{
+ ErtsEtsAllYieldData *eaydp;
+ ASSERT(esdp);
+ ASSERT(erts_get_ref_numbers_thr_id(ERTS_MAGIC_BIN_REFN(tb->common.btid))
+ == (Uint32) esdp->no);
+
+ ASSERT(esdp->ets_tables.count > 0);
+ esdp->ets_tables.count--;
+
+ eaydp = ERTS_SCHED_AUX_YIELD_DATA(esdp, ets_all);
+ if (eaydp->ongoing) {
+ /* ets:all() op process list from last to first... */
+ if (eaydp->tab == tb) {
+ if (eaydp->tab == esdp->ets_tables.clist)
+ eaydp->tab = NULL;
+ else
+ eaydp->tab = tb->common.all.prev;
+ }
+ }
+
+ if (tb->common.all.next == tb) {
+ ASSERT(tb->common.all.prev == tb);
+ ASSERT(esdp->ets_tables.clist == tb);
+ esdp->ets_tables.clist = NULL;
+ }
+ else {
+#ifdef DEBUG
+ DbTable *tmp = esdp->ets_tables.clist;
+ do {
+ if (tmp == tb) break;
+ tmp = tmp->common.all.next;
+ } while (tmp != esdp->ets_tables.clist);
+ ASSERT(tmp == tb);
+#endif
+ tb->common.all.prev->common.all.next = tb->common.all.next;
+ tb->common.all.next->common.all.prev = tb->common.all.prev;
+
+ if (esdp->ets_tables.clist == tb)
+ esdp->ets_tables.clist = tb->common.all.next;
+
+ }
+
+ table_dec_refc(tb, 0);
+}
+
+static void
+scheduled_remove_sched_table(void *vtb)
+{
+ remove_sched_table(erts_get_scheduler_data(), (DbTable *) vtb);
+}
+
+static void
+delete_sched_table(Process *c_p, DbTable *tb)
+{
+ ErtsSchedulerData *esdp = erts_proc_sched_data(c_p);
+ Uint32 sid;
+
+ ASSERT(esdp);
+
+ ASSERT(tb->common.btid);
+ sid = erts_get_ref_numbers_thr_id(ERTS_MAGIC_BIN_REFN(tb->common.btid));
+ ASSERT(1 <= sid && sid <= erts_no_schedulers);
+ if (sid == (Uint32) esdp->no)
+ remove_sched_table(esdp, tb);
+ else
+ erts_schedule_misc_aux_work((int) sid, scheduled_remove_sched_table, tb);
+}
+
+static ERTS_INLINE void
+save_owned_table(Process *c_p, DbTable *tb)
+{
+ DbTable *first;
+
+ erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_STATUS);
+
+ first = (DbTable*) erts_psd_get(c_p, ERTS_PSD_ETS_OWNED_TABLES);
+
+ erts_smp_refc_inc(&tb->common.refc, 1);
+
+ if (!first) {
+ tb->common.owned.next = tb->common.owned.prev = tb;
+ erts_psd_set(c_p, ERTS_PSD_ETS_OWNED_TABLES, tb);
+ }
+ else {
+ tb->common.owned.prev = first->common.owned.prev;
+ tb->common.owned.next = first;
+ tb->common.owned.prev->common.owned.next = tb;
+ first->common.owned.prev = tb;
+ }
+ erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_STATUS);
+}
+
+static ERTS_INLINE void
+delete_owned_table(Process *p, DbTable *tb)
+{
+ erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+ if (tb->common.owned.next == tb) {
+ DbTable* old;
+ ASSERT(tb->common.owned.prev == tb);
+ old = erts_psd_set(p, ERTS_PSD_ETS_OWNED_TABLES, NULL);
+ ASSERT(old == tb); (void)old;
+ }
+ else {
+ DbTable *first = (DbTable*) erts_psd_get(p, ERTS_PSD_ETS_OWNED_TABLES);
+#ifdef DEBUG
+ DbTable *tmp = first;
+ do {
+ if (tmp == tb) break;
+ tmp = tmp->common.owned.next;
+ } while (tmp != first);
+ ASSERT(tmp == tb);
+#endif
+ tb->common.owned.prev->common.owned.next = tb->common.owned.next;
+ tb->common.owned.next->common.owned.prev = tb->common.owned.prev;
+
+ if (tb == first)
+ erts_psd_set(p, ERTS_PSD_ETS_OWNED_TABLES, tb->common.owned.next);
+ }
+ erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+
+ table_dec_refc(tb, 1);
+}
+
+static ERTS_INLINE void db_init_lock(DbTable* tb, int use_frequent_read_lock)
{
#ifdef ERTS_SMP
erts_smp_rwmtx_opt_t rwmtx_opt = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER;
if (use_frequent_read_lock)
rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_FREQUENT_READ;
+ if (erts_ets_rwmtx_spin_count >= 0)
+ rwmtx_opt.main_spincount = erts_ets_rwmtx_spin_count;
#endif
#ifdef ERTS_SMP
- erts_smp_rwmtx_init_opt_x(&tb->common.rwlock, &rwmtx_opt,
- rwname, tb->common.the_name);
- erts_smp_mtx_init_x(&tb->common.fixlock, fixname, tb->common.the_name);
+ erts_smp_rwmtx_init_opt(&tb->common.rwlock, &rwmtx_opt, "db_tab",
+ tb->common.the_name, ERTS_LOCK_FLAGS_CATEGORY_DB);
+ erts_smp_mtx_init(&tb->common.fixlock, "db_tab_fix",
+ tb->common.the_name, ERTS_LOCK_FLAGS_CATEGORY_DB);
tb->common.is_thread_safe = !(tb->common.status & DB_FINE_LOCKED);
#endif
}
@@ -290,7 +596,6 @@ static ERTS_INLINE void db_init_lock(DbTable* tb, int use_frequent_read_lock,
static ERTS_INLINE void db_lock(DbTable* tb, db_lock_kind_t kind)
{
#ifdef ERTS_SMP
- ASSERT(tb != meta_pid_to_tab && tb != meta_pid_to_fixed_tab);
if (tb->common.type & DB_FINE_LOCKED) {
if (kind == LCK_WRITE) {
erts_smp_rwmtx_rwlock(&tb->common.rwlock);
@@ -323,8 +628,6 @@ static ERTS_INLINE void db_unlock(DbTable* tb, db_lock_kind_t kind)
* to follow the tb pointer!
*/
#ifdef ERTS_SMP
- ASSERT(tb != meta_pid_to_tab && tb != meta_pid_to_fixed_tab);
-
if (tb->common.type & DB_FINE_LOCKED) {
if (kind == LCK_WRITE) {
ASSERT(tb->common.is_thread_safe);
@@ -350,20 +653,6 @@ static ERTS_INLINE void db_unlock(DbTable* tb, db_lock_kind_t kind)
#endif
}
-
-static ERTS_INLINE void db_meta_lock(DbTable* tb, db_lock_kind_t kind)
-{
- ASSERT(tb == meta_pid_to_tab || tb == meta_pid_to_fixed_tab);
- ASSERT(kind != LCK_WRITE);
- /* As long as we only lock for READ we don't have to lock at all. */
-}
-
-static ERTS_INLINE void db_meta_unlock(DbTable* tb, db_lock_kind_t kind)
-{
- ASSERT(tb == meta_pid_to_tab || tb == meta_pid_to_fixed_tab);
- ASSERT(kind != LCK_WRITE);
-}
-
static ERTS_INLINE
DbTable* db_get_table_aux(Process *p,
Eterm id,
@@ -371,7 +660,7 @@ DbTable* db_get_table_aux(Process *p,
db_lock_kind_t kind,
int meta_already_locked)
{
- DbTable *tb = NULL;
+ DbTable *tb;
erts_smp_rwmtx_t *mtl = NULL;
/*
@@ -381,23 +670,7 @@ DbTable* db_get_table_aux(Process *p,
*/
ASSERT(erts_get_scheduler_data());
- if (is_small(id)) {
- Uint slot = unsigned_val(id) & meta_main_tab_slot_mask;
- if (!meta_already_locked) {
- mtl = get_meta_main_tab_lock(slot);
- erts_smp_rwmtx_rlock(mtl);
- }
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
- else {
- erts_smp_rwmtx_t *test_mtl = get_meta_main_tab_lock(slot);
- ERTS_SMP_LC_ASSERT(erts_lc_rwmtx_is_rlocked(test_mtl)
- || erts_lc_rwmtx_is_rwlocked(test_mtl));
- }
-#endif
- if (slot < db_max_tabs && IS_SLOT_ALIVE(slot))
- tb = meta_main_tab[slot].u.tb;
- }
- else if (is_atom(id)) {
+ if (is_atom(id)) {
struct meta_name_tab_entry* bucket = meta_name_tab_bucket(id,&mtl);
if (!meta_already_locked)
erts_smp_rwmtx_rlock(mtl);
@@ -406,7 +679,7 @@ DbTable* db_get_table_aux(Process *p,
|| erts_lc_rwmtx_is_rwlocked(mtl));
mtl = NULL;
}
-
+ tb = NULL;
if (bucket->pu.tb != NULL) {
if (is_atom(bucket->u.name_atom)) { /* single */
if (bucket->u.name_atom == id)
@@ -424,11 +697,13 @@ DbTable* db_get_table_aux(Process *p,
}
}
}
+ else
+ tb = tid2tab(id);
+
if (tb) {
db_lock(tb, kind);
- if (tb->common.id != id
- || ((tb->common.status & what) == 0
- && p->common.id != tb->common.owner)) {
+ if ((tb->common.status & what) == 0
+ && p->common.id != tb->common.owner) {
db_unlock(tb, kind);
tb = NULL;
}
@@ -447,18 +722,6 @@ DbTable* db_get_table(Process *p,
return db_get_table_aux(p, id, what, kind, 0);
}
-/* Requires meta_main_tab_locks[slot] locked.
-*/
-static ERTS_INLINE void free_slot(int slot)
-{
- ASSERT(!IS_SLOT_FREE(slot));
- erts_smp_spin_lock(&meta_main_tab_main_lock);
- SET_NEXT_FREE_SLOT(slot,meta_main_tab_first_free);
- meta_main_tab_first_free = slot;
- meta_main_tab_cnt--;
- erts_smp_spin_unlock(&meta_main_tab_main_lock);
-}
-
static int insert_named_tab(Eterm name_atom, DbTable* tb, int have_lock)
{
int ret = 0;
@@ -523,9 +786,10 @@ static int remove_named_tab(DbTable *tb, int have_lock)
{
int ret = 0;
erts_smp_rwmtx_t* rwlock;
- Eterm name_atom = tb->common.id;
+ Eterm name_atom = tb->common.the_name;
struct meta_name_tab_entry* bucket = meta_name_tab_bucket(name_atom,
&rwlock);
+ ASSERT(is_table_named(tb));
#ifdef ERTS_SMP
if (!have_lock && erts_smp_rwmtx_tryrwlock(rwlock) == EBUSY) {
db_unlock(tb, LCK_WRITE);
@@ -596,11 +860,11 @@ done:
*/
static ERTS_INLINE void local_fix_table(DbTable* tb)
{
- erts_refc_inc(&tb->common.ref, 1);
+ erts_smp_refc_inc(&tb->common.fix_count, 1);
}
static ERTS_INLINE void local_unfix_table(DbTable* tb)
{
- if (erts_refc_dectest(&tb->common.ref, 0) == 0) {
+ if (erts_smp_refc_dectest(&tb->common.fix_count, 0) == 0) {
ASSERT(IS_HASH_TABLE(tb->common.status));
db_unfix_table_hash(&(tb->hash));
}
@@ -619,7 +883,7 @@ BIF_RETTYPE ets_safe_fixtable_2(BIF_ALIST_2)
erts_fprintf(stderr,
"ets:safe_fixtable(%T,%T); Process: %T, initial: %T:%T/%bpu\n",
BIF_ARG_1, BIF_ARG_2, BIF_P->common.id,
- BIF_P->initial[0], BIF_P->initial[1], BIF_P->initial[2]);
+ BIF_P->u.initial[0], BIF_P->u.initial[1], BIF_P->u.initial[2]);
#endif
kind = (BIF_ARG_2 == am_true) ? LCK_READ : LCK_WRITE_REC;
@@ -752,6 +1016,31 @@ BIF_RETTYPE ets_prev_2(BIF_ALIST_2)
BIF_RET(ret);
}
+/*
+** take(Tab, Key)
+*/
+BIF_RETTYPE ets_take_2(BIF_ALIST_2)
+{
+ DbTable* tb;
+#ifdef DEBUG
+ int cret;
+#endif
+ Eterm ret;
+ CHECK_TABLES();
+
+ tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE_REC);
+ if (!tb) {
+ BIF_ERROR(BIF_P, BADARG);
+ }
+#ifdef DEBUG
+ cret =
+#endif
+ tb->common.meth->db_take(BIF_P, tb, BIF_ARG_2, &ret);
+ ASSERT(cret == DB_ERROR_NONE);
+ db_unlock(tb, LCK_WRITE_REC);
+ BIF_RET(ret);
+}
+
/*
** update_element(Tab, Key, {Pos, Value})
** update_element(Tab, Key, [{Pos, Value}])
@@ -779,7 +1068,7 @@ BIF_RETTYPE ets_update_element_3(BIF_ALIST_3)
list = BIF_ARG_3;
}
- if (!tb->common.meth->db_lookup_dbterm(tb, BIF_ARG_2, &handle)) {
+ if (!tb->common.meth->db_lookup_dbterm(BIF_P, tb, BIF_ARG_2, THE_NON_VALUE, &handle)) {
cret = DB_ERROR_BADKEY;
goto bail_out;
}
@@ -818,7 +1107,7 @@ BIF_RETTYPE ets_update_element_3(BIF_ALIST_3)
}
finalize:
- tb->common.meth->db_finalize_dbterm(&handle);
+ tb->common.meth->db_finalize_dbterm(cret, &handle);
bail_out:
UnUseTmpHeap(2,BIF_P);
@@ -837,14 +1126,8 @@ bail_out:
}
}
-/*
-** update_counter(Tab, Key, Incr)
-** update_counter(Tab, Key, {Upop})
-** update_counter(Tab, Key, [{Upop}])
-** Upop = {Pos,Incr} | {Pos,Incr,Threshold,WarpTo}
-** Returns new value(s) (integer or [integer])
-*/
-BIF_RETTYPE ets_update_counter_3(BIF_ALIST_3)
+static BIF_RETTYPE
+do_update_counter(Process *p, Eterm arg1, Eterm arg2, Eterm arg3, Eterm arg4)
{
DbTable* tb;
int cret = DB_ERROR_BADITEM;
@@ -854,7 +1137,7 @@ BIF_RETTYPE ets_update_counter_3(BIF_ALIST_3)
Eterm* ret_list_currp = NULL;
Eterm* ret_list_prevp = NULL;
Eterm iter;
- DeclareTmpHeap(cell,5,BIF_P);
+ DeclareTmpHeap(cell, 5, p);
Eterm *tuple = cell+2;
DbUpdateHandle handle;
Uint halloc_size = 0; /* overestimated heap usage */
@@ -862,28 +1145,29 @@ BIF_RETTYPE ets_update_counter_3(BIF_ALIST_3)
Eterm* hstart;
Eterm* hend;
- if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE_REC)) == NULL) {
- BIF_ERROR(BIF_P, BADARG);
+ if ((tb = db_get_table(p, arg1, DB_WRITE, LCK_WRITE_REC)) == NULL) {
+ BIF_ERROR(p, BADARG);
}
- UseTmpHeap(5,BIF_P);
+ UseTmpHeap(5, p);
if (!(tb->common.status & (DB_SET | DB_ORDERED_SET))) {
goto bail_out;
}
- if (is_integer(BIF_ARG_3)) { /* Incr */
- upop_list = CONS(cell, TUPLE2(tuple, make_small(tb->common.keypos+1),
- BIF_ARG_3), NIL);
+ if (is_integer(arg3)) { /* Incr */
+ upop_list = CONS(cell,
+ TUPLE2(tuple, make_small(tb->common.keypos+1), arg3),
+ NIL);
}
- else if (is_tuple(BIF_ARG_3)) { /* {Upop} */
- upop_list = CONS(cell, BIF_ARG_3, NIL);
+ else if (is_tuple(arg3)) { /* {Upop} */
+ upop_list = CONS(cell, arg3, NIL);
}
else { /* [{Upop}] (probably) */
- upop_list = BIF_ARG_3;
+ upop_list = arg3;
ret_list_prevp = &ret;
}
- if (!tb->common.meth->db_lookup_dbterm(tb, BIF_ARG_2, &handle)) {
+ if (!tb->common.meth->db_lookup_dbterm(p, tb, arg2, arg4, &handle)) {
goto bail_out; /* key not found */
}
@@ -956,13 +1240,13 @@ BIF_RETTYPE ets_update_counter_3(BIF_ALIST_3)
if (ret_list_prevp) { /* Prepare to return a list */
ret = NIL;
halloc_size += list_size;
- hstart = HAlloc(BIF_P, halloc_size);
+ hstart = HAlloc(p, halloc_size);
ret_list_currp = hstart;
htop = hstart + list_size;
hend = hstart + halloc_size;
}
else {
- hstart = htop = HAlloc(BIF_P, halloc_size);
+ hstart = htop = HAlloc(p, halloc_size);
}
hend = hstart + halloc_size;
@@ -1009,26 +1293,54 @@ BIF_RETTYPE ets_update_counter_3(BIF_ALIST_3)
(is_list(ret) && (list_val(ret)+list_size)==ret_list_currp));
ASSERT(htop <= hend);
- HRelease(BIF_P,hend,htop);
+ HRelease(p, hend, htop);
finalize:
- tb->common.meth->db_finalize_dbterm(&handle);
+ tb->common.meth->db_finalize_dbterm(cret, &handle);
bail_out:
- UnUseTmpHeap(5,BIF_P);
+ UnUseTmpHeap(5, p);
db_unlock(tb, LCK_WRITE_REC);
switch (cret) {
case DB_ERROR_NONE:
BIF_RET(ret);
case DB_ERROR_SYSRES:
- BIF_ERROR(BIF_P, SYSTEM_LIMIT);
+ BIF_ERROR(p, SYSTEM_LIMIT);
default:
- BIF_ERROR(BIF_P, BADARG);
+ BIF_ERROR(p, BADARG);
break;
}
}
+/*
+** update_counter(Tab, Key, Incr)
+** update_counter(Tab, Key, Upop)
+** update_counter(Tab, Key, [{Upop}])
+** Upop = {Pos,Incr} | {Pos,Incr,Threshold,WarpTo}
+** Returns new value(s) (integer or [integer])
+*/
+BIF_RETTYPE ets_update_counter_3(BIF_ALIST_3)
+{
+ return do_update_counter(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, THE_NON_VALUE);
+}
+
+/*
+** update_counter(Tab, Key, Incr, Default)
+** update_counter(Tab, Key, Upop, Default)
+** update_counter(Tab, Key, [{Upop}], Default)
+** Upop = {Pos,Incr} | {Pos,Incr,Threshold,WarpTo}
+** Returns new value(s) (integer or [integer])
+*/
+BIF_RETTYPE ets_update_counter_4(BIF_ALIST_4)
+{
+ if (is_not_tuple(BIF_ARG_4)) {
+ BIF_ERROR(BIF_P, BADARG);
+ }
+ return do_update_counter(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, BIF_ARG_4);
+}
+
+
/*
** The put BIF
*/
@@ -1042,7 +1354,7 @@ BIF_RETTYPE ets_insert_2(BIF_ALIST_2)
CHECK_TABLES();
- /* Write lock table if more than one object to keep atomicy */
+ /* Write lock table if more than one object to keep atomicity */
kind = ((is_list(BIF_ARG_2) && CDR(list_val(BIF_ARG_2)) != NIL)
? LCK_WRITE : LCK_WRITE_REC);
@@ -1112,7 +1424,7 @@ BIF_RETTYPE ets_insert_new_2(BIF_ALIST_2)
Eterm lookup_ret;
DbTableMethod* meth;
- /* More than one object, use LCK_WRITE to keep atomicy */
+ /* More than one object, use LCK_WRITE to keep atomicity */
kind = LCK_WRITE;
tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, kind);
if (tb == NULL) {
@@ -1192,13 +1504,14 @@ BIF_RETTYPE ets_rename_2(BIF_ALIST_2)
{
DbTable* tb;
Eterm ret;
+ Eterm old_name;
erts_smp_rwmtx_t *lck1, *lck2;
#ifdef HARDDEBUG
erts_fprintf(stderr,
"ets:rename(%T,%T); Process: %T, initial: %T:%T/%bpu\n",
BIF_ARG_1, BIF_ARG_2, BIF_P->common.id,
- BIF_P->initial[0], BIF_P->initial[1], BIF_P->initial[2]);
+ BIF_P->u.initial[0], BIF_P->u.initial[1], BIF_P->u.initial[2]);
#endif
@@ -1208,12 +1521,10 @@ BIF_RETTYPE ets_rename_2(BIF_ALIST_2)
(void) meta_name_tab_bucket(BIF_ARG_2, &lck1);
- if (is_small(BIF_ARG_1)) {
- Uint slot = unsigned_val(BIF_ARG_1) & meta_main_tab_slot_mask;
- lck2 = get_meta_main_tab_lock(slot);
- }
- else if (is_atom(BIF_ARG_1)) {
- (void) meta_name_tab_bucket(BIF_ARG_1, &lck2);
+ if (is_atom(BIF_ARG_1)) {
+ old_name = BIF_ARG_1;
+ named_tab:
+ (void) meta_name_tab_bucket(old_name, &lck2);
if (lck1 == lck2)
lck2 = NULL;
else if (lck1 > lck2) {
@@ -1223,7 +1534,16 @@ BIF_RETTYPE ets_rename_2(BIF_ALIST_2)
}
}
else {
- BIF_ERROR(BIF_P, BADARG);
+ tb = tid2tab(BIF_ARG_1);
+ if (!tb)
+ BIF_ERROR(BIF_P, BADARG);
+ else {
+ if (is_table_named(tb)) {
+ old_name = tb->common.the_name;
+ goto named_tab;
+ }
+ lck2 = NULL;
+ }
}
erts_smp_rwmtx_rwlock(lck1);
@@ -1234,21 +1554,19 @@ BIF_RETTYPE ets_rename_2(BIF_ALIST_2)
if (!tb)
goto badarg;
- if (is_not_atom(tb->common.id)) { /* Not a named table */
- tb->common.the_name = BIF_ARG_2;
- goto done;
- }
+ if (is_table_named(tb)) {
+ if (!insert_named_tab(BIF_ARG_2, tb, 1))
+ goto badarg;
- if (!insert_named_tab(BIF_ARG_2, tb, 1))
- goto badarg;
-
- if (!remove_named_tab(tb, 1))
- erl_exit(1,"Could not find named tab %s", tb->common.id);
-
- tb->common.id = tb->common.the_name = BIF_ARG_2;
+ if (!remove_named_tab(tb, 1))
+ erts_exit(ERTS_ERROR_EXIT,"Could not find named tab %s", tb->common.the_name);
+ ret = BIF_ARG_2;
+ }
+ else { /* Not a named table */
+ ret = BIF_ARG_1;
+ }
+ tb->common.the_name = BIF_ARG_2;
- done:
- ret = tb->common.id;
db_unlock(tb, LCK_WRITE);
erts_smp_rwmtx_rwunlock(lck1);
if (lck2)
@@ -1272,7 +1590,6 @@ BIF_RETTYPE ets_rename_2(BIF_ALIST_2)
BIF_RETTYPE ets_new_2(BIF_ALIST_2)
{
DbTable* tb = NULL;
- int slot;
Eterm list;
Eterm val;
Eterm ret;
@@ -1287,9 +1604,7 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
#ifdef DEBUG
int cret;
#endif
- DeclareTmpHeap(meta_tuple,3,BIF_P);
DbTableMethod* meth;
- erts_smp_rwmtx_t *mmtl;
if (is_not_atom(BIF_ARG_1)) {
BIF_ERROR(BIF_P, BADARG);
@@ -1298,7 +1613,7 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
BIF_ERROR(BIF_P, BADARG);
}
- status = DB_NORMAL | DB_SET | DB_PROTECTED;
+ status = DB_SET | DB_PROTECTED;
keypos = 1;
is_named = 0;
#ifdef ERTS_SMP
@@ -1324,7 +1639,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) {
@@ -1382,6 +1696,7 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
}
else if (val == am_named_table) {
is_named = 1;
+ status |= DB_NAMED_TABLE;
}
else if (val == am_compressed) {
is_compressed = 1;
@@ -1436,16 +1751,15 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
tb->common.type = status & ERTS_ETS_TABLE_TYPES;
/* Note, 'type' is *read only* from now on... */
#endif
- erts_refc_init(&tb->common.ref, 0);
- db_init_lock(tb, status & (DB_FINE_LOCKED|DB_FREQ_READ),
- "db_tab", "db_tab_fix");
+ erts_smp_refc_init(&tb->common.fix_count, 0);
+ db_init_lock(tb, status & (DB_FINE_LOCKED|DB_FREQ_READ));
tb->common.keypos = keypos;
tb->common.owner = BIF_P->common.id;
set_heir(BIF_P, tb, heir, heir_data);
erts_smp_atomic_init_nob(&tb->common.nitems, 0);
- tb->common.fixations = NULL;
+ tb->common.fixing_procs = NULL;
tb->common.compress = is_compressed;
#ifdef DEBUG
@@ -1454,87 +1768,36 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
meth->db_create(BIF_P, tb);
ASSERT(cret == DB_ERROR_NONE);
- erts_smp_spin_lock(&meta_main_tab_main_lock);
-
- if (meta_main_tab_cnt >= db_max_tabs) {
- erts_smp_spin_unlock(&meta_main_tab_main_lock);
- erts_send_error_to_logger_str(BIF_P->group_leader,
- "** Too many db tables **\n");
- free_heir_data(tb);
- tb->common.meth->db_free_table(tb);
- free_dbtable((void *) tb);
- BIF_ERROR(BIF_P, SYSTEM_LIMIT);
- }
+ make_btid(tb);
- slot = meta_main_tab_first_free;
- ASSERT(slot>=0 && slot<db_max_tabs);
- meta_main_tab_first_free = GET_NEXT_FREE_SLOT(slot);
- meta_main_tab_cnt++;
- if (slot >= meta_main_tab_top) {
- ASSERT(slot == meta_main_tab_top);
- meta_main_tab_top = slot + 1;
- }
-
- if (is_named) {
- ret = BIF_ARG_1;
- }
- else {
- ret = make_small(slot | meta_main_tab_seq_cnt);
- meta_main_tab_seq_cnt += meta_main_tab_seq_incr;
- ASSERT((unsigned_val(ret) & meta_main_tab_slot_mask) == slot);
- }
- erts_smp_spin_unlock(&meta_main_tab_main_lock);
-
- tb->common.id = ret;
- tb->common.slot = slot; /* store slot for erase */
+ if (is_named)
+ ret = BIF_ARG_1;
+ else
+ ret = make_tid(BIF_P, tb);
- mmtl = get_meta_main_tab_lock(slot);
- erts_smp_rwmtx_rwlock(mmtl);
- meta_main_tab[slot].u.tb = tb;
- ASSERT(IS_SLOT_ALIVE(slot));
- erts_smp_rwmtx_rwunlock(mmtl);
+ save_sched_table(BIF_P, tb);
if (is_named && !insert_named_tab(BIF_ARG_1, tb, 0)) {
- mmtl = get_meta_main_tab_lock(slot);
- erts_smp_rwmtx_rwlock(mmtl);
- free_slot(slot);
- erts_smp_rwmtx_rwunlock(mmtl);
+ tid_clear(BIF_P, tb);
db_lock(tb,LCK_WRITE);
free_heir_data(tb);
tb->common.meth->db_free_table(tb);
- schedule_free_dbtable(tb);
db_unlock(tb,LCK_WRITE);
+ table_dec_refc(tb, 0);
BIF_ERROR(BIF_P, BADARG);
}
BIF_P->flags |= F_USING_DB; /* So we can remove tb if p dies */
+ save_owned_table(BIF_P, tb);
#ifdef HARDDEBUG
erts_fprintf(stderr,
"ets:new(%T,%T)=%T; Process: %T, initial: %T:%T/%bpu\n",
BIF_ARG_1, BIF_ARG_2, ret, BIF_P->common.id,
- BIF_P->initial[0], BIF_P->initial[1], BIF_P->initial[2]);
- erts_fprintf(stderr, "ets: new: meta_pid_to_tab common.memory_size = %ld\n",
- erts_smp_atomic_read_nob(&meta_pid_to_tab->common.memory_size));
- erts_fprintf(stderr, "ets: new: meta_pid_to_fixed_tab common.memory_size = %ld\n",
- erts_smp_atomic_read_nob(&meta_pid_to_fixed_tab->common.memory_size));
+ BIF_P->u.initial[0], BIF_P->u.initial[1], BIF_P->u.initial[2]);
#endif
- UseTmpHeap(3,BIF_P);
-
- db_meta_lock(meta_pid_to_tab, LCK_WRITE_REC);
- if (db_put_hash(meta_pid_to_tab,
- TUPLE2(meta_tuple,
- BIF_P->common.id,
- make_small(slot)),
- 0) != DB_ERROR_NONE) {
- erl_exit(1,"Could not update ets metadata.");
- }
- db_meta_unlock(meta_pid_to_tab, LCK_WRITE_REC);
-
- UnUseTmpHeap(3,BIF_P);
-
BIF_RET(ret);
}
@@ -1639,15 +1902,15 @@ BIF_RETTYPE ets_lookup_element_3(BIF_ALIST_3)
*/
BIF_RETTYPE ets_delete_1(BIF_ALIST_1)
{
- int trap;
+ SWord initial_reds = ERTS_BIF_REDS_LEFT(BIF_P);
+ SWord reds = initial_reds;
DbTable* tb;
- erts_smp_rwmtx_t *mmtl;
#ifdef HARDDEBUG
erts_fprintf(stderr,
"ets:delete(%T); Process: %T, initial: %T:%T/%bpu\n",
BIF_ARG_1, BIF_P->common.id,
- BIF_P->initial[0], BIF_P->initial[1], BIF_P->initial[2]);
+ BIF_P->u.initial[0], BIF_P->u.initial[1], BIF_P->u.initial[2]);
#endif
CHECK_TABLES();
@@ -1664,7 +1927,6 @@ BIF_RETTYPE ets_delete_1(BIF_ALIST_1)
tb->common.status |= DB_DELETE;
if (tb->common.owner != BIF_P->common.id) {
- DeclareTmpHeap(meta_tuple,3,BIF_P);
/*
* The table is being deleted by a process other than its owner.
@@ -1672,68 +1934,47 @@ BIF_RETTYPE ets_delete_1(BIF_ALIST_1)
* current process will be killed (e.g. by an EXIT signal), we will
* now transfer the ownership to the current process.
*/
- UseTmpHeap(3,BIF_P);
- db_meta_lock(meta_pid_to_tab, LCK_WRITE_REC);
- db_erase_bag_exact2(meta_pid_to_tab, tb->common.owner,
- make_small(tb->common.slot));
-
- BIF_P->flags |= F_USING_DB;
- tb->common.owner = BIF_P->common.id;
-
- db_put_hash(meta_pid_to_tab,
- TUPLE2(meta_tuple,
- BIF_P->common.id,
- make_small(tb->common.slot)),
- 0);
- db_meta_unlock(meta_pid_to_tab, LCK_WRITE_REC);
- UnUseTmpHeap(3,BIF_P);
- }
- mmtl = get_meta_main_tab_lock(tb->common.slot);
-#ifdef ERTS_SMP
- if (erts_smp_rwmtx_tryrwlock(mmtl) == EBUSY) {
- /*
- * We keep our increased refc over this op in order to
- * prevent the table from disapearing.
- */
- db_unlock(tb, LCK_WRITE);
- erts_smp_rwmtx_rwlock(mmtl);
- db_lock(tb, LCK_WRITE);
+ Process *rp = erts_proc_lookup_raw(tb->common.owner);
+ /*
+ * Process 'rp' might be exiting, but our table lock prevents it
+ * from terminating as it cannot complete erts_db_process_exiting().
+ */
+ ASSERT(!(ERTS_PSFLG_FREE & erts_smp_atomic32_read_nob(&rp->state)));
+
+ delete_owned_table(rp, tb);
+ BIF_P->flags |= F_USING_DB;
+ tb->common.owner = BIF_P->common.id;
+ save_owned_table(BIF_P, tb);
}
-#endif
- /* We must keep the slot, to be found by db_proc_dead() if process dies */
- MARK_SLOT_DEAD(tb->common.slot);
- erts_smp_rwmtx_rwunlock(mmtl);
- if (is_atom(tb->common.id))
+
+ tid_clear(BIF_P, tb);
+
+ if (is_table_named(tb))
remove_named_tab(tb, 0);
/* disable inheritance */
free_heir_data(tb);
tb->common.heir = am_none;
- free_fixations_locked(tb);
-
- trap = free_table_cont(BIF_P, tb, 1, 1);
+ reds -= free_fixations_locked(BIF_P, tb);
db_unlock(tb, LCK_WRITE);
- if (trap) {
+
+ if (free_table_continue(BIF_P, tb, reds) < 0) {
/*
* Package the DbTable* pointer into a bignum so that it can be safely
* passed through a trap. We used to pass the DbTable* pointer directly
* (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
+ BUMP_ALL_REDS(BIF_P);
BIF_TRAP1(&ets_delete_continue_exp, BIF_P, make_big(hp));
}
else {
+ BUMP_REDS(BIF_P, (initial_reds - reds));
BIF_RET(am_true);
}
}
@@ -1745,7 +1986,6 @@ BIF_RETTYPE ets_give_away_3(BIF_ALIST_3)
{
Process* to_proc = NULL;
ErtsProcLocks to_locks = ERTS_PROC_LOCK_MAIN;
- DeclareTmpHeap(buf,5,BIF_P);
Eterm to_pid = BIF_ARG_2;
Eterm from_pid;
DbTable* tb = NULL;
@@ -1767,26 +2007,14 @@ BIF_RETTYPE ets_give_away_3(BIF_ALIST_3)
goto badarg; /* or should we be idempotent? return false maybe */
}
- UseTmpHeap(5,BIF_P);
- db_meta_lock(meta_pid_to_tab, LCK_WRITE_REC);
- db_erase_bag_exact2(meta_pid_to_tab, tb->common.owner,
- make_small(tb->common.slot));
-
+ delete_owned_table(BIF_P, tb);
to_proc->flags |= F_USING_DB;
tb->common.owner = to_pid;
-
- db_put_hash(meta_pid_to_tab,
- TUPLE2(buf,to_pid,make_small(tb->common.slot)),
- 0);
- db_meta_unlock(meta_pid_to_tab, LCK_WRITE_REC);
+ save_owned_table(to_proc, tb);
db_unlock(tb,LCK_WRITE);
- erts_send_message(BIF_P, to_proc, &to_locks,
- TUPLE4(buf, am_ETS_TRANSFER,
- tb->common.id,
- from_pid,
- BIF_ARG_3),
- 0);
+ send_ets_transfer_message(BIF_P, to_proc, &to_locks,
+ tb, BIF_ARG_3);
erts_smp_proc_unlock(to_proc, to_locks);
UnUseTmpHeap(5,BIF_P);
BIF_RET(am_true);
@@ -2029,7 +2257,7 @@ BIF_RETTYPE ets_select_delete_2(BIF_ALIST_2)
if (safety == ITER_UNSAFE) {
local_fix_table(tb);
}
- cret = tb->common.meth->db_select_delete(BIF_P, tb, BIF_ARG_2, &ret);
+ cret = tb->common.meth->db_select_delete(BIF_P, tb, BIF_ARG_1, BIF_ARG_2, &ret);
if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) {
fix_table_locked(BIF_P,tb);
@@ -2056,46 +2284,254 @@ BIF_RETTYPE ets_select_delete_2(BIF_ALIST_2)
return result;
}
-/*
-** Return a list of tables on this node
-*/
-BIF_RETTYPE ets_all_0(BIF_ALIST_0)
+/*
+ * ets:all/0
+ *
+ * ets:all() calls ets:internal_request_all/0 which
+ * requests information about all tables from
+ * each scheduler thread. Each scheduler replies
+ * to the calling process with information about
+ * existing tables created on that specific scheduler.
+ */
+
+struct ErtsEtsAllReq_ {
+ erts_smp_atomic32_t refc;
+ Process *proc;
+ ErtsOIRefStorage ref;
+ ErtsEtsAllReqList list[1]; /* one per scheduler */
+};
+
+#define ERTS_ETS_ALL_REQ_SIZE \
+ (sizeof(ErtsEtsAllReq) \
+ + (sizeof(ErtsEtsAllReqList) \
+ * (erts_no_schedulers - 1)))
+
+typedef struct {
+ ErtsEtsAllReq *ongoing;
+ ErlHeapFragment *hfrag;
+ DbTable *tab;
+ ErtsEtsAllReq *queue;
+} ErtsEtsAllData;
+
+/* Tables handled before yielding */
+#define ERTS_ETS_ALL_TB_YCNT 200
+/*
+ * Min yield count required before starting
+ * an operation that will require yield.
+ */
+#define ERTS_ETS_ALL_TB_YCNT_START 10
+
+#ifdef DEBUG
+/* Test yielding... */
+#undef ERTS_ETS_ALL_TB_YCNT
+#undef ERTS_ETS_ALL_TB_YCNT_START
+#define ERTS_ETS_ALL_TB_YCNT 10
+#define ERTS_ETS_ALL_TB_YCNT_START 1
+#endif
+
+static int
+ets_all_reply(ErtsSchedulerData *esdp, ErtsEtsAllReq **reqpp,
+ ErlHeapFragment **hfragpp, DbTable **tablepp,
+ int *yield_count_p)
{
- DbTable* tb;
- Eterm previous;
- int i;
- Eterm* hp;
- Eterm* hendp;
- int t_tabs_cnt;
- int t_top;
-
- erts_smp_spin_lock(&meta_main_tab_main_lock);
- t_tabs_cnt = meta_main_tab_cnt;
- t_top = meta_main_tab_top;
- erts_smp_spin_unlock(&meta_main_tab_main_lock);
-
- hp = HAlloc(BIF_P, 2*t_tabs_cnt);
- hendp = hp + 2*t_tabs_cnt;
-
- previous = NIL;
- for(i = 0; i < t_top; i++) {
- erts_smp_rwmtx_t *mmtl = get_meta_main_tab_lock(i);
- erts_smp_rwmtx_rlock(mmtl);
- if (IS_SLOT_ALIVE(i)) {
- if (hp == hendp) {
- /* Racing table creator, grab some more heap space */
- t_tabs_cnt = 10;
- hp = HAlloc(BIF_P, 2*t_tabs_cnt);
- hendp = hp + 2*t_tabs_cnt;
- }
- tb = meta_main_tab[i].u.tb;
- previous = CONS(hp, tb->common.id, previous);
- hp += 2;
- }
- erts_smp_rwmtx_runlock(mmtl);
+ ErtsEtsAllReq *reqp = *reqpp;
+ ErlHeapFragment *hfragp = *hfragpp;
+ int ycount = *yield_count_p;
+ DbTable *tb, *first;
+ Uint sz;
+ Eterm list, msg, ref, *hp;
+ ErlOffHeap *ohp;
+ ErtsMessage *mp;
+
+ /*
+ * - save_sched_table() inserts at end of circular list.
+ *
+ * - This function scans from the end so we know that
+ * the amount of tables to scan wont grow even if we
+ * yield.
+ *
+ * - remove_sched_table() updates the table we yielded
+ * on if it removes it.
+ */
+
+ if (hfragp) {
+ /* Restart of a yielded operation... */
+ ASSERT(hfragp->used_size < hfragp->alloc_size);
+ ohp = &hfragp->off_heap;
+ hp = &hfragp->mem[hfragp->used_size];
+ list = *hp;
+ hfragp->used_size = hfragp->alloc_size;
+ first = esdp->ets_tables.clist;
+ tb = *tablepp;
+ }
+ else {
+ /* A new operation... */
+ ASSERT(!*tablepp);
+
+ /* Max heap size needed... */
+ sz = esdp->ets_tables.count;
+ sz *= ERTS_MAGIC_REF_THING_SIZE + 2;
+ sz += 3 + ERTS_REF_THING_SIZE;
+ hfragp = new_message_buffer(sz);
+
+ hp = &hfragp->mem[0];
+ ohp = &hfragp->off_heap;
+ list = NIL;
+ first = esdp->ets_tables.clist;
+ tb = first ? first->common.all.prev : NULL;
+ }
+
+ if (tb) {
+ while (1) {
+ if (is_table_alive(tb)) {
+ Eterm tid;
+ if (is_table_named(tb))
+ tid = tb->common.the_name;
+ else
+ tid = erts_mk_magic_ref(&hp, ohp, tb->common.btid);
+ list = CONS(hp, tid, list);
+ hp += 2;
+ }
+
+ if (tb == first)
+ break;
+
+ tb = tb->common.all.prev;
+
+ if (--ycount <= 0) {
+ sz = hp - &hfragp->mem[0];
+ ASSERT(hfragp->alloc_size > sz + 1);
+ *hp = list;
+ hfragp->used_size = sz;
+ *hfragpp = hfragp;
+ *reqpp = reqp;
+ *tablepp = tb;
+ *yield_count_p = 0;
+ return 1; /* Yield! */
+ }
+ }
+ }
+
+ ref = erts_oiref_storage_make_ref(&reqp->ref, &hp);
+ msg = TUPLE2(hp, ref, list);
+ hp += 3;
+
+ sz = hp - &hfragp->mem[0];
+ ASSERT(sz <= hfragp->alloc_size);
+
+ hfragp = erts_resize_message_buffer(hfragp, sz, &msg, 1);
+
+ mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = hfragp;
+
+ erts_queue_message(reqp->proc, 0, mp, msg, am_system);
+
+ erts_proc_dec_refc(reqp->proc);
+
+ if (erts_smp_atomic32_dec_read_nob(&reqp->refc) == 0)
+ erts_free(ERTS_ALC_T_ETS_ALL_REQ, reqp);
+
+ *reqpp = NULL;
+ *hfragpp = NULL;
+ *tablepp = NULL;
+ *yield_count_p = ycount;
+
+ return 0;
+}
+
+int
+erts_handle_yielded_ets_all_request(ErtsSchedulerData *esdp,
+ ErtsEtsAllYieldData *eaydp)
+{
+ int ix = (int) esdp->no - 1;
+ int yc = ERTS_ETS_ALL_TB_YCNT;
+
+ while (1) {
+ if (!eaydp->ongoing) {
+ ErtsEtsAllReq *ongoing;
+
+ if (!eaydp->queue)
+ return 0; /* All work completed! */
+
+ if (yc < ERTS_ETS_ALL_TB_YCNT_START && yc > esdp->ets_tables.count)
+ return 1; /* Yield! */
+
+ eaydp->ongoing = ongoing = eaydp->queue;
+ if (ongoing->list[ix].next == ongoing)
+ eaydp->queue = NULL;
+ else {
+ ongoing->list[ix].next->list[ix].prev = ongoing->list[ix].prev;
+ ongoing->list[ix].prev->list[ix].next = ongoing->list[ix].next;
+ eaydp->queue = ongoing->list[ix].next;
+ }
+ ASSERT(!eaydp->hfrag);
+ ASSERT(!eaydp->tab);
+ }
+
+ if (ets_all_reply(esdp, &eaydp->ongoing, &eaydp->hfrag, &eaydp->tab, &yc))
+ return 1; /* Yield! */
+ }
+}
+
+static void
+handle_ets_all_request(void *vreq)
+{
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
+ ErtsEtsAllYieldData *eayp = ERTS_SCHED_AUX_YIELD_DATA(esdp, ets_all);
+ ErtsEtsAllReq *req = (ErtsEtsAllReq *) vreq;
+
+ if (!eayp->ongoing && !eayp->queue) {
+ /* No ets:all() operations ongoing... */
+ ErlHeapFragment *hf = NULL;
+ DbTable *tb = NULL;
+ int yc = ERTS_ETS_ALL_TB_YCNT;
+ if (ets_all_reply(esdp, &req, &hf, &tb, &yc)) {
+ /* Yielded... */
+ ASSERT(hf);
+ eayp->ongoing = req;
+ eayp->hfrag = hf;
+ eayp->tab = tb;
+ erts_notify_new_aux_yield_work(esdp);
+ }
}
- HRelease(BIF_P, hendp, hp);
- BIF_RET(previous);
+ else {
+ /* Ongoing ets:all() operations; queue up this request... */
+ int ix = (int) esdp->no - 1;
+ if (!eayp->queue) {
+ req->list[ix].next = req;
+ req->list[ix].prev = req;
+ eayp->queue = req;
+ }
+ else {
+ req->list[ix].next = eayp->queue;
+ req->list[ix].prev = eayp->queue->list[ix].prev;
+ eayp->queue->list[ix].prev = req;
+ req->list[ix].prev->list[ix].next = req;
+ }
+ }
+}
+
+BIF_RETTYPE ets_internal_request_all_0(BIF_ALIST_0)
+{
+ Eterm ref = erts_make_ref(BIF_P);
+ ErtsEtsAllReq *req = erts_alloc(ERTS_ALC_T_ETS_ALL_REQ,
+ ERTS_ETS_ALL_REQ_SIZE);
+ erts_smp_atomic32_init_nob(&req->refc,
+ (erts_aint32_t) erts_no_schedulers);
+ erts_oiref_storage_save(&req->ref, ref);
+ req->proc = BIF_P;
+ erts_proc_add_refc(BIF_P, (Sint) erts_no_schedulers);
+
+#ifdef ERTS_SMP
+ if (erts_no_schedulers > 1)
+ erts_schedule_multi_misc_aux_work(1,
+ erts_no_schedulers,
+ handle_ets_all_request,
+ (void *) req);
+#endif
+
+ handle_ets_all_request((void *) req);
+ BIF_RET(ref);
}
@@ -2200,7 +2636,7 @@ ets_select3(Process* p, Eterm arg1, Eterm arg2, Eterm arg3)
if (safety == ITER_UNSAFE) {
local_fix_table(tb);
}
- cret = tb->common.meth->db_select_chunk(p, tb,
+ cret = tb->common.meth->db_select_chunk(p, tb, arg1,
arg2, chunk_size,
0 /* not reversed */,
&ret);
@@ -2369,8 +2805,7 @@ ets_select2(Process* p, Eterm arg1, Eterm arg2)
local_fix_table(tb);
}
- cret = tb->common.meth->db_select(p, tb, arg2,
- 0, &ret);
+ cret = tb->common.meth->db_select(p, tb, arg1, arg2, 0, &ret);
if (DID_TRAP(p,ret) && safety != ITER_SAFE) {
fix_table_locked(p, tb);
@@ -2461,7 +2896,7 @@ BIF_RETTYPE ets_select_count_2(BIF_ALIST_2)
if (safety == ITER_UNSAFE) {
local_fix_table(tb);
}
- cret = tb->common.meth->db_select_count(BIF_P,tb,BIF_ARG_2, &ret);
+ cret = tb->common.meth->db_select_count(BIF_P,tb, BIF_ARG_1, BIF_ARG_2, &ret);
if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) {
fix_table_locked(BIF_P, tb);
@@ -2487,6 +2922,103 @@ BIF_RETTYPE ets_select_count_2(BIF_ALIST_2)
return result;
}
+/*
+ ** This is for trapping, cannot be called directly.
+ */
+static BIF_RETTYPE ets_select_replace_1(BIF_ALIST_1)
+{
+ Process *p = BIF_P;
+ Eterm a1 = BIF_ARG_1;
+ BIF_RETTYPE result;
+ DbTable* tb;
+ int cret;
+ Eterm ret;
+ Eterm *tptr;
+ db_lock_kind_t kind = LCK_WRITE_REC;
+
+ CHECK_TABLES();
+ ASSERT(is_tuple(a1));
+ tptr = tuple_val(a1);
+ ASSERT(arityval(*tptr) >= 1);
+
+ if ((tb = db_get_table(p, tptr[1], DB_WRITE, kind)) == NULL) {
+ BIF_ERROR(p,BADARG);
+ }
+
+ cret = tb->common.meth->db_select_replace_continue(p,tb,a1,&ret);
+
+ if(!DID_TRAP(p,ret) && ITERATION_SAFETY(p,tb) != ITER_SAFE) {
+ unfix_table_locked(p, tb, &kind);
+ }
+
+ db_unlock(tb, kind);
+
+ switch (cret) {
+ case DB_ERROR_NONE:
+ ERTS_BIF_PREP_RET(result, ret);
+ break;
+ default:
+ ERTS_BIF_PREP_ERROR(result, p, BADARG);
+ break;
+ }
+ erts_match_set_release_result(p);
+
+ return result;
+}
+
+
+BIF_RETTYPE ets_select_replace_2(BIF_ALIST_2)
+{
+ BIF_RETTYPE result;
+ DbTable* tb;
+ int cret;
+ Eterm ret;
+ enum DbIterSafety safety;
+
+ CHECK_TABLES();
+
+ if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE_REC)) == NULL) {
+ BIF_ERROR(BIF_P, BADARG);
+ }
+
+ if (tb->common.status & DB_BAG) {
+ /* Bag implementation presented both semantic consistency
+ and performance issues */
+ db_unlock(tb, LCK_WRITE_REC);
+ BIF_ERROR(BIF_P, BADARG);
+ }
+
+ safety = ITERATION_SAFETY(BIF_P,tb);
+ if (safety == ITER_UNSAFE) {
+ local_fix_table(tb);
+ }
+ cret = tb->common.meth->db_select_replace(BIF_P, tb, BIF_ARG_1, BIF_ARG_2, &ret);
+
+ if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) {
+ fix_table_locked(BIF_P,tb);
+ }
+ if (safety == ITER_UNSAFE) {
+ local_unfix_table(tb);
+ }
+ db_unlock(tb, LCK_WRITE_REC);
+
+ switch (cret) {
+ case DB_ERROR_NONE:
+ ERTS_BIF_PREP_RET(result, ret);
+ break;
+ case DB_ERROR_SYSRES:
+ ERTS_BIF_PREP_ERROR(result, BIF_P, SYSTEM_LIMIT);
+ break;
+ default:
+ ERTS_BIF_PREP_ERROR(result, BIF_P, BADARG);
+ break;
+ }
+
+ erts_match_set_release_result(BIF_P);
+
+ return result;
+}
+
BIF_RETTYPE ets_select_reverse_3(BIF_ALIST_3)
{
@@ -2515,7 +3047,7 @@ BIF_RETTYPE ets_select_reverse_3(BIF_ALIST_3)
if (safety == ITER_UNSAFE) {
local_fix_table(tb);
}
- cret = tb->common.meth->db_select_chunk(BIF_P,tb,
+ cret = tb->common.meth->db_select_chunk(BIF_P,tb, BIF_ARG_1,
BIF_ARG_2, chunk_size,
1 /* reversed */, &ret);
if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) {
@@ -2565,7 +3097,7 @@ BIF_RETTYPE ets_select_reverse_2(BIF_ALIST_2)
if (safety == ITER_UNSAFE) {
local_fix_table(tb);
}
- cret = tb->common.meth->db_select(BIF_P,tb,BIF_ARG_2,
+ cret = tb->common.meth->db_select(BIF_P,tb, BIF_ARG_1, BIF_ARG_2,
1 /*reversed*/, &ret);
if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) {
@@ -2642,7 +3174,9 @@ BIF_RETTYPE ets_match_object_3(BIF_ALIST_3)
BIF_RETTYPE ets_info_1(BIF_ALIST_1)
{
static Eterm fields[] = {am_protection, am_keypos, am_type, am_named_table,
- am_node, am_size, am_name, am_heir, am_owner, am_memory, am_compressed};
+ am_node, am_size, am_name, am_heir, am_owner, am_memory, am_compressed,
+ am_write_concurrency,
+ am_read_concurrency};
Eterm results[sizeof(fields)/sizeof(Eterm)];
DbTable* tb;
Eterm res;
@@ -2654,7 +3188,7 @@ BIF_RETTYPE ets_info_1(BIF_ALIST_1)
*/
if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_INFO, LCK_READ)) == NULL) {
- if (is_atom(BIF_ARG_1) || is_small(BIF_ARG_1)) {
+ if (is_atom(BIF_ARG_1) || is_ref(BIF_ARG_1)) {
BIF_RET(am_undefined);
}
BIF_ERROR(BIF_P, BADARG);
@@ -2716,7 +3250,7 @@ BIF_RETTYPE ets_info_2(BIF_ALIST_2)
Eterm ret = THE_NON_VALUE;
if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_INFO, LCK_READ)) == NULL) {
- if (is_atom(BIF_ARG_1) || is_small(BIF_ARG_1)) {
+ if (is_atom(BIF_ARG_1) || is_ref(BIF_ARG_1)) {
BIF_RET(am_undefined);
}
BIF_ERROR(BIF_P, BADARG);
@@ -2732,7 +3266,7 @@ BIF_RETTYPE ets_info_2(BIF_ALIST_2)
BIF_RETTYPE ets_is_compiled_ms_1(BIF_ALIST_1)
{
- if (erts_db_is_compiled_ms(BIF_ARG_1)) {
+ if (erts_db_get_match_prog_binary(BIF_ARG_1)) {
BIF_RET(am_true);
} else {
BIF_RET(am_false);
@@ -2747,9 +3281,9 @@ BIF_RETTYPE ets_match_spec_compile_1(BIF_ALIST_1)
BIF_ERROR(BIF_P, BADARG);
}
- hp = HAlloc(BIF_P, PROC_BIN_SIZE);
+ hp = HAlloc(BIF_P, ERTS_MAGIC_REF_THING_SIZE);
- BIF_RET(erts_mk_magic_binary_term(&hp, &MSO(BIF_P), mp));
+ BIF_RET(erts_db_make_match_prog_ref(BIF_P, mp, &hp));
}
BIF_RETTYPE ets_match_spec_run_r_3(BIF_ALIST_3)
@@ -2758,24 +3292,18 @@ BIF_RETTYPE ets_match_spec_run_r_3(BIF_ALIST_3)
int i = 0;
Eterm *hp;
Eterm lst;
- ProcBin *bp;
Binary *mp;
Eterm res;
Uint32 dummy;
- if (!(is_list(BIF_ARG_1) || BIF_ARG_1 == NIL) || !is_binary(BIF_ARG_2)) {
+ if (!(is_list(BIF_ARG_1) || BIF_ARG_1 == NIL)) {
error:
BIF_ERROR(BIF_P, BADARG);
}
- bp = (ProcBin*) binary_val(BIF_ARG_2);
- if (thing_subtag(bp->thing_word) != REFC_BINARY_SUBTAG) {
- goto error;
- }
- mp = bp->val;
- if (!IsMatchProgBinary(mp)) {
+ mp = erts_db_get_match_prog_binary(BIF_ARG_2);
+ if (!mp)
goto error;
- }
if (BIF_ARG_1 == NIL) {
BIF_RET(BIF_ARG_3);
@@ -2786,7 +3314,8 @@ 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, BIF_P,
+ mp, CAR(list_val(lst)), NULL, 0,
ERTS_PAM_COPY_RESULT, &dummy);
if (is_value(res)) {
hp = HAlloc(BIF_P, 2);
@@ -2805,35 +3334,64 @@ BIF_RETTYPE ets_match_spec_run_r_3(BIF_ALIST_3)
** External interface (NOT BIF's)
*/
+int erts_ets_rwmtx_spin_count = -1;
/* Init the db */
-void init_db(void)
+void init_db(ErtsDbSpinCount db_spin_count)
{
- DbTable init_tb;
int i;
Eterm *hp;
unsigned bits;
size_t size;
#ifdef ERTS_SMP
+ int max_spin_count = (1 << 15) - 1; /* internal limit */
erts_smp_rwmtx_opt_t rwmtx_opt = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER;
rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_FREQUENT_READ;
rwmtx_opt.lived = ERTS_SMP_RWMTX_LONG_LIVED;
- meta_main_tab_locks =
- erts_alloc_permanent_cache_aligned(ERTS_ALC_T_DB_TABLES,
- sizeof(erts_meta_main_tab_lock_t)
- * ERTS_META_MAIN_TAB_LOCK_TAB_SIZE);
-
- for (i = 0; i < ERTS_META_MAIN_TAB_LOCK_TAB_SIZE; i++) {
- erts_smp_rwmtx_init_opt_x(&meta_main_tab_locks[i].rwmtx, &rwmtx_opt,
- "meta_main_tab_slot", make_small(i));
+ switch (db_spin_count) {
+ case ERTS_DB_SPNCNT_NONE:
+ erts_ets_rwmtx_spin_count = 0;
+ break;
+ case ERTS_DB_SPNCNT_VERY_LOW:
+ erts_ets_rwmtx_spin_count = 100;
+ break;
+ case ERTS_DB_SPNCNT_LOW:
+ erts_ets_rwmtx_spin_count = 200;
+ erts_ets_rwmtx_spin_count += erts_no_schedulers * 50;
+ if (erts_ets_rwmtx_spin_count > 1000)
+ erts_ets_rwmtx_spin_count = 1000;
+ break;
+ case ERTS_DB_SPNCNT_HIGH:
+ erts_ets_rwmtx_spin_count = 2000;
+ erts_ets_rwmtx_spin_count += erts_no_schedulers * 100;
+ if (erts_ets_rwmtx_spin_count > 15000)
+ erts_ets_rwmtx_spin_count = 15000;
+ break;
+ case ERTS_DB_SPNCNT_VERY_HIGH:
+ erts_ets_rwmtx_spin_count = 15000;
+ erts_ets_rwmtx_spin_count += erts_no_schedulers * 500;
+ if (erts_ets_rwmtx_spin_count > max_spin_count)
+ erts_ets_rwmtx_spin_count = max_spin_count;
+ break;
+ case ERTS_DB_SPNCNT_EXTREMELY_HIGH:
+ erts_ets_rwmtx_spin_count = max_spin_count;
+ break;
+ case ERTS_DB_SPNCNT_NORMAL:
+ default:
+ erts_ets_rwmtx_spin_count = -1;
+ break;
}
- erts_smp_spinlock_init(&meta_main_tab_main_lock, "meta_main_tab_main");
+
+ if (erts_ets_rwmtx_spin_count >= 0)
+ rwmtx_opt.main_spincount = erts_ets_rwmtx_spin_count;
+
for (i=0; i<META_NAME_TAB_LOCK_CNT; i++) {
- erts_smp_rwmtx_init_opt_x(&meta_name_tab_rwlocks[i].lck, &rwmtx_opt,
- "meta_name_tab", make_small(i));
+ erts_smp_rwmtx_init_opt(&meta_name_tab_rwlocks[i].lck, &rwmtx_opt,
+ "meta_name_tab", make_small(i),
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DB);
}
#endif
@@ -2847,23 +3405,9 @@ void init_db(void)
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;
- meta_main_tab_seq_incr = (((Uint)1)<<bits);
-
- size = sizeof(*meta_main_tab)*db_max_tabs;
- meta_main_tab = erts_db_alloc_nt(ERTS_ALC_T_DB_TABLES, size);
- ERTS_ETS_MISC_MEM_ADD(size);
-
- meta_main_tab_cnt = 0;
- meta_main_tab_top = 0;
- for (i=1; i<db_max_tabs; i++) {
- SET_NEXT_FREE_SLOT(i-1,i);
- }
- SET_NEXT_FREE_SLOT(db_max_tabs-1, (Uint)-1);
- meta_main_tab_first_free = 0;
meta_name_tab_mask = (((Uint) 1)<<(bits-1)) - 1; /* At least half the size of main tab */
size = sizeof(struct meta_name_tab_entry)*(meta_name_tab_mask+1);
@@ -2878,70 +3422,6 @@ void init_db(void)
db_initialize_hash();
db_initialize_tree();
- /*TT*/
- /* Create meta table invertion. */
- erts_smp_atomic_init_nob(&init_tb.common.memory_size, 0);
- meta_pid_to_tab = (DbTable*) erts_db_alloc(ERTS_ALC_T_DB_TABLE,
- &init_tb,
- sizeof(DbTable));
- erts_smp_atomic_init_nob(&meta_pid_to_tab->common.memory_size,
- erts_smp_atomic_read_nob(&init_tb.common.memory_size));
-
- meta_pid_to_tab->common.id = NIL;
- meta_pid_to_tab->common.the_name = am_true;
- meta_pid_to_tab->common.status = (DB_NORMAL | DB_BAG | DB_PUBLIC | DB_FINE_LOCKED);
-#ifdef ERTS_SMP
- meta_pid_to_tab->common.type
- = meta_pid_to_tab->common.status & ERTS_ETS_TABLE_TYPES;
- /* Note, 'type' is *read only* from now on... */
- meta_pid_to_tab->common.is_thread_safe = 0;
-#endif
- meta_pid_to_tab->common.keypos = 1;
- meta_pid_to_tab->common.owner = NIL;
- erts_smp_atomic_init_nob(&meta_pid_to_tab->common.nitems, 0);
- meta_pid_to_tab->common.slot = -1;
- meta_pid_to_tab->common.meth = &db_hash;
- meta_pid_to_tab->common.compress = 0;
-
- erts_refc_init(&meta_pid_to_tab->common.ref, 0);
- /* Neither rwlock or fixlock used
- 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_smp_atomic_set_nob(&init_tb.common.memory_size, 0);
- meta_pid_to_fixed_tab = (DbTable*) erts_db_alloc(ERTS_ALC_T_DB_TABLE,
- &init_tb,
- sizeof(DbTable));
- erts_smp_atomic_init_nob(&meta_pid_to_fixed_tab->common.memory_size,
- erts_smp_atomic_read_nob(&init_tb.common.memory_size));
-
- meta_pid_to_fixed_tab->common.id = NIL;
- meta_pid_to_fixed_tab->common.the_name = am_true;
- meta_pid_to_fixed_tab->common.status = (DB_NORMAL | DB_BAG | DB_PUBLIC | DB_FINE_LOCKED);
-#ifdef ERTS_SMP
- meta_pid_to_fixed_tab->common.type
- = meta_pid_to_fixed_tab->common.status & ERTS_ETS_TABLE_TYPES;
- /* Note, 'type' is *read only* from now on... */
- meta_pid_to_fixed_tab->common.is_thread_safe = 0;
-#endif
- meta_pid_to_fixed_tab->common.keypos = 1;
- meta_pid_to_fixed_tab->common.owner = NIL;
- erts_smp_atomic_init_nob(&meta_pid_to_fixed_tab->common.nitems, 0);
- meta_pid_to_fixed_tab->common.slot = -1;
- meta_pid_to_fixed_tab->common.meth = &db_hash;
- meta_pid_to_fixed_tab->common.compress = 0;
-
- erts_refc_init(&meta_pid_to_fixed_tab->common.ref, 0);
- /* Neither rwlock or fixlock used
- 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.");
- }
-
/* Non visual BIF to trap to. */
erts_init_trap_export(&ets_select_delete_continue_exp,
am_ets, am_atom_put("delete_trap",11), 1,
@@ -2953,6 +3433,11 @@ void init_db(void)
&ets_select_count_1);
/* Non visual BIF to trap to. */
+ erts_init_trap_export(&ets_select_replace_continue_exp,
+ am_ets, am_atom_put("replace_trap",11), 1,
+ &ets_select_replace_1);
+
+ /* Non visual BIF to trap to. */
erts_init_trap_export(&ets_select_continue_exp,
am_ets, am_atom_put("select_trap",11), 1,
&ets_select_trap_1);
@@ -2970,81 +3455,18 @@ void init_db(void)
ms_delete_all = CONS(hp, ms_delete_all,NIL);
}
-#define ARRAY_CHUNK 100
-
-typedef enum {
- ErtsDbProcCleanupProgressTables,
- ErtsDbProcCleanupProgressFixations,
- ErtsDbProcCleanupProgressDone,
-} ErtsDbProcCleanupProgress;
-
-typedef enum {
- ErtsDbProcCleanupOpGetTables,
- ErtsDbProcCleanupOpDeleteTables,
- ErtsDbProcCleanupOpGetFixations,
- ErtsDbProcCleanupOpDeleteFixations,
- ErtsDbProcCleanupOpDone
-} ErtsDbProcCleanupOperation;
-
-typedef struct {
- ErtsDbProcCleanupProgress progress;
- ErtsDbProcCleanupOperation op;
- struct {
- Eterm arr[ARRAY_CHUNK];
- int size;
- int ix;
- int clean_ix;
- } slots;
-} ErtsDbProcCleanupState;
-
-
-static void
-proc_exit_cleanup_tables_meta_data(Eterm pid, ErtsDbProcCleanupState *state)
-{
- ASSERT(state->slots.clean_ix <= state->slots.ix);
- if (state->slots.clean_ix < state->slots.ix) {
- db_meta_lock(meta_pid_to_tab, LCK_WRITE_REC);
- if (state->slots.size < ARRAY_CHUNK
- && state->slots.ix == state->slots.size) {
- Eterm dummy;
- db_erase_hash(meta_pid_to_tab,pid,&dummy);
- }
- else {
- int ix;
- /* Need to erase each explicitly */
- for (ix = state->slots.clean_ix; ix < state->slots.ix; ix++)
- db_erase_bag_exact2(meta_pid_to_tab,
- pid,
- state->slots.arr[ix]);
- }
- db_meta_unlock(meta_pid_to_tab, LCK_WRITE_REC);
- state->slots.clean_ix = state->slots.ix;
- }
+void
+erts_ets_sched_spec_data_init(ErtsSchedulerData *esdp)
+{
+ ErtsEtsAllYieldData *eaydp = ERTS_SCHED_AUX_YIELD_DATA(esdp, ets_all);
+ eaydp->ongoing = NULL;
+ eaydp->hfrag = NULL;
+ eaydp->tab = NULL;
+ eaydp->queue = NULL;
+ esdp->ets_tables.clist = NULL;
+ esdp->ets_tables.count = 0;
}
-static void
-proc_exit_cleanup_fixations_meta_data(Eterm pid, ErtsDbProcCleanupState *state)
-{
- ASSERT(state->slots.clean_ix <= state->slots.ix);
- if (state->slots.clean_ix < state->slots.ix) {
- db_meta_lock(meta_pid_to_fixed_tab, LCK_WRITE_REC);
- if (state->slots.size < ARRAY_CHUNK
- && state->slots.ix == state->slots.size) {
- Eterm dummy;
- db_erase_hash(meta_pid_to_fixed_tab,pid,&dummy);
- }
- else {
- int ix;
- /* Need to erase each explicitly */
- for (ix = state->slots.clean_ix; ix < state->slots.ix; ix++)
- db_erase_bag_exact2(meta_pid_to_fixed_tab,
- pid,
- state->slots.arr[ix]);
- }
- db_meta_unlock(meta_pid_to_fixed_tab, LCK_WRITE_REC);
- state->slots.clean_ix = state->slots.ix;
- }
-}
/* In: Table LCK_WRITE
** Return TRUE : ok, table not mine and NOT locked anymore.
@@ -3054,7 +3476,6 @@ static int give_away_to_heir(Process* p, DbTable* tb)
{
Process* to_proc;
ErtsProcLocks to_locks = ERTS_PROC_LOCK_MAIN;
- DeclareTmpHeap(buf,5,p);
Eterm to_pid;
UWord heir_data;
@@ -3098,19 +3519,12 @@ retry:
erts_smp_proc_unlock(to_proc, to_locks);
return 0; /* heir dead and pid reused, table still mine */
}
- UseTmpHeap(5,p);
- db_meta_lock(meta_pid_to_tab, LCK_WRITE_REC);
- db_erase_bag_exact2(meta_pid_to_tab, tb->common.owner,
- make_small(tb->common.slot));
+ delete_owned_table(p, tb);
to_proc->flags |= F_USING_DB;
tb->common.owner = to_pid;
-
- db_put_hash(meta_pid_to_tab,
- TUPLE2(buf,to_pid,make_small(tb->common.slot)),
- 0);
- db_meta_unlock(meta_pid_to_tab, LCK_WRITE_REC);
- UnUseTmpHeap(5,p);
+ save_owned_table(to_proc, tb);
+
db_unlock(tb,LCK_WRITE);
heir_data = tb->common.heir_data;
if (!is_immed(heir_data)) {
@@ -3118,17 +3532,92 @@ retry:
ASSERT(arityval(*tpv) == 1);
heir_data = tpv[1];
}
- erts_send_message(p, to_proc, &to_locks,
- TUPLE4(buf,
- am_ETS_TRANSFER,
- tb->common.id,
- p->common.id,
- heir_data),
- 0);
+ send_ets_transfer_message(p, to_proc, &to_locks, tb, heir_data);
erts_smp_proc_unlock(to_proc, to_locks);
return !0;
}
+static void
+send_ets_transfer_message(Process *c_p, Process *proc,
+ ErtsProcLocks *locks,
+ DbTable *tb, Eterm heir_data)
+{
+ Uint hsz, hd_sz;
+ ErtsMessage *mp;
+ Eterm *hp;
+ ErlOffHeap *ohp;
+ Eterm tid, hd_copy, msg, sender;
+
+ hsz = 5;
+ if (!is_table_named(tb))
+ hsz += ERTS_MAGIC_REF_THING_SIZE;
+ if (is_immed(heir_data))
+ hd_sz = 0;
+ else {
+ hd_sz = size_object(heir_data);
+ hsz += hd_sz;
+ }
+
+ mp = erts_alloc_message_heap(proc, locks, hsz, &hp, &ohp);
+ if (is_table_named(tb))
+ tid = tb->common.the_name;
+ else
+ tid = erts_mk_magic_ref(&hp, ohp, tb->common.btid);
+ if (!hd_sz)
+ hd_copy = heir_data;
+ else
+ hd_copy = copy_struct(heir_data, hd_sz, &hp, ohp);
+ sender = c_p->common.id;
+ msg = TUPLE4(hp, am_ETS_TRANSFER, tid, sender, hd_copy);
+ erts_queue_message(proc, *locks, mp, msg, sender);
+}
+
+
+/* Auto-release fixation from exiting process */
+static SWord proc_cleanup_fixed_table(Process* p, DbFixation* fix)
+{
+ DbTable* tb = btid2tab(fix->tabs.btid);
+ SWord work = 0;
+
+ ASSERT(fix->procs.p == p); (void)p;
+ if (tb) {
+ db_lock(tb, LCK_WRITE_REC);
+ if (!(tb->common.status & DB_DELETE)) {
+ erts_aint_t diff;
+ #ifdef ERTS_SMP
+ erts_smp_mtx_lock(&tb->common.fixlock);
+ #endif
+
+ ASSERT(fixing_procs_rbt_lookup(tb->common.fixing_procs, p));
+
+ diff = -((erts_aint_t) fix->counter);
+ erts_smp_refc_add(&tb->common.fix_count,diff,0);
+ fix->counter = 0;
+
+ fixing_procs_rbt_delete(&tb->common.fixing_procs, fix);
+
+ #ifdef ERTS_SMP
+ erts_smp_mtx_unlock(&tb->common.fixlock);
+ #endif
+ if (!IS_FIXED(tb) && IS_HASH_TABLE(tb->common.status)) {
+ work += db_unfix_table_hash(&(tb->hash));
+ }
+
+ ASSERT(sizeof(DbFixation) == ERTS_ALC_DBG_BLK_SZ(fix));
+ ERTS_DB_ALC_MEM_UPDATE_(tb, sizeof(DbFixation), 0);
+ }
+ db_unlock(tb, LCK_WRITE_REC);
+ }
+
+ erts_bin_release(fix->tabs.btid);
+ erts_free(ERTS_ALC_T_DB_FIXATION, fix);
+ ERTS_ETS_MISC_MEM_ADD(-sizeof(DbFixation));
+ ++work;
+
+ return work;
+}
+
+
/*
* erts_db_process_exiting() is called when a process terminates.
* It returns 0 when completely done, and !0 when it wants to
@@ -3136,279 +3625,166 @@ 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
erts_db_process_exiting(Process *c_p, ErtsProcLocks c_p_locks)
{
- ErtsDbProcCleanupState *state = (ErtsDbProcCleanupState *) c_p->u.terminate;
+ typedef struct {
+ enum {
+ GET_OWNED_TABLE,
+ FREE_OWNED_TABLE,
+ UNFIX_TABLES,
+ }op;
+ DbTable *tb;
+ } CleanupState;
+ CleanupState *state = (CleanupState *) c_p->u.terminate;
Eterm pid = c_p->common.id;
- ErtsDbProcCleanupState default_state;
- int ret;
+ CleanupState default_state;
+ SWord initial_reds = ERTS_BIF_REDS_LEFT(c_p);
+ SWord reds = initial_reds;
if (!state) {
state = &default_state;
- state->progress = ErtsDbProcCleanupProgressTables;
- state->op = ErtsDbProcCleanupOpGetTables;
+ state->op = GET_OWNED_TABLE;
+ state->tb = NULL;
}
- while (!0) {
+ do {
switch (state->op) {
- case ErtsDbProcCleanupOpGetTables:
- state->slots.size = ARRAY_CHUNK;
- db_meta_lock(meta_pid_to_tab, LCK_READ);
- ret = db_get_element_array(meta_pid_to_tab,
- pid,
- 2,
- state->slots.arr,
- &state->slots.size);
- db_meta_unlock(meta_pid_to_tab, LCK_READ);
- if (ret == DB_ERROR_BADKEY) {
- /* Done with tables; now fixations */
- state->progress = ErtsDbProcCleanupProgressFixations;
- state->op = ErtsDbProcCleanupOpGetFixations;
- break;
- } else if (ret != DB_ERROR_NONE) {
- ERTS_DB_INTERNAL_ERROR("Inconsistent ets table metadata");
- }
-
- state->slots.ix = 0;
- state->slots.clean_ix = 0;
- state->op = ErtsDbProcCleanupOpDeleteTables;
- /* Fall through */
-
- case ErtsDbProcCleanupOpDeleteTables:
-
- while (state->slots.ix < state->slots.size) {
- DbTable *tb = NULL;
- Sint ix = unsigned_val(state->slots.arr[state->slots.ix]);
- erts_smp_rwmtx_t *mmtl = get_meta_main_tab_lock(ix);
- erts_smp_rwmtx_rlock(mmtl);
- if (!IS_SLOT_FREE(ix)) {
- tb = GET_ANY_SLOT_TAB(ix);
- ASSERT(tb);
- }
- erts_smp_rwmtx_runlock(mmtl);
- if (tb) {
- int do_yield;
- db_lock(tb, LCK_WRITE);
- /* Ownership may have changed since
- we looked up the table. */
- if (tb->common.owner != pid) {
- do_yield = 0;
- db_unlock(tb, LCK_WRITE);
- }
- else if (tb->common.heir != am_none
- && tb->common.heir != pid
- && give_away_to_heir(c_p, tb)) {
- do_yield = 0;
- }
- else {
- int first_call;
-#ifdef HARDDEBUG
- erts_fprintf(stderr,
- "erts_db_process_exiting(); Table: %T, "
- "Process: %T\n",
- tb->common.id, pid);
-#endif
- first_call = (tb->common.status & DB_DELETE) == 0;
- if (first_call) {
- /* Clear all access bits. */
- tb->common.status &= ~(DB_PROTECTED
- | DB_PUBLIC
- | DB_PRIVATE);
- tb->common.status |= DB_DELETE;
-
- if (is_atom(tb->common.id))
- remove_named_tab(tb, 0);
-
- free_heir_data(tb);
- free_fixations_locked(tb);
- }
-
- do_yield = free_table_cont(c_p, tb, first_call, 0);
- db_unlock(tb, LCK_WRITE);
- }
- if (do_yield)
- goto yield;
- }
- state->slots.ix++;
- if (ERTS_BIF_REDS_LEFT(c_p) <= 0)
- goto yield;
- }
+ case GET_OWNED_TABLE: {
+ DbTable* tb;
+ erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_STATUS);
+ tb = (DbTable*) erts_psd_get(c_p, ERTS_PSD_ETS_OWNED_TABLES);
+ erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_STATUS);
+
+ if (!tb) {
+ /* Done with owned tables; now fixations */
+ state->op = UNFIX_TABLES;
+ break;
+ }
- proc_exit_cleanup_tables_meta_data(pid, state);
- state->op = ErtsDbProcCleanupOpGetTables;
- break;
+ ASSERT(tb != state->tb);
+ state->tb = tb;
+ db_lock(tb, LCK_WRITE);
+ /*
+ * Ownership may have changed since we looked up the table.
+ */
+ if (tb->common.owner != pid) {
+ db_unlock(tb, LCK_WRITE);
+ break;
+ }
+ if (tb->common.heir != am_none
+ && tb->common.heir != pid
+ && give_away_to_heir(c_p, tb)) {
+ break;
+ }
+ tid_clear(c_p, tb);
+ /* Clear all access bits. */
+ tb->common.status &= ~(DB_PROTECTED | DB_PUBLIC | DB_PRIVATE);
+ tb->common.status |= DB_DELETE;
+
+ if (is_table_named(tb))
+ remove_named_tab(tb, 0);
+
+ free_heir_data(tb);
+ reds -= free_fixations_locked(c_p, tb);
+ db_unlock(tb, LCK_WRITE);
+ state->op = FREE_OWNED_TABLE;
+ break;
+ }
+ case FREE_OWNED_TABLE:
+ reds = free_table_continue(c_p, state->tb, reds);
+ if (reds < 0)
+ goto yield;
- case ErtsDbProcCleanupOpGetFixations:
- state->slots.size = ARRAY_CHUNK;
- db_meta_lock(meta_pid_to_fixed_tab, LCK_READ);
- ret = db_get_element_array(meta_pid_to_fixed_tab,
- pid,
- 2,
- state->slots.arr,
- &state->slots.size);
- db_meta_unlock(meta_pid_to_fixed_tab, LCK_READ);
-
- if (ret == DB_ERROR_BADKEY) {
- /* Done */
- state->progress = ErtsDbProcCleanupProgressDone;
- state->op = ErtsDbProcCleanupOpDone;
- break;
- } else if (ret != DB_ERROR_NONE) {
- ERTS_DB_INTERNAL_ERROR("Inconsistent ets fix table metadata");
- }
+ state->op = GET_OWNED_TABLE;
+ break;
- state->slots.ix = 0;
- state->slots.clean_ix = 0;
- state->op = ErtsDbProcCleanupOpDeleteFixations;
- /* Fall through */
+ case UNFIX_TABLES: {
+ DbFixation* fix;
- case ErtsDbProcCleanupOpDeleteFixations:
+ fix = (DbFixation*) erts_psd_get(c_p, ERTS_PSD_ETS_FIXED_TABLES);
- while (state->slots.ix < state->slots.size) {
- DbTable *tb = NULL;
- Sint ix = unsigned_val(state->slots.arr[state->slots.ix]);
- erts_smp_rwmtx_t *mmtl = get_meta_main_tab_lock(ix);
- erts_smp_rwmtx_rlock(mmtl);
- if (IS_SLOT_ALIVE(ix)) {
- tb = meta_main_tab[ix].u.tb;
- ASSERT(tb);
- }
- erts_smp_rwmtx_runlock(mmtl);
- if (tb) {
- int reds;
- DbFixation** pp;
-
- db_lock(tb, LCK_WRITE_REC);
- #ifdef ERTS_SMP
- erts_smp_mtx_lock(&tb->common.fixlock);
- #endif
- reds = 10;
-
- for (pp = &tb->common.fixations; *pp != NULL;
- pp = &(*pp)->next) {
- if ((*pp)->pid == pid) {
- DbFixation* fix = *pp;
- erts_aint_t diff = -((erts_aint_t) fix->counter);
- erts_refc_add(&tb->common.ref,diff,0);
- *pp = fix->next;
- erts_db_free(ERTS_ALC_T_DB_FIXATION,
- tb, fix, sizeof(DbFixation));
- ERTS_ETS_MISC_MEM_ADD(-sizeof(DbFixation));
- break;
- }
- }
- #ifdef ERTS_SMP
- erts_smp_mtx_unlock(&tb->common.fixlock);
- #endif
- if (!IS_FIXED(tb) && IS_HASH_TABLE(tb->common.status)) {
- db_unfix_table_hash(&(tb->hash));
- reds += 40;
- }
- db_unlock(tb, LCK_WRITE_REC);
- BUMP_REDS(c_p, reds);
- }
- state->slots.ix++;
- if (ERTS_BIF_REDS_LEFT(c_p) <= 0)
- goto yield;
- }
+ if (!fix) {
+ /* Done */
- proc_exit_cleanup_fixations_meta_data(pid, state);
- state->op = ErtsDbProcCleanupOpGetFixations;
- break;
+ if (state != &default_state)
+ erts_free(ERTS_ALC_T_DB_PROC_CLEANUP, state);
+ c_p->u.terminate = NULL;
- case ErtsDbProcCleanupOpDone:
+ BUMP_REDS(c_p, (initial_reds - reds));
+ return 0;
+ }
- if (state != &default_state)
- erts_free(ERTS_ALC_T_DB_PROC_CLEANUP, state);
- c_p->u.terminate = NULL;
- return 0;
+ fixed_tabs_delete(c_p, fix);
+ reds -= proc_cleanup_fixed_table(c_p, fix);
+ break;
+ }
default:
ERTS_DB_INTERNAL_ERROR("Bad internal state");
- }
- }
-
- yield:
+ }
- switch (state->progress) {
- case ErtsDbProcCleanupProgressTables:
- proc_exit_cleanup_tables_meta_data(pid, state);
- break;
- case ErtsDbProcCleanupProgressFixations:
- proc_exit_cleanup_fixations_meta_data(pid, state);
- break;
- default:
- break;
- }
+ } while (reds > 0);
- ASSERT(c_p->u.terminate == (void *) state
- || state == &default_state);
+ yield:
if (state == &default_state) {
c_p->u.terminate = erts_alloc(ERTS_ALC_T_DB_PROC_CLEANUP,
- sizeof(ErtsDbProcCleanupState));
- sys_memcpy(c_p->u.terminate,
- (void*) state,
- sizeof(ErtsDbProcCleanupState));
+ sizeof(CleanupState));
+ sys_memcpy(c_p->u.terminate, (void*) state, sizeof(CleanupState));
}
+ else
+ ASSERT(state == c_p->u.terminate);
return !0;
}
+
/* SMP note: table only need to be LCK_READ locked */
static void fix_table_locked(Process* p, DbTable* tb)
{
DbFixation *fix;
- DeclareTmpHeap(meta_tuple,3,p);
#ifdef ERTS_SMP
erts_smp_mtx_lock(&tb->common.fixlock);
#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));
+ erts_smp_refc_inc(&tb->common.fix_count,1);
+ fix = tb->common.fixing_procs;
+ if (fix == NULL) {
+ tb->common.time.monotonic
+ = erts_get_monotonic_time(erts_proc_sched_data(p));
+ tb->common.time.offset = erts_get_time_offset();
}
else {
- for (; fix != NULL; fix = fix->next) {
- if (fix->pid == p->common.id) {
- ++(fix->counter);
+ fix = fixing_procs_rbt_lookup(fix, p);
+ if (fix) {
+ ASSERT(fixed_tabs_find(NULL, fix));
+ ++(fix->counter);
+
#ifdef ERTS_SMP
- erts_smp_mtx_unlock(&tb->common.fixlock);
+ erts_smp_mtx_unlock(&tb->common.fixlock);
#endif
- return;
- }
+ return;
}
}
fix = (DbFixation *) erts_db_alloc(ERTS_ALC_T_DB_FIXATION,
tb, sizeof(DbFixation));
ERTS_ETS_MISC_MEM_ADD(sizeof(DbFixation));
- fix->pid = p->common.id;
+ fix->tabs.btid = tb->common.btid;
+ erts_refc_inc(&fix->tabs.btid->intern.refc, 2);
+ fix->procs.p = p;
fix->counter = 1;
- fix->next = tb->common.fixations;
- tb->common.fixations = fix;
+ fixing_procs_rbt_insert(&tb->common.fixing_procs, fix);
+
#ifdef ERTS_SMP
erts_smp_mtx_unlock(&tb->common.fixlock);
#endif
- p->flags |= F_USING_DB;
- UseTmpHeap(3,p);
- db_meta_lock(meta_pid_to_fixed_tab, LCK_WRITE_REC);
- if (db_put_hash(meta_pid_to_fixed_tab,
- TUPLE2(meta_tuple,
- p->common.id,
- make_small(tb->common.slot)),
- 0) != DB_ERROR_NONE) {
- UnUseTmpHeap(3,p);
- erl_exit(1,"Could not insert ets metadata in safe_fixtable.");
- }
- UnUseTmpHeap(3,p);
- db_meta_unlock(meta_pid_to_fixed_tab, LCK_WRITE_REC);
+ p->flags |= F_USING_DB;
+
+ fixed_tabs_insert(p, fix);
}
/* SMP note: May re-lock table
@@ -3416,28 +3792,26 @@ static void fix_table_locked(Process* p, DbTable* tb)
static void unfix_table_locked(Process* p, DbTable* tb,
db_lock_kind_t* kind_p)
{
- DbFixation** pp;
+ DbFixation* fix;
#ifdef ERTS_SMP
erts_smp_mtx_lock(&tb->common.fixlock);
#endif
- for (pp = &tb->common.fixations; *pp != NULL; pp = &(*pp)->next) {
- if ((*pp)->pid == p->common.id) {
- DbFixation* fix = *pp;
- erts_refc_dec(&tb->common.ref,0);
- --(fix->counter);
- ASSERT(fix->counter >= 0);
- if (fix->counter > 0) {
- break;
- }
- *pp = fix->next;
+ fix = fixing_procs_rbt_lookup(tb->common.fixing_procs, p);
+
+ if (fix) {
+ erts_smp_refc_dec(&tb->common.fix_count,0);
+ --(fix->counter);
+ ASSERT(fix->counter >= 0);
+ if (fix->counter == 0) {
+ fixing_procs_rbt_delete(&tb->common.fixing_procs, fix);
#ifdef ERTS_SMP
erts_smp_mtx_unlock(&tb->common.fixlock);
#endif
- db_meta_lock(meta_pid_to_fixed_tab, LCK_WRITE_REC);
- db_erase_bag_exact2(meta_pid_to_fixed_tab,
- p->common.id, make_small(tb->common.slot));
- db_meta_unlock(meta_pid_to_fixed_tab, LCK_WRITE_REC);
+ fixed_tabs_delete(p, fix);
+
+ erts_refc_dec(&fix->tabs.btid->intern.refc, 1);
+
erts_db_free(ERTS_ALC_T_DB_FIXATION,
tb, (void *) fix, sizeof(DbFixation));
ERTS_ETS_MISC_MEM_ADD(-sizeof(DbFixation));
@@ -3464,29 +3838,81 @@ unlocked:
}
}
-/* Assume that tb is WRITE locked */
-static void free_fixations_locked(DbTable *tb)
+struct free_fixations_ctx
{
- DbFixation *fix;
- DbFixation *next_fix;
+ Process* p;
+ DbTable* tb;
+ SWord cnt;
+};
+
+static void free_fixations_op(DbFixation* fix, void* vctx)
+{
+ struct free_fixations_ctx* ctx = (struct free_fixations_ctx*) vctx;
+ erts_aint_t diff;
+
+ ASSERT(!btid2tab(fix->tabs.btid));
+ ASSERT(fix->counter > 0);
+ ASSERT(ctx->tb->common.status & DB_DELETE);
+
+ diff = -((erts_aint_t) fix->counter);
+ erts_smp_refc_add(&ctx->tb->common.fix_count, diff, 0);
+
+#ifdef ERTS_SMP
+ if (fix->procs.p != ctx->p) { /* Fixated by other process */
+ fix->counter = 0;
+
+ /* Fake memory stats for table */
+ ASSERT(sizeof(DbFixation) == ERTS_ALC_DBG_BLK_SZ(fix));
+ ERTS_DB_ALC_MEM_UPDATE_(ctx->tb, sizeof(DbFixation), 0);
+
+ erts_schedule_ets_free_fixation(fix->procs.p->common.id, fix);
+ /*
+ * Either sys task is scheduled and erts_db_execute_free_fixation()
+ * will remove 'fix' or process will exit, drop sys task and
+ * proc_cleanup_fixed_table() will remove 'fix'.
+ */
+ }
+ else
+#endif
+ {
+ fixed_tabs_delete(fix->procs.p, fix);
- fix = tb->common.fixations;
- while (fix != NULL) {
- erts_aint_t diff = -((erts_aint_t) fix->counter);
- erts_refc_add(&tb->common.ref,diff,0);
- next_fix = fix->next;
- db_meta_lock(meta_pid_to_fixed_tab, LCK_WRITE_REC);
- db_erase_bag_exact2(meta_pid_to_fixed_tab,
- fix->pid,
- make_small(tb->common.slot));
- db_meta_unlock(meta_pid_to_fixed_tab, LCK_WRITE_REC);
- erts_db_free(ERTS_ALC_T_DB_FIXATION,
- tb, (void *) fix, sizeof(DbFixation));
- ERTS_ETS_MISC_MEM_ADD(-sizeof(DbFixation));
+ erts_bin_release(fix->tabs.btid);
- fix = next_fix;
+ erts_db_free(ERTS_ALC_T_DB_FIXATION,
+ ctx->tb, (void *) fix, sizeof(DbFixation));
+ ERTS_ETS_MISC_MEM_ADD(-sizeof(DbFixation));
}
- tb->common.fixations = NULL;
+ ctx->cnt++;
+}
+
+#ifdef ERTS_SMP
+int erts_db_execute_free_fixation(Process* p, DbFixation* fix)
+{
+ ASSERT(fix->counter == 0);
+ fixed_tabs_delete(p, fix);
+
+ erts_bin_release(fix->tabs.btid);
+
+ erts_free(ERTS_ALC_T_DB_FIXATION, fix);
+ ERTS_ETS_MISC_MEM_ADD(-sizeof(DbFixation));
+ return 1;
+}
+#endif
+
+static SWord free_fixations_locked(Process* p, DbTable *tb)
+{
+ struct free_fixations_ctx ctx;
+
+ ERTS_SMP_LC_ASSERT(erts_smp_lc_rwmtx_is_rwlocked(&tb->common.rwlock));
+
+ ctx.p = p;
+ ctx.tb = tb;
+ ctx.cnt = 0;
+ fixing_procs_rbt_foreach_destroy(&tb->common.fixing_procs,
+ free_fixations_op, &ctx);
+ tb->common.fixing_procs = NULL;
+ return ctx.cnt;
}
static void set_heir(Process* me, DbTable* tb, Eterm heir, UWord heir_data)
@@ -3550,58 +3976,40 @@ static void free_heir_data(DbTable* tb)
static BIF_RETTYPE ets_delete_trap(BIF_ALIST_1)
{
- Process *p = BIF_P;
+ SWord initial_reds = ERTS_BIF_REDS_LEFT(BIF_P);
+ SWord reds = initial_reds;
Eterm cont = BIF_ARG_1;
- int trap;
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);
- if (trap) {
- BIF_TRAP1(&ets_delete_continue_exp, p, cont);
+ if (free_table_continue(BIF_P, tb, reds) < 0) {
+ BUMP_ALL_REDS(BIF_P);
+ BIF_TRAP1(&ets_delete_continue_exp, BIF_P, cont);
}
else {
+ BUMP_REDS(BIF_P, (initial_reds - reds));
BIF_RET(am_true);
}
}
/*
- * free_table_cont() returns 0 when done and !0 when more work is needed.
+ * free_table_continue() returns reductions left
+ * done if >= 0
+ * yield if < 0
*/
-static int free_table_cont(Process *p,
- DbTable *tb,
- int first,
- int clean_meta_tab)
+static SWord free_table_continue(Process *p, DbTable *tb, SWord reds)
{
- Eterm result;
- erts_smp_rwmtx_t *mmtl;
+ reds = tb->common.meth->db_free_table_continue(tb, reds);
-#ifdef HARDDEBUG
- if (!first) {
- erts_fprintf(stderr,"ets: free_table_cont %T (continue)\r\n",
- tb->common.id);
- }
-#endif
-
- result = tb->common.meth->db_free_table_continue(tb);
-
- if (result == 0) {
+ if (reds < 0) {
#ifdef HARDDEBUG
erts_fprintf(stderr,"ets: free_table_cont %T (continue begin)\r\n",
tb->common.id);
#endif
/* More work to be done. Let other processes work and call us again. */
- BUMP_ALL_REDS(p);
- return !0;
}
else {
#ifdef HARDDEBUG
@@ -3609,32 +4017,34 @@ static int free_table_cont(Process *p,
tb->common.id);
#endif
/* Completely done - we will not get called again. */
- mmtl = get_meta_main_tab_lock(tb->common.slot);
-#ifdef ERTS_SMP
- if (erts_smp_rwmtx_tryrwlock(mmtl) == EBUSY) {
- erts_smp_rwmtx_rwunlock(&tb->common.rwlock);
- erts_smp_rwmtx_rwlock(mmtl);
- erts_smp_rwmtx_rwlock(&tb->common.rwlock);
- }
-#endif
- free_slot(tb->common.slot);
- erts_smp_rwmtx_rwunlock(mmtl);
-
- if (clean_meta_tab) {
- db_meta_lock(meta_pid_to_tab, LCK_WRITE_REC);
- db_erase_bag_exact2(meta_pid_to_tab,tb->common.owner,
- make_small(tb->common.slot));
- db_meta_unlock(meta_pid_to_tab, LCK_WRITE_REC);
- }
- schedule_free_dbtable(tb);
- BUMP_REDS(p, 100);
- return 0;
+ delete_owned_table(p, tb);
+ table_dec_refc(tb, 0);
}
+ return reds;
+}
+
+struct fixing_procs_info_ctx
+{
+ Process* p;
+ Eterm list;
+};
+
+static void fixing_procs_info_op(DbFixation* fix, void* vctx)
+{
+ struct fixing_procs_info_ctx* ctx = (struct fixing_procs_info_ctx*) vctx;
+ Eterm* hp;
+ Eterm tpl;
+
+ hp = HAllocX(ctx->p, 5, 100);
+ tpl = TUPLE2(hp, fix->procs.p->common.id, make_small(fix->counter));
+ hp += 3;
+ ctx->list = CONS(hp, tpl, ctx->list);
}
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));
@@ -3666,6 +4076,10 @@ static Eterm table_info(Process* p, DbTable* tb, Eterm What)
ret = am_protected;
else if (tb->common.status & DB_PUBLIC)
ret = am_public;
+ } else if (What == am_write_concurrency) {
+ ret = tb->common.status & DB_FINE_LOCKED ? am_true : am_false;
+ } else if (What == am_read_concurrency) {
+ ret = tb->common.status & DB_FREQ_READ ? am_true : am_false;
} else if (What == am_name) {
ret = tb->common.the_name;
} else if (What == am_keypos) {
@@ -3673,7 +4087,7 @@ static Eterm table_info(Process* p, DbTable* tb, Eterm What)
} else if (What == am_node) {
ret = erts_this_dist_entry->sysname;
} else if (What == am_named_table) {
- ret = is_atom(tb->common.id) ? am_true : am_false;
+ ret = is_table_named(tb) ? am_true : am_false;
} else if (What == am_compressed) {
ret = tb->common.compress ? am_true : am_false;
}
@@ -3688,33 +4102,51 @@ 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
if (IS_FIXED(tb)) {
Uint need;
Eterm *hp;
- Eterm tpl, lst;
- DbFixation *fix;
- need = 7;
- for (fix = tb->common.fixations; fix != NULL; fix = fix->next) {
- need += 5;
+ Eterm time;
+ Sint64 mtime;
+ struct fixing_procs_info_ctx ctx;
+
+ 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;
}
+ ctx.p = p;
+ ctx.list = NIL;
+ fixing_procs_rbt_foreach(tb->common.fixing_procs,
+ fixing_procs_info_op,
+ &ctx);
+
hp = HAlloc(p, need);
- lst = NIL;
- for (fix = tb->common.fixations; fix != NULL; fix = fix->next) {
- tpl = TUPLE2(hp,fix->pid,make_small(fix->counter));
- hp += 3;
- lst = CONS(hp,tpl,lst);
- hp += 2;
+ if (use_monotonic)
+ time = (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);
+ time = TUPLE3(hp, make_small(ms), make_small(s), make_small(us));
+ hp += 4;
}
- tpl = TUPLE3(hp,
- make_small(tb->common.megasec),
- make_small(tb->common.sec),
- make_small(tb->common.microsec));
- hp += 4;
- ret = TUPLE2(hp, tpl, lst);
+ ret = TUPLE2(hp, time, ctx.list);
} else {
ret = am_false;
}
@@ -3748,7 +4180,7 @@ static Eterm table_info(Process* p, DbTable* tb, Eterm What)
avg, std_dev_real, std_dev_exp,
make_small(stats.min_chain_len),
make_small(stats.max_chain_len),
- make_small(db_kept_items_hash(&tb->hash)));
+ make_small(stats.kept_items));
}
else {
ret = am_false;
@@ -3757,9 +4189,21 @@ static Eterm table_info(Process* p, DbTable* tb, Eterm What)
return ret;
}
-static void print_table(int to, void *to_arg, int show, DbTable* tb)
+static void print_table(fmtfn_t to, void *to_arg, int show, DbTable* tb)
{
- erts_print(to, to_arg, "Table: %T\n", tb->common.id);
+ Eterm tid;
+ Eterm heap[ERTS_MAGIC_REF_THING_SIZE];
+
+ if (is_table_named(tb)) {
+ tid = tb->common.the_name;
+ } else {
+ ErlOffHeap oh;
+ ERTS_INIT_OFF_HEAP(&oh);
+ write_magic_ref_thing(heap, &oh, (ErtsMagicBinary *) tb->common.btid);
+ tid = make_internal_ref(heap);
+ }
+
+ erts_print(to, to_arg, "Table: %T\n", tid);
erts_print(to, to_arg, "Name: %T\n", tb->common.the_name);
tb->common.meth->db_print(to, to_arg, show, tb);
@@ -3770,23 +4214,37 @@ static void print_table(int to, void *to_arg, int show, DbTable* tb)
+ sizeof(Uint)
- 1)
/ sizeof(Uint)));
+ erts_print(to, to_arg, "Type: %T\n", table_info(NULL, tb, am_type));
+ erts_print(to, to_arg, "Protection: %T\n", table_info(NULL, tb, am_protection));
+ erts_print(to, to_arg, "Compressed: %T\n", table_info(NULL, tb, am_compressed));
+ erts_print(to, to_arg, "Write Concurrency: %T\n", table_info(NULL, tb, am_write_concurrency));
+ erts_print(to, to_arg, "Read Concurrency: %T\n", table_info(NULL, tb, am_read_concurrency));
}
-void db_info(int to, void *to_arg, int show) /* Called by break handler */
+typedef struct {
+ fmtfn_t to;
+ void *to_arg;
+ int show;
+} ErtsPrintDbInfo;
+
+static void
+db_info_print(DbTable *tb, void *vpdbip)
{
- int i;
- for (i=0; i < db_max_tabs; i++)
- if (IS_SLOT_ALIVE(i)) {
- erts_print(to, to_arg, "=ets:%T\n", meta_main_tab[i].u.tb->common.owner);
- erts_print(to, to_arg, "Slot: %d\n", i);
- print_table(to, to_arg, show, meta_main_tab[i].u.tb);
- }
-#ifdef DEBUG
- erts_print(to, to_arg, "=internal_ets: Process to table index\n");
- print_table(to, to_arg, show, meta_pid_to_tab);
- erts_print(to, to_arg, "=internal_ets: Process to fixation index\n");
- print_table(to, to_arg, show, meta_pid_to_fixed_tab);
-#endif
+ ErtsPrintDbInfo *pdbip = (ErtsPrintDbInfo *) vpdbip;
+ erts_print(pdbip->to, pdbip->to_arg, "=ets:%T\n", tb->common.owner);
+ erts_print(pdbip->to, pdbip->to_arg, "Slot: %bpu\n", (Uint) tb);
+ print_table(pdbip->to, pdbip->to_arg, pdbip->show, tb);
+}
+
+void db_info(fmtfn_t to, void *to_arg, int show) /* Called by break handler */
+{
+ ErtsPrintDbInfo pdbi;
+
+ pdbi.to = to;
+ pdbi.to_arg = to_arg;
+ pdbi.show = show;
+
+ erts_db_foreach_table(db_info_print, &pdbi);
}
Uint
@@ -3801,15 +4259,22 @@ erts_get_ets_misc_mem_size(void)
void
erts_db_foreach_table(void (*func)(DbTable *, void *), void *arg)
{
- int i, j;
- j = 0;
- for(i = 0; (i < db_max_tabs && j < meta_main_tab_cnt); i++) {
- if (IS_SLOT_ALIVE(i)) {
- j++;
- (*func)(meta_main_tab[i].u.tb, arg);
- }
+ int ix;
+
+ ASSERT(erts_smp_thr_progress_is_blocking());
+
+ for (ix = 0; ix < erts_no_schedulers; ix++) {
+ ErtsSchedulerData *esdp = ERTS_SCHEDULER_IX(ix);
+ DbTable *first = esdp->ets_tables.clist;
+ if (first) {
+ DbTable *tb = first;
+ do {
+ if (is_table_alive(tb))
+ (*func)(tb, arg);
+ tb = tb->common.all.next;
+ } while (tb != first);
+ }
}
- ASSERT(j == meta_main_tab_cnt);
}
/* SMP Note: May only be used when system is locked */
@@ -3859,23 +4324,47 @@ erts_ets_colliding_names(Process* p, Eterm name, Uint cnt)
return list;
}
+#ifdef ERTS_ENABLE_LOCK_COUNT
-#ifdef HARDDEBUG /* Here comes some debug functions */
+void erts_lcnt_enable_db_lock_count(DbTable *tb, int enable) {
+ if(enable) {
+ erts_lcnt_install_new_lock_info(&tb->common.rwlock.lcnt, "db_tab",
+ tb->common.the_name, ERTS_LOCK_TYPE_RWMUTEX | ERTS_LOCK_FLAGS_CATEGORY_DB);
+ erts_lcnt_install_new_lock_info(&tb->common.fixlock.lcnt, "db_tab_fix",
+ tb->common.the_name, ERTS_LOCK_TYPE_MUTEX | ERTS_LOCK_FLAGS_CATEGORY_DB);
+ } else {
+ erts_lcnt_uninstall(&tb->common.rwlock.lcnt);
+ erts_lcnt_uninstall(&tb->common.fixlock.lcnt);
+ }
-void db_check_tables(void)
-{
-#ifdef ERTS_SMP
- return;
-#else
- int i;
+ if(IS_HASH_TABLE(tb->common.status)) {
+ erts_lcnt_enable_db_hash_lock_count(&tb->hash, enable);
+ }
+}
- for (i = 0; i < db_max_tabs; i++) {
- if (IS_SLOT_ALIVE(i)) {
- DbTable* tb = meta_main_tab[i].t;
- tb->common.meth->db_check_table(tb);
- }
+static void lcnt_update_db_locks_per_sched(void *enable) {
+ ErtsSchedulerData *esdp;
+ DbTable *head;
+
+ esdp = erts_get_scheduler_data();
+ head = esdp->ets_tables.clist;
+
+ if(head) {
+ DbTable *iterator = head;
+
+ do {
+ if(is_table_alive(iterator)) {
+ erts_lcnt_enable_db_lock_count(iterator, !!enable);
+ }
+
+ iterator = iterator->common.all.next;
+ } while (iterator != head);
}
-#endif
}
-#endif /* HARDDEBUG */
+void erts_lcnt_update_db_locks(int enable) {
+ erts_schedule_multi_misc_aux_work(0, erts_no_schedulers,
+ &lcnt_update_db_locks_per_sched, (void*)(UWord)enable);
+}
+
+#endif /* ERTS_ENABLE_LOCK_COUNT */ \ No newline at end of file
diff --git a/erts/emulator/beam/erl_db.h b/erts/emulator/beam/erl_db.h
index 5b4681fc90..d83126b3a2 100644
--- a/erts/emulator/beam/erl_db.h
+++ b/erts/emulator/beam/erl_db.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2016. 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.
+ * 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%
*/
@@ -23,8 +24,37 @@
*
*/
-#ifndef __DB_H__
-#define __DB_H__
+#ifndef ERTS_DB_SCHED_SPEC_TYPES__
+#define ERTS_DB_SCHED_SPEC_TYPES__
+
+union db_table;
+typedef union db_table DbTable;
+
+typedef struct ErtsEtsAllReq_ ErtsEtsAllReq;
+
+typedef struct {
+ ErtsEtsAllReq *next;
+ ErtsEtsAllReq *prev;
+} ErtsEtsAllReqList;
+
+typedef struct {
+ ErtsEtsAllReq *ongoing;
+ ErlHeapFragment *hfrag;
+ DbTable *tab;
+ ErtsEtsAllReq *queue;
+} ErtsEtsAllYieldData;
+
+typedef struct {
+ Uint count;
+ DbTable *clist;
+} ErtsEtsTables;
+
+#endif /* ERTS_DB_SCHED_SPEC_TYPES__ */
+
+#ifndef ERTS_ONLY_SCHED_SPEC_ETS_DATA
+
+#ifndef ERL_DB_H__
+#define ERL_DB_H__
#include "sys.h"
#undef ERL_THR_PROGRESS_TSD_TYPE_ONLY
@@ -45,6 +75,12 @@ typedef struct {
ErtsThrPrgrLaterOp data;
} DbTableRelease;
+struct ErtsSchedulerData_;
+int erts_handle_yielded_ets_all_request(struct ErtsSchedulerData_ *esdp,
+ ErtsEtsAllYieldData *eadp);
+
+void erts_ets_sched_spec_data_init(struct ErtsSchedulerData_ *esdp);
+
/*
* So, the structure for a database table, NB this is only
* interesting in db.c.
@@ -61,28 +97,45 @@ union db_table {
"ERL_MAX_ETS_TABLES" */
#define ERL_MAX_ETS_TABLES_ENV "ERL_MAX_ETS_TABLES"
-void init_db(void);
+typedef enum {
+ ERTS_DB_SPNCNT_NONE,
+ ERTS_DB_SPNCNT_VERY_LOW,
+ ERTS_DB_SPNCNT_LOW,
+ ERTS_DB_SPNCNT_NORMAL,
+ ERTS_DB_SPNCNT_HIGH,
+ ERTS_DB_SPNCNT_VERY_HIGH,
+ ERTS_DB_SPNCNT_EXTREMELY_HIGH
+} ErtsDbSpinCount;
+
+void init_db(ErtsDbSpinCount);
int erts_db_process_exiting(Process *, ErtsProcLocks);
-void db_info(int, void *, int);
+int erts_db_execute_free_fixation(Process*, DbFixation*);
+void db_info(fmtfn_t, void *, int);
void erts_db_foreach_table(void (*)(DbTable *, void *), void *);
void erts_db_foreach_offheap(DbTable *,
void (*func)(ErlOffHeap *, void *),
void *);
+extern int erts_ets_rwmtx_spin_count;
extern int user_requested_db_max_tabs; /* set in erl_init */
extern int erts_ets_realloc_always_moves; /* set in erl_init */
extern int erts_ets_always_compress; /* set in erl_init */
extern Export ets_select_delete_continue_exp;
extern Export ets_select_count_continue_exp;
+extern Export ets_select_replace_continue_exp;
extern Export ets_select_continue_exp;
extern erts_smp_atomic_t erts_ets_misc_mem_size;
Eterm erts_ets_colliding_names(Process*, Eterm name, Uint cnt);
-
Uint erts_db_get_max_tabs(void);
+#ifdef ERTS_ENABLE_LOCK_COUNT
+void erts_lcnt_enable_db_lock_count(DbTable *tb, int enable);
+void erts_lcnt_update_db_locks(int enable);
#endif
+#endif /* ERL_DB_H__ */
+
#if defined(ERTS_WANT_DB_INTERNAL__) && !defined(ERTS_HAVE_DB_INTERNAL__)
#define ERTS_HAVE_DB_INTERNAL__
@@ -255,7 +308,6 @@ erts_db_free_nt(ErtsAlcType_t type, void *ptr, Uint size)
#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
-#undef ERTS_DB_ALC_MEM_UPDATE_
-
#endif /* #if defined(ERTS_WANT_DB_INTERNAL__) && !defined(ERTS_HAVE_DB_INTERNAL__) */
+#endif /* !ERTS_ONLY_SCHED_SPEC_ETS_DATA */
diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c
index 06dac8f161..cf928a9035 100644
--- a/erts/emulator/beam/erl_db_hash.c
+++ b/erts/emulator/beam/erl_db_hash.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1998-2012. All Rights Reserved.
+ * Copyright Ericsson AB 1998-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -39,7 +40,7 @@
** DB_FINE_LOCKED set. The table variable is_thread_safe will then indicate
** if operations need to obtain fine grained locks or not. Some operations
** will for example always use exclusive table lock to guarantee
-** a higher level of atomicy.
+** a higher level of atomicity.
*/
/* FIXATION:
@@ -83,25 +84,28 @@
#include "erl_db_hash.h"
-#ifdef MYDEBUG /* Will fail test case ets_SUITE:memory */
-# define IF_DEBUG(x) x
-# define MY_ASSERT(x) ASSERT(x)
-#else
-# define IF_DEBUG(x)
-# define MY_ASSERT(x)
-#endif
-
/*
* The following symbols can be manipulated to "tune" the linear hash array
*/
-#define CHAIN_LEN 6 /* Medium bucket chain len */
+#define GROW_LIMIT(NACTIVE) ((NACTIVE)*1)
+#define SHRINK_LIMIT(NACTIVE) ((NACTIVE) / 2)
+
+/*
+** We want the first mandatory segment to be small (to reduce minimal footprint)
+** and larger extra segments (to reduce number of alloc/free calls).
+*/
+
+/* Number of slots in first segment */
+#define FIRST_SEGSZ_EXP 8
+#define FIRST_SEGSZ (1 << FIRST_SEGSZ_EXP)
+#define FIRST_SEGSZ_MASK (FIRST_SEGSZ - 1)
-/* Number of slots per segment */
-#define SEGSZ_EXP 8
-#define SEGSZ (1 << SEGSZ_EXP)
-#define SEGSZ_MASK (SEGSZ-1)
+/* Number of slots per extra segment */
+#define EXT_SEGSZ_EXP 11
+#define EXT_SEGSZ (1 << EXT_SEGSZ_EXP)
+#define EXT_SEGSZ_MASK (EXT_SEGSZ-1)
-#define NSEG_1 2 /* Size of first segment table (must be at least 2) */
+#define NSEG_1 (ErtsSizeofMember(DbTableHash,first_segtab) / sizeof(struct segment*))
#define NSEG_2 256 /* Size of second segment table */
#define NSEG_INC 128 /* Number of segments to grow after that */
@@ -122,7 +126,9 @@
#define NACTIVE(tb) ((int)erts_smp_atomic_read_nob(&(tb)->nactive))
#define NITEMS(tb) ((int)erts_smp_atomic_read_nob(&(tb)->common.nitems))
-#define BUCKET(tb, i) SEGTAB(tb)[(i) >> SEGSZ_EXP]->buckets[(i) & SEGSZ_MASK]
+#define SLOT_IX_TO_SEG_IX(i) (((i)+(EXT_SEGSZ-FIRST_SEGSZ)) >> EXT_SEGSZ_EXP)
+
+#define BUCKET(tb, i) SEGTAB(tb)[SLOT_IX_TO_SEG_IX(i)]->buckets[(i) & EXT_SEGSZ_MASK]
/*
* When deleting a table, the number of records to delete.
@@ -147,8 +153,11 @@ static ERTS_INLINE Uint hash_to_ix(DbTableHash* tb, HashValue hval)
}
/* Remember a slot containing a pseudo-deleted item (INVALID_HASH)
-*/
-static ERTS_INLINE void add_fixed_deletion(DbTableHash* tb, int ix)
+ * Return false if we got raced by unfixing thread
+ * and the object should be deleted for real.
+ */
+static ERTS_INLINE int add_fixed_deletion(DbTableHash* tb, int ix,
+ erts_aint_t fixated_by_me)
{
erts_aint_t was_next;
erts_aint_t exp_next;
@@ -159,12 +168,18 @@ static ERTS_INLINE void add_fixed_deletion(DbTableHash* tb, int ix)
fixd->slot = ix;
was_next = erts_smp_atomic_read_acqb(&tb->fixdel);
do { /* Lockless atomic insertion in linked list: */
- exp_next = was_next;
+ if (NFIXED(tb) <= fixated_by_me) {
+ erts_db_free(ERTS_ALC_T_DB_FIX_DEL, (DbTable*)tb,
+ fixd, sizeof(FixedDeletion));
+ return 0; /* raced by unfixer */
+ }
+ exp_next = was_next;
fixd->next = (FixedDeletion*) exp_next;
- was_next = erts_smp_atomic_cmpxchg_relb(&tb->fixdel,
- (erts_aint_t) fixd,
- exp_next);
+ was_next = erts_smp_atomic_cmpxchg_mb(&tb->fixdel,
+ (erts_aint_t) fixd,
+ exp_next);
}while (was_next != exp_next);
+ return 1;
}
@@ -174,11 +189,12 @@ static ERTS_INLINE void add_fixed_deletion(DbTableHash* tb, int ix)
/* optimised version of make_hash (normal case? atomic key) */
#define MAKE_HASH(term) \
((is_atom(term) ? (atom_tab(atom_val(term))->slot.bucket.hvalue) : \
- make_hash2(term)) % MAX_HASH)
+ make_internal_hash(term, 0)) % MAX_HASH)
#ifdef ERTS_SMP
# define DB_HASH_LOCK_MASK (DB_HASH_LOCK_CNT-1)
# define GET_LOCK(tb,hval) (&(tb)->locks->lck_vec[(hval) & DB_HASH_LOCK_MASK].lck)
+# define GET_LOCK_MAYBE(tb,hval) ((tb)->common.is_thread_safe ? NULL : GET_LOCK(tb,hval))
/* Fine grained read lock */
static ERTS_INLINE erts_smp_rwmtx_t* RLOCK_HASH(DbTableHash* tb, HashValue hval)
@@ -308,27 +324,23 @@ struct mp_info {
/* A table segment */
struct segment {
- HashDbTerm* buckets[SEGSZ];
-#ifdef MYDEBUG
- int is_ext_segment;
-#endif
+ HashDbTerm* buckets[1];
};
+#define SIZEOF_SEGMENT(N) \
+ (offsetof(struct segment,buckets) + sizeof(HashDbTerm*)*(N))
-/* A segment that also contains a segment table */
-struct ext_segment {
- struct segment s; /* The segment itself. Must be first */
-
+/* An extended segment table */
+struct ext_segtab {
+#ifdef ERTS_SMP
+ ErtsThrPrgrLaterOp lop;
+#endif
struct segment** prev_segtab; /* Used when table is shrinking */
- int nsegs; /* Size of segtab */
+ int prev_nsegs; /* Size of prev_segtab */
+ int nsegs; /* Size of this segtab */
struct segment* segtab[1]; /* The segment table */
};
-#define SIZEOF_EXTSEG(NSEGS) \
- (offsetof(struct ext_segment,segtab) + sizeof(struct segment*)*(NSEGS))
-
-#if defined(DEBUG) || defined(VALGRIND)
-# define EXTSEG(SEGTAB_PTR) \
- ((struct ext_segment*) (((char*)(SEGTAB_PTR)) - offsetof(struct ext_segment,segtab)))
-#endif
+#define SIZEOF_EXT_SEGTAB(NSEGS) \
+ (offsetof(struct ext_segtab,segtab) + sizeof(struct segment*)*(NSEGS))
static ERTS_INLINE void SET_SEGTAB(DbTableHash* tb,
@@ -338,53 +350,28 @@ static ERTS_INLINE void SET_SEGTAB(DbTableHash* tb,
erts_smp_atomic_set_wb(&tb->segtab, (erts_aint_t) segtab);
else
erts_smp_atomic_set_nob(&tb->segtab, (erts_aint_t) segtab);
-#ifdef VALGRIND
- tb->top_ptr_to_segment_with_active_segtab = EXTSEG(segtab);
-#endif
}
-
-/* How the table segments relate to each other:
-
- ext_segment: ext_segment: "plain" segment
- #=================# #================# #=============#
- | bucket[0] |<--+ +------->| bucket[256] | +->| bucket[512] |
- | bucket[1] | | | | [257] | | | [513] |
- : : | | : : | : :
- | bucket[255] | | | | [511] | | | [767] |
- |-----------------| | | |----------------| | #=============#
- | prev_segtab=NULL| | | +--<---prev_segtab | |
- | nsegs = 2 | | | | | nsegs = 256 | |
-+->| segtab[0] -->-------+---|---|--<---segtab[0] |<-+ |
-| | segtab[1] -->-----------+---|--<---segtab[1] | | |
-| #=================# | | segtab[2] -->-----|--+ ext_segment:
-| | : : | #================#
-+----------------<---------------+ | segtab[255] ->----|----->| bucket[255*256]|
- #================# | | |
- | : :
- | |----------------|
- +----<---prev_segtab |
- : :
-*/
-
+/* Used by select_replace on analyze_pattern */
+typedef int (*extra_match_validator_t)(int keypos, Eterm match, Eterm guard, Eterm body);
/*
** Forward decl's (static functions)
*/
-static struct ext_segment* alloc_ext_seg(DbTableHash* tb, unsigned seg_ix,
- struct segment** old_segtab);
-static int alloc_seg(DbTableHash *tb);
+static struct ext_segtab* alloc_ext_segtab(DbTableHash* tb, unsigned seg_ix);
+static void alloc_seg(DbTableHash *tb);
static int free_seg(DbTableHash *tb, int free_records);
static HashDbTerm* next(DbTableHash *tb, Uint *iptr, erts_smp_rwmtx_t** lck_ptr,
HashDbTerm *list);
static HashDbTerm* search_list(DbTableHash* tb, Eterm key,
HashValue hval, HashDbTerm *list);
-static void shrink(DbTableHash* tb, int nactive);
-static void grow(DbTableHash* tb, int nactive);
+static void shrink(DbTableHash* tb, int nitems);
+static void grow(DbTableHash* tb, int nitems);
static Eterm build_term_list(Process* p, HashDbTerm* ptr1, HashDbTerm* ptr2,
- DbTableHash*);
-static int analyze_pattern(DbTableHash *tb, Eterm pattern,
- struct mp_info *mpi);
+ Uint sz, DbTableHash*);
+static int analyze_pattern(DbTableHash *tb, Eterm pattern,
+ extra_match_validator_t extra_validator, /* Optional callback */
+ struct mp_info *mpi);
/*
* Method interface functions
@@ -408,31 +395,37 @@ static int db_erase_object_hash(DbTable *tbl, Eterm object,Eterm *ret);
static int db_slot_hash(Process *p, DbTable *tbl,
Eterm slot_term, Eterm *ret);
-static int db_select_chunk_hash(Process *p, DbTable *tbl,
+static int db_select_chunk_hash(Process *p, DbTable *tbl, Eterm tid,
Eterm pattern, Sint chunk_size,
int reverse, Eterm *ret);
-static int db_select_hash(Process *p, DbTable *tbl,
+static int db_select_hash(Process *p, DbTable *tbl, Eterm tid,
Eterm pattern, int reverse, Eterm *ret);
-static int db_select_count_hash(Process *p, DbTable *tbl,
- Eterm pattern, Eterm *ret);
-static int db_select_delete_hash(Process *p, DbTable *tbl,
- Eterm pattern, Eterm *ret);
-
-static int db_select_continue_hash(Process *p, DbTable *tbl,
+static int db_select_continue_hash(Process *p, DbTable *tbl,
Eterm continuation, Eterm *ret);
-static int db_select_count_continue_hash(Process *p, DbTable *tbl,
+static int db_select_count_hash(Process *p, DbTable *tbl, Eterm tid,
+ Eterm pattern, Eterm *ret);
+static int db_select_count_continue_hash(Process *p, DbTable *tbl,
Eterm continuation, Eterm *ret);
+static int db_select_delete_hash(Process *p, DbTable *tbl, Eterm tid,
+ Eterm pattern, Eterm *ret);
static int db_select_delete_continue_hash(Process *p, DbTable *tbl,
Eterm continuation, Eterm *ret);
-static void db_print_hash(int to,
+
+static int db_select_replace_hash(Process *p, DbTable *tbl, Eterm tid,
+ Eterm pattern, Eterm *ret);
+static int db_select_replace_continue_hash(Process *p, DbTable *tbl,
+ Eterm continuation, Eterm *ret);
+
+static int db_take_hash(Process *, DbTable *, Eterm, Eterm *);
+static void db_print_hash(fmtfn_t to,
void *to_arg,
int show,
DbTable *tbl);
static int db_free_table_hash(DbTable *tbl);
-static int db_free_table_continue_hash(DbTable *tbl);
+static SWord db_free_table_continue_hash(DbTable *tbl, SWord reds);
static void db_foreach_offheap_hash(DbTable *,
@@ -443,21 +436,22 @@ static int db_delete_all_objects_hash(Process* p, DbTable* tbl);
#ifdef HARDDEBUG
static void db_check_table_hash(DbTableHash *tb);
#endif
-static int db_lookup_dbterm_hash(DbTable *tbl, Eterm key, DbUpdateHandle* handle);
-static void db_finalize_dbterm_hash(DbUpdateHandle* handle);
+static int
+db_lookup_dbterm_hash(Process *p, DbTable *tbl, Eterm key, Eterm obj,
+ DbUpdateHandle* handle);
+static void
+db_finalize_dbterm_hash(int cret, DbUpdateHandle* handle);
static ERTS_INLINE void try_shrink(DbTableHash* tb)
{
int nactive = NACTIVE(tb);
- if (nactive > SEGSZ && NITEMS(tb) < (nactive * CHAIN_LEN)
+ int nitems = NITEMS(tb);
+ if (nactive > FIRST_SEGSZ && nitems < SHRINK_LIMIT(nactive)
&& !IS_FIXED(tb)) {
- shrink(tb, nactive);
+ shrink(tb, nitems);
}
}
-#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,
@@ -467,7 +461,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);
}
}
@@ -480,7 +474,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);
}
}
@@ -536,16 +530,14 @@ DbTableMethod db_hash =
db_select_delete_continue_hash,
db_select_count_hash,
db_select_count_continue_hash,
+ db_select_replace_hash,
+ db_select_replace_continue_hash,
+ db_take_hash,
db_delete_all_objects_hash,
db_free_table_hash,
db_free_table_continue_hash,
db_print_hash,
db_foreach_offheap_hash,
-#ifdef HARDDEBUG
- db_check_table_hash,
-#else
- NULL,
-#endif
db_lookup_dbterm_hash,
db_finalize_dbterm_hash
};
@@ -593,16 +585,17 @@ static void restore_fixdel(DbTableHash* tb, FixedDeletion* fixdel)
** Table interface routines ie what's called by the bif's
*/
-void db_unfix_table_hash(DbTableHash *tb)
+SWord db_unfix_table_hash(DbTableHash *tb)
{
FixedDeletion* fixdel;
+ SWord work = 0;
ERTS_SMP_LC_ASSERT(erts_smp_lc_rwmtx_is_rwlocked(&tb->common.rwlock)
|| (erts_smp_lc_rwmtx_is_rlocked(&tb->common.rwlock)
&& !tb->common.is_thread_safe));
restart:
- fixdel = (FixedDeletion*) erts_smp_atomic_xchg_acqb(&tb->fixdel,
- (erts_aint_t) NULL);
+ fixdel = (FixedDeletion*) erts_smp_atomic_xchg_mb(&tb->fixdel,
+ (erts_aint_t) NULL);
while (fixdel != NULL) {
FixedDeletion *fx = fixdel;
int ix = fx->slot;
@@ -616,7 +609,7 @@ restart:
if (!IS_FIXED(tb)) {
goto restart; /* unfixed again! */
}
- return;
+ return work;
}
if (ix < NACTIVE(tb)) {
bp = &BUCKET(tb, ix);
@@ -626,6 +619,7 @@ restart:
if (b->hvalue == INVALID_HASH) {
*bp = b->next;
free_term(tb, b);
+ work++;
b = *bp;
} else {
bp = &b->next;
@@ -641,57 +635,47 @@ restart:
(void *) fx,
sizeof(FixedDeletion));
ERTS_ETS_MISC_MEM_ADD(-sizeof(FixedDeletion));
+ work++;
}
/* ToDo: Maybe try grow/shrink the table as well */
-}
-/* Only used by tests
-*/
-Uint db_kept_items_hash(DbTableHash *tb)
-{
- Uint kept_items = 0;
- Uint ix = 0;
- erts_smp_rwmtx_t* lck = RLOCK_HASH(tb,ix);
- HashDbTerm* b;
- do {
- for (b = BUCKET(tb, ix); b != NULL; b = b->next) {
- if (b->hvalue == INVALID_HASH) {
- ++kept_items;
- }
- }
- ix = next_slot(tb, ix, &lck);
- }while (ix);
- return kept_items;
+ return work;
}
int db_create_hash(Process *p, DbTable *tbl)
{
DbTableHash *tb = &tbl->hash;
- erts_smp_atomic_init_nob(&tb->szm, SEGSZ_MASK);
- erts_smp_atomic_init_nob(&tb->nactive, SEGSZ);
+ erts_smp_atomic_init_nob(&tb->szm, FIRST_SEGSZ_MASK);
+ erts_smp_atomic_init_nob(&tb->nactive, FIRST_SEGSZ);
erts_smp_atomic_init_nob(&tb->fixdel, (erts_aint_t)NULL);
erts_smp_atomic_init_nob(&tb->segtab, (erts_aint_t)NULL);
- SET_SEGTAB(tb, alloc_ext_seg(tb,0,NULL)->segtab);
+ SET_SEGTAB(tb, tb->first_segtab);
tb->nsegs = NSEG_1;
- tb->nslots = SEGSZ;
+ tb->nslots = FIRST_SEGSZ;
+ tb->first_segtab[0] = (struct segment*) erts_db_alloc(ERTS_ALC_T_DB_SEG,
+ (DbTable *) tb,
+ SIZEOF_SEGMENT(FIRST_SEGSZ));
+ sys_memset(tb->first_segtab[0], 0, SIZEOF_SEGMENT(FIRST_SEGSZ));
- erts_smp_atomic_init_nob(&tb->is_resizing, 0);
#ifdef ERTS_SMP
+ erts_smp_atomic_init_nob(&tb->is_resizing, 0);
if (tb->common.type & DB_FINE_LOCKED) {
erts_smp_rwmtx_opt_t rwmtx_opt = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER;
int i;
if (tb->common.type & DB_FREQ_READ)
rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_FREQUENT_READ;
+ if (erts_ets_rwmtx_spin_count >= 0)
+ rwmtx_opt.main_spincount = erts_ets_rwmtx_spin_count;
tb->locks = (DbTableHashFineLocks*) erts_db_alloc_fnf(ERTS_ALC_T_DB_SEG, /* Other type maybe? */
(DbTable *) tb,
sizeof(DbTableHashFineLocks));
for (i=0; i<DB_HASH_LOCK_CNT; ++i) {
- erts_smp_rwmtx_init_opt_x(&tb->locks->lck_vec[i].lck, &rwmtx_opt,
- "db_hash_slot", make_small(i));
+ erts_smp_rwmtx_init_opt(&tb->locks->lck_vec[i].lck, &rwmtx_opt,
+ "db_hash_slot", tb->common.the_name, ERTS_LOCK_FLAGS_CATEGORY_DB);
}
- /* This important property is needed to guarantee that the buckets
+ /* This important property is needed to guarantee the two buckets
* involved in a grow/shrink operation it protected by the same lock:
*/
ASSERT(erts_smp_atomic_read_nob(&tb->nactive) % DB_HASH_LOCK_CNT == 0);
@@ -867,11 +851,10 @@ Lnew:
WUNLOCK_HASH(lck);
{
int nactive = NACTIVE(tb);
- if (nitems > nactive * (CHAIN_LEN+1) && !IS_FIXED(tb)) {
- grow(tb, nactive);
+ if (nitems > GROW_LIMIT(nactive) && !IS_FIXED(tb)) {
+ grow(tb, nitems);
}
}
- CHECK_TABLES();
return DB_ERROR_NONE;
Ldone:
@@ -879,105 +862,55 @@ Ldone:
return ret;
}
-int db_get_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
+static Eterm
+get_term_list(Process *p, DbTableHash *tb, Eterm key, HashValue hval,
+ HashDbTerm *b1, HashDbTerm **bend)
{
- DbTableHash *tb = &tbl->hash;
- HashValue hval;
- int ix;
- HashDbTerm* b1;
- erts_smp_rwmtx_t* lck;
-
- hval = MAKE_HASH(key);
- lck = RLOCK_HASH(tb,hval);
- ix = hash_to_ix(tb, hval);
- b1 = BUCKET(tb, ix);
+ HashDbTerm* b2 = b1->next;
+ Eterm copy;
+ Uint sz = b1->dbterm.size + 2;
- while(b1 != 0) {
- if (has_live_key(tb,b1,key,hval)) {
- HashDbTerm* b2 = b1->next;
- Eterm copy;
+ if (tb->common.status & (DB_BAG | DB_DUPLICATE_BAG)) {
+ while (b2 && has_key(tb, b2, key, hval)) {
+ if (b2->hvalue != INVALID_HASH)
+ sz += b2->dbterm.size + 2;
- if (tb->common.status & (DB_BAG | DB_DUPLICATE_BAG)) {
- while(b2 != NULL && has_key(tb,b2,key,hval))
- b2 = b2->next;
- }
- copy = build_term_list(p, b1, b2, tb);
- CHECK_TABLES();
- *ret = copy;
- goto done;
- }
- b1 = b1->next;
+ b2 = b2->next;
+ }
}
- *ret = NIL;
-done:
- RUNLOCK_HASH(lck);
- return DB_ERROR_NONE;
+ copy = build_term_list(p, b1, b2, sz, tb);
+ if (bend) {
+ *bend = b2;
+ }
+ return copy;
}
-int db_get_element_array(DbTable *tbl,
- Eterm key,
- int ndex,
- Eterm *ret,
- int *num_ret)
+int db_get_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
{
DbTableHash *tb = &tbl->hash;
HashValue hval;
int ix;
- HashDbTerm* b1;
- int num = 0;
- int retval;
+ HashDbTerm* b;
erts_smp_rwmtx_t* lck;
- ASSERT(!IS_FIXED(tbl)); /* no support for fixed tables here */
-
hval = MAKE_HASH(key);
- lck = RLOCK_HASH(tb, hval);
+ lck = RLOCK_HASH(tb,hval);
ix = hash_to_ix(tb, hval);
- b1 = BUCKET(tb, ix);
+ b = BUCKET(tb, ix);
- while(b1 != 0) {
- if (has_live_key(tb,b1,key,hval)) {
- if (tb->common.status & (DB_BAG | DB_DUPLICATE_BAG)) {
- HashDbTerm* b;
- HashDbTerm* b2 = b1->next;
-
- while(b2 != NULL && has_live_key(tb,b2,key,hval)) {
- if (ndex > arityval(b2->dbterm.tpl[0])) {
- retval = DB_ERROR_BADITEM;
- goto done;
- }
- b2 = b2->next;
- }
-
- b = b1;
- while(b != b2) {
- if (num < *num_ret) {
- ret[num++] = b->dbterm.tpl[ndex];
- } else {
- retval = DB_ERROR_NONE;
- goto done;
- }
- b = b->next;
- }
- *num_ret = num;
- }
- else {
- ASSERT(*num_ret > 0);
- ret[0] = b1->dbterm.tpl[ndex];
- *num_ret = 1;
- }
- retval = DB_ERROR_NONE;
+ while(b != 0) {
+ if (has_live_key(tb, b, key, hval)) {
+ *ret = get_term_list(p, tb, key, hval, b, NULL);
goto done;
}
- b1 = b1->next;
+ b = b->next;
}
- retval = DB_ERROR_BADKEY;
+ *ret = NIL;
done:
RUNLOCK_HASH(lck);
- return retval;
+ return DB_ERROR_NONE;
}
-
static int db_member_hash(DbTable *tbl, Eterm key, Eterm *ret)
{
DbTableHash *tb = &tbl->hash;
@@ -1048,7 +981,6 @@ static int db_get_element_hash(Process *p, DbTable *tbl,
Eterm copy = db_copy_element_from_ets(&tb->common, p,
&b->dbterm, ndex, &hp, 2);
elem_list = CONS(hp, copy, elem_list);
- hp += 2;
}
b = b->next;
}
@@ -1070,54 +1002,6 @@ done:
}
/*
- * Very internal interface, removes elements of arity two from
- * BAG. Used for the PID meta table
- */
-int db_erase_bag_exact2(DbTable *tbl, Eterm key, Eterm value)
-{
- DbTableHash *tb = &tbl->hash;
- HashValue hval;
- int ix;
- HashDbTerm** bp;
- HashDbTerm* b;
- erts_smp_rwmtx_t* lck;
- int found = 0;
-
- hval = MAKE_HASH(key);
- lck = WLOCK_HASH(tb,hval);
- ix = hash_to_ix(tb, hval);
- bp = &BUCKET(tb, ix);
- b = *bp;
-
- ASSERT(!IS_FIXED(tb));
- ASSERT((tb->common.status & DB_BAG));
- ASSERT(!tb->common.compress);
-
- while(b != 0) {
- if (has_live_key(tb,b,key,hval)) {
- found = 1;
- if ((arityval(b->dbterm.tpl[0]) == 2) &&
- EQ(value, b->dbterm.tpl[2])) {
- *bp = b->next;
- free_term(tb, b);
- erts_smp_atomic_dec_nob(&tb->common.nitems);
- b = *bp;
- break;
- }
- } else if (found) {
- break;
- }
- bp = &b->next;
- b = b->next;
- }
- WUNLOCK_HASH(lck);
- if (found) {
- try_shrink(tb);
- }
- return DB_ERROR_NONE;
-}
-
-/*
** NB, this is for the db_erase/2 bif.
*/
int db_erase_hash(DbTable *tbl, Eterm key, Eterm *ret)
@@ -1139,9 +1023,9 @@ int db_erase_hash(DbTable *tbl, Eterm key, Eterm *ret)
while(b != 0) {
if (has_live_key(tb,b,key,hval)) {
--nitems_diff;
- if (nitems_diff == -1 && IS_FIXED(tb)) {
+ if (nitems_diff == -1 && IS_FIXED(tb)
+ && add_fixed_deletion(tb, ix, 0)) {
/* Pseudo remove (no need to keep several of same key) */
- add_fixed_deletion(tb, ix);
b->hvalue = INVALID_HASH;
} else {
*bp = b->next;
@@ -1193,9 +1077,8 @@ static int db_erase_object_hash(DbTable *tbl, Eterm object, Eterm *ret)
++nkeys;
if (db_eq(&tb->common,object, &b->dbterm)) {
--nitems_diff;
- if (nkeys==1 && IS_FIXED(tb)) { /* Pseudo remove */
- add_fixed_deletion(tb,ix);
- b->hvalue = INVALID_HASH;
+ if (nkeys==1 && IS_FIXED(tb) && add_fixed_deletion(tb,ix,0)) {
+ b->hvalue = INVALID_HASH; /* Pseudo remove */
bp = &b->next;
b = b->next;
} else {
@@ -1240,7 +1123,7 @@ static int db_slot_hash(Process *p, DbTable *tbl, Eterm slot_term, Eterm *ret)
lck = RLOCK_HASH(tb, slot);
nactive = NACTIVE(tb);
if (slot < nactive) {
- *ret = build_term_list(p, BUCKET(tb, slot), 0, tb);
+ *ret = build_term_list(p, BUCKET(tb, slot), NULL, 0, tb);
retval = DB_ERROR_NONE;
}
else if (slot == nactive) {
@@ -1265,810 +1148,1145 @@ static BIF_RETTYPE bif_trap1(Export *bif,
{
BIF_TRAP1(bif, p, p1);
}
-
+
+
/*
- * Continue collecting select matches, this may happen either due to a trap
- * or when the user calls ets:select/1
+ * Match traversal callbacks
*/
-static int db_select_continue_hash(Process *p,
- DbTable *tbl,
- Eterm continuation,
- Eterm *ret)
-{
- DbTableHash *tb = &tbl->hash;
- Sint slot_ix;
- Sint save_slot_ix;
- Sint chunk_size;
- int all_objects;
- Binary *mp;
- int num_left = 1000;
- HashDbTerm *current = 0;
- Eterm match_list;
- Eterm *hp;
- Eterm match_res;
- Sint got;
- Eterm *tptr;
- erts_smp_rwmtx_t* lck;
-#define RET_TO_BIF(Term, State) do { *ret = (Term); return State; } while(0);
+/* Called when no match is possible.
+ * context_ptr: Pointer to context
+ * ret: Pointer to traversal function term return.
+ *
+ * Both the direct return value and 'ret' are used as the traversal function return values.
+ */
+typedef int (*mtraversal_on_nothing_can_match_t)(void* context_ptr, Eterm* ret);
+
+/* Called for each match result.
+ * context_ptr: Pointer to context
+ * slot_ix: Current slot index
+ * current_ptr_ptr: Triple pointer to either the bucket or the 'next' pointer in the previous element;
+ * can be (carefully) used to adjust iteration when deleting or replacing elements.
+ * match_res: The result of running the match program against the current term.
+ *
+ * Should return 1 for successful match, 0 otherwise.
+ */
+typedef int (*mtraversal_on_match_res_t)(void* context_ptr, Sint slot_ix, HashDbTerm*** current_ptr_ptr,
+ Eterm match_res);
+
+/* Called when either we've matched enough elements in this cycle or EOT was reached.
+ * context_ptr: Pointer to context
+ * slot_ix: Current slot index
+ * got: How many elements have been matched so far
+ * iterations_left: Number of intended iterations (down from an initial max.) left in this traversal cycle
+ * mpp: Double pointer to the compiled match program
+ * ret: Pointer to traversal function term return.
+ *
+ * Both the direct return value and 'ret' are used as the traversal function return values.
+ * If *mpp is set to NULL, it won't be deallocated (useful for trapping.)
+ */
+typedef int (*mtraversal_on_loop_ended_t)(void* context_ptr, Sint slot_ix, Sint got,
+ Sint iterations_left, Binary** mpp, Eterm* ret);
+
+/* Called when it's time to trap
+ * context_ptr: Pointer to context
+ * slot_ix: Current slot index
+ * got: How many elements have been matched so far
+ * mpp: Double pointer to the compiled match program
+ * ret: Pointer to traversal function term return.
+ *
+ * Both the direct return value and 'ret' are used as the traversal function return values.
+ * If *mpp is set to NULL, it won't be deallocated (useful for trapping.)
+ */
+typedef int (*mtraversal_on_trap_t)(void* context_ptr, Sint slot_ix, Sint got, Binary** mpp, Eterm* ret);
- /* Decode continuation. We know it's a tuple but not the arity or anything else */
+/*
+ * Begin hash table match traversal
+ */
+static int match_traverse(Process* p, DbTableHash* tb,
+ Eterm pattern,
+ extra_match_validator_t extra_match_validator, /* Optional */
+ Sint chunk_size, /* If 0, no chunking */
+ Sint iterations_left, /* Nr. of iterations left */
+ Eterm** hpp, /* Heap */
+ int lock_for_write, /* Set to 1 if we're going to delete or
+ modify existing terms */
+ mtraversal_on_nothing_can_match_t on_nothing_can_match,
+ mtraversal_on_match_res_t on_match_res,
+ mtraversal_on_loop_ended_t on_loop_ended,
+ mtraversal_on_trap_t on_trap,
+ void* context_ptr, /* State for callbacks above */
+ Eterm* ret)
+{
+ Sint slot_ix; /* Slot index */
+ HashDbTerm** current_ptr; /* Refers to either the bucket pointer or
+ * the 'next' pointer in the previous term
+ */
+ HashDbTerm* saved_current; /* Helper to avoid double skip on match */
+ struct mp_info mpi;
+ unsigned current_list_pos = 0; /* Prefound buckets list index */
+ Eterm match_res;
+ Sint got = 0; /* Matched terms counter */
+ erts_smp_rwmtx_t* lck; /* Slot lock */
+ int ret_value;
+#ifdef ERTS_SMP
+ erts_smp_rwmtx_t* (*lock_hash_function)(DbTableHash*, HashValue)
+ = (lock_for_write ? WLOCK_HASH : RLOCK_HASH);
+ void (*unlock_hash_function)(erts_smp_rwmtx_t*)
+ = (lock_for_write ? WUNLOCK_HASH : RUNLOCK_HASH);
+#else
+ #define lock_hash_function(tb, hval) NULL
+ #define unlock_hash_function(lck) ((void)lck)
+#endif
+ Sint (*next_slot_function)(DbTableHash*, Uint, erts_smp_rwmtx_t**)
+ = (lock_for_write ? next_slot_w : next_slot);
- tptr = tuple_val(continuation);
+ if ((ret_value = analyze_pattern(tb, pattern, extra_match_validator, &mpi))
+ != DB_ERROR_NONE)
+ {
+ *ret = NIL;
+ goto done;
+ }
- if (arityval(*tptr) != 6)
- RET_TO_BIF(NIL,DB_ERROR_BADPARAM);
-
- if (!is_small(tptr[2]) || !is_small(tptr[3]) || !is_binary(tptr[4]) ||
- !(is_list(tptr[5]) || tptr[5] == NIL) || !is_small(tptr[6]))
- RET_TO_BIF(NIL,DB_ERROR_BADPARAM);
- if ((chunk_size = signed_val(tptr[3])) < 0)
- RET_TO_BIF(NIL,DB_ERROR_BADPARAM);
- if (!(thing_subtag(*binary_val(tptr[4])) == REFC_BINARY_SUBTAG))
- RET_TO_BIF(NIL,DB_ERROR_BADPARAM);
- mp = ((ProcBin *) binary_val(tptr[4]))->val;
- if (!IsMatchProgBinary(mp))
- RET_TO_BIF(NIL,DB_ERROR_BADPARAM);
- all_objects = mp->flags & BIN_FLAG_ALL_OBJECTS;
- match_list = tptr[5];
- if ((got = signed_val(tptr[6])) < 0)
- RET_TO_BIF(NIL,DB_ERROR_BADPARAM);
+ if (!mpi.something_can_match) {
+ /* Can't possibly match anything */
+ ret_value = on_nothing_can_match(context_ptr, ret);
+ goto done;
+ }
- slot_ix = signed_val(tptr[2]);
- if (slot_ix < 0 /* EOT */
- || (chunk_size && got >= chunk_size)) {
- goto done; /* Already got all or enough in the match_list */
+ if (mpi.all_objects) {
+ mpi.mp->intern.flags |= BIN_FLAG_ALL_OBJECTS;
}
- lck = RLOCK_HASH(tb,slot_ix);
- if (slot_ix >= NACTIVE(tb)) {
- RUNLOCK_HASH(lck);
- RET_TO_BIF(NIL,DB_ERROR_BADPARAM);
+ /*
+ * Look for initial slot / bucket
+ */
+ if (!mpi.key_given) {
+ /* Run this code if pattern is variable or GETKEY(pattern) */
+ /* is a variable */
+ slot_ix = 0;
+ lck = lock_hash_function(tb,slot_ix);
+ for (;;) {
+ ASSERT(slot_ix < NACTIVE(tb));
+ if (*(current_ptr = &BUCKET(tb,slot_ix)) != NULL) {
+ break;
+ }
+ slot_ix = next_slot_function(tb,slot_ix,&lck);
+ if (slot_ix == 0) {
+ ret_value = on_loop_ended(context_ptr, slot_ix, got, iterations_left, &mpi.mp, ret);
+ goto done;
+ }
+ }
+ } else {
+ /* We have at least one */
+ slot_ix = mpi.lists[current_list_pos].ix;
+ lck = lock_hash_function(tb, slot_ix);
+ current_ptr = mpi.lists[current_list_pos].bucket;
+ ASSERT(*current_ptr == BUCKET(tb,slot_ix));
+ ++current_list_pos;
}
- while ((current = BUCKET(tb,slot_ix)) == NULL) {
- slot_ix = next_slot(tb, slot_ix, &lck);
- if (slot_ix == 0) {
- slot_ix = -1; /* EOT */
- goto done;
- }
- }
+ /*
+ * Execute traversal cycle
+ */
for(;;) {
- if (current->hvalue != INVALID_HASH &&
- (match_res = db_match_dbterm(&tb->common, p, mp, all_objects,
- &current->dbterm, &hp, 2),
- is_value(match_res))) {
+ if (*current_ptr != NULL) {
+ if ((*current_ptr)->hvalue != INVALID_HASH) {
+ match_res = db_match_dbterm(&tb->common, p, mpi.mp, 0,
+ &(*current_ptr)->dbterm, hpp, 2);
+ saved_current = *current_ptr;
+ if (on_match_res(context_ptr, slot_ix, &current_ptr, match_res)) {
+ ++got;
+ }
+ --iterations_left;
+ if (*current_ptr != saved_current) {
+ /* Don't advance to next, the callback did it already */
+ continue;
+ }
+ }
+ current_ptr = &((*current_ptr)->next);
+ }
+ else if (mpi.key_given) { /* Key is bound */
+ unlock_hash_function(lck);
+ if (current_list_pos == mpi.num_lists) {
+ ret_value = on_loop_ended(context_ptr, -1, got, iterations_left, &mpi.mp, ret);
+ goto done;
+ } else {
+ slot_ix = mpi.lists[current_list_pos].ix;
+ lck = lock_hash_function(tb, slot_ix);
+ current_ptr = mpi.lists[current_list_pos].bucket;
+ ASSERT(mpi.lists[current_list_pos].bucket == &BUCKET(tb,slot_ix));
+ ++current_list_pos;
+ }
+ }
+ else { /* Key is variable */
+ if ((slot_ix = next_slot_function(tb,slot_ix,&lck)) == 0) {
+ slot_ix = -1;
+ break;
+ }
+ if (chunk_size && got >= chunk_size) {
+ unlock_hash_function(lck);
+ break;
+ }
+ if (iterations_left <= 0 || MBUF(p)) {
+ /*
+ * We have either reached our limit, or just created some heap fragments.
+ * Since many heap fragments will make the GC slower, trap and GC now.
+ */
+ unlock_hash_function(lck);
+ ret_value = on_trap(context_ptr, slot_ix, got, &mpi.mp, ret);
+ goto done;
+ }
+ current_ptr = &BUCKET(tb,slot_ix);
+ }
+ }
- match_list = CONS(hp, match_res, match_list);
- ++got;
- }
+ ret_value = on_loop_ended(context_ptr, slot_ix, got, iterations_left, &mpi.mp, ret);
- --num_left;
- save_slot_ix = slot_ix;
- if ((current = next(tb, (Uint*)&slot_ix, &lck, current)) == NULL) {
- slot_ix = -1; /* EOT */
- break;
- }
- if (slot_ix != save_slot_ix) {
- if (chunk_size && got >= chunk_size) {
- RUNLOCK_HASH(lck);
- break;
- }
- if (num_left <= 0 || MBUF(p)) {
- /*
- * We have either reached our limit, or just created some heap fragments.
- * Since many heap fragments will make the GC slower, trap and GC now.
- */
- RUNLOCK_HASH(lck);
- goto trap;
- }
- }
- }
done:
- BUMP_REDS(p, 1000 - num_left);
- if (chunk_size) {
- Eterm continuation;
- Eterm rest = NIL;
- Sint rest_size = 0;
-
- if (got > chunk_size) { /* Cannot write destructively here,
- the list may have
- been in user space */
- rest = NIL;
- hp = HAlloc(p, (got - chunk_size) * 2);
- while (got-- > chunk_size) {
- rest = CONS(hp, CAR(list_val(match_list)), rest);
- hp += 2;
- match_list = CDR(list_val(match_list));
- ++rest_size;
- }
- }
- if (rest != NIL || slot_ix >= 0) {
- hp = HAlloc(p,3+7);
- continuation = TUPLE6(hp, tptr[1], make_small(slot_ix),
- tptr[3], tptr[4], rest,
- make_small(rest_size));
- hp += 7;
- RET_TO_BIF(TUPLE2(hp, match_list, continuation),DB_ERROR_NONE);
- } else {
- if (match_list != NIL) {
- hp = HAlloc(p, 3);
- RET_TO_BIF(TUPLE2(hp, match_list, am_EOT),DB_ERROR_NONE);
- } else {
- RET_TO_BIF(am_EOT, DB_ERROR_NONE);
- }
- }
+ /* We should only jump directly to this label if
+ * we've already called on_nothing_can_match / on_loop_ended / on_trap
+ */
+ if (mpi.mp != NULL) {
+ erts_bin_free(mpi.mp);
}
- RET_TO_BIF(match_list,DB_ERROR_NONE);
-
-trap:
- BUMP_ALL_REDS(p);
-
- hp = HAlloc(p,7);
- continuation = TUPLE6(hp, tptr[1], make_small(slot_ix), tptr[3],
- tptr[4], match_list, make_small(got));
- RET_TO_BIF(bif_trap1(&ets_select_continue_exp, p,
- continuation),
- DB_ERROR_NONE);
-
-#undef RET_TO_BIF
-
-}
+ if (mpi.lists != mpi.dlists) {
+ erts_free(ERTS_ALC_T_DB_SEL_LIST,
+ (void *) mpi.lists);
+ }
+ return ret_value;
-static int db_select_hash(Process *p, DbTable *tbl,
- Eterm pattern, int reverse,
- Eterm *ret)
-{
- return db_select_chunk_hash(p, tbl, pattern, 0, reverse, ret);
+#ifndef SMP
+#undef lock_hash_function
+#undef unlock_hash_function
+#endif
}
-static int db_select_chunk_hash(Process *p, DbTable *tbl,
- Eterm pattern, Sint chunk_size,
- int reverse, /* not used */
- Eterm *ret)
+/*
+ * Continue hash table match traversal
+ */
+static int match_traverse_continue(Process* p, DbTableHash* tb,
+ Sint chunk_size, /* If 0, no chunking */
+ Sint iterations_left, /* Nr. of iterations left */
+ Eterm** hpp, /* Heap */
+ Sint slot_ix, /* Slot index to resume traversal from */
+ Sint got, /* Matched terms counter */
+ Binary** mpp, /* Existing match program */
+ int lock_for_write, /* Set to 1 if we're going to delete or
+ modify existing terms */
+ mtraversal_on_match_res_t on_match_res,
+ mtraversal_on_loop_ended_t on_loop_ended,
+ mtraversal_on_trap_t on_trap,
+ void* context_ptr, /* For callbacks */
+ Eterm* ret)
{
- DbTableHash *tb = &tbl->hash;
- struct mp_info mpi;
- Sint slot_ix;
- HashDbTerm *current = 0;
- unsigned current_list_pos = 0;
- Eterm match_list;
+ int all_objects = (*mpp)->intern.flags & BIN_FLAG_ALL_OBJECTS;
+ HashDbTerm** current_ptr; /* Refers to either the bucket pointer or
+ * the 'next' pointer in the previous term
+ */
+ HashDbTerm* saved_current; /* Helper to avoid double skip on match */
Eterm match_res;
- Eterm *hp;
- int num_left = 1000;
- Uint got = 0;
- Eterm continuation;
- int errcode;
- Eterm mpb;
erts_smp_rwmtx_t* lck;
+ int ret_value;
+#ifdef ERTS_SMP
+ erts_smp_rwmtx_t* (*lock_hash_function)(DbTableHash*, HashValue)
+ = (lock_for_write ? WLOCK_HASH : RLOCK_HASH);
+ void (*unlock_hash_function)(erts_smp_rwmtx_t*)
+ = (lock_for_write ? WUNLOCK_HASH : RUNLOCK_HASH);
+#else
+ #define lock_hash_function(tb, hval) NULL
+ #define unlock_hash_function(lck) ((void)lck)
+#endif
+ Sint (*next_slot_function)(DbTableHash* tb, Uint ix, erts_smp_rwmtx_t** lck_ptr)
+ = (lock_for_write ? next_slot_w : next_slot);
-
-#define RET_TO_BIF(Term,RetVal) do { \
- if (mpi.mp != NULL) { \
- erts_bin_free(mpi.mp); \
- } \
- if (mpi.lists != mpi.dlists) { \
- erts_free(ERTS_ALC_T_DB_SEL_LIST, \
- (void *) mpi.lists); \
- } \
- *ret = (Term); \
- return RetVal; \
- } while(0)
-
-
- if ((errcode = analyze_pattern(tb, pattern, &mpi)) != DB_ERROR_NONE) {
- RET_TO_BIF(NIL,errcode);
+ if (got < 0) {
+ *ret = NIL;
+ return DB_ERROR_BADPARAM;
}
- if (!mpi.something_can_match) {
- if (chunk_size) {
- RET_TO_BIF(am_EOT, DB_ERROR_NONE); /* We're done */
- }
- RET_TO_BIF(NIL, DB_ERROR_NONE);
- /* can't possibly match anything */
+ if (slot_ix < 0 /* EOT */
+ || (chunk_size && got >= chunk_size))
+ {
+ /* Already got all or enough in the match_list */
+ ret_value = on_loop_ended(context_ptr, slot_ix, got, iterations_left, mpp, ret);
+ goto done;
}
- if (!mpi.key_given) {
- /* Run this code if pattern is variable or GETKEY(pattern) */
- /* is a variable */
- slot_ix = 0;
- lck = RLOCK_HASH(tb,slot_ix);
- for (;;) {
- ASSERT(slot_ix < NACTIVE(tb));
- if ((current = BUCKET(tb,slot_ix)) != NULL) {
- break;
- }
- slot_ix = next_slot(tb,slot_ix,&lck);
- if (slot_ix == 0) {
- if (chunk_size) {
- RET_TO_BIF(am_EOT, DB_ERROR_NONE); /* We're done */
- }
- RET_TO_BIF(NIL,DB_ERROR_NONE);
- }
- }
- } else {
- /* We have at least one */
- slot_ix = mpi.lists[current_list_pos].ix;
- lck = RLOCK_HASH(tb, slot_ix);
- current = *(mpi.lists[current_list_pos].bucket);
- ASSERT(current == BUCKET(tb,slot_ix));
- ++current_list_pos;
+ lck = lock_hash_function(tb, slot_ix);
+ if (slot_ix >= NACTIVE(tb)) { /* Is this possible? */
+ unlock_hash_function(lck);
+ *ret = NIL;
+ ret_value = DB_ERROR_BADPARAM;
+ goto done;
}
- match_list = NIL;
-
+ /*
+ * Resume traversal cycle from where we left
+ */
+ current_ptr = &BUCKET(tb,slot_ix);
for(;;) {
- if (current != NULL) {
- if (current->hvalue != INVALID_HASH) {
- match_res = db_match_dbterm(&tb->common, p, mpi.mp, 0,
- &current->dbterm, &hp, 2);
- if (is_value(match_res)) {
- match_list = CONS(hp, match_res, match_list);
- ++got;
- }
- }
- current = current->next;
- }
- else if (mpi.key_given) { /* Key is bound */
- RUNLOCK_HASH(lck);
- if (current_list_pos == mpi.num_lists) {
- slot_ix = -1; /* EOT */
- goto done;
- } else {
- slot_ix = mpi.lists[current_list_pos].ix;
- lck = RLOCK_HASH(tb, slot_ix);
- current = *(mpi.lists[current_list_pos].bucket);
- ASSERT(mpi.lists[current_list_pos].bucket == &BUCKET(tb,slot_ix));
- ++current_list_pos;
- }
- }
- else { /* Key is variable */
- --num_left;
-
- if ((slot_ix=next_slot(tb,slot_ix,&lck)) == 0) {
- slot_ix = -1;
- break;
- }
- if (chunk_size && got >= chunk_size) {
- RUNLOCK_HASH(lck);
- break;
- }
- if (num_left <= 0 || MBUF(p)) {
- /*
- * We have either reached our limit, or just created some heap fragments.
- * Since many heap fragments will make the GC slower, trap and GC now.
- */
- RUNLOCK_HASH(lck);
- goto trap;
- }
- current = BUCKET(tb,slot_ix);
+ if (*current_ptr != NULL) {
+ if ((*current_ptr)->hvalue != INVALID_HASH) {
+ match_res = db_match_dbterm(&tb->common, p, *mpp, all_objects,
+ &(*current_ptr)->dbterm, hpp, 2);
+ saved_current = *current_ptr;
+ if (on_match_res(context_ptr, slot_ix, &current_ptr, match_res)) {
+ ++got;
+ }
+ --iterations_left;
+ if (*current_ptr != saved_current) {
+ /* Don't advance to next, the callback did it already */
+ continue;
+ }
+ }
+ current_ptr = &((*current_ptr)->next);
+ }
+ else {
+ if ((slot_ix=next_slot_function(tb,slot_ix,&lck)) == 0) {
+ slot_ix = -1;
+ break;
+ }
+ if (chunk_size && got >= chunk_size) {
+ unlock_hash_function(lck);
+ break;
+ }
+ if (iterations_left <= 0 || MBUF(p)) {
+ /*
+ * We have either reached our limit, or just created some heap fragments.
+ * Since many heap fragments will make the GC slower, trap and GC now.
+ */
+ unlock_hash_function(lck);
+ ret_value = on_trap(context_ptr, slot_ix, got, mpp, ret);
+ goto done;
+ }
+ current_ptr = &BUCKET(tb,slot_ix);
}
}
-done:
- BUMP_REDS(p, 1000 - num_left);
- if (chunk_size) {
- Eterm continuation;
- Eterm rest = NIL;
- Sint rest_size = 0;
-
- if (mpi.all_objects)
- (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS;
- if (got > chunk_size) { /* Split list in return value and 'rest' */
- Eterm tmp = match_list;
- rest = match_list;
- while (got-- > chunk_size + 1) {
- tmp = CDR(list_val(tmp));
- ++rest_size;
- }
- ++rest_size;
- match_list = CDR(list_val(tmp));
- CDR(list_val(tmp)) = NIL; /* Destructive, the list has never
- been in 'user space' */
- }
- if (rest != NIL || slot_ix >= 0) { /* Need more calls */
- hp = HAlloc(p,3+7+PROC_BIN_SIZE);
- mpb =db_make_mp_binary(p,(mpi.mp),&hp);
- if (mpi.all_objects)
- (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS;
- continuation = TUPLE6(hp, tb->common.id,make_small(slot_ix),
- make_small(chunk_size),
- mpb, rest,
- make_small(rest_size));
- mpi.mp = NULL; /*otherwise the return macro will destroy it */
- hp += 7;
- RET_TO_BIF(TUPLE2(hp, match_list, continuation),DB_ERROR_NONE);
- } else { /* All data is exhausted */
- if (match_list != NIL) { /* No more data to search but still a
- result to return to the caller */
- hp = HAlloc(p, 3);
- RET_TO_BIF(TUPLE2(hp, match_list, am_EOT),DB_ERROR_NONE);
- } else { /* Reached the end of the ttable with no data to return */
- RET_TO_BIF(am_EOT, DB_ERROR_NONE);
- }
- }
- }
- RET_TO_BIF(match_list,DB_ERROR_NONE);
-trap:
- BUMP_ALL_REDS(p);
- if (mpi.all_objects)
- (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS;
- hp = HAlloc(p,7+PROC_BIN_SIZE);
- mpb =db_make_mp_binary(p,(mpi.mp),&hp);
- continuation = TUPLE6(hp, tb->common.id, make_small(slot_ix),
- make_small(chunk_size),
- mpb, match_list,
- make_small(got));
- mpi.mp = NULL; /*otherwise the return macro will destroy it */
- RET_TO_BIF(bif_trap1(&ets_select_continue_exp, p,
- continuation),
- DB_ERROR_NONE);
-#undef RET_TO_BIF
+ ret_value = on_loop_ended(context_ptr, slot_ix, got, iterations_left, mpp, ret);
+
+done:
+ /* We should only jump directly to this label if
+ * we've already called on_loop_ended / on_trap
+ */
+ return ret_value;
+#ifndef SMP
+#undef lock_hash_function
+#undef unlock_hash_function
+#endif
}
-static int db_select_count_hash(Process *p,
- DbTable *tbl,
- Eterm pattern,
- Eterm *ret)
+
+/*
+ * Common traversal trapping/continuation code;
+ * used by select_count, select_delete and select_replace,
+ * as well as their continuation-handling counterparts.
+ */
+
+static ERTS_INLINE int on_mtraversal_simple_trap(Export* trap_function,
+ Process* p,
+ DbTableHash* tb,
+ Eterm tid,
+ Eterm* prev_continuation_tptr,
+ Sint slot_ix,
+ Sint got,
+ Binary** mpp,
+ Eterm* ret)
{
- DbTableHash *tb = &tbl->hash;
- struct mp_info mpi;
- Uint slot_ix = 0;
- HashDbTerm* current = NULL;
- unsigned current_list_pos = 0;
- Eterm *hp;
- int num_left = 1000;
- Uint got = 0;
- Eterm continuation;
- int errcode;
+ Eterm* hp;
Eterm egot;
Eterm mpb;
- erts_smp_rwmtx_t* lck;
-
-#define RET_TO_BIF(Term,RetVal) do { \
- if (mpi.mp != NULL) { \
- erts_bin_free(mpi.mp); \
- } \
- if (mpi.lists != mpi.dlists) { \
- erts_free(ERTS_ALC_T_DB_SEL_LIST, \
- (void *) mpi.lists); \
- } \
- *ret = (Term); \
- return RetVal; \
- } while(0)
-
-
- if ((errcode = analyze_pattern(tb, pattern, &mpi)) != DB_ERROR_NONE) {
- RET_TO_BIF(NIL,errcode);
- }
-
- if (!mpi.something_can_match) {
- RET_TO_BIF(make_small(0), DB_ERROR_NONE);
- /* can't possibly match anything */
- }
-
- if (!mpi.key_given) {
- /* Run this code if pattern is variable or GETKEY(pattern) */
- /* is a variable */
- slot_ix = 0;
- lck = RLOCK_HASH(tb,slot_ix);
- current = BUCKET(tb,slot_ix);
- } else {
- /* We have at least one */
- slot_ix = mpi.lists[current_list_pos].ix;
- lck = RLOCK_HASH(tb, slot_ix);
- current = *(mpi.lists[current_list_pos].bucket);
- ASSERT(current == BUCKET(tb,slot_ix));
- ++current_list_pos;
- }
+ Eterm continuation;
+ int is_first_trap = (prev_continuation_tptr == NULL);
+ size_t base_halloc_sz = (is_first_trap ? ERTS_MAGIC_REF_THING_SIZE : 0);
- for(;;) {
- if (current != NULL) {
- if (current->hvalue != INVALID_HASH) {
- if (db_match_dbterm(&tb->common, p, mpi.mp, 0,
- &current->dbterm, NULL,0) == am_true) {
- ++got;
- }
- --num_left;
- }
- current = current->next;
- }
- else { /* next bucket */
- if (mpi.key_given) { /* Key is bound */
- RUNLOCK_HASH(lck);
- if (current_list_pos == mpi.num_lists) {
- goto done;
- } else {
- slot_ix = mpi.lists[current_list_pos].ix;
- lck = RLOCK_HASH(tb, slot_ix);
- current = *(mpi.lists[current_list_pos].bucket);
- ASSERT(mpi.lists[current_list_pos].bucket == &BUCKET(tb,slot_ix));
- ++current_list_pos;
- }
- }
- else {
- if ((slot_ix=next_slot(tb,slot_ix,&lck)) == 0) {
- goto done;
- }
- if (num_left <= 0) {
- RUNLOCK_HASH(lck);
- goto trap;
- }
- current = BUCKET(tb,slot_ix);
- }
- }
- }
-done:
- BUMP_REDS(p, 1000 - num_left);
- RET_TO_BIF(erts_make_integer(got,p),DB_ERROR_NONE);
-trap:
BUMP_ALL_REDS(p);
if (IS_USMALL(0, got)) {
- hp = HAlloc(p, PROC_BIN_SIZE + 5);
+ hp = HAlloc(p, base_halloc_sz + 5);
egot = make_small(got);
}
else {
- hp = HAlloc(p, BIG_UINT_HEAP_SIZE + PROC_BIN_SIZE + 5);
+ hp = HAlloc(p, base_halloc_sz + BIG_UINT_HEAP_SIZE + 5);
egot = uint_to_big(got, hp);
hp += BIG_UINT_HEAP_SIZE;
}
- mpb = db_make_mp_binary(p,mpi.mp,&hp);
- continuation = TUPLE4(hp, tb->common.id, make_small(slot_ix),
- mpb,
- egot);
- mpi.mp = NULL; /*otherwise the return macro will destroy it */
- RET_TO_BIF(bif_trap1(&ets_select_count_continue_exp, p,
- continuation),
- DB_ERROR_NONE);
-#undef RET_TO_BIF
+ if (is_first_trap) {
+ mpb = erts_db_make_match_prog_ref(p, *mpp, &hp);
+ *mpp = NULL; /* otherwise the caller will destroy it */
+ }
+ else {
+ mpb = prev_continuation_tptr[3];
+ }
+
+ continuation = TUPLE4(
+ hp,
+ tid,
+ make_small(slot_ix),
+ mpb,
+ egot);
+ *ret = bif_trap1(trap_function, p, continuation);
+ return DB_ERROR_NONE;
}
-static int db_select_delete_hash(Process *p,
- DbTable *tbl,
- Eterm pattern,
- Eterm *ret)
+static ERTS_INLINE int unpack_simple_mtraversal_continuation(Eterm continuation,
+ Eterm** tptr_ptr,
+ Eterm* tid_ptr,
+ Sint* slot_ix_p,
+ Binary** mpp,
+ Sint* got_p)
{
- DbTableHash *tb = &tbl->hash;
- struct mp_info mpi;
- Uint slot_ix = 0;
- HashDbTerm **current = NULL;
- unsigned current_list_pos = 0;
- Eterm *hp;
- int num_left = 1000;
- Uint got = 0;
- Eterm continuation;
- int errcode;
- Uint last_pseudo_delete = (Uint)-1;
- Eterm mpb;
- Eterm egot;
-#ifdef ERTS_SMP
- erts_aint_t fixated_by_me = tb->common.is_thread_safe ? 0 : 1; /* ToDo: something nicer */
-#else
- erts_aint_t fixated_by_me = 0;
-#endif
- erts_smp_rwmtx_t* lck;
-
-#define RET_TO_BIF(Term,RetVal) do { \
- if (mpi.mp != NULL) { \
- erts_bin_free(mpi.mp); \
- } \
- if (mpi.lists != mpi.dlists) { \
- erts_free(ERTS_ALC_T_DB_SEL_LIST, \
- (void *) mpi.lists); \
- } \
- *ret = (Term); \
- return RetVal; \
- } while(0)
-
+ Eterm* tptr;
+ ASSERT(is_tuple(continuation));
+ tptr = tuple_val(continuation);
+ if (arityval(*tptr) != 4)
+ return 1;
- if ((errcode = analyze_pattern(tb, pattern, &mpi)) != DB_ERROR_NONE) {
- RET_TO_BIF(NIL,errcode);
+ if (! is_small(tptr[2]) || !(is_big(tptr[4]) || is_small(tptr[4]))) {
+ return 1;
}
- if (!mpi.something_can_match) {
- RET_TO_BIF(make_small(0), DB_ERROR_NONE);
- /* can't possibly match anything */
+ *tptr_ptr = tptr;
+ *tid_ptr = tptr[1];
+ *slot_ix_p = unsigned_val(tptr[2]);
+ *mpp = erts_db_get_match_prog_binary_unchecked(tptr[3]);
+ if (is_big(tptr[4])) {
+ *got_p = big_to_uint32(tptr[4]);
+ }
+ else {
+ *got_p = unsigned_val(tptr[4]);
}
+ return 0;
+}
- if (!mpi.key_given) {
- /* Run this code if pattern is variable or GETKEY(pattern) */
- /* is a variable */
- lck = WLOCK_HASH(tb,slot_ix);
- current = &BUCKET(tb,slot_ix);
- } else {
- /* We have at least one */
- slot_ix = mpi.lists[current_list_pos].ix;
- lck = WLOCK_HASH(tb, slot_ix);
- current = mpi.lists[current_list_pos++].bucket;
- ASSERT(*current == BUCKET(tb,slot_ix));
+
+/*
+ *
+ * select / select_chunk match traversal
+ *
+ */
+
+#define MAX_SELECT_CHUNK_ITERATIONS 1000
+
+typedef struct {
+ Process* p;
+ DbTableHash* tb;
+ Eterm tid;
+ Eterm* hp;
+ Sint chunk_size;
+ Eterm match_list;
+ Eterm* prev_continuation_tptr;
+} mtraversal_select_chunk_context_t;
+
+static int mtraversal_select_chunk_on_nothing_can_match(void* context_ptr, Eterm* ret) {
+ mtraversal_select_chunk_context_t* sc_context_ptr = (mtraversal_select_chunk_context_t*) context_ptr;
+ *ret = (sc_context_ptr->chunk_size > 0 ? am_EOT : NIL);
+ return DB_ERROR_NONE;
+}
+
+static int mtraversal_select_chunk_on_match_res(void* context_ptr, Sint slot_ix,
+ HashDbTerm*** current_ptr_ptr,
+ Eterm match_res)
+{
+ mtraversal_select_chunk_context_t* sc_context_ptr = (mtraversal_select_chunk_context_t*) context_ptr;
+ if (is_value(match_res)) {
+ sc_context_ptr->match_list = CONS(sc_context_ptr->hp, match_res, sc_context_ptr->match_list);
+ return 1;
}
+ return 0;
+}
+static int mtraversal_select_chunk_on_loop_ended(void* context_ptr, Sint slot_ix, Sint got,
+ Sint iterations_left, Binary** mpp, Eterm* ret)
+{
+ mtraversal_select_chunk_context_t* sc_context_ptr = (mtraversal_select_chunk_context_t*) context_ptr;
+ Eterm mpb;
- for(;;) {
- if ((*current) == NULL) {
- if (mpi.key_given) { /* Key is bound */
- WUNLOCK_HASH(lck);
- if (current_list_pos == mpi.num_lists) {
- goto done;
- } else {
- slot_ix = mpi.lists[current_list_pos].ix;
- lck = WLOCK_HASH(tb, slot_ix);
- current = mpi.lists[current_list_pos].bucket;
- ASSERT(mpi.lists[current_list_pos].bucket == &BUCKET(tb,slot_ix));
- ++current_list_pos;
- }
- } else {
- if ((slot_ix=next_slot_w(tb,slot_ix,&lck)) == 0) {
- goto done;
- }
- if (num_left <= 0) {
- WUNLOCK_HASH(lck);
- goto trap;
- }
- current = &BUCKET(tb,slot_ix);
- }
- }
- else if ((*current)->hvalue == INVALID_HASH) {
- current = &((*current)->next);
- }
- else {
- int did_erase = 0;
- if (db_match_dbterm(&tb->common, p, mpi.mp, 0,
- &(*current)->dbterm, NULL, 0) == am_true) {
- if (NFIXED(tb) > fixated_by_me) { /* fixated by others? */
- if (slot_ix != last_pseudo_delete) {
- add_fixed_deletion(tb, slot_ix);
- last_pseudo_delete = slot_ix;
- }
- (*current)->hvalue = INVALID_HASH;
- } else {
- HashDbTerm *del = *current;
- *current = (*current)->next;
- free_term(tb, del);
- did_erase = 1;
- }
- erts_smp_atomic_dec_nob(&tb->common.nitems);
- ++got;
- }
- --num_left;
- if (!did_erase) {
- current = &((*current)->next);
- }
- }
+ if (iterations_left == MAX_SELECT_CHUNK_ITERATIONS) {
+ /* We didn't get to iterate a single time, which means EOT */
+ ASSERT(sc_context_ptr->match_list == NIL);
+ *ret = (sc_context_ptr->chunk_size > 0 ? am_EOT : NIL);
+ return DB_ERROR_NONE;
}
-done:
- BUMP_REDS(p, 1000 - num_left);
- if (got) {
- try_shrink(tb);
+ else {
+ ASSERT(iterations_left < MAX_SELECT_CHUNK_ITERATIONS);
+ BUMP_REDS(sc_context_ptr->p, MAX_SELECT_CHUNK_ITERATIONS - iterations_left);
+ if (sc_context_ptr->chunk_size) {
+ Eterm continuation;
+ Eterm rest = NIL;
+ Sint rest_size = 0;
+
+ if (got > sc_context_ptr->chunk_size) { /* Split list in return value and 'rest' */
+ Eterm tmp = sc_context_ptr->match_list;
+ rest = sc_context_ptr->match_list;
+ while (got-- > sc_context_ptr->chunk_size + 1) {
+ tmp = CDR(list_val(tmp));
+ ++rest_size;
+ }
+ ++rest_size;
+ sc_context_ptr->match_list = CDR(list_val(tmp));
+ CDR(list_val(tmp)) = NIL; /* Destructive, the list has never
+ been in 'user space' */
+ }
+ if (rest != NIL || slot_ix >= 0) { /* Need more calls */
+ sc_context_ptr->hp = HAlloc(sc_context_ptr->p, 3 + 7 + ERTS_MAGIC_REF_THING_SIZE);
+ mpb = erts_db_make_match_prog_ref(sc_context_ptr->p, *mpp, &sc_context_ptr->hp);
+ continuation = TUPLE6(
+ sc_context_ptr->hp,
+ sc_context_ptr->tid,
+ make_small(slot_ix),
+ make_small(sc_context_ptr->chunk_size),
+ mpb, rest,
+ make_small(rest_size));
+ *mpp = NULL; /* Otherwise the caller will destroy it */
+ sc_context_ptr->hp += 7;
+ *ret = TUPLE2(sc_context_ptr->hp, sc_context_ptr->match_list, continuation);
+ return DB_ERROR_NONE;
+ } else { /* All data is exhausted */
+ if (sc_context_ptr->match_list != NIL) { /* No more data to search but still a
+ result to return to the caller */
+ sc_context_ptr->hp = HAlloc(sc_context_ptr->p, 3);
+ *ret = TUPLE2(sc_context_ptr->hp, sc_context_ptr->match_list, am_EOT);
+ return DB_ERROR_NONE;
+ } else { /* Reached the end of the ttable with no data to return */
+ *ret = am_EOT;
+ return DB_ERROR_NONE;
+ }
+ }
+ }
+ *ret = sc_context_ptr->match_list;
+ return DB_ERROR_NONE;
}
- RET_TO_BIF(erts_make_integer(got,p),DB_ERROR_NONE);
-trap:
- BUMP_ALL_REDS(p);
- if (IS_USMALL(0, got)) {
- hp = HAlloc(p, PROC_BIN_SIZE + 5);
- egot = make_small(got);
+}
+
+static int mtraversal_select_chunk_on_trap(void* context_ptr, Sint slot_ix, Sint got,
+ Binary** mpp, Eterm* ret)
+{
+ mtraversal_select_chunk_context_t* sc_context_ptr = (mtraversal_select_chunk_context_t*) context_ptr;
+ Eterm mpb;
+ Eterm continuation;
+ Eterm* hp;
+
+ BUMP_ALL_REDS(sc_context_ptr->p);
+
+ if (sc_context_ptr->prev_continuation_tptr == NULL) {
+ /* First time we're trapping */
+ hp = HAlloc(sc_context_ptr->p, 7 + ERTS_MAGIC_REF_THING_SIZE);
+ mpb = erts_db_make_match_prog_ref(sc_context_ptr->p, *mpp, &hp);
+ continuation = TUPLE6(
+ hp,
+ sc_context_ptr->tid,
+ make_small(slot_ix),
+ make_small(sc_context_ptr->chunk_size),
+ mpb,
+ sc_context_ptr->match_list,
+ make_small(got));
+ *mpp = NULL; /* otherwise the caller will destroy it */
}
else {
- hp = HAlloc(p, BIG_UINT_HEAP_SIZE + PROC_BIN_SIZE + 5);
- egot = uint_to_big(got, hp);
- hp += BIG_UINT_HEAP_SIZE;
- }
- mpb = db_make_mp_binary(p,mpi.mp,&hp);
- continuation = TUPLE4(hp, tb->common.id, make_small(slot_ix),
- mpb,
- egot);
- mpi.mp = NULL; /*otherwise the return macro will destroy it */
- RET_TO_BIF(bif_trap1(&ets_select_delete_continue_exp, p,
- continuation),
- DB_ERROR_NONE);
+ /* Not the first time we're trapping; reuse continuation terms */
+ hp = HAlloc(sc_context_ptr->p, 7);
+ continuation = TUPLE6(
+ hp,
+ sc_context_ptr->prev_continuation_tptr[1],
+ make_small(slot_ix),
+ sc_context_ptr->prev_continuation_tptr[3],
+ sc_context_ptr->prev_continuation_tptr[4],
+ sc_context_ptr->match_list,
+ make_small(got));
+ }
+ *ret = bif_trap1(&ets_select_continue_exp, sc_context_ptr->p, continuation);
+ return DB_ERROR_NONE;
+}
-#undef RET_TO_BIF
+static int db_select_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, int reverse, Eterm *ret) {
+ return db_select_chunk_hash(p, tbl, tid, pattern, 0, reverse, ret);
+}
+static int db_select_chunk_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, Sint chunk_size,
+ int reverse, Eterm *ret)
+{
+ mtraversal_select_chunk_context_t sc_context;
+ sc_context.p = p;
+ sc_context.tb = &tbl->hash;
+ sc_context.tid = tid;
+ sc_context.hp = NULL;
+ sc_context.chunk_size = chunk_size;
+ sc_context.match_list = NIL;
+ sc_context.prev_continuation_tptr = NULL;
+
+ return match_traverse(
+ sc_context.p, sc_context.tb,
+ pattern, NULL,
+ sc_context.chunk_size,
+ MAX_SELECT_CHUNK_ITERATIONS,
+ &sc_context.hp, 0,
+ mtraversal_select_chunk_on_nothing_can_match,
+ mtraversal_select_chunk_on_match_res,
+ mtraversal_select_chunk_on_loop_ended,
+ mtraversal_select_chunk_on_trap,
+ &sc_context, ret);
}
+
/*
-** This is called when select_delete traps
-*/
-static int db_select_delete_continue_hash(Process *p,
- DbTable *tbl,
- Eterm continuation,
- Eterm *ret)
+ *
+ * select_continue match traversal
+ *
+ */
+
+static int mtraversal_select_chunk_continue_on_loop_ended(void* context_ptr, Sint slot_ix, Sint got,
+ Sint iterations_left, Binary** mpp, Eterm* ret)
{
- DbTableHash *tb = &tbl->hash;
- Uint slot_ix;
- Uint last_pseudo_delete = (Uint)-1;
- HashDbTerm **current = NULL;
- Eterm *hp;
- int num_left = 1000;
- Uint got;
- Eterm *tptr;
- Binary *mp;
- Eterm egot;
- int fixated_by_me = ONLY_WRITER(p,tb) ? 0 : 1; /* ToDo: something nicer */
- erts_smp_rwmtx_t* lck;
+ mtraversal_select_chunk_context_t* sc_context_ptr = (mtraversal_select_chunk_context_t*) context_ptr;
+ Eterm continuation;
+ Eterm rest = NIL;
+ Eterm* hp;
+
+ ASSERT(iterations_left <= MAX_SELECT_CHUNK_ITERATIONS);
+ BUMP_REDS(sc_context_ptr->p, MAX_SELECT_CHUNK_ITERATIONS - iterations_left);
+ if (sc_context_ptr->chunk_size) {
+ Sint rest_size = 0;
+ if (got > sc_context_ptr->chunk_size) {
+ /* Cannot write destructively here,
+ the list may have
+ been in user space */
+ hp = HAlloc(sc_context_ptr->p, (got - sc_context_ptr->chunk_size) * 2);
+ while (got-- > sc_context_ptr->chunk_size) {
+ rest = CONS(hp, CAR(list_val(sc_context_ptr->match_list)), rest);
+ hp += 2;
+ sc_context_ptr->match_list = CDR(list_val(sc_context_ptr->match_list));
+ ++rest_size;
+ }
+ }
+ if (rest != NIL || slot_ix >= 0) {
+ hp = HAlloc(sc_context_ptr->p, 3 + 7);
+ continuation = TUPLE6(
+ hp,
+ sc_context_ptr->prev_continuation_tptr[1],
+ make_small(slot_ix),
+ sc_context_ptr->prev_continuation_tptr[3],
+ sc_context_ptr->prev_continuation_tptr[4],
+ rest,
+ make_small(rest_size));
+ hp += 7;
+ *ret = TUPLE2(hp, sc_context_ptr->match_list, continuation);
+ return DB_ERROR_NONE;
+ } else {
+ if (sc_context_ptr->match_list != NIL) {
+ hp = HAlloc(sc_context_ptr->p, 3);
+ *ret = TUPLE2(hp, sc_context_ptr->match_list, am_EOT);
+ return DB_ERROR_NONE;
+ } else {
+ *ret = am_EOT;
+ return DB_ERROR_NONE;
+ }
+ }
+ }
+ *ret = sc_context_ptr->match_list;
+ return DB_ERROR_NONE;
+}
-#define RET_TO_BIF(Term,RetVal) do { \
- *ret = (Term); \
- return RetVal; \
- } while(0)
+/*
+ * This is called when select traps
+ */
+static int db_select_continue_hash(Process* p, DbTable* tbl, Eterm continuation, Eterm* ret) {
+ mtraversal_select_chunk_context_t sc_context = {0};
+ Eterm* tptr;
+ Eterm tid;
+ Binary* mp;
+ Sint got;
+ Sint slot_ix;
+ Sint chunk_size;
+ Eterm match_list;
+ Sint iterations_left = MAX_SELECT_CHUNK_ITERATIONS;
-
+ /* Decode continuation. We know it's a tuple but not the arity or anything else */
+ ASSERT(is_tuple(continuation));
tptr = tuple_val(continuation);
- slot_ix = unsigned_val(tptr[2]);
- mp = ((ProcBin *) binary_val(tptr[3]))->val;
- if (is_big(tptr[4])) {
- got = big_to_uint32(tptr[4]);
- } else {
- got = unsigned_val(tptr[4]);
- }
-
- lck = WLOCK_HASH(tb,slot_ix);
- if (slot_ix >= NACTIVE(tb)) {
- WUNLOCK_HASH(lck);
- goto done;
- }
- current = &BUCKET(tb,slot_ix);
- for(;;) {
- if ((*current) == NULL) {
- if ((slot_ix=next_slot_w(tb,slot_ix,&lck)) == 0) {
- goto done;
- }
- if (num_left <= 0) {
- WUNLOCK_HASH(lck);
- goto trap;
- }
- current = &BUCKET(tb,slot_ix);
- }
- else if ((*current)->hvalue == INVALID_HASH) {
- current = &((*current)->next);
- }
- else {
- int did_erase = 0;
- if (db_match_dbterm(&tb->common, p, mp, 0,
- &(*current)->dbterm, NULL, 0) == am_true) {
- if (NFIXED(tb) > fixated_by_me) { /* fixated by others? */
- if (slot_ix != last_pseudo_delete) {
- add_fixed_deletion(tb, slot_ix);
- last_pseudo_delete = slot_ix;
- }
- (*current)->hvalue = INVALID_HASH;
- } else {
- HashDbTerm *del = *current;
- *current = (*current)->next;
- free_term(tb, del);
- did_erase = 1;
- }
- erts_smp_atomic_dec_nob(&tb->common.nitems);
- ++got;
- }
-
- --num_left;
- if (!did_erase) {
- current = &((*current)->next);
- }
- }
+ if (arityval(*tptr) != 6)
+ goto badparam;
+
+ if (!is_small(tptr[2]) || !is_small(tptr[3]) ||
+ !(is_list(tptr[5]) || tptr[5] == NIL) || !is_small(tptr[6]))
+ goto badparam;
+ if ((chunk_size = signed_val(tptr[3])) < 0)
+ goto badparam;
+
+ mp = erts_db_get_match_prog_binary(tptr[4]);
+ if (mp == NULL)
+ goto badparam;
+
+ if ((got = signed_val(tptr[6])) < 0)
+ goto badparam;
+
+ tid = tptr[1];
+ slot_ix = signed_val(tptr[2]);
+ match_list = tptr[5];
+
+ /* Proceed */
+ sc_context.p = p;
+ sc_context.tb = &tbl->hash;
+ sc_context.tid = tid;
+ sc_context.hp = NULL;
+ sc_context.chunk_size = chunk_size;
+ sc_context.match_list = match_list;
+ sc_context.prev_continuation_tptr = tptr;
+
+ return match_traverse_continue(
+ sc_context.p, sc_context.tb, sc_context.chunk_size,
+ iterations_left, &sc_context.hp, slot_ix, got, &mp, 0,
+ mtraversal_select_chunk_on_match_res, /* Reuse callback */
+ mtraversal_select_chunk_continue_on_loop_ended,
+ mtraversal_select_chunk_on_trap, /* Reuse callback */
+ &sc_context, ret);
+
+badparam:
+ *ret = NIL;
+ return DB_ERROR_BADPARAM;
+}
+
+#undef MAX_SELECT_CHUNK_ITERATIONS
+
+
+/*
+ *
+ * select_count match traversal
+ *
+ */
+
+#define MAX_SELECT_COUNT_ITERATIONS 1000
+
+typedef struct {
+ Process* p;
+ DbTableHash* tb;
+ Eterm tid;
+ Eterm* hp;
+ Eterm* prev_continuation_tptr;
+} mtraversal_select_count_context_t;
+
+static int mtraversal_select_count_on_nothing_can_match(void* context_ptr, Eterm* ret) {
+ *ret = make_small(0);
+ return DB_ERROR_NONE;
+}
+
+static int mtraversal_select_count_on_match_res(void* context_ptr, Sint slot_ix,
+ HashDbTerm*** current_ptr_ptr,
+ Eterm match_res)
+{
+ return (match_res == am_true);
+}
+
+static int mtraversal_select_count_on_loop_ended(void* context_ptr, Sint slot_ix, Sint got,
+ Sint iterations_left, Binary** mpp, Eterm* ret)
+{
+ mtraversal_select_count_context_t* scnt_context_ptr = (mtraversal_select_count_context_t*) context_ptr;
+ ASSERT(iterations_left <= MAX_SELECT_COUNT_ITERATIONS);
+ BUMP_REDS(scnt_context_ptr->p, MAX_SELECT_COUNT_ITERATIONS - iterations_left);
+ *ret = erts_make_integer(got, scnt_context_ptr->p);
+ return DB_ERROR_NONE;
+}
+
+static int mtraversal_select_count_on_trap(void* context_ptr, Sint slot_ix, Sint got,
+ Binary** mpp, Eterm* ret)
+{
+ mtraversal_select_count_context_t* scnt_context_ptr = (mtraversal_select_count_context_t*) context_ptr;
+ return on_mtraversal_simple_trap(
+ &ets_select_count_continue_exp,
+ scnt_context_ptr->p,
+ scnt_context_ptr->tb,
+ scnt_context_ptr->tid,
+ scnt_context_ptr->prev_continuation_tptr,
+ slot_ix, got, mpp, ret);
+}
+
+static int db_select_count_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, Eterm *ret) {
+ mtraversal_select_count_context_t scnt_context = {0};
+ Sint iterations_left = MAX_SELECT_COUNT_ITERATIONS;
+ Sint chunk_size = 0;
+
+ scnt_context.p = p;
+ scnt_context.tb = &tbl->hash;
+ scnt_context.tid = tid;
+ scnt_context.hp = NULL;
+ scnt_context.prev_continuation_tptr = NULL;
+
+ return match_traverse(
+ scnt_context.p, scnt_context.tb,
+ pattern, NULL,
+ chunk_size, iterations_left, NULL, 0,
+ mtraversal_select_count_on_nothing_can_match,
+ mtraversal_select_count_on_match_res,
+ mtraversal_select_count_on_loop_ended,
+ mtraversal_select_count_on_trap,
+ &scnt_context, ret);
+}
+
+/*
+ * This is called when select_count traps
+ */
+static int db_select_count_continue_hash(Process* p, DbTable* tbl, Eterm continuation, Eterm* ret) {
+ mtraversal_select_count_context_t scnt_context = {0};
+ Eterm* tptr;
+ Eterm tid;
+ Binary* mp;
+ Sint got;
+ Sint slot_ix;
+ Sint chunk_size = 0;
+ *ret = NIL;
+
+ if (unpack_simple_mtraversal_continuation(continuation, &tptr, &tid, &slot_ix, &mp, &got)) {
+ *ret = NIL;
+ return DB_ERROR_BADPARAM;
+ }
+
+ scnt_context.p = p;
+ scnt_context.tb = &tbl->hash;
+ scnt_context.tid = tid;
+ scnt_context.hp = NULL;
+ scnt_context.prev_continuation_tptr = tptr;
+
+ return match_traverse_continue(
+ scnt_context.p, scnt_context.tb, chunk_size,
+ MAX_SELECT_COUNT_ITERATIONS,
+ NULL, slot_ix, got, &mp, 0,
+ mtraversal_select_count_on_match_res, /* Reuse callback */
+ mtraversal_select_count_on_loop_ended, /* Reuse callback */
+ mtraversal_select_count_on_trap, /* Reuse callback */
+ &scnt_context, ret);
+}
+
+#undef MAX_SELECT_COUNT_ITERATIONS
+
+
+/*
+ *
+ * select_delete match traversal
+ *
+ */
+
+#define MAX_SELECT_DELETE_ITERATIONS 1000
+
+typedef struct {
+ Process* p;
+ DbTableHash* tb;
+ Eterm tid;
+ Eterm* hp;
+ Eterm* prev_continuation_tptr;
+ erts_aint_t fixated_by_me;
+ Uint last_pseudo_delete;
+} mtraversal_select_delete_context_t;
+
+static int mtraversal_select_delete_on_nothing_can_match(void* context_ptr, Eterm* ret) {
+ *ret = make_small(0);
+ return DB_ERROR_NONE;
+}
+
+static int mtraversal_select_delete_on_match_res(void* context_ptr, Sint slot_ix,
+ HashDbTerm*** current_ptr_ptr,
+ Eterm match_res)
+{
+ HashDbTerm** current_ptr = *current_ptr_ptr;
+ mtraversal_select_delete_context_t* sd_context_ptr = (mtraversal_select_delete_context_t*) context_ptr;
+ HashDbTerm* del;
+ if (match_res != am_true)
+ return 0;
+
+ if (NFIXED(sd_context_ptr->tb) > sd_context_ptr->fixated_by_me) { /* fixated by others? */
+ if (slot_ix != sd_context_ptr->last_pseudo_delete) {
+ if (!add_fixed_deletion(sd_context_ptr->tb, slot_ix, sd_context_ptr->fixated_by_me))
+ goto do_erase;
+ sd_context_ptr->last_pseudo_delete = slot_ix;
+ }
+ (*current_ptr)->hvalue = INVALID_HASH;
}
-done:
- BUMP_REDS(p, 1000 - num_left);
- if (got) {
- try_shrink(tb);
+ else {
+ do_erase:
+ del = *current_ptr;
+ *current_ptr = (*current_ptr)->next; // replace pointer to term using next
+ free_term(sd_context_ptr->tb, del);
}
- RET_TO_BIF(erts_make_integer(got,p),DB_ERROR_NONE);
-trap:
- BUMP_ALL_REDS(p);
- if (IS_USMALL(0, got)) {
- hp = HAlloc(p, 5);
- egot = make_small(got);
+ erts_smp_atomic_dec_nob(&sd_context_ptr->tb->common.nitems);
+
+ return 1;
+}
+
+static int mtraversal_select_delete_on_loop_ended(void* context_ptr, Sint slot_ix, Sint got,
+ Sint iterations_left, Binary** mpp, Eterm* ret)
+{
+ mtraversal_select_delete_context_t* sd_context_ptr = (mtraversal_select_delete_context_t*) context_ptr;
+ ASSERT(iterations_left <= MAX_SELECT_DELETE_ITERATIONS);
+ BUMP_REDS(sd_context_ptr->p, MAX_SELECT_DELETE_ITERATIONS - iterations_left);
+ if (got) {
+ try_shrink(sd_context_ptr->tb);
}
- else {
- hp = HAlloc(p, BIG_UINT_HEAP_SIZE + 5);
- egot = uint_to_big(got, hp);
- hp += BIG_UINT_HEAP_SIZE;
+ *ret = erts_make_integer(got, sd_context_ptr->p);
+ return DB_ERROR_NONE;
+}
+
+static int mtraversal_select_delete_on_trap(void* context_ptr, Sint slot_ix, Sint got,
+ Binary** mpp, Eterm* ret)
+{
+ mtraversal_select_delete_context_t* sd_context_ptr = (mtraversal_select_delete_context_t*) context_ptr;
+ return on_mtraversal_simple_trap(
+ &ets_select_delete_continue_exp,
+ sd_context_ptr->p,
+ sd_context_ptr->tb,
+ sd_context_ptr->tid,
+ sd_context_ptr->prev_continuation_tptr,
+ slot_ix, got, mpp, ret);
+}
+
+static int db_select_delete_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, Eterm *ret) {
+ mtraversal_select_delete_context_t sd_context = {0};
+ Sint chunk_size = 0;
+
+ sd_context.p = p;
+ sd_context.tb = &tbl->hash;
+ sd_context.tid = tid;
+ sd_context.hp = NULL;
+ sd_context.prev_continuation_tptr = NULL;
+#ifdef ERTS_SMP
+ sd_context.fixated_by_me = sd_context.tb->common.is_thread_safe ? 0 : 1; /* TODO: something nicer */
+#else
+ sd_context.fixated_by_me = 0;
+#endif
+ sd_context.last_pseudo_delete = (Uint) -1;
+
+ return match_traverse(
+ sd_context.p, sd_context.tb,
+ pattern, NULL,
+ chunk_size,
+ MAX_SELECT_DELETE_ITERATIONS, NULL, 1,
+ mtraversal_select_delete_on_nothing_can_match,
+ mtraversal_select_delete_on_match_res,
+ mtraversal_select_delete_on_loop_ended,
+ mtraversal_select_delete_on_trap,
+ &sd_context, ret);
+}
+
+/*
+ * This is called when select_delete traps
+ */
+static int db_select_delete_continue_hash(Process* p, DbTable* tbl, Eterm continuation, Eterm* ret) {
+ mtraversal_select_delete_context_t sd_context = {0};
+ Eterm* tptr;
+ Eterm tid;
+ Binary* mp;
+ Sint got;
+ Sint slot_ix;
+ Sint chunk_size = 0;
+
+ if (unpack_simple_mtraversal_continuation(continuation, &tptr, &tid, &slot_ix, &mp, &got)) {
+ *ret = NIL;
+ return DB_ERROR_BADPARAM;
+ }
+
+ sd_context.p = p;
+ sd_context.tb = &tbl->hash;
+ sd_context.tid = tid;
+ sd_context.hp = NULL;
+ sd_context.prev_continuation_tptr = tptr;
+ sd_context.fixated_by_me = ONLY_WRITER(p, sd_context.tb) ? 0 : 1; /* TODO: something nicer */
+ sd_context.last_pseudo_delete = (Uint) -1;
+
+ return match_traverse_continue(
+ sd_context.p, sd_context.tb, chunk_size,
+ MAX_SELECT_DELETE_ITERATIONS,
+ NULL, slot_ix, got, &mp, 1,
+ mtraversal_select_delete_on_match_res, /* Reuse callback */
+ mtraversal_select_delete_on_loop_ended, /* Reuse callback */
+ mtraversal_select_delete_on_trap, /* Reuse callback */
+ &sd_context, ret);
+}
+
+#undef MAX_SELECT_DELETE_ITERATIONS
+
+
+/*
+ *
+ * select_replace match traversal
+ *
+ */
+
+#define MAX_SELECT_REPLACE_ITERATIONS 1000
+
+typedef struct {
+ Process* p;
+ DbTableHash* tb;
+ Eterm tid;
+ Eterm* hp;
+ Eterm* prev_continuation_tptr;
+} mtraversal_select_replace_context_t;
+
+static int mtraversal_select_replace_on_nothing_can_match(void* context_ptr, Eterm* ret) {
+ *ret = make_small(0);
+ return DB_ERROR_NONE;
+}
+
+static int mtraversal_select_replace_on_match_res(void* context_ptr, Sint slot_ix,
+ HashDbTerm*** current_ptr_ptr,
+ Eterm match_res)
+{
+ mtraversal_select_replace_context_t* sr_context_ptr = (mtraversal_select_replace_context_t*) context_ptr;
+ DbTableHash* tb = sr_context_ptr->tb;
+ HashDbTerm* new;
+ HashDbTerm* next;
+ HashValue hval;
+
+ if (is_value(match_res)) {
+#ifdef DEBUG
+ Eterm key = db_getkey(tb->common.keypos, match_res);
+ ASSERT(is_value(key));
+ ASSERT(eq(key, GETKEY(tb, (**current_ptr_ptr)->dbterm.tpl)));
+#endif
+ next = (**current_ptr_ptr)->next;
+ hval = (**current_ptr_ptr)->hvalue;
+ new = new_dbterm(tb, match_res);
+ new->next = next;
+ new->hvalue = hval;
+ free_term(tb, **current_ptr_ptr);
+ **current_ptr_ptr = new; /* replace 'next' pointer in previous object */
+ *current_ptr_ptr = &((**current_ptr_ptr)->next); /* advance to next object */
+ return 1;
}
- continuation = TUPLE4(hp, tb->common.id, make_small(slot_ix),
- tptr[3],
- egot);
- RET_TO_BIF(bif_trap1(&ets_select_delete_continue_exp, p,
- continuation),
- DB_ERROR_NONE);
+ return 0;
+}
-#undef RET_TO_BIF
+static int mtraversal_select_replace_on_loop_ended(void* context_ptr, Sint slot_ix, Sint got,
+ Sint iterations_left, Binary** mpp, Eterm* ret)
+{
+ mtraversal_select_replace_context_t* sr_context_ptr = (mtraversal_select_replace_context_t*) context_ptr;
+ ASSERT(iterations_left <= MAX_SELECT_REPLACE_ITERATIONS);
+ /* the more objects we've replaced, the more reductions we've consumed */
+ BUMP_REDS(sr_context_ptr->p,
+ MIN(MAX_SELECT_REPLACE_ITERATIONS * 2,
+ (MAX_SELECT_REPLACE_ITERATIONS - iterations_left) + (int)got));
+ *ret = erts_make_integer(got, sr_context_ptr->p);
+ return DB_ERROR_NONE;
+}
+static int mtraversal_select_replace_on_trap(void* context_ptr, Sint slot_ix, Sint got,
+ Binary** mpp, Eterm* ret)
+{
+ mtraversal_select_replace_context_t* sr_context_ptr = (mtraversal_select_replace_context_t*) context_ptr;
+ return on_mtraversal_simple_trap(
+ &ets_select_replace_continue_exp,
+ sr_context_ptr->p,
+ sr_context_ptr->tb,
+ sr_context_ptr->tid,
+ sr_context_ptr->prev_continuation_tptr,
+ slot_ix, got, mpp, ret);
}
-
+
+static int db_select_replace_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, Eterm *ret)
+{
+ mtraversal_select_replace_context_t sr_context = {0};
+ Sint chunk_size = 0;
+
+ /* Bag implementation presented both semantic consistency and performance issues,
+ * unsupported for now
+ */
+ ASSERT(!(tbl->hash.common.status & DB_BAG));
+
+ sr_context.p = p;
+ sr_context.tb = &tbl->hash;
+ sr_context.tid = tid;
+ sr_context.hp = NULL;
+ sr_context.prev_continuation_tptr = NULL;
+
+ return match_traverse(
+ sr_context.p, sr_context.tb,
+ pattern, db_match_keeps_key,
+ chunk_size,
+ MAX_SELECT_REPLACE_ITERATIONS, NULL, 1,
+ mtraversal_select_replace_on_nothing_can_match,
+ mtraversal_select_replace_on_match_res,
+ mtraversal_select_replace_on_loop_ended,
+ mtraversal_select_replace_on_trap,
+ &sr_context, ret);
+}
+
/*
-** This is called when select_count traps
-*/
-static int db_select_count_continue_hash(Process *p,
- DbTable *tbl,
- Eterm continuation,
- Eterm *ret)
+ * This is called when select_replace traps
+ */
+static int db_select_replace_continue_hash(Process* p, DbTable* tbl, Eterm continuation, Eterm* ret)
{
- DbTableHash *tb = &tbl->hash;
- Uint slot_ix;
- HashDbTerm* current;
- Eterm *hp;
- int num_left = 1000;
- Uint got;
- Eterm *tptr;
- Binary *mp;
- Eterm egot;
- erts_smp_rwmtx_t* lck;
+ mtraversal_select_replace_context_t sr_context = {0};
+ Eterm* tptr;
+ Eterm tid ;
+ Binary* mp;
+ Sint got;
+ Sint slot_ix;
+ Sint chunk_size = 0;
+ *ret = NIL;
-#define RET_TO_BIF(Term,RetVal) do { \
- *ret = (Term); \
- return RetVal; \
- } while(0)
+ if (unpack_simple_mtraversal_continuation(continuation, &tptr, &tid, &slot_ix, &mp, &got)) {
+ *ret = NIL;
+ return DB_ERROR_BADPARAM;
+ }
+
+ /* Proceed */
+ sr_context.p = p;
+ sr_context.tb = &tbl->hash;
+ sr_context.tid = tid;
+ sr_context.hp = NULL;
+ sr_context.prev_continuation_tptr = tptr;
+
+ return match_traverse_continue(
+ sr_context.p, sr_context.tb, chunk_size,
+ MAX_SELECT_REPLACE_ITERATIONS,
+ NULL, slot_ix, got, &mp, 1,
+ mtraversal_select_replace_on_match_res, /* Reuse callback */
+ mtraversal_select_replace_on_loop_ended, /* Reuse callback */
+ mtraversal_select_replace_on_trap, /* Reuse callback */
+ &sr_context, ret);
+}
-
- tptr = tuple_val(continuation);
- slot_ix = unsigned_val(tptr[2]);
- mp = ((ProcBin *) binary_val(tptr[3]))->val;
- if (is_big(tptr[4])) {
- got = big_to_uint32(tptr[4]);
- } else {
- got = unsigned_val(tptr[4]);
- }
-
- lck = RLOCK_HASH(tb, slot_ix);
- if (slot_ix >= NACTIVE(tb)) { /* Is this posible? */
- RUNLOCK_HASH(lck);
- goto done;
- }
- current = BUCKET(tb,slot_ix);
-
- for(;;) {
- if (current != NULL) {
- if (current->hvalue == INVALID_HASH) {
- current = current->next;
- continue;
- }
- if (db_match_dbterm(&tb->common, p, mp, 0, &current->dbterm,
- NULL, 0) == am_true) {
- ++got;
- }
- --num_left;
- current = current->next;
- }
- else { /* next bucket */
- if ((slot_ix = next_slot(tb,slot_ix,&lck)) == 0) {
- goto done;
- }
- if (num_left <= 0) {
- RUNLOCK_HASH(lck);
- goto trap;
- }
- current = BUCKET(tb,slot_ix);
- }
- }
-done:
- BUMP_REDS(p, 1000 - num_left);
- RET_TO_BIF(erts_make_integer(got,p),DB_ERROR_NONE);
-trap:
- BUMP_ALL_REDS(p);
- if (IS_USMALL(0, got)) {
- hp = HAlloc(p, 5);
- egot = make_small(got);
+static int db_take_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
+{
+ DbTableHash *tb = &tbl->hash;
+ HashDbTerm **bp, *b;
+ HashValue hval = MAKE_HASH(key);
+ erts_smp_rwmtx_t *lck = WLOCK_HASH(tb, hval);
+ int ix = hash_to_ix(tb, hval);
+ int nitems_diff = 0;
+
+ *ret = NIL;
+ for (bp = &BUCKET(tb, ix), b = *bp; b; bp = &b->next, b = b->next) {
+ if (has_live_key(tb, b, key, hval)) {
+ HashDbTerm *bend;
+
+ *ret = get_term_list(p, tb, key, hval, b, &bend);
+ while (b != bend) {
+ --nitems_diff;
+ if (nitems_diff == -1 && IS_FIXED(tb)
+ && add_fixed_deletion(tb, ix, 0)) {
+ /* Pseudo remove (no need to keep several of same key) */
+ bp = &b->next;
+ b->hvalue = INVALID_HASH;
+ b = b->next;
+ } else {
+ *bp = b->next;
+ free_term(tb, b);
+ b = *bp;
+ }
+ }
+ break;
+ }
}
- else {
- hp = HAlloc(p, BIG_UINT_HEAP_SIZE + 5);
- egot = uint_to_big(got, hp);
- hp += BIG_UINT_HEAP_SIZE;
+ WUNLOCK_HASH(lck);
+ if (nitems_diff) {
+ erts_smp_atomic_add_nob(&tb->common.nitems, nitems_diff);
+ try_shrink(tb);
}
- continuation = TUPLE4(hp, tb->common.id, make_small(slot_ix),
- tptr[3],
- egot);
- RET_TO_BIF(bif_trap1(&ets_select_count_continue_exp, p,
- continuation),
- DB_ERROR_NONE);
+ return DB_ERROR_NONE;
+}
-#undef RET_TO_BIF
-}
-
/*
** Other interface routines (not directly coupled to one bif)
*/
@@ -2088,7 +2306,7 @@ int db_mark_all_deleted_hash(DbTable *tbl)
for (i = 0; i < NACTIVE(tb); i++) {
if ((list = BUCKET(tb,i)) != NULL) {
- add_fixed_deletion(tb, i);
+ add_fixed_deletion(tb, i, 0);
do {
list->hvalue = INVALID_HASH;
list = list->next;
@@ -2101,13 +2319,41 @@ int db_mark_all_deleted_hash(DbTable *tbl)
/* Display hash table contents (for dump) */
-static void db_print_hash(int to, void *to_arg, int show, DbTable *tbl)
+static void db_print_hash(fmtfn_t to, void *to_arg, int show, DbTable *tbl)
{
DbTableHash *tb = &tbl->hash;
+ DbHashStats stats;
int i;
erts_print(to, to_arg, "Buckets: %d\n", NACTIVE(tb));
-
+
+#ifdef ERTS_SMP
+ i = tbl->common.is_thread_safe;
+ /* If crash dumping we set table to thread safe in order to
+ avoid taking any locks */
+ if (ERTS_IS_CRASH_DUMPING)
+ tbl->common.is_thread_safe = 1;
+
+ db_calc_stats_hash(&tbl->hash, &stats);
+
+ tbl->common.is_thread_safe = i;
+#else
+ db_calc_stats_hash(&tbl->hash, &stats);
+#endif
+
+ erts_print(to, to_arg, "Chain Length Avg: %f\n", stats.avg_chain_len);
+ erts_print(to, to_arg, "Chain Length Max: %d\n", stats.max_chain_len);
+ erts_print(to, to_arg, "Chain Length Min: %d\n", stats.min_chain_len);
+ erts_print(to, to_arg, "Chain Length Std Dev: %f\n",
+ stats.std_dev_chain_len);
+ erts_print(to, to_arg, "Chain Length Expected Std Dev: %f\n",
+ stats.std_dev_expected);
+
+ if (IS_FIXED(tb))
+ erts_print(to, to_arg, "Fixed: %d\n", stats.kept_items);
+ else
+ erts_print(to, to_arg, "Fixed: false\n");
+
if (show) {
for (i = 0; i < NACTIVE(tb); i++) {
HashDbTerm* list = BUCKET(tb,i);
@@ -2119,11 +2365,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, ",");
@@ -2137,19 +2383,17 @@ static void db_print_hash(int to, void *to_arg, int show, DbTable *tbl)
/* release all memory occupied by a single table */
static int db_free_table_hash(DbTable *tbl)
{
- while (!db_free_table_continue_hash(tbl))
+ while (db_free_table_continue_hash(tbl, ERTS_SWORD_MAX) < 0)
;
return 0;
}
-static int db_free_table_continue_hash(DbTable *tbl)
+static SWord db_free_table_continue_hash(DbTable *tbl, SWord reds)
{
DbTableHash *tb = &tbl->hash;
- int done;
FixedDeletion* fixdel = (FixedDeletion*) erts_smp_atomic_read_acqb(&tb->fixdel);
- ERTS_SMP_LC_ASSERT(IS_TAB_WLOCKED(tb));
+ ERTS_SMP_LC_ASSERT(IS_TAB_WLOCKED(tb) || (tb->common.status & DB_DELETE));
- done = 0;
while (fixdel != NULL) {
FixedDeletion *fx = fixdel;
@@ -2159,22 +2403,21 @@ static int db_free_table_continue_hash(DbTable *tbl)
(void *) fx,
sizeof(FixedDeletion));
ERTS_ETS_MISC_MEM_ADD(-sizeof(FixedDeletion));
- if (++done >= 2*DELETE_RECORD_LIMIT) {
+ if (--reds < 0) {
erts_smp_atomic_set_relb(&tb->fixdel, (erts_aint_t)fixdel);
- return 0; /* Not done */
+ return reds; /* Not done */
}
}
erts_smp_atomic_set_relb(&tb->fixdel, (erts_aint_t)NULL);
- done /= 2;
while(tb->nslots != 0) {
- free_seg(tb, 1);
+ reds -= EXT_SEGSZ/64 + free_seg(tb, 1);
/*
* If we have done enough work, get out here.
*/
- if (++done >= (DELETE_RECORD_LIMIT / CHAIN_LEN / SEGSZ)) {
- return 0; /* Not done */
+ if (reds < 0) {
+ return reds; /* Not done */
}
}
#ifdef ERTS_SMP
@@ -2189,7 +2432,7 @@ static int db_free_table_continue_hash(DbTable *tbl)
}
#endif
ASSERT(erts_smp_atomic_read_nob(&tb->common.memory_size) == sizeof(DbTable));
- return 1; /* Done */
+ return reds; /* Done */
}
@@ -2202,7 +2445,8 @@ static int db_free_table_continue_hash(DbTable *tbl)
** slots should be searched. Also compiles the match program
*/
static int analyze_pattern(DbTableHash *tb, Eterm pattern,
- struct mp_info *mpi)
+ extra_match_validator_t extra_validator, /* Optional callback */
+ struct mp_info *mpi)
{
Eterm *ptpl;
Eterm lst, tpl, ttpl;
@@ -2240,7 +2484,10 @@ static int analyze_pattern(DbTableHash *tb, Eterm pattern,
i = 0;
for(lst = pattern; is_list(lst); lst = CDR(list_val(lst))) {
- Eterm body;
+ Eterm match;
+ Eterm guard;
+ Eterm body;
+
ttpl = CAR(list_val(lst));
if (!is_tuple(ttpl)) {
if (buff != sbuff) {
@@ -2255,9 +2502,17 @@ static int analyze_pattern(DbTableHash *tb, Eterm pattern,
}
return DB_ERROR_BADPARAM;
}
- matches[i] = tpl = ptpl[1];
- guards[i] = ptpl[2];
+ matches[i] = match = tpl = ptpl[1];
+ guards[i] = guard = ptpl[2];
bodies[i] = body = ptpl[3];
+
+ if(extra_validator != NULL && !extra_validator(tb->common.keypos, match, guard, body)) {
+ if (buff != sbuff) {
+ erts_free(ERTS_ALC_T_DB_TMP, buff);
+ }
+ return DB_ERROR_BADPARAM;
+ }
+
if (!is_list(body) || CDR(list_val(body)) != NIL ||
CAR(list_val(body)) != am_DollarUnderscore) {
mpi->all_objects = 0;
@@ -2332,90 +2587,81 @@ static int analyze_pattern(DbTableHash *tb, Eterm pattern,
return DB_ERROR_NONE;
}
-static struct ext_segment* alloc_ext_seg(DbTableHash* tb, unsigned seg_ix,
- struct segment** old_segtab)
+static struct ext_segtab* alloc_ext_segtab(DbTableHash* tb, unsigned seg_ix)
{
- int nsegs;
- struct ext_segment* eseg;
+ struct segment** old_segtab = SEGTAB(tb);
+ int nsegs = 0;
+ struct ext_segtab* est;
+ ASSERT(seg_ix >= NSEG_1);
switch (seg_ix) {
- case 0: nsegs = NSEG_1; break;
- case 1: nsegs = NSEG_2; break;
- default: nsegs = seg_ix + NSEG_INC; break;
- }
- eseg = (struct ext_segment*) erts_db_alloc_fnf(ERTS_ALC_T_DB_SEG,
- (DbTable *) tb,
- SIZEOF_EXTSEG(nsegs));
- ASSERT(eseg != NULL);
- sys_memset(&eseg->s, 0, sizeof(struct segment));
- IF_DEBUG(eseg->s.is_ext_segment = 1);
- eseg->prev_segtab = old_segtab;
- eseg->nsegs = nsegs;
- if (old_segtab) {
- ASSERT(nsegs > tb->nsegs);
- sys_memcpy(eseg->segtab, old_segtab, tb->nsegs*sizeof(struct segment*));
- }
+ case NSEG_1: nsegs = NSEG_2; break;
+ default: nsegs = seg_ix + NSEG_INC; break;
+ }
+ ASSERT(nsegs > tb->nsegs);
+ est = (struct ext_segtab*) erts_db_alloc(ERTS_ALC_T_DB_SEG,
+ (DbTable *) tb,
+ SIZEOF_EXT_SEGTAB(nsegs));
+ est->nsegs = nsegs;
+ est->prev_segtab = old_segtab;
+ est->prev_nsegs = tb->nsegs;
+ sys_memcpy(est->segtab, old_segtab, tb->nsegs*sizeof(struct segment*));
#ifdef DEBUG
- sys_memset(&eseg->segtab[seg_ix], 0, (nsegs-seg_ix)*sizeof(struct segment*));
+ sys_memset(&est->segtab[seg_ix], 0, (nsegs-seg_ix)*sizeof(struct segment*));
#endif
- eseg->segtab[seg_ix] = &eseg->s;
- return eseg;
+ return est;
}
/* Extend table with one new segment
*/
-static int alloc_seg(DbTableHash *tb)
+static void alloc_seg(DbTableHash *tb)
{
- int seg_ix = tb->nslots >> SEGSZ_EXP;
-
- if (seg_ix+1 == tb->nsegs) { /* New segtab needed (extended segment) */
- struct segment** segtab = SEGTAB(tb);
- struct ext_segment* seg = alloc_ext_seg(tb, seg_ix, segtab);
- if (seg == NULL) return 0;
- segtab[seg_ix] = &seg->s;
- /* We don't use the new segtab until next call (see "shrink race") */
- }
- else { /* Just a new plain segment */
- struct segment** segtab;
- if (seg_ix == tb->nsegs) { /* Time to start use segtab from last call */
- struct ext_segment* eseg;
- eseg = (struct ext_segment*) SEGTAB(tb)[seg_ix-1];
- MY_ASSERT(eseg!=NULL && eseg->s.is_ext_segment);
- SET_SEGTAB(tb, eseg->segtab);
- tb->nsegs = eseg->nsegs;
- }
- ASSERT(seg_ix < tb->nsegs);
- segtab = SEGTAB(tb);
- ASSERT(segtab[seg_ix] == NULL);
- segtab[seg_ix] = (struct segment*) erts_db_alloc_fnf(ERTS_ALC_T_DB_SEG,
- (DbTable *) tb,
- sizeof(struct segment));
- if (segtab[seg_ix] == NULL) return 0;
- sys_memset(segtab[seg_ix], 0, sizeof(struct segment));
- }
- tb->nslots += SEGSZ;
- return 1;
+ int seg_ix = SLOT_IX_TO_SEG_IX(tb->nslots);
+ struct segment** segtab;
+
+ ASSERT(seg_ix > 0);
+ if (seg_ix == tb->nsegs) { /* New segtab needed */
+ struct ext_segtab* est = alloc_ext_segtab(tb, seg_ix);
+ SET_SEGTAB(tb, est->segtab);
+ tb->nsegs = est->nsegs;
+ }
+ ASSERT(seg_ix < tb->nsegs);
+ segtab = SEGTAB(tb);
+ segtab[seg_ix] = (struct segment*) erts_db_alloc(ERTS_ALC_T_DB_SEG,
+ (DbTable *) tb,
+ SIZEOF_SEGMENT(EXT_SEGSZ));
+ sys_memset(segtab[seg_ix], 0, SIZEOF_SEGMENT(EXT_SEGSZ));
+ tb->nslots += EXT_SEGSZ;
+}
+
+#ifdef ERTS_SMP
+static void dealloc_ext_segtab(void* lop_data)
+{
+ struct ext_segtab* est = (struct ext_segtab*) lop_data;
+
+ erts_free(ERTS_ALC_T_DB_SEG, est);
}
+#endif
/* Shrink table by freeing the top segment
** free_records: 1=free any records in segment, 0=assume segment is empty
*/
static int free_seg(DbTableHash *tb, int free_records)
{
- int seg_ix = (tb->nslots >> SEGSZ_EXP) - 1;
- int bytes;
- struct segment** segtab = SEGTAB(tb);
- struct ext_segment* top = (struct ext_segment*) segtab[seg_ix];
+ const int seg_ix = SLOT_IX_TO_SEG_IX(tb->nslots) - 1;
+ struct segment** const segtab = SEGTAB(tb);
+ struct segment* const segp = segtab[seg_ix];
+ Uint seg_sz;
int nrecords = 0;
- ASSERT(top != NULL);
+ ASSERT(segp != NULL);
#ifndef DEBUG
if (free_records)
#endif
{
- int i;
- for (i=0; i<SEGSZ; ++i) {
- HashDbTerm* p = top->s.buckets[i];
+ int i = (seg_ix == 0) ? FIRST_SEGSZ : EXT_SEGSZ;
+ while (i--) {
+ HashDbTerm* p = segp->buckets[i];
while(p != 0) {
HashDbTerm* nxt = p->next;
ASSERT(free_records); /* segment not empty as assumed? */
@@ -2425,55 +2671,46 @@ static int free_seg(DbTableHash *tb, int free_records)
}
}
}
-
- /* The "shrink race":
- * We must avoid deallocating an extended segment while its segtab may
- * still be used by other threads.
- * The trick is to stop use a segtab one call earlier. That is, stop use
- * a segtab when the segment above it is deallocated. When the segtab is
- * later deallocated, it has not been used for a very long time.
- * It is even theoretically safe as we have by then rehashed the entire
- * segment, seizing *all* locks, so there cannot exist any retarded threads
- * still hanging in BUCKET macro with an old segtab pointer.
- * For this to work, we must of course allocate a new segtab one call
- * earlier in alloc_seg() as well. And this is also the reason why
- * the minimum size of the first segtab is 2 and not 1 (NSEG_1).
- */
- if (seg_ix == tb->nsegs-1 || seg_ix==0) { /* Dealloc extended segment */
- MY_ASSERT(top->s.is_ext_segment);
- ASSERT(segtab != top->segtab || seg_ix==0);
- bytes = SIZEOF_EXTSEG(top->nsegs);
- }
- else { /* Dealloc plain segment */
- struct ext_segment* newtop = (struct ext_segment*) segtab[seg_ix-1];
- MY_ASSERT(!top->s.is_ext_segment);
-
- if (segtab == newtop->segtab) { /* New top segment is extended */
- MY_ASSERT(newtop->s.is_ext_segment);
- if (newtop->prev_segtab != NULL) {
- /* Time to use a smaller segtab */
- SET_SEGTAB(tb, newtop->prev_segtab);
- tb->nsegs = seg_ix;
- ASSERT(tb->nsegs == EXTSEG(SEGTAB(tb))->nsegs);
- }
- else {
- ASSERT(NSEG_1 > 2 && seg_ix==1);
- }
- }
- bytes = sizeof(struct segment);
+ if (seg_ix >= NSEG_1) {
+ struct ext_segtab* est = ErtsContainerStruct_(segtab,struct ext_segtab,segtab);
+
+ if (seg_ix == est->prev_nsegs) { /* Dealloc extended segtab */
+ ASSERT(est->prev_segtab != NULL);
+ SET_SEGTAB(tb, est->prev_segtab);
+ tb->nsegs = est->prev_nsegs;
+
+#ifdef ERTS_SMP
+ if (!tb->common.is_thread_safe) {
+ /*
+ * Table is doing a graceful shrink operation and we must avoid
+ * deallocating this segtab while it may still be read by other
+ * threads. Schedule deallocation with thread progress to make
+ * sure no lingering threads are still hanging in BUCKET macro
+ * with an old segtab pointer.
+ */
+ Uint sz = SIZEOF_EXT_SEGTAB(est->nsegs);
+ ASSERT(sz == ERTS_ALC_DBG_BLK_SZ(est));
+ ERTS_DB_ALC_MEM_UPDATE_(tb, sz, 0);
+ erts_schedule_thr_prgr_later_cleanup_op(dealloc_ext_segtab,
+ est,
+ &est->lop,
+ sz);
+ }
+ else
+#endif
+ erts_db_free(ERTS_ALC_T_DB_SEG, (DbTable*)tb, est,
+ SIZEOF_EXT_SEGTAB(est->nsegs));
+ }
}
+ seg_sz = (seg_ix == 0) ? FIRST_SEGSZ : EXT_SEGSZ;
+ erts_db_free(ERTS_ALC_T_DB_SEG, (DbTable *)tb, segp, SIZEOF_SEGMENT(seg_sz));
- erts_db_free(ERTS_ALC_T_DB_SEG, (DbTable *)tb,
- (void*)top, bytes);
#ifdef DEBUG
- if (seg_ix > 0) {
- if (seg_ix < tb->nsegs) SEGTAB(tb)[seg_ix] = NULL;
- } else {
- SET_SEGTAB(tb, NULL);
- }
+ if (seg_ix < tb->nsegs)
+ SEGTAB(tb)[seg_ix] = NULL;
#endif
- tb->nslots -= SEGSZ;
+ tb->nslots -= seg_sz;
ASSERT(tb->nslots >= 0);
return nrecords;
}
@@ -2483,23 +2720,23 @@ static int free_seg(DbTableHash *tb, int free_records)
** Copy terms from ptr1 until ptr2
** works for ptr1 == ptr2 == 0 => []
** or ptr2 == 0
+** sz is either precalculated heap size or 0 if not known
*/
static Eterm build_term_list(Process* p, HashDbTerm* ptr1, HashDbTerm* ptr2,
- DbTableHash* tb)
+ Uint sz, DbTableHash* tb)
{
- int sz = 0;
HashDbTerm* ptr;
Eterm list = NIL;
Eterm copy;
Eterm *hp, *hend;
- ptr = ptr1;
- while(ptr != ptr2) {
-
- if (ptr->hvalue != INVALID_HASH)
- sz += ptr->dbterm.size + 2;
-
- ptr = ptr->next;
+ if (!sz) {
+ ptr = ptr1;
+ while(ptr != ptr2) {
+ if (ptr->hvalue != INVALID_HASH)
+ sz += ptr->dbterm.size + 2;
+ ptr = ptr->next;
+ }
}
hp = HAlloc(p, sz);
@@ -2522,104 +2759,111 @@ static Eterm build_term_list(Process* p, HashDbTerm* ptr1, HashDbTerm* ptr2,
static ERTS_INLINE int
begin_resizing(DbTableHash* tb)
{
+#ifdef ERTS_SMP
if (DB_USING_FINE_LOCKING(tb))
- return !erts_smp_atomic_xchg_acqb(&tb->is_resizing, 1);
- else {
- if (erts_smp_atomic_read_nob(&tb->is_resizing))
- return 0;
- erts_smp_atomic_set_nob(&tb->is_resizing, 1);
- return 1;
- }
+ return !erts_atomic_xchg_acqb(&tb->is_resizing, 1);
+ else
+ ERTS_LC_ASSERT(erts_lc_rwmtx_is_rwlocked(&tb->common.rwlock));
+#endif
+ return 1;
}
static ERTS_INLINE void
done_resizing(DbTableHash* tb)
{
+#ifdef ERTS_SMP
if (DB_USING_FINE_LOCKING(tb))
- erts_smp_atomic_set_relb(&tb->is_resizing, 0);
- else
- erts_smp_atomic_set_nob(&tb->is_resizing, 0);
+ erts_atomic_set_relb(&tb->is_resizing, 0);
+#endif
}
-/* Grow table with one new bucket.
+/* Grow table with one or more new buckets.
** Allocate new segment if needed.
*/
-static void grow(DbTableHash* tb, int nactive)
+static void grow(DbTableHash* tb, int nitems)
{
HashDbTerm** pnext;
HashDbTerm** to_pnext;
HashDbTerm* p;
erts_smp_rwmtx_t* lck;
- int from_ix;
+ int nactive;
+ int from_ix, to_ix;
int szm;
+ int loop_limit = 5;
- if (!begin_resizing(tb))
- return; /* already in progress */
- if (NACTIVE(tb) != nactive) {
- goto abort; /* already done (race) */
- }
-
- /* Ensure that the slot nactive exists */
- if (nactive == tb->nslots) {
- /* Time to get a new segment */
- ASSERT((nactive & SEGSZ_MASK) == 0);
- if (!alloc_seg(tb)) goto abort;
- }
- ASSERT(nactive < tb->nslots);
-
- szm = erts_smp_atomic_read_nob(&tb->szm);
- if (nactive <= szm) {
- from_ix = nactive & (szm >> 1);
- } else {
- ASSERT(nactive == szm+1);
- from_ix = 0;
- szm = (szm<<1) | 1;
- }
+ do {
+ if (!begin_resizing(tb))
+ return; /* already in progress */
+ nactive = NACTIVE(tb);
+ if (nitems <= GROW_LIMIT(nactive)) {
+ goto abort; /* already done (race) */
+ }
- lck = WLOCK_HASH(tb, from_ix);
- /* Now a final double check (with the from_ix lock held)
- * that we did not get raced by a table fixer.
- */
- if (IS_FIXED(tb)) {
- WUNLOCK_HASH(lck);
- goto abort;
- }
- erts_smp_atomic_inc_nob(&tb->nactive);
- if (from_ix == 0) {
- if (DB_USING_FINE_LOCKING(tb))
- erts_smp_atomic_set_relb(&tb->szm, szm);
- else
- erts_smp_atomic_set_nob(&tb->szm, szm);
- }
- done_resizing(tb);
+ /* Ensure that the slot nactive exists */
+ if (nactive == tb->nslots) {
+ /* Time to get a new segment */
+ ASSERT(((nactive-FIRST_SEGSZ) & EXT_SEGSZ_MASK) == 0);
+ alloc_seg(tb);
+ }
+ ASSERT(nactive < tb->nslots);
+
+ szm = erts_smp_atomic_read_nob(&tb->szm);
+ if (nactive <= szm) {
+ from_ix = nactive & (szm >> 1);
+ } else {
+ ASSERT(nactive == szm+1);
+ from_ix = 0;
+ szm = (szm<<1) | 1;
+ }
+ to_ix = nactive;
+
+ lck = WLOCK_HASH(tb, from_ix);
+ ERTS_SMP_ASSERT(lck == GET_LOCK_MAYBE(tb,to_ix));
+ /* Now a final double check (with the from_ix lock held)
+ * that we did not get raced by a table fixer.
+ */
+ if (IS_FIXED(tb)) {
+ WUNLOCK_HASH(lck);
+ goto abort;
+ }
+ erts_smp_atomic_set_nob(&tb->nactive, ++nactive);
+ if (from_ix == 0) {
+ if (DB_USING_FINE_LOCKING(tb))
+ erts_smp_atomic_set_relb(&tb->szm, szm);
+ else
+ erts_smp_atomic_set_nob(&tb->szm, szm);
+ }
+ done_resizing(tb);
+
+ /* Finally, let's split the bucket. We try to do it in a smart way
+ to keep link order and avoid unnecessary updates of next-pointers */
+ pnext = &BUCKET(tb, from_ix);
+ p = *pnext;
+ to_pnext = &BUCKET(tb, to_ix);
+ while (p != NULL) {
+ if (p->hvalue == INVALID_HASH) { /* rare but possible with fine locking */
+ *pnext = p->next;
+ free_term(tb, p);
+ p = *pnext;
+ }
+ else {
+ int ix = p->hvalue & szm;
+ if (ix != from_ix) {
+ ASSERT(ix == (from_ix ^ ((szm+1)>>1)));
+ *to_pnext = p;
+ /* Swap "from" and "to": */
+ from_ix = ix;
+ to_pnext = pnext;
+ }
+ pnext = &p->next;
+ p = *pnext;
+ }
+ }
+ *to_pnext = NULL;
+ WUNLOCK_HASH(lck);
- /* Finally, let's split the bucket. We try to do it in a smart way
- to keep link order and avoid unnecessary updates of next-pointers */
- pnext = &BUCKET(tb, from_ix);
- p = *pnext;
- to_pnext = &BUCKET(tb, nactive);
- while (p != NULL) {
- if (p->hvalue == INVALID_HASH) { /* rare but possible with fine locking */
- *pnext = p->next;
- free_term(tb, p);
- p = *pnext;
- }
- else {
- int ix = p->hvalue & szm;
- if (ix != from_ix) {
- ASSERT(ix == (from_ix ^ ((szm+1)>>1)));
- *to_pnext = p;
- /* Swap "from" and "to": */
- from_ix = ix;
- to_pnext = pnext;
- }
- pnext = &p->next;
- p = *pnext;
- }
- }
- *to_pnext = NULL;
+ }while (--loop_limit && nitems > GROW_LIMIT(nactive));
- WUNLOCK_HASH(lck);
return;
abort:
@@ -2630,60 +2874,78 @@ abort:
/* Shrink table by joining top bucket.
** Remove top segment if it gets empty.
*/
-static void shrink(DbTableHash* tb, int nactive)
-{
- if (!begin_resizing(tb))
- return; /* already in progress */
- if (NACTIVE(tb) == nactive) {
- erts_smp_rwmtx_t* lck;
- int src_ix = nactive - 1;
- int low_szm = erts_smp_atomic_read_nob(&tb->szm) >> 1;
- int dst_ix = src_ix & low_szm;
-
- ASSERT(dst_ix < src_ix);
- ASSERT(nactive > SEGSZ);
- lck = WLOCK_HASH(tb, dst_ix);
- /* Double check for racing table fixers */
- if (!IS_FIXED(tb)) {
- HashDbTerm** src_bp = &BUCKET(tb, src_ix);
- HashDbTerm** dst_bp = &BUCKET(tb, dst_ix);
- HashDbTerm** bp = src_bp;
-
- /* Q: Why join lists by appending "dst" at the end of "src"?
- A: Must step through "src" anyway to purge pseudo deleted. */
- while(*bp != NULL) {
- if ((*bp)->hvalue == INVALID_HASH) {
- HashDbTerm* deleted = *bp;
- *bp = deleted->next;
- free_term(tb, deleted);
- } else {
- bp = &(*bp)->next;
- }
- }
- *bp = *dst_bp;
- *dst_bp = *src_bp;
- *src_bp = NULL;
-
- erts_smp_atomic_set_nob(&tb->nactive, src_ix);
- if (dst_ix == 0) {
- erts_smp_atomic_set_relb(&tb->szm, low_szm);
- }
- WUNLOCK_HASH(lck);
-
- if (tb->nslots - src_ix >= SEGSZ) {
- free_seg(tb, 0);
- }
- }
- else {
- WUNLOCK_HASH(lck);
- }
+static void shrink(DbTableHash* tb, int nitems)
+{
+ HashDbTerm** src_bp;
+ HashDbTerm** dst_bp;
+ HashDbTerm** bp;
+ erts_smp_rwmtx_t* lck;
+ int src_ix, dst_ix, low_szm;
+ int nactive;
+ int loop_limit = 5;
- }
- /*else already done */
+ do {
+ if (!begin_resizing(tb))
+ return; /* already in progress */
+ nactive = NACTIVE(tb);
+ if (!(nactive > FIRST_SEGSZ && nitems < SHRINK_LIMIT(nactive))) {
+ goto abort; /* already done (race) */
+ }
+ src_ix = nactive - 1;
+ low_szm = erts_smp_atomic_read_nob(&tb->szm) >> 1;
+ dst_ix = src_ix & low_szm;
+
+ ASSERT(dst_ix < src_ix);
+ ASSERT(nactive > FIRST_SEGSZ);
+ lck = WLOCK_HASH(tb, dst_ix);
+ ERTS_SMP_ASSERT(lck == GET_LOCK_MAYBE(tb,src_ix));
+ /* Double check for racing table fixers */
+ if (IS_FIXED(tb)) {
+ WUNLOCK_HASH(lck);
+ goto abort;
+ }
+
+ src_bp = &BUCKET(tb, src_ix);
+ dst_bp = &BUCKET(tb, dst_ix);
+ bp = src_bp;
+
+ /*
+ * We join lists by appending "dst" at the end of "src"
+ * as we must step through "src" anyway to purge pseudo deleted.
+ */
+ while(*bp != NULL) {
+ if ((*bp)->hvalue == INVALID_HASH) {
+ HashDbTerm* deleted = *bp;
+ *bp = deleted->next;
+ free_term(tb, deleted);
+ } else {
+ bp = &(*bp)->next;
+ }
+ }
+ *bp = *dst_bp;
+ *dst_bp = *src_bp;
+ *src_bp = NULL;
+
+ nactive = src_ix;
+ erts_smp_atomic_set_nob(&tb->nactive, nactive);
+ if (dst_ix == 0) {
+ erts_smp_atomic_set_relb(&tb->szm, low_szm);
+ }
+ WUNLOCK_HASH(lck);
+
+ if (tb->nslots - src_ix >= EXT_SEGSZ) {
+ free_seg(tb, 0);
+ }
+ done_resizing(tb);
+
+ } while (--loop_limit
+ && nactive > FIRST_SEGSZ && nitems < SHRINK_LIMIT(nactive));
+ return;
+
+abort:
done_resizing(tb);
}
-
/* Search a list of tuples for a matching key */
static HashDbTerm* search_list(DbTableHash* tb, Eterm key,
@@ -2730,63 +2992,136 @@ static HashDbTerm* next(DbTableHash *tb, Uint *iptr, erts_smp_rwmtx_t** lck_ptr,
return NULL;
}
-static int db_lookup_dbterm_hash(DbTable *tbl, Eterm key, DbUpdateHandle* handle)
+static int
+db_lookup_dbterm_hash(Process *p, DbTable *tbl, Eterm key, Eterm obj,
+ DbUpdateHandle* handle)
{
DbTableHash *tb = &tbl->hash;
- HashDbTerm* b;
- HashDbTerm** prevp;
- int ix;
HashValue hval;
+ HashDbTerm **bp, *b;
erts_smp_rwmtx_t* lck;
+ int flags = 0;
+
+ ASSERT(tb->common.status & DB_SET);
hval = MAKE_HASH(key);
- lck = WLOCK_HASH(tb,hval);
- ix = hash_to_ix(tb, hval);
- prevp = &BUCKET(tb, ix);
- b = *prevp;
+ lck = WLOCK_HASH(tb, hval);
+ bp = &BUCKET(tb, hash_to_ix(tb, hval));
+ b = *bp;
- while (b != 0) {
- if (has_live_key(tb,b,key,hval)) {
- handle->tb = tbl;
- handle->bp = (void**) prevp;
- handle->dbterm = &b->dbterm;
- handle->mustResize = 0;
- handle->new_size = b->dbterm.size;
- #if HALFWORD_HEAP
- handle->abs_vec = NULL;
- #endif
- handle->lck = lck;
- /* KEEP hval WLOCKED, db_finalize_dbterm_hash will WUNLOCK */
- return 1;
- }
- prevp = &b->next;
- b = *prevp;
+ for (;;) {
+ if (b == NULL) {
+ break;
+ }
+ if (has_key(tb, b, key, hval)) {
+ if (b->hvalue != INVALID_HASH) {
+ goto Ldone;
+ }
+ break;
+ }
+ bp = &b->next;
+ b = *bp;
}
- WUNLOCK_HASH(lck);
- return 0;
+
+ if (obj == THE_NON_VALUE) {
+ WUNLOCK_HASH(lck);
+ return 0;
+ }
+
+ {
+ Eterm *objp = tuple_val(obj);
+ int arity = arityval(*objp);
+ Eterm *htop, *hend;
+
+ ASSERT(arity >= tb->common.keypos);
+ htop = HAlloc(p, arity + 1);
+ hend = htop + arity + 1;
+ sys_memcpy(htop, objp, sizeof(Eterm) * (arity + 1));
+ htop[tb->common.keypos] = key;
+ obj = make_tuple(htop);
+
+ if (b == NULL) {
+ HashDbTerm *q = new_dbterm(tb, obj);
+
+ q->hvalue = hval;
+ q->next = NULL;
+ *bp = b = q;
+ flags |= DB_INC_TRY_GROW;
+ } else {
+ HashDbTerm *q, *next = b->next;
+
+ ASSERT(b->hvalue == INVALID_HASH);
+ q = replace_dbterm(tb, b, obj);
+ q->next = next;
+ q->hvalue = hval;
+ *bp = b = q;
+ erts_smp_atomic_inc_nob(&tb->common.nitems);
+ }
+
+ HRelease(p, hend, htop);
+ flags |= DB_NEW_OBJECT;
+ }
+
+Ldone:
+ handle->tb = tbl;
+ handle->bp = (void **)bp;
+ handle->dbterm = &b->dbterm;
+ handle->flags = flags;
+ handle->new_size = b->dbterm.size;
+ handle->lck = lck;
+ return 1;
}
/* Must be called after call to db_lookup_dbterm
*/
-static void db_finalize_dbterm_hash(DbUpdateHandle* handle)
+static void
+db_finalize_dbterm_hash(int cret, DbUpdateHandle* handle)
{
DbTable* tbl = handle->tb;
- HashDbTerm* oldp = (HashDbTerm*) *(handle->bp);
+ DbTableHash *tb = &tbl->hash;
+ HashDbTerm **bp = (HashDbTerm **) handle->bp;
+ HashDbTerm *b = *bp;
erts_smp_rwmtx_t* lck = (erts_smp_rwmtx_t*) handle->lck;
+ HashDbTerm* free_me = NULL;
- ERTS_SMP_LC_ASSERT(IS_HASH_WLOCKED(&tbl->hash,lck)); /* locked by db_lookup_dbterm_hash */
+ ERTS_SMP_LC_ASSERT(IS_HASH_WLOCKED(tb, lck)); /* locked by db_lookup_dbterm_hash */
- ASSERT((&oldp->dbterm == handle->dbterm) == !(tbl->common.compress && handle->mustResize));
+ ASSERT((&b->dbterm == handle->dbterm) == !(tb->common.compress && handle->flags & DB_MUST_RESIZE));
- if (handle->mustResize) {
- db_finalize_resize(handle, offsetof(HashDbTerm,dbterm));
- WUNLOCK_HASH(lck);
+ if (handle->flags & DB_NEW_OBJECT && cret != DB_ERROR_NONE) {
+ if (IS_FIXED(tb) && add_fixed_deletion(tb, hash_to_ix(tb, b->hvalue),
+ 0)) {
+ b->hvalue = INVALID_HASH;
+ } else {
+ *bp = b->next;
+ free_me = b;
+ }
- free_term(&tbl->hash, oldp);
- }
- else {
- WUNLOCK_HASH(lck);
+ WUNLOCK_HASH(lck);
+ erts_smp_atomic_dec_nob(&tb->common.nitems);
+ try_shrink(tb);
+ } else {
+ if (handle->flags & DB_MUST_RESIZE) {
+ db_finalize_resize(handle, offsetof(HashDbTerm,dbterm));
+ free_me = b;
+ }
+ if (handle->flags & DB_INC_TRY_GROW) {
+ int nactive;
+ int nitems = erts_smp_atomic_inc_read_nob(&tb->common.nitems);
+ WUNLOCK_HASH(lck);
+ nactive = NACTIVE(tb);
+
+ if (nitems > GROW_LIMIT(nactive) && !IS_FIXED(tb)) {
+ grow(tb, nitems);
+ }
+ } else {
+ WUNLOCK_HASH(lck);
+ }
}
+
+ if (free_me)
+ free_term(tb, free_me);
+
#ifdef DEBUG
handle->dbterm = 0;
#endif
@@ -2833,6 +3168,7 @@ void db_calc_stats_hash(DbTableHash* tb, DbHashStats* stats)
erts_smp_rwmtx_t* lck;
int sum = 0;
int sq_sum = 0;
+ int kept_items = 0;
int ix;
int len;
@@ -2844,6 +3180,8 @@ void db_calc_stats_hash(DbTableHash* tb, DbHashStats* stats)
len = 0;
for (b = BUCKET(tb,ix); b!=NULL; b=b->next) {
len++;
+ if (b->hvalue == INVALID_HASH)
+ ++kept_items;
}
sum += len;
sq_sum += len*len;
@@ -2855,26 +3193,33 @@ void db_calc_stats_hash(DbTableHash* tb, DbHashStats* stats)
stats->std_dev_chain_len = sqrt((sq_sum - stats->avg_chain_len*sum) / NACTIVE(tb));
/* Expected standard deviation from a good uniform hash function,
ie binomial distribution (not taking the linear hashing into acount) */
- stats->std_dev_expected = sqrt(stats->avg_chain_len * (1 - 1.0/NACTIVE(tb)));
+ stats->std_dev_expected = sqrt(stats->avg_chain_len * (1 - 1.0/NACTIVE(tb)));
+ stats->kept_items = kept_items;
}
-#ifdef HARDDEBUG
-void db_check_table_hash(DbTable *tbl)
+/* For testing only */
+Eterm erts_ets_hash_sizeof_ext_segtab(void)
{
- DbTableHash *tb = &tbl->hash;
- HashDbTerm* list;
- int j;
-
- for (j = 0; j < tb->nactive; j++) {
- 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);
- }
- list = list->next;
- }
- }
- }
+ return make_small(((SIZEOF_EXT_SEGTAB(0)-1) / sizeof(UWord)) + 1);
}
-#endif
+#ifdef ERTS_ENABLE_LOCK_COUNT
+void erts_lcnt_enable_db_hash_lock_count(DbTableHash *tb, int enable) {
+ int i;
+
+ if(tb->locks == NULL) {
+ return;
+ }
+
+ for(i = 0; i < DB_HASH_LOCK_CNT; i++) {
+ erts_lcnt_ref_t *ref = &tb->locks->lck_vec[i].lck.lcnt;
+
+ if(enable) {
+ erts_lcnt_install_new_lock_info(ref, "db_hash_slot", tb->common.the_name,
+ ERTS_LOCK_TYPE_RWMUTEX | ERTS_LOCK_FLAGS_CATEGORY_DB);
+ } else {
+ erts_lcnt_uninstall(ref);
+ }
+ }
+}
+#endif /* ERTS_ENABLE_LOCK_COUNT */
diff --git a/erts/emulator/beam/erl_db_hash.h b/erts/emulator/beam/erl_db_hash.h
index 908cec11d4..523ed7860e 100644
--- a/erts/emulator/beam/erl_db_hash.h
+++ b/erts/emulator/beam/erl_db_hash.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1998-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1998-2017. 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.
+ * 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%
*/
@@ -42,30 +43,30 @@ typedef struct hash_db_term {
typedef struct db_table_hash_fine_locks {
union {
erts_smp_rwmtx_t lck;
- byte _cache_line_alignment[64];
+ byte _cache_line_alignment[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(erts_smp_rwmtx_t))];
}lck_vec[DB_HASH_LOCK_CNT];
} DbTableHashFineLocks;
typedef struct db_table_hash {
DbTableCommon common;
- erts_smp_atomic_t segtab; /* The segment table (struct segment**) */
+ /* SMP: szm and nactive are write-protected by is_resizing or table write lock */
erts_smp_atomic_t szm; /* current size mask. */
-
+ erts_smp_atomic_t nactive; /* Number of "active" slots */
+
+ erts_smp_atomic_t segtab; /* The segment table (struct segment**) */
+ struct segment* first_segtab[1];
+
/* SMP: nslots and nsegs are protected by is_resizing or table write lock */
int nslots; /* Total number of slots */
int nsegs; /* Size of segment table */
/* List of slots where elements have been deleted while table was fixed */
erts_smp_atomic_t fixdel; /* (FixedDeletion*) */
- erts_smp_atomic_t nactive; /* Number of "active" slots */
- erts_smp_atomic_t is_resizing; /* grow/shrink in progress */
#ifdef ERTS_SMP
+ erts_smp_atomic_t is_resizing; /* grow/shrink in progress */
DbTableHashFineLocks* locks;
#endif
-#ifdef VALGRIND
- struct ext_segment* top_ptr_to_segment_with_active_segtab;
-#endif
} DbTableHash;
@@ -74,7 +75,7 @@ typedef struct db_table_hash {
** table types. The process is always an [in out] parameter.
*/
void db_initialize_hash(void);
-void db_unfix_table_hash(DbTableHash *tb /* [in out] */);
+SWord db_unfix_table_hash(DbTableHash *tb);
Uint db_kept_items_hash(DbTableHash *tb);
/* Interface for meta pid table */
@@ -87,14 +88,6 @@ int db_get_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret);
int db_erase_hash(DbTable *tbl, Eterm key, Eterm *ret);
-int db_get_element_array(DbTable *tbl,
- Eterm key,
- int ndex,
- Eterm *ret,
- int *num_ret);
-
-int db_erase_bag_exact2(DbTable *tbl, Eterm key, Eterm value);
-
/* not yet in method table */
int db_mark_all_deleted_hash(DbTable *tbl);
@@ -104,8 +97,14 @@ typedef struct {
float std_dev_expected;
int max_chain_len;
int min_chain_len;
+ int kept_items;
}DbHashStats;
void db_calc_stats_hash(DbTableHash* tb, DbHashStats*);
+Eterm erts_ets_hash_sizeof_ext_segtab(void);
+
+#ifdef ERTS_ENABLE_LOCK_COUNT
+void erts_lcnt_enable_db_hash_lock_count(DbTableHash *tb, int enable);
+#endif
#endif /* _DB_HASH_H */
diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c
index a62a83a928..7c80e92e50 100644
--- a/erts/emulator/beam/erl_db_tree.c
+++ b/erts/emulator/beam/erl_db_tree.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1998-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1998-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -75,8 +76,14 @@
((Dtt->pos) ? \
(Dtt)->array[(Dtt)->pos - 1] : NULL)
-#define EMPTY_NODE(Dtt) (TOP_NODE(Dtt) == NULL)
+#define TOPN_NODE(Dtt, Pos) \
+ (((Pos) < Dtt->pos) ? \
+ (Dtt)->array[(Dtt)->pos - ((Pos) + 1)] : NULL)
+#define REPLACE_TOP_NODE(Dtt, Node) \
+ if ((Dtt)->pos) (Dtt)->array[(Dtt)->pos - 1] = (Node)
+
+#define EMPTY_NODE(Dtt) (TOP_NODE(Dtt) == NULL)
/* Obtain table static stack if available. NULL if not.
@@ -179,7 +186,6 @@ static ERTS_INLINE TreeDbTerm* replace_dbterm(DbTableTree *tb, TreeDbTerm* old,
static TreeDbTerm *traverse_until(TreeDbTerm *t, int *current, int to);
static void check_slot_pos(DbTableTree *tb);
static void check_saved_stack(DbTableTree *tb);
-static int check_table_tree(DbTableTree* tb, TreeDbTerm *t);
#define TREE_DEBUG
#endif
@@ -225,9 +231,9 @@ struct mp_info {
Eterm most; /* The highest matching key (possibly
* partially bound expression) */
- TreeDbTerm *save_term; /* If the key is completely bound, this
- * will be the Tree node we're searching
- * for, otherwise it will be useless */
+ TreeDbTerm **save_term; /* If the key is completely bound, this
+ * will be the Tree node we're searching
+ * for, otherwise it will be useless */
Binary *mp; /* The compiled match program */
};
@@ -277,12 +283,30 @@ struct select_delete_context {
};
/*
+ * Used by doit_select_replace
+ */
+struct select_replace_context {
+ Process *p;
+ DbTableTree *tb;
+ Binary *mp;
+ Eterm end_condition;
+ Eterm *lastobj;
+ Sint32 max;
+ int keypos;
+ int all_objects;
+ Sint replaced;
+};
+
+/* Used by select_replace on analyze_pattern */
+typedef int (*extra_match_validator_t)(int keypos, Eterm match, Eterm guard, Eterm body);
+
+/*
** 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);
+static SWord do_free_tree_continue(DbTableTree *tb, SWord reds);
static void free_term(DbTableTree *tb, TreeDbTerm* p);
static int balance_left(TreeDbTerm **this);
static int balance_right(TreeDbTerm **this);
@@ -290,15 +314,16 @@ 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_ptr(DbTableTree *tb, DbTreeStack*, TreeDbTerm *this);
+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 *,
@@ -306,19 +331,28 @@ 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 *,
int),
- void *context);
-static int key_given(DbTableTree *tb, Eterm pattern, TreeDbTerm **ret,
+ void *context);
+static void traverse_update_backwards(DbTableTree *tb,
+ DbTreeStack*,
+ Eterm lastkey,
+ int (*doit)(DbTableTree *tb,
+ TreeDbTerm **, // out
+ void *,
+ int),
+ 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);
+ extra_match_validator_t extra_validator, /* Optional callback */
+ struct mp_info *mpi);
static int doit_select(DbTableTree *tb,
TreeDbTerm *this,
void *ptr,
@@ -335,6 +369,10 @@ static int doit_select_delete(DbTableTree *tb,
TreeDbTerm *this,
void *ptr,
int forward);
+static int doit_select_replace(DbTableTree *tb,
+ TreeDbTerm **this_ptr,
+ void *ptr,
+ int forward);
static int partly_bound_can_match_lesser(Eterm partly_bound_1,
Eterm partly_bound_2);
@@ -368,26 +406,31 @@ static int db_erase_tree(DbTable *tbl, Eterm key, Eterm *ret);
static int db_erase_object_tree(DbTable *tbl, Eterm object,Eterm *ret);
static int db_slot_tree(Process *p, DbTable *tbl,
Eterm slot_term, Eterm *ret);
-static int db_select_tree(Process *p, DbTable *tbl,
+static int db_select_tree(Process *p, DbTable *tbl, Eterm tid,
Eterm pattern, int reversed, Eterm *ret);
-static int db_select_count_tree(Process *p, DbTable *tbl,
+static int db_select_count_tree(Process *p, DbTable *tbl, Eterm tid,
Eterm pattern, Eterm *ret);
-static int db_select_chunk_tree(Process *p, DbTable *tbl,
+static int db_select_chunk_tree(Process *p, DbTable *tbl, Eterm tid,
Eterm pattern, Sint chunk_size,
int reversed, Eterm *ret);
static int db_select_continue_tree(Process *p, DbTable *tbl,
Eterm continuation, Eterm *ret);
static int db_select_count_continue_tree(Process *p, DbTable *tbl,
Eterm continuation, Eterm *ret);
-static int db_select_delete_tree(Process *p, DbTable *tbl,
+static int db_select_delete_tree(Process *p, DbTable *tbl, Eterm tid,
Eterm pattern, Eterm *ret);
static int db_select_delete_continue_tree(Process *p, DbTable *tbl,
Eterm continuation, Eterm *ret);
-static void db_print_tree(int to, void *to_arg,
+static int db_select_replace_tree(Process *p, DbTable *tbl, Eterm tid,
+ Eterm pattern, Eterm *ret);
+static int db_select_replace_continue_tree(Process *p, DbTable *tbl,
+ Eterm continuation, Eterm *ret);
+static int db_take_tree(Process *, DbTable *, Eterm, Eterm *);
+static void db_print_tree(fmtfn_t to, void *to_arg,
int show, DbTable *tbl);
static int db_free_table_tree(DbTable *tbl);
-static int db_free_table_continue_tree(DbTable *tbl);
+static SWord db_free_table_continue_tree(DbTable *tbl, SWord);
static void db_foreach_offheap_tree(DbTable *,
void (*)(ErlOffHeap *, void *),
@@ -398,8 +441,11 @@ static int db_delete_all_objects_tree(Process* p, DbTable* tbl);
#ifdef HARDDEBUG
static void db_check_table_tree(DbTable *tbl);
#endif
-static int db_lookup_dbterm_tree(DbTable *, Eterm key, DbUpdateHandle*);
-static void db_finalize_dbterm_tree(DbUpdateHandle*);
+static int
+db_lookup_dbterm_tree(Process *, DbTable *, Eterm key, Eterm obj,
+ DbUpdateHandle*);
+static void
+db_finalize_dbterm_tree(int cret, DbUpdateHandle *);
/*
** Static variables
@@ -431,16 +477,14 @@ DbTableMethod db_tree =
db_select_delete_continue_tree,
db_select_count_tree,
db_select_count_continue_tree,
+ db_select_replace_tree,
+ db_select_replace_continue_tree,
+ db_take_tree,
db_delete_all_objects_tree,
db_free_table_tree,
db_free_table_continue_tree,
db_print_tree,
db_foreach_offheap_tree,
-#ifdef HARDDEBUG
- db_check_table_tree,
-#else
- NULL,
-#endif
db_lookup_dbterm_tree,
db_finalize_dbterm_tree
@@ -511,7 +555,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;
@@ -557,7 +601,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;
@@ -567,19 +611,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)
@@ -613,7 +651,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;
@@ -768,7 +806,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;
@@ -935,17 +973,15 @@ static int db_select_continue_tree(Process *p,
if (arityval(*tptr) != 8)
RET_TO_BIF(NIL,DB_ERROR_BADPARAM);
- if (!is_small(tptr[4]) || !is_binary(tptr[5]) ||
+ if (!is_small(tptr[4]) ||
!(is_list(tptr[6]) || tptr[6] == NIL) || !is_small(tptr[7]) ||
!is_small(tptr[8]))
RET_TO_BIF(NIL,DB_ERROR_BADPARAM);
lastkey = tptr[2];
end_condition = tptr[3];
- if (!(thing_subtag(*binary_val(tptr[5])) == REFC_BINARY_SUBTAG))
- RET_TO_BIF(NIL,DB_ERROR_BADPARAM);
- mp = ((ProcBin *) binary_val(tptr[5]))->val;
- if (!IsMatchProgBinary(mp))
+ mp = erts_db_get_match_prog_binary(tptr[5]);
+ if (!mp)
RET_TO_BIF(NIL,DB_ERROR_BADPARAM);
chunk_size = signed_val(tptr[4]);
@@ -956,7 +992,7 @@ static int db_select_continue_tree(Process *p,
sc.lastobj = NULL;
sc.max = 1000;
sc.keypos = tb->common.keypos;
- sc.all_objects = mp->flags & BIN_FLAG_ALL_OBJECTS;
+ sc.all_objects = mp->intern.flags & BIN_FLAG_ALL_OBJECTS;
sc.chunk_size = chunk_size;
reverse = unsigned_val(tptr[7]);
sc.got = signed_val(tptr[8]);
@@ -964,15 +1000,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);
@@ -997,9 +1033,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],
@@ -1020,8 +1056,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);
@@ -1033,16 +1069,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],
@@ -1060,7 +1096,7 @@ static int db_select_continue_tree(Process *p,
}
-static int db_select_tree(Process *p, DbTable *tbl,
+static int db_select_tree(Process *p, DbTable *tbl, Eterm tid,
Eterm pattern, int reverse, Eterm *ret)
{
/* Strategy: Traverse backwards to build resulting list from tail to head */
@@ -1069,7 +1105,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;
@@ -1098,7 +1133,7 @@ static int db_select_tree(Process *p, DbTable *tbl,
sc.got = 0;
sc.chunk_size = 0;
- if ((errcode = analyze_pattern(tb, pattern, &mpi)) != DB_ERROR_NONE) {
+ if ((errcode = analyze_pattern(tb, pattern, NULL, &mpi)) != DB_ERROR_NONE) {
RET_TO_BIF(NIL,errcode);
}
@@ -1111,8 +1146,8 @@ static int db_select_tree(Process *p, DbTable *tbl,
sc.all_objects = mpi.all_objects;
if (!mpi.got_partial && mpi.some_limitation &&
- CMP(mpi.least,mpi.most) == 0) {
- doit_select(tb,mpi.save_term,&sc,0 /* direction doesn't matter */);
+ CMP_EQ(mpi.least,mpi.most)) {
+ doit_select(tb,*(mpi.save_term),&sc,0 /* direction doesn't matter */);
RET_TO_BIF(sc.accum,DB_ERROR_NONE);
}
@@ -1121,20 +1156,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
@@ -1147,16 +1180,16 @@ static int db_select_tree(Process *p, DbTable *tbl,
}
key = GETKEY(tb, sc.lastobj);
- sz = size_object_rel(key, sc.lastobj);
- hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE);
- key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL);
+ sz = size_object(key);
+ hp = HAlloc(p, 9 + sz + ERTS_MAGIC_REF_THING_SIZE);
+ 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);
+ (mpi.mp)->intern.flags |= BIN_FLAG_ALL_OBJECTS;
+ mpb= erts_db_make_match_prog_ref(p,mpi.mp,&hp);
continuation = TUPLE8
(hp,
- tb->common.id,
+ tid,
key,
sc.end_condition, /* From the match program, needn't be copied */
make_small(0), /* Chunk size of zero means not chunked to the
@@ -1207,14 +1240,12 @@ 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];
- if (!(thing_subtag(*binary_val(tptr[4])) == REFC_BINARY_SUBTAG))
- RET_TO_BIF(NIL,DB_ERROR_BADPARAM);
- mp = ((ProcBin *) binary_val(tptr[4]))->val;
- if (!IsMatchProgBinary(mp))
+ mp = erts_db_get_match_prog_binary(tptr[4]);
+ if (!mp)
RET_TO_BIF(NIL,DB_ERROR_BADPARAM);
sc.p = p;
@@ -1230,7 +1261,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);
@@ -1240,12 +1271,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);
@@ -1255,7 +1286,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],
@@ -1270,7 +1301,7 @@ static int db_select_count_continue_tree(Process *p,
}
-static int db_select_count_tree(Process *p, DbTable *tbl,
+static int db_select_count_tree(Process *p, DbTable *tbl, Eterm tid,
Eterm pattern, Eterm *ret)
{
DbTableTree *tb = &tbl->tree;
@@ -1278,7 +1309,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;
@@ -1306,7 +1336,7 @@ static int db_select_count_tree(Process *p, DbTable *tbl,
sc.keypos = tb->common.keypos;
sc.got = 0;
- if ((errcode = analyze_pattern(tb, pattern, &mpi)) != DB_ERROR_NONE) {
+ if ((errcode = analyze_pattern(tb, pattern, NULL, &mpi)) != DB_ERROR_NONE) {
RET_TO_BIF(NIL,errcode);
}
@@ -1319,8 +1349,8 @@ static int db_select_count_tree(Process *p, DbTable *tbl,
sc.all_objects = mpi.all_objects;
if (!mpi.got_partial && mpi.some_limitation &&
- CMP(mpi.least,mpi.most) == 0) {
- doit_select_count(tb,mpi.save_term,&sc,0 /* dummy */);
+ CMP_EQ(mpi.least,mpi.most)) {
+ doit_select_count(tb,*(mpi.save_term),&sc,0 /* dummy */);
RET_TO_BIF(erts_make_integer(sc.got,p),DB_ERROR_NONE);
}
@@ -1328,12 +1358,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) {
@@ -1341,24 +1370,24 @@ 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);
+ hp = HAlloc(p, sz + ERTS_MAGIC_REF_THING_SIZE + 6);
egot = make_small(sc.got);
}
else {
- hp = HAlloc(p, BIG_UINT_HEAP_SIZE + sz + PROC_BIN_SIZE + 6);
+ hp = HAlloc(p, BIG_UINT_HEAP_SIZE + sz + ERTS_MAGIC_REF_THING_SIZE + 6);
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);
+ (mpi.mp)->intern.flags |= BIN_FLAG_ALL_OBJECTS;
+ mpb = erts_db_make_match_prog_ref(p,mpi.mp,&hp);
continuation = TUPLE5
(hp,
- tb->common.id,
+ tid,
key,
sc.end_condition, /* From the match program, needn't be copied */
mpb,
@@ -1372,7 +1401,7 @@ static int db_select_count_tree(Process *p, DbTable *tbl,
}
-static int db_select_chunk_tree(Process *p, DbTable *tbl,
+static int db_select_chunk_tree(Process *p, DbTable *tbl, Eterm tid,
Eterm pattern, Sint chunk_size,
int reverse,
Eterm *ret)
@@ -1382,7 +1411,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;
@@ -1411,7 +1439,7 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl,
sc.got = 0;
sc.chunk_size = chunk_size;
- if ((errcode = analyze_pattern(tb, pattern, &mpi)) != DB_ERROR_NONE) {
+ if ((errcode = analyze_pattern(tb, pattern, NULL, &mpi)) != DB_ERROR_NONE) {
RET_TO_BIF(NIL,errcode);
}
@@ -1424,8 +1452,8 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl,
sc.all_objects = mpi.all_objects;
if (!mpi.got_partial && mpi.some_limitation &&
- CMP(mpi.least,mpi.most) == 0) {
- doit_select(tb,mpi.save_term,&sc, 0 /* direction doesn't matter */);
+ CMP_EQ(mpi.least,mpi.most)) {
+ doit_select(tb,*(mpi.save_term),&sc, 0 /* direction doesn't matter */);
if (sc.accum != NIL) {
hp=HAlloc(p, 3);
RET_TO_BIF(TUPLE2(hp,sc.accum,am_EOT),DB_ERROR_NONE);
@@ -1439,20 +1467,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);
@@ -1477,16 +1503,16 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl,
}
key = GETKEY(tb, sc.lastobj);
- sz = size_object_rel(key, sc.lastobj);
- hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE);
- key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL);
+ sz = size_object(key);
+ hp = HAlloc(p, 9 + sz + ERTS_MAGIC_REF_THING_SIZE);
+ 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);
+ (mpi.mp)->intern.flags |= BIN_FLAG_ALL_OBJECTS;
+ mpb = erts_db_make_match_prog_ref(p,mpi.mp,&hp);
continuation = TUPLE8
(hp,
- tb->common.id,
+ tid,
key,
sc.end_condition, /* From the match program,
needn't be copied */
@@ -1502,16 +1528,16 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl,
}
key = GETKEY(tb, sc.lastobj);
- sz = size_object_rel(key, sc.lastobj);
- hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE);
- key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL);
+ sz = size_object(key);
+ hp = HAlloc(p, 9 + sz + ERTS_MAGIC_REF_THING_SIZE);
+ 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);
+ (mpi.mp)->intern.flags |= BIN_FLAG_ALL_OBJECTS;
+ mpb = erts_db_make_match_prog_ref(p,mpi.mp,&hp);
continuation = TUPLE8
(hp,
- tb->common.id,
+ tid,
key,
sc.end_condition, /* From the match program, needn't be copied */
make_small(chunk_size),
@@ -1566,7 +1592,7 @@ static int db_select_delete_continue_tree(Process *p,
sc.erase_lastterm = 0; /* Before first RET_TO_BIF */
sc.lastterm = NULL;
- mp = ((ProcBin *) binary_val(tptr[4]))->val;
+ mp = erts_db_get_match_prog_binary_unchecked(tptr[4]);
sc.p = p;
sc.tb = tb;
if (is_big(tptr[5])) {
@@ -1580,7 +1606,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);
@@ -1589,11 +1615,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);
@@ -1603,7 +1629,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],
@@ -1617,14 +1643,13 @@ static int db_select_delete_continue_tree(Process *p,
#undef RET_TO_BIF
}
-static int db_select_delete_tree(Process *p, DbTable *tbl,
+static int db_select_delete_tree(Process *p, DbTable *tbl, Eterm tid,
Eterm pattern, Eterm *ret)
{
DbTableTree *tb = &tbl->tree;
struct select_delete_context sc;
struct mp_info mpi;
Eterm lastkey = THE_NON_VALUE;
- Eterm* lk_base = NULL;
Eterm key;
Eterm continuation;
unsigned sz;
@@ -1656,7 +1681,7 @@ static int db_select_delete_tree(Process *p, DbTable *tbl,
sc.keypos = tb->common.keypos;
sc.tb = tb;
- if ((errcode = analyze_pattern(tb, pattern, &mpi)) != DB_ERROR_NONE) {
+ if ((errcode = analyze_pattern(tb, pattern, NULL, &mpi)) != DB_ERROR_NONE) {
RET_TO_BIF(0,errcode);
}
@@ -1668,8 +1693,8 @@ static int db_select_delete_tree(Process *p, DbTable *tbl,
sc.mp = mpi.mp;
if (!mpi.got_partial && mpi.some_limitation &&
- CMP(mpi.least,mpi.most) == 0) {
- doit_select_delete(tb,mpi.save_term,&sc, 0 /* direction doesn't
+ CMP_EQ(mpi.least,mpi.most)) {
+ doit_select_delete(tb,*(mpi.save_term),&sc, 0 /* direction doesn't
matter */);
RET_TO_BIF(erts_make_integer(sc.accum,p),DB_ERROR_NONE);
}
@@ -1677,12 +1702,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) {
@@ -1690,22 +1714,22 @@ 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);
+ hp = HAlloc(p, sz + ERTS_MAGIC_REF_THING_SIZE + 6);
eaccsum = make_small(sc.accum);
}
else {
- hp = HAlloc(p, BIG_UINT_HEAP_SIZE + sz + PROC_BIN_SIZE + 6);
+ hp = HAlloc(p, BIG_UINT_HEAP_SIZE + sz + ERTS_MAGIC_REF_THING_SIZE + 6);
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);
- mpb = db_make_mp_binary(p,mpi.mp,&hp);
+ key = copy_struct(key, sz, &hp, &MSO(p));
+ mpb = erts_db_make_match_prog_ref(p,mpi.mp,&hp);
continuation = TUPLE5
(hp,
- tb->common.id,
+ tid,
key,
sc.end_condition, /* From the match program, needn't be copied */
mpb,
@@ -1722,13 +1746,237 @@ static int db_select_delete_tree(Process *p, DbTable *tbl,
}
+static int db_select_replace_continue_tree(Process *p,
+ DbTable *tbl,
+ Eterm continuation,
+ Eterm *ret)
+{
+ DbTableTree *tb = &tbl->tree;
+ DbTreeStack* stack;
+ struct select_replace_context sc;
+ unsigned sz;
+ Eterm *hp;
+ Eterm lastkey;
+ Eterm end_condition;
+ Binary *mp;
+ Eterm key;
+ Eterm *tptr;
+ Eterm ereplaced;
+ Sint prev_replaced;
+
+
+#define RET_TO_BIF(Term, State) do { *ret = (Term); return State; } while(0);
+
+ /* Decode continuation. We know it's a tuple and everything else as
+ this is only called by ourselves */
+
+ /* continuation:
+ {Table, Lastkey, EndCondition, MatchProgBin, HowManyReplaced}*/
+
+ tptr = tuple_val(continuation);
+
+ if (arityval(*tptr) != 5)
+ erts_exit(ERTS_ERROR_EXIT,"Internal error in ets:select_replace/1");
+
+ lastkey = tptr[2];
+ end_condition = tptr[3];
+ mp = erts_db_get_match_prog_binary_unchecked(tptr[4]);
+
+ sc.p = p;
+ sc.mp = mp;
+ sc.end_condition = NIL;
+ sc.lastobj = NULL;
+ sc.max = 1000;
+ sc.keypos = tb->common.keypos;
+ if (is_big(tptr[5])) {
+ sc.replaced = big_to_uint32(tptr[5]);
+ } else {
+ sc.replaced = unsigned_val(tptr[5]);
+ }
+ prev_replaced = sc.replaced;
+
+ stack = get_any_stack(tb);
+ traverse_update_backwards(tb, stack, lastkey, &doit_select_replace, &sc);
+ release_stack(tb,stack);
+
+ // the more objects we've replaced, the more reductions we've consumed
+ BUMP_REDS(p, MIN(2000, (1000 - sc.max) + (sc.replaced - prev_replaced)));
+
+ if (sc.max > 0) {
+ RET_TO_BIF(erts_make_integer(sc.replaced,p), DB_ERROR_NONE);
+ }
+ key = GETKEY(tb, sc.lastobj);
+ if (end_condition != NIL &&
+ (cmp_partly_bound(end_condition,key) > 0)) {
+ /* done anyway */
+ RET_TO_BIF(make_small(sc.replaced),DB_ERROR_NONE);
+ }
+ /* Not done yet, let's trap. */
+ sz = size_object(key);
+ if (IS_USMALL(0, sc.replaced)) {
+ hp = HAlloc(p, sz + 6);
+ ereplaced = make_small(sc.replaced);
+ }
+ else {
+ hp = HAlloc(p, BIG_UINT_HEAP_SIZE + sz + 6);
+ ereplaced = uint_to_big(sc.replaced, hp);
+ hp += BIG_UINT_HEAP_SIZE;
+ }
+ key = copy_struct(key, sz, &hp, &MSO(p));
+ continuation = TUPLE5
+ (hp,
+ tptr[1],
+ key,
+ tptr[3],
+ tptr[4],
+ ereplaced);
+ RET_TO_BIF(bif_trap1(&ets_select_replace_continue_exp, p, continuation),
+ DB_ERROR_NONE);
+
+#undef RET_TO_BIF
+}
+
+static int db_select_replace_tree(Process *p, DbTable *tbl, Eterm tid,
+ Eterm pattern, Eterm *ret)
+{
+ DbTableTree *tb = &tbl->tree;
+ DbTreeStack* stack;
+ struct select_replace_context sc;
+ struct mp_info mpi;
+ Eterm lastkey = THE_NON_VALUE;
+ Eterm key;
+ Eterm continuation;
+ unsigned sz;
+ Eterm *hp;
+ TreeDbTerm *this;
+ int errcode;
+ Eterm ereplaced;
+ Eterm mpb;
+
+
+#define RET_TO_BIF(Term,RetVal) do { \
+ if (mpi.mp != NULL) { \
+ erts_bin_free(mpi.mp); \
+ } \
+ *ret = (Term); \
+ return RetVal; \
+ } while(0)
+
+ mpi.mp = NULL;
+
+ sc.lastobj = NULL;
+ sc.p = p;
+ sc.tb = tb;
+ sc.max = 1000;
+ sc.end_condition = NIL;
+ sc.keypos = tb->common.keypos;
+ sc.replaced = 0;
+
+ if ((errcode = analyze_pattern(tb, pattern, db_match_keeps_key, &mpi)) != DB_ERROR_NONE) {
+ RET_TO_BIF(NIL,errcode);
+ }
+
+ if (!mpi.something_can_match) {
+ RET_TO_BIF(make_small(0),DB_ERROR_NONE);
+ /* can't possibly match anything */
+ }
+
+ sc.mp = mpi.mp;
+ sc.all_objects = mpi.all_objects;
+
+ stack = get_static_stack(tb);
+ if (!mpi.got_partial && mpi.some_limitation &&
+ CMP_EQ(mpi.least,mpi.most)) {
+ TreeDbTerm* term = *(mpi.save_term);
+ doit_select_replace(tb,mpi.save_term,&sc,0 /* dummy */);
+ if (stack != NULL) {
+ if (TOP_NODE(stack) == term)
+ // throw away potentially invalid reference
+ REPLACE_TOP_NODE(stack, *(mpi.save_term));
+ release_stack(tb, stack);
+ }
+ RET_TO_BIF(erts_make_integer(sc.replaced,p),DB_ERROR_NONE);
+ }
+
+ if (stack == NULL)
+ stack = get_any_stack(tb);
+
+ if (mpi.some_limitation) {
+ if ((this = find_next_from_pb_key(tb, stack, mpi.most)) != NULL) {
+ lastkey = GETKEY(tb, this->dbterm.tpl);
+ }
+ sc.end_condition = mpi.least;
+ }
+
+ traverse_update_backwards(tb, stack, lastkey, &doit_select_replace, &sc);
+ release_stack(tb,stack);
+ // the more objects we've replaced, the more reductions we've consumed
+ BUMP_REDS(p, MIN(2000, (1000 - sc.max) + sc.replaced));
+ if (sc.max > 0) {
+ RET_TO_BIF(erts_make_integer(sc.replaced,p),DB_ERROR_NONE);
+ }
+
+ key = GETKEY(tb, sc.lastobj);
+ sz = size_object(key);
+ if (IS_USMALL(0, sc.replaced)) {
+ hp = HAlloc(p, sz + ERTS_MAGIC_REF_THING_SIZE + 6);
+ ereplaced = make_small(sc.replaced);
+ }
+ else {
+ hp = HAlloc(p, BIG_UINT_HEAP_SIZE + sz + ERTS_MAGIC_REF_THING_SIZE + 6);
+ ereplaced = uint_to_big(sc.replaced, hp);
+ hp += BIG_UINT_HEAP_SIZE;
+ }
+ key = copy_struct(key, sz, &hp, &MSO(p));
+ if (mpi.all_objects)
+ (mpi.mp)->intern.flags |= BIN_FLAG_ALL_OBJECTS;
+ mpb = erts_db_make_match_prog_ref(p,mpi.mp,&hp);
+
+ continuation = TUPLE5
+ (hp,
+ tid,
+ key,
+ sc.end_condition, /* From the match program, needn't be copied */
+ mpb,
+ ereplaced);
+
+ /* Don't free mpi.mp, so don't use macro */
+ *ret = bif_trap1(&ets_select_replace_continue_exp, p, continuation);
+ return DB_ERROR_NONE;
+
+#undef RET_TO_BIF
+
+}
+
+static int db_take_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
+{
+ DbTableTree *tb = &tbl->tree;
+ TreeDbTerm *this;
+
+ *ret = NIL;
+ this = linkout_tree(tb, key);
+ if (this) {
+ Eterm copy, *hp, *hend;
+
+ hp = HAlloc(p, this->dbterm.size + 2);
+ hend = hp + this->dbterm.size + 2;
+ copy = db_copy_object_from_ets(&tb->common,
+ &this->dbterm, &hp, &MSO(p));
+ *ret = CONS(hp, copy, NIL);
+ hp += 2;
+ HRelease(p, hend, hp);
+ free_term(tb, this);
+ }
+ return DB_ERROR_NONE;
+}
+
/*
** Other interface routines (not directly coupled to one bif)
*/
/* Display tree contents (for dump) */
-static void db_print_tree(int to, void *to_arg,
+static void db_print_tree(fmtfn_t to, void *to_arg,
int show,
DbTable *tbl)
{
@@ -1749,23 +1997,22 @@ static void db_print_tree(int to, void *to_arg,
/* release all memory occupied by a single table */
static int db_free_table_tree(DbTable *tbl)
{
- while (!db_free_table_continue_tree(tbl))
+ while (db_free_table_continue_tree(tbl, ERTS_SWORD_MAX) < 0)
;
return 1;
}
-static int db_free_table_continue_tree(DbTable *tbl)
+static SWord db_free_table_continue_tree(DbTable *tbl, SWord reds)
{
DbTableTree *tb = &tbl->tree;
- int result;
if (!tb->deletion) {
tb->static_stack.pos = 0;
tb->deletion = 1;
PUSH_NODE(&tb->static_stack, tb->root);
}
- result = do_free_tree_cont(tb, DELETE_RECORD_LIMIT);
- if (result) { /* Completely done. */
+ reds = do_free_tree_continue(tb, reds);
+ if (reds >= 0) { /* Completely done. */
erts_db_free(ERTS_ALC_T_DB_STK,
(DbTable *) tb,
(void *) tb->static_stack.array,
@@ -1773,7 +2020,7 @@ static int db_free_table_continue_tree(DbTable *tbl)
ASSERT(erts_smp_atomic_read_nob(&tb->common.memory_size)
== sizeof(DbTable));
}
- return result;
+ return reds;
}
static int db_delete_all_objects_tree(Process* p, DbTable* tbl)
@@ -1817,9 +2064,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];
@@ -1841,7 +2086,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);
@@ -1905,7 +2150,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);
@@ -1948,8 +2193,9 @@ static TreeDbTerm *linkout_object_tree(DbTableTree *tb,
** For the select functions, analyzes the pattern and determines which
** part of the tree should be searched. Also compiles the match program
*/
-static int analyze_pattern(DbTableTree *tb, Eterm pattern,
- struct mp_info *mpi)
+static int analyze_pattern(DbTableTree *tb, Eterm pattern,
+ extra_match_validator_t extra_validator, /* Optional callback */
+ struct mp_info *mpi)
{
Eterm lst, tpl, ttpl;
Eterm *matches,*guards, *bodies;
@@ -1987,7 +2233,10 @@ static int analyze_pattern(DbTableTree *tb, Eterm pattern,
i = 0;
for(lst = pattern; is_list(lst); lst = CDR(list_val(lst))) {
- Eterm body;
+ Eterm match;
+ Eterm guard;
+ Eterm body;
+
ttpl = CAR(list_val(lst));
if (!is_tuple(ttpl)) {
if (buff != sbuff) {
@@ -2002,9 +2251,17 @@ static int analyze_pattern(DbTableTree *tb, Eterm pattern,
}
return DB_ERROR_BADPARAM;
}
- matches[i] = tpl = ptpl[1];
- guards[i] = ptpl[2];
+ matches[i] = match = tpl = ptpl[1];
+ guards[i] = guard = ptpl[2];
bodies[i] = body = ptpl[3];
+
+ if(extra_validator != NULL && !extra_validator(tb->common.keypos, match, guard, body)) {
+ if (buff != sbuff) {
+ erts_free(ERTS_ALC_T_DB_TMP, buff);
+ }
+ return DB_ERROR_BADPARAM;
+ }
+
if (!is_list(body) || CDR(list_val(body)) != NIL ||
CAR(list_val(body)) != am_DollarUnderscore) {
mpi->all_objects = 0;
@@ -2012,7 +2269,7 @@ static int analyze_pattern(DbTableTree *tb, Eterm pattern,
++i;
partly_bound = NIL;
- res = key_given(tb, tpl, &mpi->save_term, &partly_bound);
+ res = key_given(tb, tpl, &(mpi->save_term), &partly_bound);
if ( res >= 0 ) { /* Can match something */
key = 0;
mpi->something_can_match = 1;
@@ -2058,7 +2315,7 @@ static int analyze_pattern(DbTableTree *tb, Eterm pattern,
return DB_ERROR_NONE;
}
-static int do_free_tree_cont(DbTableTree *tb, int num_left)
+static SWord do_free_tree_continue(DbTableTree *tb, SWord reds)
{
TreeDbTerm *root;
TreeDbTerm *p;
@@ -2077,15 +2334,14 @@ static int do_free_tree_cont(DbTableTree *tb, int num_left)
root = p;
} else {
free_term(tb, root);
- if (--num_left > 0) {
- break;
- } else {
- return 0; /* Done enough for now */
- }
+ if (--reds < 0) {
+ return reds; /* Done enough for now */
+ }
+ break;
}
}
}
- return 1;
+ return reds;
}
/*
@@ -2291,15 +2547,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;
}
@@ -2309,7 +2563,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 */
@@ -2349,15 +2603,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;
}
@@ -2367,7 +2619,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 */
@@ -2420,8 +2672,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);
@@ -2454,8 +2705,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);
@@ -2486,10 +2736,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
@@ -2511,7 +2761,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
@@ -2522,33 +2772,115 @@ static TreeDbTerm **find_node2(DbTableTree *tb, Eterm key)
return this;
}
-static int db_lookup_dbterm_tree(DbTable *tbl, Eterm key, DbUpdateHandle* handle)
+/*
+ * Find node and return the address of the node pointer (NULL if not found)
+ * Tries to reuse the existing stack for performance.
+ */
+
+static TreeDbTerm **find_ptr(DbTableTree *tb, DbTreeStack *stack, TreeDbTerm *this) {
+ Eterm key = GETKEY(tb, this->dbterm.tpl);
+ TreeDbTerm *tmp;
+ TreeDbTerm *parent;
+ Sint c;
+
+ if(( tmp = TOP_NODE(stack)) != NULL) {
+ if (!cmp_key_eq(tb,key,tmp)) {
+ /* Start from the beginning */
+ stack->pos = stack->slot = 0;
+ }
+ }
+ if (EMPTY_NODE(stack)) { /* Have to rebuild the stack */
+ if (( tmp = tb->root ) == NULL)
+ return NULL;
+ for (;;) {
+ PUSH_NODE(stack, tmp);
+ if (( c = cmp_key(tb,key,tmp) ) < 0) {
+ if (tmp->left == NULL) /* We are at the next
+ and the element does
+ not exist */
+ break;
+ else
+ tmp = tmp->left;
+ } else if (c > 0) {
+ if (tmp->right == NULL) /* Done */
+ return NULL;
+ else
+ tmp = tmp->right;
+ } else
+ break;
+ }
+ }
+
+ if (TOP_NODE(stack) != this)
+ return NULL;
+
+ parent = TOPN_NODE(stack, 1);
+ if (parent == NULL)
+ return ((this != tb->root) ? NULL : &(tb->root));
+ if (parent->left == this)
+ return &(parent->left);
+ if (parent->right == this)
+ return &(parent->right);
+ return NULL;
+}
+
+static int
+db_lookup_dbterm_tree(Process *p, DbTable *tbl, Eterm key, Eterm obj,
+ DbUpdateHandle* handle)
{
DbTableTree *tb = &tbl->tree;
TreeDbTerm **pp = find_node2(tb, key);
-
- if (pp == NULL) return 0;
+ int flags = 0;
+
+ if (pp == NULL) {
+ if (obj == THE_NON_VALUE) {
+ return 0;
+ } else {
+ Eterm *objp = tuple_val(obj);
+ int arity = arityval(*objp);
+ Eterm *htop, *hend;
+
+ ASSERT(arity >= tb->common.keypos);
+ htop = HAlloc(p, arity + 1);
+ hend = htop + arity + 1;
+ sys_memcpy(htop, objp, sizeof(Eterm) * (arity + 1));
+ htop[tb->common.keypos] = key;
+ obj = make_tuple(htop);
+
+ if (db_put_tree(tbl, obj, 1) != DB_ERROR_NONE) {
+ return 0;
+ }
+
+ pp = find_node2(tb, key);
+ ASSERT(pp != NULL);
+ HRelease(p, hend, htop);
+ flags |= DB_NEW_OBJECT;
+ }
+ }
handle->tb = tbl;
handle->dbterm = &(*pp)->dbterm;
- handle->mustResize = 0;
+ handle->flags = flags;
handle->bp = (void**) pp;
handle->new_size = (*pp)->dbterm.size;
-#if HALFWORD_HEAP
- handle->abs_vec = NULL;
-#endif
return 1;
}
-static void db_finalize_dbterm_tree(DbUpdateHandle* handle)
+static void
+db_finalize_dbterm_tree(int cret, DbUpdateHandle *handle)
{
- if (handle->mustResize) {
- TreeDbTerm* oldp = (TreeDbTerm*) *handle->bp;
+ DbTable *tbl = handle->tb;
+ DbTableTree *tb = &tbl->tree;
+ TreeDbTerm *bp = (TreeDbTerm *) *handle->bp;
+ if (handle->flags & DB_NEW_OBJECT && cret != DB_ERROR_NONE) {
+ Eterm ret;
+ db_erase_tree(tbl, GETKEY(tb, bp->dbterm.tpl), &ret);
+ } else if (handle->flags & DB_MUST_RESIZE) {
db_finalize_resize(handle, offsetof(TreeDbTerm,dbterm));
- reset_static_stack(&handle->tb->tree);
+ reset_static_stack(tb);
- free_term(&handle->tb->tree, oldp);
+ free_term(tb, bp);
}
#ifdef DEBUG
handle->dbterm = 0;
@@ -2561,7 +2893,7 @@ static void db_finalize_dbterm_tree(DbUpdateHandle* handle)
*/
static void traverse_backwards(DbTableTree *tb,
DbTreeStack* stack,
- Eterm lastkey, Eterm* lk_base,
+ Eterm lastkey,
int (*doit)(DbTableTree *,
TreeDbTerm *,
void *,
@@ -2580,16 +2912,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;
}
@@ -2600,7 +2931,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 *,
@@ -2619,28 +2950,75 @@ 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;
}
}
/*
+ * Traverse the tree with an update callback function, used by db_select_replace
+ */
+static void traverse_update_backwards(DbTableTree *tb,
+ DbTreeStack* stack,
+ Eterm lastkey,
+ int (*doit)(DbTableTree*,
+ TreeDbTerm**,
+ void*,
+ int),
+ void* context)
+{
+ int res;
+ TreeDbTerm *this, *next, **this_ptr;
+
+ if (lastkey == THE_NON_VALUE) {
+ stack->pos = stack->slot = 0;
+ if (( this = tb->root ) == NULL) {
+ return;
+ }
+ while (this != NULL) {
+ PUSH_NODE(stack, this);
+ this = this->right;
+ }
+ this = TOP_NODE(stack);
+ this_ptr = find_ptr(tb, stack, this);
+ ASSERT(this_ptr != NULL);
+ res = (*doit)(tb, this_ptr, context, 0);
+ REPLACE_TOP_NODE(stack, *this_ptr);
+ next = find_prev(tb, stack, GETKEY(tb, (*this_ptr)->dbterm.tpl));
+ if (!res)
+ return;
+ } else {
+ next = find_prev(tb, stack, lastkey);
+ }
+
+ while ((this = next) != NULL) {
+ this_ptr = find_ptr(tb, stack, this);
+ ASSERT(this_ptr != NULL);
+ res = (*doit)(tb, this_ptr, context, 0);
+ REPLACE_TOP_NODE(stack, *this_ptr);
+ next = find_prev(tb, stack, GETKEY(tb, (*this_ptr)->dbterm.tpl));
+ if (!res)
+ return;
+ }
+}
+
+/*
* Returns 0 if not given 1 if given and -1 on no possible match
* if key is given; *ret is set to point to the object concerned.
*/
-static int key_given(DbTableTree *tb, Eterm pattern, TreeDbTerm **ret,
+static int key_given(DbTableTree *tb, Eterm pattern, TreeDbTerm ***ret,
Eterm *partly_bound)
{
- TreeDbTerm *this;
+ TreeDbTerm **this;
Eterm key;
ASSERT(ret != NULL);
@@ -2650,13 +3028,13 @@ static int key_given(DbTableTree *tb, Eterm pattern, TreeDbTerm **ret,
if (is_non_value(key))
return -1; /* can't possibly match anything */
if (!db_has_variable(key)) { /* Bound key */
- if (( this = find_node(tb, key) ) == NULL) {
+ if (( this = find_node2(tb, key) ) == NULL) {
return -1;
}
*ret = this;
return 1;
} else if (partly_bound != NULL && key != am_Underscore &&
- db_is_variable(key) < 0)
+ db_is_variable(key) < 0 && !db_has_map(key))
*partly_bound = key;
return 0;
@@ -2664,7 +3042,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;
@@ -2678,44 +3056,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;
}
@@ -2723,14 +3101,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)
@@ -2739,7 +3116,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;
}
@@ -2956,12 +3333,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,
@@ -2993,8 +3368,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,
@@ -3020,12 +3394,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;
}
@@ -3063,14 +3435,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;
}
@@ -3080,6 +3451,46 @@ static int doit_select_delete(DbTableTree *tb, TreeDbTerm *this, void *ptr,
return 1;
}
+static int doit_select_replace(DbTableTree *tb, TreeDbTerm **this, void *ptr,
+ int forward)
+{
+ struct select_replace_context *sc = (struct select_replace_context *) ptr;
+ Eterm ret;
+
+ sc->lastobj = (*this)->dbterm.tpl;
+
+ /* Always backwards traversing */
+ if (sc->end_condition != NIL &&
+ (cmp_partly_bound(sc->end_condition,
+ 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 (is_value(ret)) {
+ TreeDbTerm* new;
+ TreeDbTerm* old = *this;
+#ifdef DEBUG
+ Eterm key = db_getkey(tb->common.keypos, ret);
+ ASSERT(is_value(key));
+ ASSERT(cmp_key(tb, key, old) == 0);
+#endif
+ new = new_dbterm(tb, ret);
+ new->left = old->left;
+ new->right = old->right;
+ new->balance = old->balance;
+ sc->lastobj = new->dbterm.tpl;
+ *this = new;
+ free_term(tb, old);
+ ++(sc->replaced);
+ }
+ if (--(sc->max) <= 0) {
+ return 0;
+ }
+ return 1;
+}
+
#ifdef TREE_DEBUG
static void do_dump_tree2(DbTableTree* tb, int to, void *to_arg, int show,
TreeDbTerm *t, int offset)
@@ -3096,11 +3507,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);
}
@@ -3109,6 +3519,9 @@ static void do_dump_tree2(DbTableTree* tb, int to, void *to_arg, int show,
#ifdef HARDDEBUG
+/*
+ * No called, but kept as it might come to use
+ */
void db_check_table_tree(DbTable *tbl)
{
DbTableTree *tb = &tbl->tree;
diff --git a/erts/emulator/beam/erl_db_tree.h b/erts/emulator/beam/erl_db_tree.h
index 7bc235e135..72749ead1e 100644
--- a/erts/emulator/beam/erl_db_tree.h
+++ b/erts/emulator/beam/erl_db_tree.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1998-2009. All Rights Reserved.
+ * Copyright Ericsson AB 1998-2016. 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.
+ * 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%
*/
diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c
index 3927615e04..13eacaa8a9 100644
--- a/erts/emulator/beam/erl_db_util.c
+++ b/erts/emulator/beam/erl_db_util.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1998-2014. All Rights Reserved.
+ * Copyright Ericsson AB 1998-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -122,6 +123,9 @@ do { \
#define TermWords(t) (((t) / (sizeof(UWord)/sizeof(Eterm))) + !!((t) % (sizeof(UWord)/sizeof(Eterm))))
+#define add_dmc_err(EINFO, STR, VAR, TERM, SEV) \
+ vadd_dmc_err(EINFO, SEV, VAR, STR, TERM)
+
static ERTS_INLINE Process *
get_proc(Process *cp, Uint32 cp_locks, Eterm id, Uint32 id_locks)
@@ -134,21 +138,22 @@ get_proc(Process *cp, Uint32 cp_locks, Eterm id, Uint32 id_locks)
static Eterm
-set_tracee_flags(Process *tracee_p, Eterm tracer, Uint d_flags, Uint e_flags) {
+set_tracee_flags(Process *tracee_p, ErtsTracer tracer,
+ Uint d_flags, Uint e_flags) {
Eterm ret;
Uint flags;
- if (tracer == NIL) {
+ if (ERTS_TRACER_IS_NIL(tracer)) {
flags = ERTS_TRACE_FLAGS(tracee_p) & ~TRACEE_FLAGS;
} else {
flags = ((ERTS_TRACE_FLAGS(tracee_p) & ~d_flags) | e_flags);
- if (! flags) tracer = NIL;
+ if (! flags) tracer = erts_tracer_nil;
}
- ret = ((ERTS_TRACER_PROC(tracee_p) != tracer
+ ret = ((!ERTS_TRACER_COMPARE(ERTS_TRACER(tracee_p),tracer)
|| ERTS_TRACE_FLAGS(tracee_p) != flags)
? am_true
: am_false);
- ERTS_TRACER_PROC(tracee_p) = tracer;
+ erts_tracer_replace(&tracee_p->common, tracer);
ERTS_TRACE_FLAGS(tracee_p) = flags;
return ret;
}
@@ -162,46 +167,18 @@ set_tracee_flags(Process *tracee_p, Eterm tracer, Uint d_flags, Uint e_flags) {
** returns fail_term on failure. Fails if tracer pid or port is invalid.
*/
static Eterm
-set_match_trace(Process *tracee_p, Eterm fail_term, Eterm tracer,
+set_match_trace(Process *tracee_p, Eterm fail_term, ErtsTracer tracer,
Uint d_flags, Uint e_flags) {
- Eterm ret = fail_term;
- Process *tracer_p;
-
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCKS_ALL ==
- erts_proc_lc_my_proc_locks(tracee_p));
-
- if (is_internal_pid(tracer)
- && (tracer_p =
- erts_pid2proc(tracee_p, ERTS_PROC_LOCKS_ALL,
- tracer, ERTS_PROC_LOCKS_ALL))) {
- if (tracee_p != tracer_p) {
- ret = set_tracee_flags(tracee_p, tracer, d_flags, e_flags);
- ERTS_TRACE_FLAGS(tracer_p) |= (ERTS_TRACE_FLAGS(tracee_p)
- ? F_TRACER
- : 0);
- erts_smp_proc_unlock(tracer_p, ERTS_PROC_LOCKS_ALL);
- }
- } else if (is_internal_port(tracer)) {
- Port *tracer_port =
- erts_id2port_sflgs(tracer,
- tracee_p,
- ERTS_PROC_LOCKS_ALL,
- ERTS_PORT_SFLGS_INVALID_TRACER_LOOKUP);
- if (tracer_port) {
- ret = set_tracee_flags(tracee_p, tracer, d_flags, e_flags);
- erts_port_release(tracer_port);
- }
- } else {
- ASSERT(is_nil(tracer));
- ret = set_tracee_flags(tracee_p, tracer, d_flags, e_flags);
- }
- return ret;
-}
+ ERTS_SMP_LC_ASSERT(
+ ERTS_PROC_LOCKS_ALL == erts_proc_lc_my_proc_locks(tracee_p)
+ || erts_thr_progress_is_blocking());
-/* Type checking... */
-
-#define BOXED_IS_TUPLE(Boxed) is_arity_value(*boxed_val((Boxed)))
+ if (ERTS_TRACER_IS_NIL(tracer)
+ || erts_is_tracer_enabled(tracer, &tracee_p->common))
+ return set_tracee_flags(tracee_p, tracer, d_flags, e_flags);
+ return fail_term;
+}
/*
**
@@ -218,7 +195,9 @@ typedef enum {
matchTuple,
matchPushT,
matchPushL,
+ matchPushM,
matchPop,
+ matchSwap,
matchBind,
matchCmp,
matchEqBin,
@@ -227,21 +206,21 @@ typedef enum {
matchEqRef,
matchEq,
matchList,
+ matchMap,
+ matchKey,
matchSkip,
matchPushC,
matchConsA, /* Car is below Cdr */
matchConsB, /* Cdr is below Car (unusual) */
matchMkTuple,
+ matchMkFlatMap,
+ matchMkHashMap,
matchCall0,
matchCall1,
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) */
@@ -308,9 +287,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 {
@@ -372,7 +348,6 @@ typedef struct MatchVariable {
Eterm term;
#ifdef DEBUG
Process* proc;
- Eterm* base;
#endif
} MatchVariable;
@@ -413,7 +388,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;
@@ -440,17 +415,27 @@ get_match_pseudo_process(Process *c_p, Uint heap_size)
{
ErtsMatchPseudoProcess *mpsp;
#ifdef ERTS_SMP
- mpsp = (ErtsMatchPseudoProcess *) c_p->scheduler_data->match_pseudo_process;
- if (mpsp)
+ ErtsSchedulerData *esdp;
+
+ esdp = c_p ? c_p->scheduler_data : erts_get_scheduler_data();
+
+ mpsp = esdp ? esdp->match_pseudo_process :
+ (ErtsMatchPseudoProcess*) erts_smp_tsd_get(match_pseudo_process_key);
+
+ if (mpsp) {
+ ASSERT(mpsp == erts_smp_tsd_get(match_pseudo_process_key));
+ ASSERT(mpsp->process.scheduler_data == esdp);
cleanup_match_pseudo_process(mpsp, 0);
+ }
else {
ASSERT(erts_smp_tsd_get(match_pseudo_process_key) == NULL);
mpsp = create_match_pseudo_process();
- c_p->scheduler_data->match_pseudo_process = (void *) mpsp;
+ if (esdp) {
+ esdp->match_pseudo_process = (void *) mpsp;
+ }
+ mpsp->process.scheduler_data = esdp;
erts_smp_tsd_set(match_pseudo_process_key, (void *) mpsp);
}
- ASSERT(mpsp == erts_smp_tsd_get(match_pseudo_process_key));
- mpsp->process.scheduler_data = c_p->scheduler_data;
#else
mpsp = match_pseudo_process;
cleanup_match_pseudo_process(mpsp, 0);
@@ -856,6 +841,13 @@ static int match_compact(ErlHeapFragment *expr, DMCErrInfo *err_info);
static Uint my_size_object(Eterm t);
static Eterm my_copy_struct(Eterm t, Eterm **hp, ErlOffHeap* off_heap);
+/* Guard subroutines */
+static void
+dmc_rearrange_constants(DMCContext *context, DMC_STACK_TYPE(UWord) *text,
+ int textpos, Eterm *p, Uint nelems);
+static DMCRet
+dmc_array(DMCContext *context, DMCHeap *heap, DMC_STACK_TYPE(UWord) *text,
+ Eterm *p, Uint nelems, int *constant);
/* Guard compilation */
static void do_emit_constant(DMCContext *context, DMC_STACK_TYPE(UWord) *text,
Eterm t);
@@ -869,6 +861,9 @@ static DMCRet dmc_tuple(DMCContext *context,
DMC_STACK_TYPE(UWord) *text,
Eterm t,
int *constant);
+static DMCRet
+dmc_map(DMCContext *context, DMCHeap *heap, DMC_STACK_TYPE(UWord) *text,
+ Eterm t, int *constant);
static DMCRet dmc_variable(DMCContext *context,
DMCHeap *heap,
DMC_STACK_TYPE(UWord) *text,
@@ -888,12 +883,14 @@ static DMCRet compile_guard_expr(DMCContext *context,
DMCHeap *heap,
DMC_STACK_TYPE(UWord) *text,
Eterm t);
-/* match expression subroutine */
+/* match expression subroutines */
static DMCRet dmc_one_term(DMCContext *context,
DMCHeap *heap,
DMC_STACK_TYPE(Eterm) *stack,
DMC_STACK_TYPE(UWord) *text,
Eterm c);
+static Eterm
+dmc_private_copy(DMCContext *context, Eterm c);
#ifdef DMC_DEBUG
@@ -906,11 +903,7 @@ void db_match_dis(Binary *prog);
#define TRACE /* Nothing */
#define FENCE_PATTERN_SIZE 0
#endif
-static void add_dmc_err(DMCErrInfo *err_info,
- char *str,
- int variable,
- Eterm term,
- DMCErrorSeverity severity);
+static void vadd_dmc_err(DMCErrInfo*, DMCErrorSeverity, int var, const char *str, ...);
static Eterm dpm_array_to_list(Process *psp, Eterm *arr, int arity);
@@ -1006,12 +999,20 @@ Eterm erts_match_set_get_source(Binary *mpsp)
}
/* This one is for the tracing */
-Binary *erts_match_set_compile(Process *p, Eterm matchexpr) {
+Binary *erts_match_set_compile(Process *p, Eterm matchexpr, Eterm MFA) {
Binary *bin;
Uint sz;
Eterm *hp;
+ Uint flags;
+
+ switch (MFA) {
+ case am_receive: flags = DCOMP_TRACE; break;
+ case am_send: flags = DCOMP_TRACE | DCOMP_ALLOW_TRACE_OPS; break;
+ default:
+ flags = DCOMP_TRACE | DCOMP_CALL_TRACE | DCOMP_ALLOW_TRACE_OPS;
+ }
- bin = db_match_set_compile(p, matchexpr, DCOMP_TRACE);
+ bin = db_match_set_compile(p, matchexpr, flags);
if (bin != NULL) {
MatchProg *prog = Binary2MatchProg(bin);
sz = size_object(matchexpr);
@@ -1118,9 +1119,186 @@ error:
return NULL;
}
-/* This is used when tracing */
-Eterm erts_match_set_lint(Process *p, Eterm matchexpr) {
- return db_match_set_lint(p, matchexpr, DCOMP_TRACE);
+/*
+ * Compare a matching term 'a' with a constructing term 'b' for equality.
+ *
+ * Returns true if 'b' is guaranteed to always construct
+ * the same term as 'a' has matched.
+ */
+static int db_match_eq_body(Eterm a, Eterm b, int const_mode)
+{
+ DECLARE_ESTACK(s);
+ Uint arity;
+ Eterm *ap, *bp;
+ const Eterm CONST_MODE_OFF = THE_NON_VALUE;
+
+ while (1) {
+ switch(b & _TAG_PRIMARY_MASK) {
+ case TAG_PRIMARY_LIST:
+ if (!is_list(a))
+ return 0;
+ ESTACK_PUSH2(s, CDR(list_val(a)), CDR(list_val(b)));
+ a = CAR(list_val(a));
+ b = CAR(list_val(b));
+ continue; /* loop without pop */
+
+ case TAG_PRIMARY_BOXED:
+ if (is_tuple(b)) {
+ bp = tuple_val(b);
+ if (!const_mode) {
+ if (bp[0] == make_arityval(1) && is_tuple(bp[1])) {
+ b = bp[1]; /* double-tuple syntax */
+ }
+ else if (bp[0] == make_arityval(2) && bp[1] == am_const) {
+ ESTACK_PUSH(s, CONST_MODE_OFF);
+ const_mode = 1; /* {const, term()} syntax */
+ b = bp[2];
+ continue; /* loop without pop */
+ }
+ else
+ return 0; /* function call or invalid tuple syntax */
+ }
+ if (!is_tuple(a))
+ return 0;
+
+ ap = tuple_val(a);
+ bp = tuple_val(b);
+ if (ap[0] != bp[0])
+ return 0;
+ arity = arityval(ap[0]);
+ if (arity > 0) {
+ a = *(++ap);
+ b = *(++bp);
+ while(--arity) {
+ ESTACK_PUSH2(s, *(++ap), *(++bp));
+ }
+ continue; /* loop without pop */
+ }
+ }
+ else if (is_map(b)) {
+ /* We don't know what other pairs the matched map may contain */
+ return 0;
+ }
+ else if (!eq(a,b)) /* other boxed */
+ return 0;
+ break;
+
+ case TAG_PRIMARY_IMMED1:
+ if (a != b || a == am_Underscore || a == am_DollarDollar
+ || a == am_DollarUnderscore
+ || (const_mode && db_is_variable(a) >= 0)) {
+
+ return 0;
+ }
+ break;
+ default:
+ erts_exit(ERTS_ABORT_EXIT, "db_compare: "
+ "Bad object on ESTACK: 0x%bex\n", b);
+ }
+
+pop_next:
+ if (ESTACK_ISEMPTY(s))
+ break; /* done */
+
+ b = ESTACK_POP(s);
+ if (b == CONST_MODE_OFF) {
+ ASSERT(const_mode);
+ const_mode = 0;
+ goto pop_next;
+ }
+ a = ESTACK_POP(s);
+ }
+
+ DESTROY_ESTACK(s);
+ return 1;
+}
+
+/* This is used by select_replace */
+int db_match_keeps_key(int keypos, Eterm match, Eterm guard, Eterm body)
+{
+ Eterm match_key;
+ Eterm* body_list;
+ Eterm single_body_term;
+ Eterm* single_body_term_tpl;
+ Eterm single_body_subterm;
+ Eterm single_body_subterm_key;
+ Eterm* single_body_subterm_key_tpl;
+ int const_mode;
+
+ if (!is_list(body)) {
+ return 0;
+ }
+
+ body_list = list_val(body);
+ if (CDR(body_list) != NIL) {
+ return 0;
+ }
+
+ single_body_term = CAR(body_list);
+ if (single_body_term == am_DollarUnderscore) {
+ /* same tuple is returned */
+ return 1;
+ }
+
+ if (!is_tuple(single_body_term)) {
+ return 0;
+ }
+
+ match_key = db_getkey(keypos, match);
+ if (!is_value(match_key)) {
+ // can't get key out of match
+ return 0;
+ }
+
+ single_body_term_tpl = tuple_val(single_body_term);
+ if (single_body_term_tpl[0] == make_arityval(2) &&
+ single_body_term_tpl[1] == am_const) {
+ /* {const, {"ets-tuple constant"}} */
+ single_body_subterm = single_body_term_tpl[2];
+ const_mode = 1;
+ }
+ else if (*single_body_term_tpl == make_arityval(1)) {
+ /* {{"ets-tuple construction"}} */
+ single_body_subterm = single_body_term_tpl[1];
+ const_mode = 0;
+ }
+ else {
+ /* not a tuple construction */
+ return 0;
+ }
+
+ single_body_subterm_key = db_getkey(keypos, single_body_subterm);
+ if (!is_value(single_body_subterm_key)) {
+ // can't get key out of single body subterm
+ return 0;
+ }
+
+ if (db_match_eq_body(match_key, single_body_subterm_key, const_mode)) {
+ /* tuple with same key is returned */
+ return 1;
+ }
+
+ if (const_mode) {
+ /* constant key did not match */
+ return 0;
+ }
+
+ if (!is_tuple(single_body_subterm_key)) {
+ /* can't possibly be an element instruction */
+ return 0;
+ }
+
+ single_body_subterm_key_tpl = tuple_val(single_body_subterm_key);
+ if (single_body_subterm_key_tpl[0] == make_arityval(3) &&
+ single_body_subterm_key_tpl[1] == am_element &&
+ single_body_subterm_key_tpl[3] == am_DollarUnderscore &&
+ single_body_subterm_key_tpl[2] == make_small(keypos))
+ {
+ /* {element, KeyPos, '$_'} */
+ return 1;
+ }
+
+ return 0;
}
Eterm db_match_set_lint(Process *p, Eterm matchexpr, Uint flags)
@@ -1141,8 +1319,8 @@ Eterm db_match_set_lint(Process *p, Eterm matchexpr, Uint flags)
int i;
if (!is_list(matchexpr)) {
- add_dmc_err(err_info, "Match programs are not in a list.",
- -1, 0UL, dmcError);
+ add_dmc_err(err_info, "Match programs are not in a list.",
+ -1, 0UL, dmcError);
goto done;
}
num_heads = 0;
@@ -1150,9 +1328,8 @@ Eterm db_match_set_lint(Process *p, Eterm matchexpr, Uint flags)
++num_heads;
if (l != NIL) { /* proper list... */
- add_dmc_err(err_info, "Match programs are not in a proper "
- "list.",
- -1, 0UL, dmcError);
+ add_dmc_err(err_info, "Match programs are not in a proper list.",
+ -1, 0UL, dmcError);
goto done;
}
@@ -1219,30 +1396,37 @@ done:
return ret;
}
-Eterm erts_match_set_run(Process *p, Binary *mpsp,
- Eterm *args, int num_args,
- enum erts_pam_run_flags in_flags,
- Uint32 *return_flags)
+/* Returns
+ * am_false if no match or
+ * if {message,false} has been called,
+ * am_true if {message,_} has NOT been called or
+ * if {message,true} has been called,
+ * Msg if {message,Msg} has been called.
+ *
+ * If return value is_not_immed
+ * then erts_match_set_release_result_trace() must be called to release it.
+ */
+Eterm erts_match_set_run_trace(Process *c_p,
+ Process *self,
+ Binary *mpsp,
+ Eterm *args, int num_args,
+ enum erts_pam_run_flags in_flags,
+ Uint32 *return_flags)
{
Eterm ret;
- ret = db_prog_match(p, mpsp, NIL, NULL, args, num_args,
+ ret = db_prog_match(c_p, self, mpsp, NIL, args, num_args,
in_flags, return_flags);
-#if defined(HARDDEBUG)
- if (is_non_value(ret)) {
- erts_fprintf(stderr, "Failed\n");
- } else {
- erts_fprintf(stderr, "Returning : %T\n", ret);
+
+ ASSERT(!(is_non_value(ret) && *return_flags));
+
+ if (is_non_value(ret) || ret == am_false) {
+ erts_match_set_release_result(c_p);
+ return am_false;
}
-#endif
+ if (is_immed(ret))
+ erts_match_set_release_result(c_p);
return ret;
- /* Returns
- * THE_NON_VALUE if no match
- * am_false if {message,false} has been called,
- * am_true if {message,_} has not been called or
- * if {message,true} has been called,
- * Msg if {message,Msg} has been called.
- */
}
static Eterm erts_match_set_run_ets(Process *p, Binary *mpsp,
@@ -1251,7 +1435,8 @@ 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, p,
+ mpsp, args, NULL, num_args,
ERTS_PAM_COPY_RESULT,
return_flags);
#if defined(HARDDEBUG)
@@ -1364,7 +1549,112 @@ restart:
for (;;) {
switch (t & _TAG_PRIMARY_MASK) {
case TAG_PRIMARY_BOXED:
- if (!BOXED_IS_TUPLE(t)) {
+ if (is_flatmap(t)) {
+ num_iters = flatmap_get_size(flatmap_val(t));
+ if (!structure_checked) {
+ DMC_PUSH(text, matchMap);
+ DMC_PUSH(text, num_iters);
+ }
+ structure_checked = 0;
+ for (i = 0; i < num_iters; ++i) {
+ Eterm key = flatmap_get_keys(flatmap_val(t))[i];
+ if (db_is_variable(key) >= 0) {
+ if (context.err_info) {
+ add_dmc_err(context.err_info,
+ "Variable found in map key.",
+ -1, 0UL, dmcError);
+ }
+ goto error;
+ } else if (key == am_Underscore) {
+ if (context.err_info) {
+ add_dmc_err(context.err_info,
+ "Underscore found in map key.",
+ -1, 0UL, dmcError);
+ }
+ goto error;
+ }
+ DMC_PUSH(text, matchKey);
+ DMC_PUSH(text, dmc_private_copy(&context, key));
+ {
+ int old_stack = ++(context.stack_used);
+ Eterm value = flatmap_get_values(flatmap_val(t))[i];
+ res = dmc_one_term(&context, &heap, &stack, &text,
+ value);
+ ASSERT(res != retFail);
+ if (res == retRestart) {
+ goto restart;
+ }
+ if (old_stack != context.stack_used) {
+ ASSERT(old_stack + 1 == context.stack_used);
+ DMC_PUSH(text, matchSwap);
+ }
+ if (context.stack_used > context.stack_need) {
+ context.stack_need = context.stack_used;
+ }
+ DMC_PUSH(text, matchPop);
+ --(context.stack_used);
+ }
+ }
+ break;
+ }
+ if (is_hashmap(t)) {
+ DECLARE_WSTACK(wstack);
+ Eterm *kv;
+ num_iters = hashmap_size(t);
+ if (!structure_checked) {
+ DMC_PUSH(text, matchMap);
+ DMC_PUSH(text, num_iters);
+ }
+ structure_checked = 0;
+
+ hashmap_iterator_init(&wstack, t, 0);
+
+ while ((kv=hashmap_iterator_next(&wstack)) != NULL) {
+ Eterm key = CAR(kv);
+ Eterm value = CDR(kv);
+ if (db_is_variable(key) >= 0) {
+ if (context.err_info) {
+ add_dmc_err(context.err_info,
+ "Variable found in map key.",
+ -1, 0UL, dmcError);
+ }
+ DESTROY_WSTACK(wstack);
+ goto error;
+ } else if (key == am_Underscore) {
+ if (context.err_info) {
+ add_dmc_err(context.err_info,
+ "Underscore found in map key.",
+ -1, 0UL, dmcError);
+ }
+ DESTROY_WSTACK(wstack);
+ goto error;
+ }
+ DMC_PUSH(text, matchKey);
+ DMC_PUSH(text, dmc_private_copy(&context, key));
+ {
+ int old_stack = ++(context.stack_used);
+ res = dmc_one_term(&context, &heap, &stack, &text,
+ value);
+ ASSERT(res != retFail);
+ if (res == retRestart) {
+ DESTROY_WSTACK(wstack);
+ goto restart;
+ }
+ if (old_stack != context.stack_used) {
+ ASSERT(old_stack + 1 == context.stack_used);
+ DMC_PUSH(text, matchSwap);
+ }
+ if (context.stack_used > context.stack_need) {
+ context.stack_need = context.stack_used;
+ }
+ DMC_PUSH(text, matchPop);
+ --(context.stack_used);
+ }
+ }
+ DESTROY_WSTACK(wstack);
+ break;
+ }
+ if (!is_tuple(t)) {
goto simple_term;
}
num_iters = arityval(*tuple_val(t));
@@ -1589,17 +1879,18 @@ error: /* Here is were we land when compilation failed. */
/*
** Free a match program (in a binary)
*/
-void erts_db_match_prog_destructor(Binary *bprog)
+int erts_db_match_prog_destructor(Binary *bprog)
{
MatchProg *prog;
if (bprog == NULL)
- return;
+ return 1;
prog = Binary2MatchProg(bprog);
if (prog->term_save != NULL) {
free_message_buffer(prog->term_save);
}
if (prog->saved_program_buf != NULL)
free_message_buffer(prog->saved_program_buf);
+ return 1;
}
void
@@ -1636,96 +1927,31 @@ 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.
** the parameter 'arity' is only used if 'term' is actually an array,
** i.e. 'DCOMP_TRACE' was specified
*/
-Eterm db_prog_match(Process *c_p, Binary *bprog,
- Eterm term, Eterm* base,
+Eterm db_prog_match(Process *c_p,
+ Process *self,
+ Binary *bprog,
+ Eterm term,
Eterm *termp,
int arity,
enum erts_pam_run_flags in_flags,
Uint32 *return_flags)
{
MatchProg *prog = Binary2MatchProg(bprog);
- Eterm *ep;
- Eterm *tp;
+ const Eterm *ep, *tp, **sp;
Eterm t;
- Eterm **sp;
Eterm *esp;
MatchVariable* variables;
- BeamInstr *cp;
- UWord *pc = prog->text;
+ ErtsCodeMFA *cp;
+ const UWord *pc = prog->text;
Eterm *ehp;
Eterm ret;
- Uint n = 0; /* To avoid warning. */
+ Uint n;
int i;
unsigned do_catch;
ErtsMatchPseudoProcess *mpsp;
@@ -1737,17 +1963,16 @@ Eterm db_prog_match(Process *c_p, Binary *bprog,
Eterm (*bif)(Process*, ...);
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);
+ ERTS_UNDEF(n,0);
+ ERTS_UNDEF(current_scheduled,NULL);
+
+ ASSERT(c_p || !(in_flags & ERTS_PAM_COPY_RESULT));
mpsp = get_match_pseudo_process(c_p, prog->heap_size);
psp = &mpsp->process;
@@ -1755,33 +1980,11 @@ Eterm db_prog_match(Process *c_p, Binary *bprog,
/* We need to lure the scheduler into believing in the pseudo process,
because of floating point exceptions. Do *after* mpsp is set!!! */
- esdp = ERTS_GET_SCHEDULER_DATA_FROM_PROC(c_p);
- ASSERT(esdp != NULL);
- current_scheduled = esdp->current_process;
+ esdp = erts_get_scheduler_data();
+ if (esdp)
+ current_scheduled = esdp->current_process;
/* SMP: psp->scheduler_data is set by get_match_pseudo_process */
- atomic_trace = 0;
-#define BEGIN_ATOMIC_TRACE(p) \
- do { \
- if (! atomic_trace) { \
- erts_refc_inc(&bprog->refc, 2); \
- erts_smp_proc_unlock((p), ERTS_PROC_LOCK_MAIN); \
- erts_smp_thr_progress_block(); \
- atomic_trace = !0; \
- } \
- } while (0)
-#define END_ATOMIC_TRACE(p) \
- do { \
- if (atomic_trace) { \
- erts_smp_thr_progress_unblock(); \
- erts_smp_proc_lock((p), ERTS_PROC_LOCK_MAIN); \
- if (erts_refc_dectest(&bprog->refc, 0) == 0) {\
- erts_bin_free(bprog); \
- } \
- atomic_trace = 0; \
- } \
- } while (0)
-
#ifdef DMC_DEBUG
save_op = 0;
heap_fence = (Eterm*)((char*) mpsp->u.heap + prog->stack_offset) - 1;
@@ -1799,29 +2002,24 @@ 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;
esp = (Eterm*)((char*)mpsp->u.heap + prog->stack_offset);
- sp = (Eterm **) esp;
+ sp = (const Eterm **)esp;
ret = am_true;
do_catch = 0;
fail_label = -1;
build_proc = psp;
- esdp->current_process = psp;
- ASSERT_HALFWORD(!c_p_checkpoint.p);
+ if (esdp)
+ esdp->current_process = psp;
#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
@@ -1829,11 +2027,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);
}
@@ -1857,9 +2055,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();
@@ -1867,9 +2065,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();
@@ -1879,46 +2077,94 @@ 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(*ep)) {
+ FAIL();
+ }
+ n = *pc++;
+ if (is_flatmap(*ep)) {
+ if (flatmap_get_size(flatmap_val(*ep)) < n) {
+ FAIL();
+ }
+ } else {
+ ASSERT(is_hashmap(*ep));
+ if (hashmap_size(*ep) < n) {
+ FAIL();
+ }
+ }
+ ep = flatmap_val(*ep);
+ break;
+ case matchPushM:
+ if (!is_map(*ep)) {
+ FAIL();
+ }
+ n = *pc++;
+ if (is_flatmap(*ep)) {
+ if (flatmap_get_size(flatmap_val(*ep)) < n) {
+ FAIL();
+ }
+ } else {
+ ASSERT(is_hashmap(*ep));
+ if (hashmap_size(*ep) < n) {
+ FAIL();
+ }
+ }
+ *sp++ = flatmap_val(*ep++);
+ break;
+ case matchKey:
+ t = (Eterm) *pc++;
+ tp = erts_maps_get(t, make_boxed(ep));
+ if (!tp) {
+ FAIL();
+ }
+ *sp++ = ep;
+ ep = tp;
+ break;
case matchPop:
ep = *(--sp);
break;
+ case matchSwap:
+ tp = sp[-1];
+ sp[-1] = sp[-2];
+ sp[-2] = tp;
+ break;
case matchBind:
n = *pc++;
variables[n].term = *ep++;
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);
@@ -1927,9 +2173,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)
@@ -1987,6 +2233,39 @@ restart:
}
*esp++ = t;
break;
+ case matchMkFlatMap:
+ n = *pc++;
+ ehp = HAllocX(build_proc, MAP_HEADER_FLATMAP_SZ + n, HEAP_XTRA);
+ t = *--esp;
+ {
+ flatmap_t *m = (flatmap_t *)ehp;
+ m->thing_word = MAP_HEADER_FLATMAP;
+ m->size = n;
+ m->keys = t;
+ }
+ t = make_flatmap(ehp);
+ ehp += MAP_HEADER_FLATMAP_SZ;
+ while (n--) {
+ *ehp++ = *--esp;
+ }
+ *esp++ = t;
+ break;
+ case matchMkHashMap:
+ n = *pc++;
+ esp -= 2*n;
+ ehp = HAllocX(build_proc, 2*n, HEAP_XTRA);
+ {
+ ErtsHeapFactory factory;
+ Uint ix;
+ for (ix = 0; ix < 2*n; ix++){
+ ehp[ix] = esp[ix];
+ }
+ erts_factory_proc_init(&factory, build_proc);
+ t = erts_hashmap_from_array(&factory, ehp, n, 0);
+ erts_factory_close(&factory);
+ }
+ *esp++ = t;
+ break;
case matchCall0:
bif = (Eterm (*)(Process*, ...)) *pc++;
t = (*bif)(build_proc, bif_args);
@@ -2038,70 +2317,43 @@ 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 {
- *esp = term;
+ *esp++ = term;
}
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);
@@ -2117,7 +2369,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:
@@ -2193,7 +2444,7 @@ restart:
pc += n;
break;
case matchSelf:
- *esp++ = c_p->common.id;
+ *esp++ = self->common.id;
break;
case matchWaste:
--esp;
@@ -2203,6 +2454,7 @@ restart:
break;
case matchProcessDump: {
erts_dsprintf_buf_t *dsbufp = erts_create_tmp_dsbuf(0);
+ ASSERT(c_p == self);
print_process_info(ERTS_PRINT_DSBUF, (void *) dsbufp, c_p);
*esp++ = new_binary(build_proc, (byte *)dsbufp->str,
dsbufp->str_len);
@@ -2221,18 +2473,16 @@ restart:
*return_flags |= MATCH_SET_EXCEPTION_TRACE;
*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
- )
+ case matchIsSeqTrace:
+ ASSERT(c_p == self);
+ if (have_seqtrace(SEQ_TRACE_TOKEN(c_p)))
*esp++ = am_true;
else
*esp++ = am_false;
break;
case matchSetSeqToken:
- t = erts_seq_trace(c_p, esp[-1], esp[-2], 0);
+ ASSERT(c_p == self);
+ t = erts_seq_trace(c_p, esp[-1], esp[-2], 0);
if (is_non_value(t)) {
esp[-2] = FAIL_TERM;
} else {
@@ -2240,7 +2490,8 @@ restart:
}
--esp;
break;
- case matchSetSeqTokenFake:
+ case matchSetSeqTokenFake:
+ ASSERT(c_p == self);
t = seq_trace_fake(c_p, esp[-1]);
if (is_non_value(t)) {
esp[-2] = FAIL_TERM;
@@ -2249,12 +2500,9 @@ 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
- )
+ case matchGetSeqToken:
+ ASSERT(c_p == self);
+ if (have_no_seqtrace(SEQ_TRACE_TOKEN(c_p)))
*esp++ = NIL;
else {
Eterm sender = SEQ_TRACE_TOKEN_SENDER(c_p);
@@ -2277,61 +2525,75 @@ restart:
ASSERT(is_immed(ehp[5]));
}
break;
- case matchEnableTrace:
+ case matchEnableTrace:
+ ASSERT(c_p == self);
if ( (n = erts_trace_flag2bit(esp[-1]))) {
- BEGIN_ATOMIC_TRACE(c_p);
- set_tracee_flags(c_p, ERTS_TRACER_PROC(c_p), 0, n);
+ erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
+ set_tracee_flags(c_p, ERTS_TRACER(c_p), 0, n);
+ erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
esp[-1] = am_true;
} else {
esp[-1] = FAIL_TERM;
}
break;
- case matchEnableTrace2:
+ case matchEnableTrace2:
+ ASSERT(c_p == self);
n = erts_trace_flag2bit((--esp)[-1]);
esp[-1] = FAIL_TERM;
if (n) {
- BEGIN_ATOMIC_TRACE(c_p);
- if ( (tmpp = get_proc(c_p, 0, esp[0], 0))) {
+ if ( (tmpp = get_proc(c_p, ERTS_PROC_LOCK_MAIN, esp[0], ERTS_PROC_LOCKS_ALL))) {
/* Always take over the tracer of the current process */
- set_tracee_flags(tmpp, ERTS_TRACER_PROC(c_p), 0, n);
- esp[-1] = am_true;
+ set_tracee_flags(tmpp, ERTS_TRACER(c_p), 0, n);
+ if (tmpp == c_p)
+ erts_smp_proc_unlock(tmpp, ERTS_PROC_LOCKS_ALL_MINOR);
+ else
+ erts_smp_proc_unlock(tmpp, ERTS_PROC_LOCKS_ALL);
+ esp[-1] = am_true;
}
}
break;
- case matchDisableTrace:
+ case matchDisableTrace:
+ ASSERT(c_p == self);
if ( (n = erts_trace_flag2bit(esp[-1]))) {
- BEGIN_ATOMIC_TRACE(c_p);
- set_tracee_flags(c_p, ERTS_TRACER_PROC(c_p), n, 0);
+ erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
+ set_tracee_flags(c_p, ERTS_TRACER(c_p), n, 0);
+ erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
esp[-1] = am_true;
} else {
esp[-1] = FAIL_TERM;
}
break;
- case matchDisableTrace2:
+ case matchDisableTrace2:
+ ASSERT(c_p == self);
n = erts_trace_flag2bit((--esp)[-1]);
esp[-1] = FAIL_TERM;
if (n) {
- BEGIN_ATOMIC_TRACE(c_p);
- if ( (tmpp = get_proc(c_p, 0, esp[0], 0))) {
+ if ( (tmpp = get_proc(c_p, ERTS_PROC_LOCK_MAIN, esp[0], ERTS_PROC_LOCKS_ALL))) {
/* Always take over the tracer of the current process */
- set_tracee_flags(tmpp, ERTS_TRACER_PROC(c_p), n, 0);
- esp[-1] = am_true;
+ set_tracee_flags(tmpp, ERTS_TRACER(c_p), n, 0);
+ if (tmpp == c_p)
+ erts_smp_proc_unlock(tmpp, ERTS_PROC_LOCKS_ALL_MINOR);
+ else
+ erts_smp_proc_unlock(tmpp, ERTS_PROC_LOCKS_ALL);
+ esp[-1] = am_true;
}
}
break;
- case matchCaller:
+ case matchCaller:
+ ASSERT(c_p == self);
if (!(c_p->cp) || !(cp = find_function_from_pc(c_p->cp))) {
*esp++ = am_undefined;
} else {
ehp = HAllocX(build_proc, 4, HEAP_XTRA);
*esp++ = make_tuple(ehp);
ehp[0] = make_arityval(3);
- ehp[1] = cp[0];
- ehp[2] = cp[1];
- ehp[3] = make_small((Uint) cp[2]);
+ ehp[1] = cp->module;
+ ehp[2] = cp->function;
+ ehp[3] = make_small((Uint) cp->arity);
}
break;
- case matchSilent:
+ case matchSilent:
+ ASSERT(c_p == self);
--esp;
if (in_flags & ERTS_PAM_IGNORE_TRACE_SILENT)
break;
@@ -2346,11 +2608,12 @@ restart:
erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
}
break;
- case matchTrace2:
+ case matchTrace2:
+ ASSERT(c_p == self);
{
/* disable enable */
Uint d_flags = 0, e_flags = 0; /* process trace flags */
- Eterm tracer = ERTS_TRACER_PROC(c_p);
+ ErtsTracer tracer = erts_tracer_nil;
/* XXX Atomicity note: Not fully atomic. Default tracer
* is sampled from current process but applied to
* tracee and tracer later after releasing main
@@ -2362,29 +2625,35 @@ restart:
* {trace,[],[{{tracer,Tracer}}]} is much, much older.
*/
int cputs = 0;
+ erts_tracer_update(&tracer, ERTS_TRACER(c_p));
if (! erts_trace_flags(esp[-1], &d_flags, &tracer, &cputs) ||
! erts_trace_flags(esp[-2], &e_flags, &tracer, &cputs) ||
cputs ) {
(--esp)[-1] = FAIL_TERM;
+ ERTS_TRACER_CLEAR(&tracer);
break;
}
erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
(--esp)[-1] = set_match_trace(c_p, FAIL_TERM, tracer,
d_flags, e_flags);
erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
+ ERTS_TRACER_CLEAR(&tracer);
}
break;
- case matchTrace3:
+ case matchTrace3:
+ ASSERT(c_p == self);
{
/* disable enable */
Uint d_flags = 0, e_flags = 0; /* process trace flags */
- Eterm tracer = ERTS_TRACER_PROC(c_p);
+ ErtsTracer tracer = erts_tracer_nil;
/* XXX Atomicity note. Not fully atomic. See above.
* Above it could possibly be solved, but not here.
*/
int cputs = 0;
Eterm tracee = (--esp)[0];
+
+ erts_tracer_update(&tracer, ERTS_TRACER(c_p));
if (! erts_trace_flags(esp[-1], &d_flags, &tracer, &cputs) ||
! erts_trace_flags(esp[-2], &e_flags, &tracer, &cputs) ||
@@ -2392,6 +2661,7 @@ restart:
! (tmpp = get_proc(c_p, ERTS_PROC_LOCK_MAIN,
tracee, ERTS_PROC_LOCKS_ALL))) {
(--esp)[-1] = FAIL_TERM;
+ ERTS_TRACER_CLEAR(&tracer);
break;
}
if (tmpp == c_p) {
@@ -2405,29 +2675,24 @@ restart:
erts_smp_proc_unlock(tmpp, ERTS_PROC_LOCKS_ALL);
erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
}
+ ERTS_TRACER_CLEAR(&tracer);
}
break;
case matchCatch: /* Match success, now build result */
do_catch = 1;
if (in_flags & ERTS_PAM_COPY_RESULT) {
build_proc = c_p;
- esdp->current_process = c_p;
+ if (esdp)
+ esdp->current_process = c_p;
}
break;
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
@@ -2441,36 +2706,25 @@ 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);
}
#endif
- esdp->current_process = current_scheduled;
-
- END_ATOMIC_TRACE(c_p);
+ if (esdp)
+ esdp->current_process = current_scheduled;
return ret;
#undef FAIL
#undef FAIL_TERM
-#undef BEGIN_ATOMIC_TRACE
-#undef END_ATOMIC_TRACE
}
-/*
- * Convert a match program to a "magic" binary to return up to erlang
- */
-Eterm db_make_mp_binary(Process *p, Binary *mp, Eterm **hpp)
-{
- return erts_mk_magic_binary_term(hpp, &MSO(p), mp);
-}
-
DMCErrInfo *db_new_dmc_err_info(void)
{
DMCErrInfo *ret = erts_alloc(ERTS_ALC_T_DB_DMC_ERR_INFO,
@@ -2590,21 +2844,14 @@ 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;
}
ASSERT(((DbTableCommon*)handle->tb)->compress);
- ASSERT(!handle->mustResize);
+ ASSERT(!(handle->flags & DB_MUST_RESIZE));
handle->dbterm = db_alloc_tmp_uncompressed(&handle->tb->common,
handle->dbterm);
- handle->mustResize = 1;
+ handle->flags |= DB_MUST_RESIZE;
return handle->dbterm->tpl[position];
}
@@ -2624,9 +2871,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;
@@ -2637,21 +2881,14 @@ void db_do_update_element(DbUpdateHandle* handle,
#endif
return;
}
- if (!handle->mustResize) {
+ if (!(handle->flags & DB_MUST_RESIZE)) {
if (handle->tb->common.compress) {
handle->dbterm = db_alloc_tmp_uncompressed(&handle->tb->common,
handle->dbterm);
- handle->mustResize = 1;
+ 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) {
@@ -2661,7 +2898,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:
@@ -2681,40 +2918,20 @@ 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;
/* write new value in old dbterm, finalize will make a flat copy */
handle->dbterm->tpl[position] = newval;
- handle->mustResize = 1;
-
-#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
+ handle->flags |= DB_MUST_RESIZE;
}
static ERTS_INLINE byte* db_realloc_term(DbTableCommon* tb, void* old,
@@ -2813,7 +3030,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) {
@@ -2832,7 +3049,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);
}
@@ -2879,7 +3096,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;
@@ -2962,29 +3179,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));
}
@@ -2996,27 +3192,34 @@ Eterm db_copy_from_comp(DbTableCommon* tb, DbTerm* bp, Eterm** hpp,
{
Eterm* hp = *hpp;
int i, arity = arityval(bp->tpl[0]);
+ ErtsHeapFactory factory;
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);
+
for (i=arity; i>0; i--) {
if (i != tb->keypos) {
if (is_immed(bp->tpl[i])) {
hp[i] = bp->tpl[i];
}
else {
- hp[i] = erts_decode_ext_ets(hpp, off_heap,
+ hp[i] = erts_decode_ext_ets(&factory,
elem2ext(bp->tpl, i));
}
}
}
+ *hpp = factory.hp;
+ erts_factory_close(&factory);
+
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);
}
@@ -3032,21 +3235,22 @@ Eterm db_copy_element_from_ets(DbTableCommon* tb, Process* p,
if (tb->compress && pos != tb->keypos) {
byte* ext = elem2ext(obj->tpl, pos);
Sint sz = erts_decode_ext_size_ets(ext, db_alloced_size_comp(obj)) + extra;
- Eterm* hp = HAlloc(p, sz);
- Eterm* endp = hp + sz;
- Eterm copy = erts_decode_ext_ets(&hp, &MSO(p), ext);
- *hpp = hp;
- hp += extra;
- HRelease(p, endp, hp);
+ Eterm copy;
+ ErtsHeapFactory factory;
+
+ erts_factory_proc_prealloc_init(&factory, p, sz);
+ copy = erts_decode_ext_ets(&factory, ext);
+ *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));
}
}
@@ -3069,16 +3273,18 @@ void db_cleanup_offheap_comp(DbTerm* obj)
}
switch (thing_subtag(u.hdr->thing_word)) {
case REFC_BINARY_SUBTAG:
- if (erts_refc_dectest(&u.pb->val->refc, 0) == 0) {
- erts_bin_free(u.pb->val);
- }
+ erts_bin_release(u.pb->val);
break;
case FUN_SUBTAG:
ASSERT(u.pb != &tmp);
- if (erts_refc_dectest(&u.fun->fe->refc, 0) == 0) {
+ if (erts_smp_refc_dectest(&u.fun->fe->refc, 0) == 0) {
erts_erase_fun_entry(u.fun->fe);
}
break;
+ case REF_SUBTAG:
+ ASSERT(is_magic_ref_thing(u.hdr));
+ erts_bin_release((Binary *)u.mref->mb);
+ break;
default:
ASSERT(is_external_header(u.hdr->thing_word));
ASSERT(u.pb != &tmp);
@@ -3151,49 +3357,89 @@ int db_is_variable(Eterm obj)
return N;
}
+/* check if node is (or contains) a map
+ * return 1 if node contains a map
+ * return 0 otherwise
+ */
+
+int db_has_map(Eterm node) {
+ DECLARE_ESTACK(s);
+
+ ESTACK_PUSH(s,node);
+ while (!ESTACK_ISEMPTY(s)) {
+ node = ESTACK_POP(s);
+ if (is_list(node)) {
+ while (is_list(node)) {
+ ESTACK_PUSH(s,CAR(list_val(node)));
+ node = CDR(list_val(node));
+ }
+ ESTACK_PUSH(s,node); /* Non wellformed list or [] */
+ } else if (is_tuple(node)) {
+ Eterm *tuple = tuple_val(node);
+ int arity = arityval(*tuple);
+ while(arity--) {
+ ESTACK_PUSH(s,*(++tuple));
+ }
+ } else if is_map(node) {
+ DESTROY_ESTACK(s);
+ return 1;
+ }
+ }
+ DESTROY_ESTACK(s);
+ return 0;
+}
/* check if obj is (or contains) a variable */
/* return 1 if obj contains a variable or underscore */
/* return 0 if obj is fully ground */
-int db_has_variable(Eterm obj)
-{
- switch(obj & _TAG_PRIMARY_MASK) {
- case TAG_PRIMARY_LIST: {
- while (is_list(obj)) {
- if (db_has_variable(CAR(list_val(obj))))
+int db_has_variable(Eterm node) {
+ DECLARE_ESTACK(s);
+
+ ESTACK_PUSH(s,node);
+ while (!ESTACK_ISEMPTY(s)) {
+ node = ESTACK_POP(s);
+ switch(node & _TAG_PRIMARY_MASK) {
+ case TAG_PRIMARY_LIST:
+ while (is_list(node)) {
+ ESTACK_PUSH(s,CAR(list_val(node)));
+ node = CDR(list_val(node));
+ }
+ ESTACK_PUSH(s,node); /* Non wellformed list or [] */
+ break;
+ case TAG_PRIMARY_BOXED:
+ if (is_tuple(node)) {
+ Eterm *tuple = tuple_val(node);
+ int arity = arityval(*tuple);
+ while(arity--) {
+ ESTACK_PUSH(s,*(++tuple));
+ }
+ } else if (is_flatmap(node)) {
+ Eterm *values = flatmap_get_values(flatmap_val(node));
+ Uint size = flatmap_get_size(flatmap_val(node));
+ ESTACK_PUSH(s, ((flatmap_t *) flatmap_val(node))->keys);
+ while (size--) {
+ ESTACK_PUSH(s, *(values++));
+ }
+ } else if (is_map(node)) { /* other map-nodes or map-heads */
+ Eterm *ptr = hashmap_val(node);
+ int i = hashmap_bitcount(MAP_HEADER_VAL(*ptr));
+ ptr += MAP_HEADER_ARITY(*ptr);
+ while(i--) { ESTACK_PUSH(s, *++ptr); }
+ }
+ break;
+ case TAG_PRIMARY_IMMED1:
+ if (node == am_Underscore || db_is_variable(node) >= 0) {
+ DESTROY_ESTACK(s);
return 1;
- obj = CDR(list_val(obj));
- }
- return(db_has_variable(obj)); /* Non wellformed list or [] */
- }
- case TAG_PRIMARY_BOXED:
- if (!BOXED_IS_TUPLE(obj)) {
- return 0;
- } else {
- Eterm *tuple = tuple_val(obj);
- int arity = arityval(*tuple++);
- while(arity--) {
- if (db_has_variable(*tuple))
- return 1;
- tuple++;
}
- return(0);
+ break;
}
- case TAG_PRIMARY_IMMED1:
- if (obj == am_Underscore || db_is_variable(obj) >= 0)
- return 1;
}
+ DESTROY_ESTACK(s);
return 0;
}
-int erts_db_is_compiled_ms(Eterm term)
-{
- return (is_binary(term)
- && (thing_subtag(*binary_val(term)) == REFC_BINARY_SUBTAG)
- && IsMatchProgBinary((((ProcBin *) binary_val(term))->val)));
-}
-
/*
** Local (static) utilities.
*/
@@ -3207,20 +3453,20 @@ int erts_db_is_compiled_ms(Eterm term)
** Utility to add an error
*/
-static void add_dmc_err(DMCErrInfo *err_info,
- char *str,
- int variable,
- Eterm term,
- DMCErrorSeverity severity)
+static void vadd_dmc_err(DMCErrInfo *err_info,
+ DMCErrorSeverity severity,
+ int variable,
+ const char *str,
+ ...)
{
+ DMCError *e;
+ va_list args;
+ va_start(args, str);
+
+
/* Linked in in reverse order, to ease the formatting */
- DMCError *e = erts_alloc(ERTS_ALC_T_DB_DMC_ERROR, sizeof(DMCError));
- if (term != 0UL) {
- erts_snprintf(e->error_string, DMC_ERR_STR_LEN, str, term);
- } else {
- strncpy(e->error_string, str, DMC_ERR_STR_LEN);
- e->error_string[DMC_ERR_STR_LEN] ='\0';
- }
+ e = erts_alloc(ERTS_ALC_T_DB_DMC_ERROR, sizeof(DMCError));
+ erts_vsnprintf(e->error_string, DMC_ERR_STR_LEN, str, args);
e->variable = variable;
e->severity = severity;
e->next = err_info->first;
@@ -3230,8 +3476,11 @@ static void add_dmc_err(DMCErrInfo *err_info,
err_info->first = e;
if (severity >= dmcError)
err_info->error_added = 1;
+
+ va_end(args);
}
+
/*
** Handle one term in the match expression (not the guard)
*/
@@ -3243,11 +3492,9 @@ static DMCRet dmc_one_term(DMCContext *context,
{
Sint n;
Eterm *hp;
- ErlHeapFragment *tmp_mb;
Uint sz, sz2, sz3;
Uint i, j;
-
switch (c & _TAG_PRIMARY_MASK) {
case TAG_PRIMARY_IMMED1:
if ((n = db_is_variable(c)) >= 0) { /* variable */
@@ -3334,30 +3581,24 @@ static DMCRet dmc_one_term(DMCContext *context,
DMC_PUSH(*text, n);
DMC_PUSH(*stack, c);
break;
+ case (_TAG_HEADER_MAP >> _TAG_PRIMARY_SIZE):
+ if (is_flatmap(c))
+ n = flatmap_get_size(flatmap_val(c));
+ else
+ n = hashmap_size(c);
+ DMC_PUSH(*text, matchPushM);
+ ++(context->stack_used);
+ DMC_PUSH(*text, n);
+ DMC_PUSH(*stack, c);
+ break;
case (_TAG_HEADER_REF >> _TAG_PRIMARY_SIZE):
{
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):
@@ -3366,77 +3607,51 @@ 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 */
- /*
- ** Make a private copy...
- */
- n = size_object(c);
- tmp_mb = new_message_buffer(n);
- hp = tmp_mb->mem;
DMC_PUSH(*text, matchEqBin);
- DMC_PUSH(*text, copy_struct(c, n, &hp, &(tmp_mb->off_heap)));
- tmp_mb->next = context->save;
- context->save = tmp_mb;
+ DMC_PUSH(*text, dmc_private_copy(context, c));
break;
}
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;
}
/*
+** Make a private copy of a term in a context.
+*/
+
+static Eterm
+dmc_private_copy(DMCContext *context, Eterm c)
+{
+ Uint n = size_object(c);
+ ErlHeapFragment *tmp_mb = new_message_buffer(n);
+ Eterm *hp = tmp_mb->mem;
+ Eterm copy = copy_struct(c, n, &hp, &(tmp_mb->off_heap));
+ tmp_mb->next = context->save;
+ context->save = tmp_mb;
+ return copy;
+}
+
+/*
** Match guard compilation
*/
@@ -3464,24 +3679,21 @@ static void do_emit_constant(DMCContext *context, DMC_STACK_TYPE(UWord) *text,
context->stack_need = context->stack_used;
}
-#define RETURN_ERROR_X(String, X, Y, ContextP, ConstantF) \
-do { \
-if ((ContextP)->err_info != NULL) { \
- (ConstantF) = 0; \
- add_dmc_err((ContextP)->err_info, String, X, Y, dmcError); \
- return retOk; \
-} else \
- return retFail; \
-} while(0)
+#define RETURN_ERROR_X(VAR, ContextP, ConstantF, String, ARG) \
+ (((ContextP)->err_info != NULL) \
+ ? ((ConstantF) = 0, \
+ vadd_dmc_err((ContextP)->err_info, dmcError, VAR, String, ARG), \
+ retOk) \
+ : retFail)
#define RETURN_ERROR(String, ContextP, ConstantF) \
- RETURN_ERROR_X(String, -1, 0UL, ContextP, ConstantF)
+ return RETURN_ERROR_X(-1, ContextP, ConstantF, String, 0)
#define RETURN_VAR_ERROR(String, N, ContextP, ConstantF) \
- RETURN_ERROR_X(String, N, 0UL, ContextP, ConstantF)
+ return RETURN_ERROR_X(N, ContextP, ConstantF, String, 0)
#define RETURN_TERM_ERROR(String, T, ContextP, ConstantF) \
- RETURN_ERROR_X(String, -1, T, ContextP, ConstantF)
+ return RETURN_ERROR_X(-1, ContextP, ConstantF, String, T)
#define WARNING(String, ContextP) \
add_dmc_err((ContextP)->err_info, String, -1, 0UL, dmcWarning)
@@ -3527,57 +3739,78 @@ static DMCRet dmc_list(DMCContext *context,
return retOk;
}
-static DMCRet dmc_tuple(DMCContext *context,
- DMCHeap *heap,
- DMC_STACK_TYPE(UWord) *text,
- Eterm t,
- int *constant)
+static void
+dmc_rearrange_constants(DMCContext *context, DMC_STACK_TYPE(UWord) *text,
+ int textpos, Eterm *p, Uint nelems)
{
DMC_STACK_TYPE(UWord) instr_save;
+ Uint i;
+
+ DMC_INIT_STACK(instr_save);
+ while (DMC_STACK_NUM(*text) > textpos) {
+ DMC_PUSH(instr_save, DMC_POP(*text));
+ }
+ for (i = nelems; i--;) {
+ do_emit_constant(context, text, p[i]);
+ }
+ while(!DMC_EMPTY(instr_save)) {
+ DMC_PUSH(*text, DMC_POP(instr_save));
+ }
+ DMC_FREE(instr_save);
+}
+
+static DMCRet
+dmc_array(DMCContext *context, DMCHeap *heap, DMC_STACK_TYPE(UWord) *text,
+ Eterm *p, Uint nelems, int *constant)
+{
int all_constant = 1;
int textpos = DMC_STACK_NUM(*text);
- Eterm *p = tuple_val(t);
- Uint nelems = arityval(*p);
Uint i;
- int c;
- DMCRet ret;
/*
- ** We remember where we started to layout code,
+ ** We remember where we started to layout code,
** assume all is constant and back up and restart if not so.
- ** The tuple should be laid out with the last element first,
- ** so we can memcpy the tuple to the eheap.
+ ** The array should be laid out with the last element first,
+ ** so we can memcpy it to the eheap.
*/
- for (i = nelems; i > 0; --i) {
- if ((ret = dmc_expr(context, heap, text, p[i], &c)) != retOk)
- return ret;
- if (!c && all_constant) {
- all_constant = 0;
- if (i < nelems) {
- Uint j;
+ for (i = nelems; i--;) {
+ DMCRet ret;
+ int c;
- /*
- * Oops, we need to relayout the constants.
- * Save the already laid out instructions.
- */
- DMC_INIT_STACK(instr_save);
- while (DMC_STACK_NUM(*text) > textpos)
- DMC_PUSH(instr_save, DMC_POP(*text));
- for (j = nelems; j > i; --j)
- do_emit_constant(context, text, p[j]);
- while(!DMC_EMPTY(instr_save))
- DMC_PUSH(*text, DMC_POP(instr_save));
- DMC_FREE(instr_save);
- }
- } else if (c && !all_constant) {
- /* push a constant */
- do_emit_constant(context, text, p[i]);
- }
+ ret = dmc_expr(context, heap, text, p[i], &c);
+ if (ret != retOk) {
+ return ret;
+ }
+ if (!c && all_constant) {
+ all_constant = 0;
+ if (i < nelems - 1) {
+ dmc_rearrange_constants(context, text, textpos,
+ p + i + 1, nelems - i - 1);
+ }
+ } else if (c && !all_constant) {
+ do_emit_constant(context, text, p[i]);
+ }
+ }
+ *constant = all_constant;
+ return retOk;
+}
+
+static DMCRet
+dmc_tuple(DMCContext *context, DMCHeap *heap, DMC_STACK_TYPE(UWord) *text,
+ Eterm t, int *constant)
+{
+ int all_constant;
+ Eterm *p = tuple_val(t);
+ Uint nelems = arityval(*p);
+ DMCRet ret;
+
+ ret = dmc_array(context, heap, text, p + 1, nelems, &all_constant);
+ if (ret != retOk) {
+ return ret;
}
-
if (all_constant) {
- *constant = 1;
- return retOk;
+ *constant = 1;
+ return retOk;
}
DMC_PUSH(*text, matchMkTuple);
DMC_PUSH(*text, nelems);
@@ -3586,6 +3819,93 @@ static DMCRet dmc_tuple(DMCContext *context,
return retOk;
}
+static DMCRet
+dmc_map(DMCContext *context, DMCHeap *heap, DMC_STACK_TYPE(UWord) *text,
+ Eterm t, int *constant)
+{
+ int nelems;
+ int constant_values;
+ DMCRet ret;
+ if (is_flatmap(t)) {
+ flatmap_t *m = (flatmap_t *)flatmap_val(t);
+ Eterm *values = flatmap_get_values(m);
+
+ nelems = flatmap_get_size(m);
+ ret = dmc_array(context, heap, text, values, nelems, &constant_values);
+
+ if (ret != retOk) {
+ return ret;
+ }
+ if (constant_values) {
+ *constant = 1;
+ return retOk;
+ }
+ DMC_PUSH(*text, matchPushC);
+ DMC_PUSH(*text, dmc_private_copy(context, m->keys));
+ if (++context->stack_used > context->stack_need) {
+ context->stack_need = context->stack_used;
+ }
+ DMC_PUSH(*text, matchMkFlatMap);
+ DMC_PUSH(*text, nelems);
+ context->stack_used -= nelems;
+ *constant = 0;
+ return retOk;
+ } else {
+ DECLARE_WSTACK(wstack);
+ Eterm *kv;
+ int c;
+
+ ASSERT(is_hashmap(t));
+
+ hashmap_iterator_init(&wstack, t, 1);
+ constant_values = 1;
+ nelems = hashmap_size(t);
+
+ while ((kv=hashmap_iterator_prev(&wstack)) != NULL) {
+ if ((ret = dmc_expr(context, heap, text, CDR(kv), &c)) != retOk) {
+ DESTROY_WSTACK(wstack);
+ return ret;
+ }
+ if (!c)
+ constant_values = 0;
+ }
+
+ if (constant_values) {
+ *constant = 1;
+ DESTROY_WSTACK(wstack);
+ return retOk;
+ }
+
+ *constant = 0;
+
+ hashmap_iterator_init(&wstack, t, 1);
+
+ while ((kv=hashmap_iterator_prev(&wstack)) != NULL) {
+ /* push key */
+ if ((ret = dmc_expr(context, heap, text, CAR(kv), &c)) != retOk) {
+ DESTROY_WSTACK(wstack);
+ return ret;
+ }
+ if (c) {
+ do_emit_constant(context, text, CAR(kv));
+ }
+ /* push value */
+ if ((ret = dmc_expr(context, heap, text, CDR(kv), &c)) != retOk) {
+ DESTROY_WSTACK(wstack);
+ return ret;
+ }
+ if (c) {
+ do_emit_constant(context, text, CDR(kv));
+ }
+ }
+ DMC_PUSH(*text, matchMkHashMap);
+ DMC_PUSH(*text, nelems);
+ context->stack_used -= nelems;
+ DESTROY_WSTACK(wstack);
+ return retOk;
+ }
+}
+
static DMCRet dmc_whole_expression(DMCContext *context,
DMCHeap *heap,
DMC_STACK_TYPE(UWord) *text,
@@ -3620,24 +3940,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;
}
@@ -3655,7 +3959,7 @@ static DMCRet dmc_variable(DMCContext *context,
Uint n = db_is_variable(t);
if (n >= heap->vars_used || !heap->vars[n].is_bound) {
- RETURN_VAR_ERROR("Variable $%d is unbound.", n, context, *constant);
+ RETURN_VAR_ERROR("Variable $%%d is unbound.", n, context, *constant);
}
dmc_add_pushv_variant(context, heap, text, n);
@@ -3987,7 +4291,30 @@ static DMCRet dmc_exception_trace(DMCContext *context,
return retOk;
}
-
+static int check_trace(const char* op,
+ DMCContext *context,
+ int *constant,
+ int need_cflags,
+ int allow_in_guard,
+ DMCRet* retp)
+{
+ if (!(context->cflags & DCOMP_TRACE)) {
+ *retp = RETURN_ERROR_X(-1, context, *constant, "Special form '%s' "
+ "used in wrong dialect.", op);
+ return 0;
+ }
+ if ((context->cflags & need_cflags) != need_cflags) {
+ *retp = RETURN_ERROR_X(-1, context, *constant, "Special form '%s' "
+ "not allow for this trace event.", op);
+ return 0;
+ }
+ if (context->is_guard && !allow_in_guard) {
+ *retp = RETURN_ERROR_X(-1, context, *constant, "Special form '%s' "
+ "called in guard context.", op);
+ return 0;
+ }
+ return 1;
+}
static DMCRet dmc_is_seq_trace(DMCContext *context,
DMCHeap *heap,
@@ -3997,12 +4324,11 @@ static DMCRet dmc_is_seq_trace(DMCContext *context,
{
Eterm *p = tuple_val(t);
Uint a = arityval(*p);
+ DMCRet ret;
- if (!(context->cflags & DCOMP_TRACE)) {
- RETURN_ERROR("Special form 'is_seq_trace' used in wrong dialect.",
- context,
- *constant);
- }
+ if (!check_trace("is_seq_trace", context, constant, DCOMP_ALLOW_TRACE_OPS, 1, &ret))
+ return ret;
+
if (a != 1) {
RETURN_TERM_ERROR("Special form 'is_seq_trace' called with "
"arguments in %T.", t, context, *constant);
@@ -4026,16 +4352,8 @@ static DMCRet dmc_set_seq_token(DMCContext *context,
DMCRet ret;
int c;
-
- if (!(context->cflags & DCOMP_TRACE)) {
- RETURN_ERROR("Special form 'set_seq_token' used in wrong dialect.",
- context,
- *constant);
- }
- if (context->is_guard) {
- RETURN_ERROR("Special form 'set_seq_token' called in "
- "guard context.", context, *constant);
- }
+ if (!check_trace("set_seq_trace", context, constant, DCOMP_ALLOW_TRACE_OPS, 0, &ret))
+ return ret;
if (a != 3) {
RETURN_TERM_ERROR("Special form 'set_seq_token' called with wrong "
@@ -4072,16 +4390,11 @@ static DMCRet dmc_get_seq_token(DMCContext *context,
{
Eterm *p = tuple_val(t);
Uint a = arityval(*p);
+ DMCRet ret;
+
+ if (!check_trace("get_seq_token", context, constant, DCOMP_ALLOW_TRACE_OPS, 0, &ret))
+ return ret;
- if (!(context->cflags & DCOMP_TRACE)) {
- RETURN_ERROR("Special form 'get_seq_token' used in wrong dialect.",
- context,
- *constant);
- }
- if (context->is_guard) {
- RETURN_ERROR("Special form 'get_seq_token' called in "
- "guard context.", context, *constant);
- }
if (a != 1) {
RETURN_TERM_ERROR("Special form 'get_seq_token' called with "
"arguments in %T.", t, context,
@@ -4145,16 +4458,10 @@ static DMCRet dmc_process_dump(DMCContext *context,
{
Eterm *p = tuple_val(t);
Uint a = arityval(*p);
-
- if (!(context->cflags & DCOMP_TRACE)) {
- RETURN_ERROR("Special form 'process_dump' used in wrong dialect.",
- context,
- *constant);
- }
- if (context->is_guard) {
- RETURN_ERROR("Special form 'process_dump' called in "
- "guard context.", context, *constant);
- }
+ DMCRet ret;
+
+ if (!check_trace("process_dump", context, constant, DCOMP_ALLOW_TRACE_OPS, 0, &ret))
+ return ret;
if (a != 1) {
RETURN_TERM_ERROR("Special form 'process_dump' called with "
@@ -4178,17 +4485,8 @@ static DMCRet dmc_enable_trace(DMCContext *context,
DMCRet ret;
int c;
-
- if (!(context->cflags & DCOMP_TRACE)) {
- RETURN_ERROR("Special form 'enable_trace' used in wrong dialect.",
- context,
- *constant);
- }
- if (context->is_guard) {
- RETURN_ERROR("Special form 'enable_trace' called in guard context.",
- context,
- *constant);
- }
+ if (!check_trace("enable_trace", context, constant, DCOMP_ALLOW_TRACE_OPS, 0, &ret))
+ return ret;
switch (a) {
case 2:
@@ -4237,18 +4535,9 @@ static DMCRet dmc_disable_trace(DMCContext *context,
Uint a = arityval(*p);
DMCRet ret;
int c;
-
- if (!(context->cflags & DCOMP_TRACE)) {
- RETURN_ERROR("Special form 'disable_trace' used in wrong dialect.",
- context,
- *constant);
- }
- if (context->is_guard) {
- RETURN_ERROR("Special form 'disable_trace' called in guard context.",
- context,
- *constant);
- }
+ if (!check_trace("disable_trace", context, constant, DCOMP_ALLOW_TRACE_OPS, 0, &ret))
+ return ret;
switch (a) {
case 2:
@@ -4298,17 +4587,8 @@ static DMCRet dmc_trace(DMCContext *context,
DMCRet ret;
int c;
-
- if (!(context->cflags & DCOMP_TRACE)) {
- RETURN_ERROR("Special form 'trace' used in wrong dialect.",
- context,
- *constant);
- }
- if (context->is_guard) {
- RETURN_ERROR("Special form 'trace' called in guard context.",
- context,
- *constant);
- }
+ if (!check_trace("trace", context, constant, DCOMP_ALLOW_TRACE_OPS, 0, &ret))
+ return ret;
switch (a) {
case 3:
@@ -4369,16 +4649,11 @@ static DMCRet dmc_caller(DMCContext *context,
{
Eterm *p = tuple_val(t);
Uint a = arityval(*p);
+ DMCRet ret;
- if (!(context->cflags & DCOMP_TRACE)) {
- RETURN_ERROR("Special form 'caller' used in wrong dialect.",
- context,
- *constant);
- }
- if (context->is_guard) {
- RETURN_ERROR("Special form 'caller' called in "
- "guard context.", context, *constant);
- }
+ if (!check_trace("caller", context, constant,
+ (DCOMP_CALL_TRACE|DCOMP_ALLOW_TRACE_OPS), 0, &ret))
+ return ret;
if (a != 1) {
RETURN_TERM_ERROR("Special form 'caller' called with "
@@ -4404,15 +4679,8 @@ static DMCRet dmc_silent(DMCContext *context,
DMCRet ret;
int c;
- if (!(context->cflags & DCOMP_TRACE)) {
- RETURN_ERROR("Special form 'silent' used in wrong dialect.",
- context,
- *constant);
- }
- if (context->is_guard) {
- RETURN_ERROR("Special form 'silent' called in "
- "guard context.", context, *constant);
- }
+ if (!check_trace("silent", context, constant, DCOMP_ALLOW_TRACE_OPS, 0, &ret))
+ return ret;
if (a != 2) {
RETURN_TERM_ERROR("Special form 'silent' called with wrong "
@@ -4553,7 +4821,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);
@@ -4580,7 +4848,10 @@ static DMCRet dmc_expr(DMCContext *context,
return ret;
break;
case TAG_PRIMARY_BOXED:
- if (!BOXED_IS_TUPLE(t)) {
+ if (is_map(t)) {
+ return dmc_map(context, heap, text, t, constant);
+ }
+ if (!is_tuple(t)) {
goto simple_term;
}
p = tuple_val(t);
@@ -4830,7 +5101,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;
@@ -4855,7 +5126,7 @@ static Eterm my_copy_struct(Eterm t, Eterm **hp, ErlOffHeap* off_heap)
*hp += 2;
break;
case TAG_PRIMARY_BOXED:
- if (BOXED_IS_TUPLE(t)) {
+ if (is_tuple(t)) {
if (arityval(*tuple_val(t)) == 1 &&
is_tuple(a = tuple_val(t)[1])) {
Uint i,n;
@@ -4875,7 +5146,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 {
@@ -4949,13 +5220,16 @@ static Eterm match_spec_test(Process *p, Eterm against, Eterm spec, int trace)
return THE_NON_VALUE;
}
if (trace) {
- lint_res = db_match_set_lint(p, spec, DCOMP_TRACE | DCOMP_FAKE_DESTRUCTIVE);
- mps = db_match_set_compile(p, spec, DCOMP_TRACE | DCOMP_FAKE_DESTRUCTIVE);
+ const Uint cflags = (DCOMP_TRACE | DCOMP_FAKE_DESTRUCTIVE |
+ DCOMP_CALL_TRACE | DCOMP_ALLOW_TRACE_OPS);
+ lint_res = db_match_set_lint(p, spec, cflags);
+ mps = db_match_set_compile(p, spec, cflags);
} else {
- lint_res = db_match_set_lint(p, spec, DCOMP_TABLE | DCOMP_FAKE_DESTRUCTIVE);
- mps = db_match_set_compile(p, spec, DCOMP_TABLE | DCOMP_FAKE_DESTRUCTIVE);
+ const Uint cflags = (DCOMP_TABLE | DCOMP_FAKE_DESTRUCTIVE);
+ lint_res = db_match_set_lint(p, spec, cflags);
+ mps = db_match_set_compile(p, spec, cflags);
}
-
+
if (mps == NULL) {
hp = HAlloc(p,3);
ret = TUPLE2(hp, am_error, lint_res);
@@ -4986,7 +5260,8 @@ static Eterm match_spec_test(Process *p, Eterm against, Eterm spec, int trace)
}
save_cp = p->cp;
p->cp = NULL;
- res = erts_match_set_run(p, mps, arr, n,
+ res = erts_match_set_run_trace(p, p,
+ mps, arr, n,
ERTS_PAM_COPY_RESULT|ERTS_PAM_IGNORE_TRACE_SILENT,
&ret_flags);
p->cp = save_cp;
@@ -5062,18 +5337,21 @@ void db_free_tmp_uncompressed(DbTerm* obj)
Eterm db_match_dbterm(DbTableCommon* tb, Process* c_p, Binary* bprog,
int all, DbTerm* obj, Eterm** hpp, Uint extra)
{
+ enum erts_pam_run_flags flags;
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,
- ERTS_PAM_COPY_RESULT|ERTS_PAM_CONTIGUOUS_TUPLE, &dummy);
+ flags = (hpp ?
+ ERTS_PAM_COPY_RESULT | ERTS_PAM_CONTIGUOUS_TUPLE :
+ ERTS_PAM_TMP_RESULT | ERTS_PAM_CONTIGUOUS_TUPLE);
+
+ res = db_prog_match(c_p, c_p,
+ bprog, make_tuple(obj->tpl), NULL, 0,
+ flags, &dummy);
if (is_value(res) && hpp!=NULL) {
*hpp = HAlloc(c_p, extra);
@@ -5126,6 +5404,18 @@ void db_match_dis(Binary *bp)
++t;
erts_printf("Tuple\t%beu\n", n);
break;
+ case matchMap:
+ ++t;
+ n = *t;
+ ++t;
+ erts_printf("Map\t%beu\n", n);
+ break;
+ case matchKey:
+ ++t;
+ p = (Eterm) *t;
+ ++t;
+ erts_printf("Key\t%p (%T)\n", t, p);
+ break;
case matchPushT:
++t;
n = *t;
@@ -5136,10 +5426,20 @@ void db_match_dis(Binary *bp)
++t;
erts_printf("PushL\n");
break;
+ case matchPushM:
+ ++t;
+ n = *t;
+ ++t;
+ erts_printf("PushM\t%beu\n", n);
+ break;
case matchPop:
++t;
erts_printf("Pop\n");
break;
+ case matchSwap:
+ ++t;
+ erts_printf("Swap\n");
+ break;
case matchBind:
++t;
n = *t;
@@ -5161,24 +5461,35 @@ void db_match_dis(Binary *bp)
case matchEqRef:
++t;
{
- RefThing *rt = (RefThing *) t;
+ Uint32 *num;
int ri;
- n = thing_arityval(rt->header);
- erts_printf("EqRef\t(%d) {", (int) n);
+
+ if (is_ordinary_ref_thing(t)) {
+ ErtsORefThing *rt = (ErtsORefThing *) t;
+ num = rt->num;
+ t += TermWords(ERTS_REF_THING_SIZE);
+ }
+ else {
+ ErtsMRefThing *mrt = (ErtsMRefThing *) t;
+ ASSERT(is_magic_ref_thing(t));
+ num = mrt->mb->refn;
+ t += TermWords(ERTS_MAGIC_REF_THING_SIZE);
+ }
+
+ erts_printf("EqRef\t(%d) {", (int) ERTS_REF_NUMBERS);
first = 1;
- for (ri = 0; ri < n; ++ri) {
+ for (ri = 0; ri < ERTS_REF_NUMBERS; ++ri) {
if (first)
first = 0;
else
erts_printf(", ");
-#if defined(ARCH_64) && !HALFWORD_HEAP
- erts_printf("0x%016bex", rt->data.ui[ri]);
+#if defined(ARCH_64)
+ erts_printf("0x%016bex", num[ri]);
#else
- erts_printf("0x%08bex", rt->data.ui[ri]);
+ erts_printf("0x%08bex", num[ri]);
#endif
}
}
- t += TermWords(REF_THING_SIZE);
erts_printf("}\n");
break;
case matchEqBig:
@@ -5195,7 +5506,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);
@@ -5252,6 +5563,18 @@ void db_match_dis(Binary *bp)
++t;
erts_printf("MkTuple\t%beu\n", n);
break;
+ case matchMkFlatMap:
+ ++t;
+ n = *t;
+ ++t;
+ erts_printf("MkFlatMap\t%beu\n", n);
+ break;
+ case matchMkHashMap:
+ ++t;
+ n = *t;
+ ++t;
+ erts_printf("MkHashMap\t%beu\n", n);
+ break;
case matchOr:
++t;
n = *t;
@@ -5306,13 +5629,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 328b19dfc9..7ce104a84c 100644
--- a/erts/emulator/beam/erl_db_util.h
+++ b/erts/emulator/beam/erl_db_util.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1998-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1998-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -22,6 +23,7 @@
#include "global.h"
#include "erl_message.h"
+#include "erl_bif_unique.h"
/*#define HARDDEBUG 1*/
@@ -73,8 +75,9 @@ typedef struct db_term {
*/
} DbTerm;
-union db_table;
-typedef union db_table DbTable;
+#define DB_MUST_RESIZE 1
+#define DB_NEW_OBJECT 2
+#define DB_INC_TRY_GROW 4
/* Info about a database entry while it's being updated
* (by update_counter or update_element)
@@ -84,11 +87,8 @@ typedef struct {
DbTerm* dbterm;
void** bp; /* {Hash|Tree}DbTerm** */
Uint new_size;
- int mustResize;
+ int flags;
void* lck;
-#if HALFWORD_HEAP
- unsigned char* abs_vec; /* [i] true if dbterm->tpl[i] is absolute Eterm */
-#endif
} DbUpdateHandle;
@@ -135,44 +135,58 @@ typedef struct db_table_method
Eterm slot,
Eterm* ret);
int (*db_select_chunk)(Process* p,
- DbTable* tb, /* [in out] */
+ DbTable* tb, /* [in out] */
+ Eterm tid,
Eterm pattern,
Sint chunk_size,
int reverse,
Eterm* ret);
int (*db_select)(Process* p,
- DbTable* tb, /* [in out] */
+ DbTable* tb, /* [in out] */
+ Eterm tid,
Eterm pattern,
int reverse,
Eterm* ret);
int (*db_select_delete)(Process* p,
- DbTable* tb, /* [in out] */
+ DbTable* tb, /* [in out] */
+ Eterm tid,
Eterm pattern,
Eterm* ret);
int (*db_select_continue)(Process* p,
- DbTable* tb, /* [in out] */
+ DbTable* tb, /* [in out] */
Eterm continuation,
Eterm* ret);
int (*db_select_delete_continue)(Process* p,
- DbTable* tb, /* [in out] */
+ DbTable* tb, /* [in out] */
Eterm continuation,
Eterm* ret);
int (*db_select_count)(Process* p,
- DbTable* tb, /* [in out] */
+ DbTable* tb, /* [in out] */
+ Eterm tid,
Eterm pattern,
Eterm* ret);
int (*db_select_count_continue)(Process* p,
DbTable* tb, /* [in out] */
Eterm continuation,
Eterm* ret);
+ int (*db_select_replace)(Process* p,
+ DbTable* tb, /* [in out] */
+ Eterm tid,
+ Eterm pattern,
+ Eterm* ret);
+ int (*db_select_replace_continue)(Process* p,
+ DbTable* tb, /* [in out] */
+ Eterm continuation,
+ Eterm* ret);
+ int (*db_take)(Process *, DbTable *, Eterm, Eterm *);
int (*db_delete_all_objects)(Process* p,
DbTable* db /* [in out] */ );
int (*db_free_table)(DbTable* db /* [in out] */ );
- int (*db_free_table_continue)(DbTable* db); /* [in out] */
+ SWord (*db_free_table_continue)(DbTable* db, SWord reds);
- void (*db_print)(int to,
+ void (*db_print)(fmtfn_t to,
void* to_arg,
int show,
DbTable* tb /* [in out] */ );
@@ -180,26 +194,43 @@ typedef struct db_table_method
void (*db_foreach_offheap)(DbTable* db, /* [in out] */
void (*func)(ErlOffHeap *, void *),
void *arg);
- void (*db_check_table)(DbTable* tb);
- /* Lookup a dbterm for updating. Return false if not found.
- */
- int (*db_lookup_dbterm)(DbTable*, Eterm key,
- DbUpdateHandle* handle); /* [out] */
+ /* Lookup a dbterm for updating. Return false if not found. */
+ int (*db_lookup_dbterm)(Process *, DbTable *, Eterm key, Eterm obj,
+ DbUpdateHandle* handle);
- /* Must be called for each db_lookup_dbterm that returned true,
- ** even if dbterm was not updated.
- */
- void (*db_finalize_dbterm)(DbUpdateHandle* handle);
+ /* Must be called for each db_lookup_dbterm that returned true, even if
+ ** dbterm was not updated. If the handle was of a new object and cret is
+ ** not DB_ERROR_NONE, the object is removed from the table. */
+ void (*db_finalize_dbterm)(int cret, DbUpdateHandle* handle);
} DbTableMethod;
typedef struct db_fixation {
- Eterm pid;
+ /* Node in fixed_tabs list */
+ struct {
+ struct db_fixation *next, *prev;
+ Binary* btid;
+ } tabs;
+
+ /* Node in fixing_procs tree */
+ struct {
+ struct db_fixation *left, *right, *parent;
+ int is_red;
+ Process* p;
+ } procs;
+
+ /* Number of fixations on table from procs.p
+ * Protected by table write lock or read lock + fixlock
+ */
Uint counter;
- struct db_fixation *next;
} DbFixation;
+typedef struct {
+ DbTable *next;
+ DbTable *prev;
+} DbTableList;
+
/*
* This structure contains data for all different types of database
* tables. Note that these fields must match the same fields
@@ -209,10 +240,13 @@ typedef struct db_fixation {
*/
typedef struct db_table_common {
- erts_refc_t ref; /* fixation counter */
+ erts_smp_refc_t refc; /* reference count of table struct */
+ erts_smp_refc_t fix_count;/* fixation counter */
+ DbTableList all;
+ DbTableList owned;
#ifdef ERTS_SMP
erts_smp_rwmtx_t rwlock; /* rw lock on table */
- erts_smp_mtx_t fixlock; /* Protects fixations,megasec,sec,microsec */
+ erts_smp_mtx_t fixlock; /* Protects fixing_procs and time */
int is_thread_safe; /* No fine locking inside table needed */
Uint32 type; /* table type, *read only* after creation */
#endif
@@ -221,41 +255,43 @@ typedef struct db_table_common {
UWord heir_data; /* To send in ETS-TRANSFER (is_immed or (DbTerm*) */
Uint64 heir_started_interval; /* To further identify the heir */
Eterm the_name; /* an atom */
- Eterm id; /* atom | integer */
+ Binary *btid;
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 */
- DbFixation* fixations; /* List of processes who have done safe_fixtable,
+ struct { /* Last fixation time */
+ ErtsMonotonicTime monotonic;
+ ErtsMonotonicTime offset;
+ } time;
+ DbFixation* fixing_procs; /* Tree of processes who have done safe_fixtable,
"local" fixations not included. */
/* All 32-bit fields */
Uint32 status; /* bit masks defined below */
- int slot; /* slot index in meta_main_tab */
int keypos; /* defaults to 1 */
int compress;
} DbTableCommon;
/* These are status bit patterns */
-#define DB_NORMAL (1 << 0)
-#define DB_PRIVATE (1 << 1)
-#define DB_PROTECTED (1 << 2)
-#define DB_PUBLIC (1 << 3)
-#define DB_BAG (1 << 4)
-#define DB_SET (1 << 5)
-/*#define DB_LHASH (1 << 6)*/
-#define DB_FINE_LOCKED (1 << 7) /* fine grained locking enabled */
-#define DB_DUPLICATE_BAG (1 << 8)
-#define DB_ORDERED_SET (1 << 9)
-#define DB_DELETE (1 << 10) /* table is being deleted */
-#define DB_FREQ_READ (1 << 11)
-
-#define ERTS_ETS_TABLE_TYPES (DB_BAG|DB_SET|DB_DUPLICATE_BAG|DB_ORDERED_SET|DB_FINE_LOCKED|DB_FREQ_READ)
+#define DB_PRIVATE (1 << 0)
+#define DB_PROTECTED (1 << 1)
+#define DB_PUBLIC (1 << 2)
+#define DB_DELETE (1 << 3) /* table is being deleted */
+#define DB_SET (1 << 4)
+#define DB_BAG (1 << 5)
+#define DB_DUPLICATE_BAG (1 << 6)
+#define DB_ORDERED_SET (1 << 7)
+#define DB_FINE_LOCKED (1 << 8) /* write_concurrency */
+#define DB_FREQ_READ (1 << 9) /* read_concurrency */
+#define DB_NAMED_TABLE (1 << 10)
+
+#define ERTS_ETS_TABLE_TYPES (DB_BAG|DB_SET|DB_DUPLICATE_BAG|DB_ORDERED_SET\
+ |DB_FINE_LOCKED|DB_FREQ_READ|DB_NAMED_TABLE)
#define IS_HASH_TABLE(Status) (!!((Status) & \
(DB_BAG | DB_SET | DB_DUPLICATE_BAG)))
#define IS_TREE_TABLE(Status) (!!((Status) & \
DB_ORDERED_SET))
-#define NFIXED(T) (erts_refc_read(&(T)->common.ref,0))
+#define NFIXED(T) (erts_smp_refc_read(&(T)->common.fix_count,0))
#define IS_FIXED(T) (NFIXED(T) != 0)
/*
@@ -283,10 +319,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;
}
}
@@ -298,14 +334,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);
@@ -339,6 +375,7 @@ void* db_store_term(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj);
void* db_store_term_comp(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj);
Eterm db_copy_element_from_ets(DbTableCommon* tb, Process* p, DbTerm* obj,
Uint pos, Eterm** hpp, Uint extra);
+int db_has_map(Eterm obj);
int db_has_variable(Eterm obj);
int db_is_variable(Eterm obj);
void db_do_update_element(DbUpdateHandle* handle,
@@ -349,7 +386,8 @@ Eterm db_add_counter(Eterm** hpp, Wterm counter, Eterm incr);
Eterm db_match_set_lint(Process *p, Eterm matchexpr, Uint flags);
Binary *db_match_set_compile(Process *p, Eterm matchexpr,
Uint flags);
-void erts_db_match_prog_destructor(Binary *);
+int db_match_keeps_key(int keypos, Eterm match, Eterm guard, Eterm body);
+int erts_db_match_prog_destructor(Binary *);
typedef struct match_prog {
ErlHeapFragment *term_save; /* Only if needed, a list of message
@@ -420,6 +458,11 @@ typedef struct dmc_err_info {
#define DCOMP_FAKE_DESTRUCTIVE ((Uint) 8) /* When this is active, no setting of
trace control words or seq_trace tokens will be done. */
+/* Allow lock seizing operations on the tracee and 3rd party processes */
+#define DCOMP_ALLOW_TRACE_OPS ((Uint) 0x10)
+
+/* This is call trace */
+#define DCOMP_CALL_TRACE ((Uint) 0x20)
Binary *db_match_compile(Eterm *matchexpr, Eterm *guards,
Eterm *body, int num_matches,
@@ -430,7 +473,8 @@ 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, Process *self,
+ Binary *prog, Eterm term,
Eterm *termp, int arity,
enum erts_pam_run_flags in_flags,
Uint32 *return_flags /* Zeroed on enter */);
@@ -444,29 +488,54 @@ Eterm db_format_dmc_err_info(Process *p, DMCErrInfo *ei);
void db_free_dmc_err_info(DMCErrInfo *ei);
/* Completely free's an error info structure, including all recorded
errors */
-Eterm db_make_mp_binary(Process *p, Binary *mp, Eterm **hpp);
-/* Convert a match program to a erlang "magic" binary to be returned to userspace,
- increments the reference counter. */
-int erts_db_is_compiled_ms(Eterm term);
+
+ERTS_GLB_INLINE Eterm erts_db_make_match_prog_ref(Process *p, Binary *mp, Eterm **hpp);
+ERTS_GLB_INLINE Binary *erts_db_get_match_prog_binary(Eterm term);
+ERTS_GLB_INLINE Binary *erts_db_get_match_prog_binary_unchecked(Eterm term);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+/*
+ * Convert a match program to a "magic" ref to return up to erlang
+ */
+ERTS_GLB_INLINE Eterm erts_db_make_match_prog_ref(Process *p, Binary *mp, Eterm **hpp)
+{
+ return erts_mk_magic_ref(hpp, &MSO(p), mp);
+}
+
+ERTS_GLB_INLINE Binary *
+erts_db_get_match_prog_binary_unchecked(Eterm term)
+{
+ Binary *bp = erts_magic_ref2bin(term);
+ ASSERT(bp->intern.flags & BIN_FLAG_MAGIC);
+ ASSERT((ERTS_MAGIC_BIN_DESTRUCTOR(bp) == erts_db_match_prog_destructor));
+ return bp;
+}
+
+ERTS_GLB_INLINE Binary *
+erts_db_get_match_prog_binary(Eterm term)
+{
+ Binary *bp;
+ if (!is_internal_magic_ref(term))
+ return NULL;
+ bp = erts_magic_ref2bin(term);
+ ASSERT(bp->intern.flags & BIN_FLAG_MAGIC);
+ if (ERTS_MAGIC_BIN_DESTRUCTOR(bp) != erts_db_match_prog_destructor)
+ return NULL;
+ return bp;
+}
+
+#endif
/*
** Convenience when compiling into Binary structures
*/
#define IsMatchProgBinary(BP) \
- (((BP)->flags & BIN_FLAG_MAGIC) \
+ (((BP)->intern.flags & BIN_FLAG_MAGIC) \
&& ERTS_MAGIC_BIN_DESTRUCTOR((BP)) == erts_db_match_prog_destructor)
#define Binary2MatchProg(BP) \
(ASSERT(IsMatchProgBinary((BP))), \
((MatchProg *) ERTS_MAGIC_BIN_DATA((BP))))
-/*
-** Debugging
-*/
-#ifdef HARDDEBUG
-void db_check_tables(void); /* in db.c */
-#define CHECK_TABLES() db_check_tables()
-#else
-#define CHECK_TABLES()
-#endif
#endif /* _DB_UTIL_H */
diff --git a/erts/emulator/beam/erl_debug.c b/erts/emulator/beam/erl_debug.c
index 50bdc79506..bf8244564a 100644
--- a/erts/emulator/beam/erl_debug.c
+++ b/erts/emulator/beam/erl_debug.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1998-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1998-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -59,10 +60,10 @@ static const char dashes[PTR_SIZE+3] = {
void pps(Process*, Eterm*);
void ptd(Process*, Eterm);
-void paranoid_display(int, void*, Process*, Eterm);
+void paranoid_display(fmtfn_t, void*, Process*, Eterm);
static int dcount;
-static int pdisplay1(int to, void *to_arg, Process* p, Eterm obj);
+static int pdisplay1(fmtfn_t to, void *to_arg, Process* p, Eterm obj);
void ptd(Process* p, Eterm x)
{
@@ -76,14 +77,14 @@ void ptd(Process* p, Eterm x)
*/
void
-paranoid_display(int to, void *to_arg, Process* p, Eterm obj)
+paranoid_display(fmtfn_t to, void *to_arg, Process* p, Eterm obj)
{
dcount = 100000;
pdisplay1(to, to_arg, p, obj);
}
static int
-pdisplay1(int to, void *to_arg, Process* p, Eterm obj)
+pdisplay1(fmtfn_t to, void *to_arg, Process* p, Eterm obj)
{
int i, k;
Eterm* nobj;
@@ -129,7 +130,7 @@ pdisplay1(int to, void *to_arg, Process* p, Eterm obj)
Uint32 *ref_num;
erts_print(to, to_arg, "#Ref<%lu", ref_channel_no(obj));
ref_num = ref_numbers(obj);
- for (i = ref_no_of_numbers(obj)-1; i >= 0; i--)
+ for (i = ref_no_numbers(obj)-1; i >= 0; i--)
erts_print(to, to_arg, ",%lu", ref_num[i]);
erts_print(to, to_arg, ">");
break;
@@ -188,6 +189,9 @@ pdisplay1(int to, void *to_arg, Process* p, Eterm obj)
case BINARY_DEF:
erts_print(to, to_arg, "#Bin");
break;
+ case MATCHSTATE_DEF:
+ erts_print(to, to_arg, "#Matchstate");
+ break;
default:
erts_print(to, to_arg, "unknown object %x", obj);
}
@@ -197,7 +201,7 @@ pdisplay1(int to, void *to_arg, Process* p, Eterm obj)
void
pps(Process* p, Eterm* stop)
{
- int to = ERTS_PRINT_STDOUT;
+ fmtfn_t to = ERTS_PRINT_STDOUT;
void *to_arg = NULL;
Eterm* sp = STACK_START(p) - 1;
@@ -251,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),
@@ -283,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),
@@ -308,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;
}
@@ -368,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
@@ -381,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));
}
}
@@ -391,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));
@@ -412,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);
@@ -527,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) {
@@ -538,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");
@@ -627,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 af51212281..029320691d 100644
--- a/erts/emulator/beam/erl_debug.h
+++ b/erts/emulator/beam/erl_debug.h
@@ -3,16 +3,17 @@
*
* Copyright Ericsson AB 2004-2012. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -47,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;
@@ -91,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_dirty_bif.tab b/erts/emulator/beam/erl_dirty_bif.tab
new file mode 100644
index 0000000000..10c76d2579
--- /dev/null
+++ b/erts/emulator/beam/erl_dirty_bif.tab
@@ -0,0 +1,87 @@
+#
+# %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%
+#
+
+#
+# Static declaration of BIFs that should execute on dirty schedulers.
+#
+# <dirty-bif-decl> ::= <type> <bif>
+# <bif> ::= <module> ":" <name> "/" <arity>
+# <type> ::= dirty-cpu | dirty-io | dirty-cpu-test | dirty-io-test
+#
+# When dirty scheduler support is available, a BIF declared with the
+# 'dirty-cpu' type will unconditionally execute on a dirty CPU scheduler,
+# and a BIF declared with the type 'dirty-io' will unconditionally execute
+# on a dirty IO scheduler. When dirty scheduler support is not available
+# all BIFs will of course execute on normal schedulers.
+#
+# When the emulator has been configured with the debug option
+# '--enable-dirty-schedulers-test', BIFs with the types 'dirty-cpu-test',
+# and 'dirty-io-test' will unconditionally execute on dirty schedulers.
+# When this debug option has not been enabled, these BIFs will be executed
+# on normal schedulers.
+#
+# BIFs marked as 'ubif' in ./bif.tab will be ignored, i.e., will always
+# execute on normal schedulers.
+#
+
+# --- Dirty BIFs ---
+
+dirty-cpu erts_debug:dirty_cpu/2
+dirty-io erts_debug:dirty_io/2
+
+# lcnt_control/1 doesn't need to be dirty.
+dirty-cpu erts_debug:lcnt_control/2
+dirty-cpu erts_debug:lcnt_collect/0
+dirty-cpu erts_debug:lcnt_clear/0
+
+# --- TEST of Dirty BIF functionality ---
+# Functions below will execute on dirty schedulers when emulator has
+# been configured for testing dirty schedulers. This is used for test
+# and debug purposes only. We really do *not* want to execute these
+# on dirty schedulers on a real system.
+
+dirty-cpu-test erlang:'++'/2
+dirty-cpu-test erlang:append/2
+dirty-cpu-test erlang:'--'/2
+dirty-cpu-test erlang:subtract/2
+dirty-cpu-test erlang:iolist_size/1
+dirty-cpu-test erlang:make_tuple/2
+dirty-cpu-test erlang:make_tuple/3
+dirty-cpu-test erlang:append_element/2
+dirty-cpu-test erlang:insert_element/3
+dirty-cpu-test erlang:delete_element/2
+dirty-cpu-test erlang:atom_to_list/1
+dirty-cpu-test erlang:list_to_atom/1
+dirty-cpu-test erlang:list_to_existing_atom/1
+dirty-cpu-test erlang:integer_to_list/1
+dirty-cpu-test erlang:string_to_integer/1
+dirty-cpu-test erlang:list_to_integer/1
+dirty-cpu-test erlang:list_to_integer/2
+dirty-cpu-test erlang:float_to_list/1
+dirty-cpu-test erlang:float_to_list/2
+dirty-cpu-test erlang:float_to_binary/1
+dirty-cpu-test erlang:float_to_binary/2
+dirty-cpu-test erlang:string_to_float/1
+dirty-cpu-test erlang:list_to_float/1
+dirty-cpu-test erlang:binary_to_float/1
+dirty-cpu-test erlang:tuple_to_list/1
+dirty-cpu-test erlang:list_to_tuple/1
+dirty-cpu-test erlang:display/1
+dirty-cpu-test erlang:display_string/1
diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h
index 3ecb379326..5ad616fec3 100644
--- a/erts/emulator/beam/erl_driver.h
+++ b/erts/emulator/beam/erl_driver.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1999-2014. All Rights Reserved.
+ * Copyright Ericsson AB 1999-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -36,56 +37,9 @@
# 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>
-#include <sys/types.h> /* ssize_t */
#if defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_)
#ifndef STATIC_ERLANG_DRIVER
@@ -93,24 +47,6 @@
#define ERL_DRIVER_TYPES_ONLY
#define WIN32_DYNAMIC_ERL_DRIVER
#endif
-/*
- * This structure can be cast to a WSABUF structure.
- */
-typedef struct _SysIOVec {
- unsigned long iov_len;
- char* iov_base;
-} SysIOVec;
-#else /* Unix */
-# ifdef HAVE_SYS_UIO_H
-# include <sys/types.h>
-# include <sys/uio.h>
-typedef struct iovec SysIOVec;
-# else
-typedef struct {
- char* iov_base;
- size_t iov_len;
-} SysIOVec;
-# endif
#endif
#ifndef EXTERN
@@ -121,11 +57,10 @@ typedef struct {
# endif
#endif
-/* Values for mode arg to driver_select() */
-#define ERL_DRV_READ (1 << 0)
-#define ERL_DRV_WRITE (1 << 1)
-#define ERL_DRV_USE (1 << 2)
-#define ERL_DRV_USE_NO_CALLBACK (ERL_DRV_USE | (1 << 3))
+#define ERL_DRV_READ ((int)ERL_NIF_SELECT_READ)
+#define ERL_DRV_WRITE ((int)ERL_NIF_SELECT_WRITE)
+#define ERL_DRV_USE ((int)ERL_NIF_SELECT_STOP)
+#define ERL_DRV_USE_NO_CALLBACK (ERL_DRV_USE | (ERL_DRV_USE << 1))
/* Old deprecated */
#define DO_READ ERL_DRV_READ
@@ -133,7 +68,7 @@ typedef struct {
#define ERL_DRV_EXTENDED_MARKER (0xfeeeeeed)
#define ERL_DRV_EXTENDED_MAJOR_VERSION 3
-#define ERL_DRV_EXTENDED_MINOR_VERSION 0
+#define ERL_DRV_EXTENDED_MINOR_VERSION 3
/*
* The emulator will refuse to load a driver with a major version
@@ -171,34 +106,19 @@ 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__)
+#if defined(__WIN32__) || defined(_WIN32)
typedef ErlDrvUInt ErlDrvSizeT;
typedef ErlDrvSInt ErlDrvSSizeT;
#else
@@ -236,19 +156,23 @@ struct erl_drv_event_data {
#endif
typedef struct erl_drv_event_data *ErlDrvEventData; /* Event data */
-/*
- * A driver monitor
- */
-typedef struct {
- unsigned char data[sizeof(void *)*4];
-} ErlDrvMonitor;
-
typedef struct {
unsigned long megasecs;
unsigned long secs;
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.
*/
@@ -361,6 +285,9 @@ typedef struct erl_drv_entry {
/* Called on behalf of driver_select when
it is safe to release 'event'. A typical
unix driver would call close(event) */
+ void (*emergency_close)(ErlDrvData drv_data);
+ /* called when the port is closed abruptly.
+ specifically when erl_crash_dump is called. */
/* When adding entries here, dont forget to pad in obsolete/driver.h */
} ErlDrvEntry;
@@ -382,22 +309,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)
@@ -681,8 +609,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. */
@@ -692,18 +628,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 3f829ea7ea..31b4817fb1 100644
--- a/erts/emulator/beam/erl_drv_nif.h
+++ b/erts/emulator/beam/erl_drv_nif.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2010. All Rights Reserved.
+ * Copyright Ericsson AB 2010-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -35,21 +36,133 @@ typedef struct {
int scheduler_threads;
int nif_major_version;
int nif_minor_version;
+ int dirty_scheduler_support;
} ErlDrvSysInfo;
typedef struct {
int suggested_stack_size;
} ErlDrvThreadOpts;
-#if defined(ERL_DRV_DIRTY_SCHEDULER_SUPPORT) || defined(ERL_NIF_DIRTY_SCHEDULER_SUPPORT)
+
typedef enum {
- ERL_DRV_DIRTY_JOB_CPU_BOUND = 1,
- ERL_DRV_DIRTY_JOB_IO_BOUND = 2
-} ErlDrvDirtyJobFlags;
+ ERL_DIRTY_JOB_CPU_BOUND = 1,
+ ERL_DIRTY_JOB_IO_BOUND = 2
+} ErlDirtyJobFlags;
+
+/* Values for enif_select AND mode arg for driver_select() */
+enum ErlNifSelectFlags {
+ ERL_NIF_SELECT_READ = (1 << 0),
+ ERL_NIF_SELECT_WRITE = (1 << 1),
+ ERL_NIF_SELECT_STOP = (1 << 2)
+};
+
+/*
+ * A driver monitor
+ */
+typedef struct {
+ unsigned char data[sizeof(void *)*4];
+} ErlDrvMonitor;
+
+
+#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
+#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
-#endif /* __ERL_DRV_NIF_H__ */
+#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
+#if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_))
+/*
+ * This structure can be cast to a WSABUF structure.
+ */
+typedef struct _SysIOVec {
+ unsigned long iov_len;
+ char* iov_base;
+} SysIOVec;
+#else /* Unix */
+# include <sys/types.h>
+# ifdef HAVE_SYS_UIO_H
+# include <sys/uio.h>
+typedef struct iovec SysIOVec;
+# else
+typedef struct {
+ char* iov_base;
+ size_t iov_len;
+} SysIOVec;
+# endif
+#endif
+
+#endif /* __ERL_DRV_NIF_H__ */
diff --git a/erts/emulator/beam/erl_drv_thread.c b/erts/emulator/beam/erl_drv_thread.c
index 147249f751..742c428f2a 100644
--- a/erts/emulator/beam/erl_drv_thread.c
+++ b/erts/emulator/beam/erl_drv_thread.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2007-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2007-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -42,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
@@ -53,6 +54,9 @@ fatal_error(int err, char *func)
struct ErlDrvMutex_ {
ethr_mutex mtx;
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ erts_lcnt_ref_t lcnt;
+#endif
char *name;
};
@@ -63,6 +67,9 @@ struct ErlDrvCond_ {
struct ErlDrvRWLock_ {
ethr_rwmutex rwmtx;
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ erts_lcnt_ref_t lcnt;
+#endif
char *name;
};
@@ -139,7 +146,8 @@ void erl_drv_thr_init(void)
sizeof(char *)*ERL_DRV_TSD_KEYS_INC);
for (i = 0; i < ERL_DRV_TSD_KEYS_INC; i++)
used_tsd_keys[i] = NULL;
- erts_mtx_init(&tsd_mtx, "drv_tsd");
+ erts_mtx_init(&tsd_mtx, "drv_tsd", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_IO);
}
/*
@@ -160,14 +168,18 @@ erl_drv_mutex_create(char *name)
opt.posix_compliant = 1;
if (ethr_mutex_init_opt(&dmtx->mtx, &opt) != 0) {
erts_free(ERTS_ALC_T_DRV_MTX, (void *) dmtx);
- dmtx = NULL;
+ return NULL;
}
- else if (!name)
- dmtx->name = no_name;
- else {
+ if (name) {
dmtx->name = ((char *) dmtx) + sizeof(ErlDrvMutex);
sys_strcpy(dmtx->name, name);
+ } else {
+ dmtx->name = no_name;
}
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ erts_lcnt_init_ref_x(&dmtx->lcnt, dmtx->name, NIL,
+ ERTS_LOCK_TYPE_MUTEX | ERTS_LOCK_FLAGS_CATEGORY_IO);
+#endif
}
return dmtx;
#else
@@ -179,7 +191,11 @@ void
erl_drv_mutex_destroy(ErlDrvMutex *dmtx)
{
#ifdef USE_THREADS
- int res = dmtx ? ethr_mutex_destroy(&dmtx->mtx) : EINVAL;
+ int res;
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ erts_lcnt_uninstall(&dmtx->lcnt);
+#endif
+ res = dmtx ? ethr_mutex_destroy(&dmtx->mtx) : EINVAL;
if (res != 0)
fatal_error(res, "erl_drv_mutex_destroy()");
erts_free(ERTS_ALC_T_DRV_MTX, (void *) dmtx);
@@ -201,9 +217,14 @@ int
erl_drv_mutex_trylock(ErlDrvMutex *dmtx)
{
#ifdef USE_THREADS
+ int res;
if (!dmtx)
fatal_error(EINVAL, "erl_drv_mutex_trylock()");
- return ethr_mutex_trylock(&dmtx->mtx);
+ res = ethr_mutex_trylock(&dmtx->mtx);
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ erts_lcnt_trylock(&dmtx->lcnt, res);
+#endif
+ return res;
#else
return 0;
#endif
@@ -215,8 +236,14 @@ erl_drv_mutex_lock(ErlDrvMutex *dmtx)
#ifdef USE_THREADS
if (!dmtx)
fatal_error(EINVAL, "erl_drv_mutex_lock()");
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ erts_lcnt_lock(&dmtx->lcnt);
+#endif
ethr_mutex_lock(&dmtx->mtx);
#endif
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ erts_lcnt_lock_post(&dmtx->lcnt);
+#endif
}
void
@@ -225,6 +252,9 @@ erl_drv_mutex_unlock(ErlDrvMutex *dmtx)
#ifdef USE_THREADS
if (!dmtx)
fatal_error(EINVAL, "erl_drv_mutex_unlock()");
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ erts_lcnt_unlock(&dmtx->lcnt);
+#endif
ethr_mutex_unlock(&dmtx->mtx);
#endif
}
@@ -305,10 +335,18 @@ erl_drv_cond_wait(ErlDrvCond *dcnd, ErlDrvMutex *dmtx)
if (!dcnd || !dmtx) {
fatal_error(EINVAL, "erl_drv_cond_wait()");
}
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ erts_lcnt_unlock(&dmtx->lcnt);
+#endif
while (1) {
int res = ethr_cond_wait(&dcnd->cnd, &dmtx->mtx);
- if (res == 0)
+ if (res == 0) {
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ erts_lcnt_lock(&dmtx->lcnt);
+ erts_lcnt_lock_post(&dmtx->lcnt);
+#endif
break;
+ }
}
#endif
}
@@ -323,14 +361,18 @@ erl_drv_rwlock_create(char *name)
if (drwlck) {
if (ethr_rwmutex_init(&drwlck->rwmtx) != 0) {
erts_free(ERTS_ALC_T_DRV_RWLCK, (void *) drwlck);
- drwlck = NULL;
+ return NULL;
}
- else if (!name)
- drwlck->name = no_name;
- else {
+ if (name) {
drwlck->name = ((char *) drwlck) + sizeof(ErlDrvRWLock);
sys_strcpy(drwlck->name, name);
+ } else {
+ drwlck->name = no_name;
}
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ erts_lcnt_init_ref_x(&drwlck->lcnt, drwlck->name, NIL,
+ ERTS_LOCK_TYPE_RWMUTEX | ERTS_LOCK_FLAGS_CATEGORY_IO);
+#endif
}
return drwlck;
#else
@@ -342,7 +384,11 @@ void
erl_drv_rwlock_destroy(ErlDrvRWLock *drwlck)
{
#ifdef USE_THREADS
- int res = drwlck ? ethr_rwmutex_destroy(&drwlck->rwmtx) : EINVAL;
+ int res;
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ erts_lcnt_uninstall(&drwlck->lcnt);
+#endif
+ res = drwlck ? ethr_rwmutex_destroy(&drwlck->rwmtx) : EINVAL;
if (res != 0)
fatal_error(res, "erl_drv_rwlock_destroy()");
erts_free(ERTS_ALC_T_DRV_RWLCK, (void *) drwlck);
@@ -363,9 +409,14 @@ int
erl_drv_rwlock_tryrlock(ErlDrvRWLock *drwlck)
{
#ifdef USE_THREADS
+ int res;
if (!drwlck)
fatal_error(EINVAL, "erl_drv_rwlock_tryrlock()");
- return ethr_rwmutex_tryrlock(&drwlck->rwmtx);
+ res = ethr_rwmutex_tryrlock(&drwlck->rwmtx);
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ erts_lcnt_trylock_opt(&drwlck->lcnt, res, ERTS_LOCK_OPTIONS_READ);
+#endif
+ return res;
#else
return 0;
#endif
@@ -377,7 +428,13 @@ erl_drv_rwlock_rlock(ErlDrvRWLock *drwlck)
#ifdef USE_THREADS
if (!drwlck)
fatal_error(EINVAL, "erl_drv_rwlock_rlock()");
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ erts_lcnt_lock_opt(&drwlck->lcnt, ERTS_LOCK_OPTIONS_READ);
+#endif
ethr_rwmutex_rlock(&drwlck->rwmtx);
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ erts_lcnt_lock_post(&drwlck->lcnt);
+#endif
#endif
}
@@ -387,6 +444,9 @@ erl_drv_rwlock_runlock(ErlDrvRWLock *drwlck)
#ifdef USE_THREADS
if (!drwlck)
fatal_error(EINVAL, "erl_drv_rwlock_runlock()");
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ erts_lcnt_unlock_opt(&drwlck->lcnt, ERTS_LOCK_OPTIONS_READ);
+#endif
ethr_rwmutex_runlock(&drwlck->rwmtx);
#endif
}
@@ -395,9 +455,14 @@ int
erl_drv_rwlock_tryrwlock(ErlDrvRWLock *drwlck)
{
#ifdef USE_THREADS
+ int res;
if (!drwlck)
fatal_error(EINVAL, "erl_drv_rwlock_tryrwlock()");
- return ethr_rwmutex_tryrwlock(&drwlck->rwmtx);
+ res = ethr_rwmutex_tryrwlock(&drwlck->rwmtx);
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ erts_lcnt_trylock_opt(&drwlck->lcnt, res, ERTS_LOCK_OPTIONS_RDWR);
+#endif
+ return res;
#else
return 0;
#endif
@@ -409,7 +474,13 @@ erl_drv_rwlock_rwlock(ErlDrvRWLock *drwlck)
#ifdef USE_THREADS
if (!drwlck)
fatal_error(EINVAL, "erl_drv_rwlock_rwlock()");
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ erts_lcnt_lock_opt(&drwlck->lcnt, ERTS_LOCK_OPTIONS_RDWR);
+#endif
ethr_rwmutex_rwlock(&drwlck->rwmtx);
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ erts_lcnt_lock_post(&drwlck->lcnt);
+#endif
#endif
}
@@ -419,6 +490,9 @@ erl_drv_rwlock_rwunlock(ErlDrvRWLock *drwlck)
#ifdef USE_THREADS
if (!drwlck)
fatal_error(EINVAL, "erl_drv_rwlock_rwunlock()");
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ erts_lcnt_unlock_opt(&drwlck->lcnt, ERTS_LOCK_OPTIONS_RDWR);
+#endif
ethr_rwmutex_rwunlock(&drwlck->rwmtx);
#endif
}
@@ -601,17 +675,16 @@ erl_drv_thread_create(char *name,
#ifdef USE_THREADS
int res;
struct ErlDrvTid_ *dtid;
- ethr_thr_opts ethr_opts;
+ ethr_thr_opts ethr_opts = ETHR_THR_OPTS_DEFAULT_INITER;
ethr_thr_opts *use_opts;
- ethr_thr_opts def_ethr_opts = ETHR_THR_OPTS_DEFAULT_INITER;
- if (!opts)
+ if (!opts && !name)
use_opts = NULL;
else {
- sys_memcpy((void *) &ethr_opts,
- (void *) &def_ethr_opts,
- sizeof(ethr_thr_opts));
- ethr_opts.suggested_stack_size = opts->suggested_stack_size;
+ if(opts)
+ ethr_opts.suggested_stack_size = opts->suggested_stack_size;
+
+ ethr_opts.name = name;
use_opts = &ethr_opts;
}
diff --git a/erts/emulator/beam/erl_fun.c b/erts/emulator/beam/erl_fun.c
index 88947b5536..535f677bb3 100644
--- a/erts/emulator/beam/erl_fun.c
+++ b/erts/emulator/beam/erl_fun.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2000-2010. All Rights Reserved.
+ * Copyright Ericsson AB 2000-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -30,6 +31,9 @@
static Hash erts_fun_table;
#include "erl_smp.h"
+#ifdef HIPE
+# include "hipe_mode_switch.h"
+#endif
static erts_smp_rwmtx_t erts_fun_table_lock;
@@ -48,8 +52,8 @@ static void fun_free(ErlFunEntry* obj);
* to unloaded_fun[]. The -1 in unloaded_fun[0] will be interpreted
* as an illegal arity when attempting to call a fun.
*/
-static BeamInstr unloaded_fun_code[3] = {NIL, -1, 0};
-static BeamInstr* unloaded_fun = unloaded_fun_code + 2;
+static BeamInstr unloaded_fun_code[4] = {NIL, NIL, -1, 0};
+static BeamInstr* unloaded_fun = unloaded_fun_code + 3;
void
erts_init_fun_table(void)
@@ -59,18 +63,22 @@ erts_init_fun_table(void)
rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_FREQUENT_READ;
rwmtx_opt.lived = ERTS_SMP_RWMTX_LONG_LIVED;
- erts_smp_rwmtx_init_opt(&erts_fun_table_lock, &rwmtx_opt, "fun_tab");
+ erts_smp_rwmtx_init_opt(&erts_fun_table_lock, &rwmtx_opt, "fun_tab", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
f.hash = (H_FUN) fun_hash;
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);
}
void
-erts_fun_info(int to, void *to_arg)
+erts_fun_info(fmtfn_t to, void *to_arg)
{
int lock = !ERTS_IS_CRASH_DUMPING;
if (lock)
@@ -106,9 +114,9 @@ erts_put_fun_entry(Eterm mod, int uniq, int index)
fe = (ErlFunEntry *) hash_put(&erts_fun_table, (void*) &template);
sys_memset(fe->uniq, 0, sizeof(fe->uniq));
fe->index = 0;
- refc = erts_refc_inctest(&fe->refc, 0);
+ refc = erts_smp_refc_inctest(&fe->refc, 0);
if (refc < 2) /* New or pending delete */
- erts_refc_inc(&fe->refc, 1);
+ erts_smp_refc_inc(&fe->refc, 1);
erts_fun_write_unlock();
return fe;
}
@@ -130,9 +138,9 @@ erts_put_fun_entry2(Eterm mod, int old_uniq, int old_index,
sys_memcpy(fe->uniq, uniq, sizeof(fe->uniq));
fe->index = index;
fe->arity = arity;
- refc = erts_refc_inctest(&fe->refc, 0);
+ refc = erts_smp_refc_inctest(&fe->refc, 0);
if (refc < 2) /* New or pending delete */
- erts_refc_inc(&fe->refc, 1);
+ erts_smp_refc_inc(&fe->refc, 1);
erts_fun_write_unlock();
return fe;
}
@@ -157,9 +165,9 @@ erts_get_fun_entry(Eterm mod, int uniq, int index)
erts_fun_read_lock();
ret = (ErlFunEntry *) hash_get(&erts_fun_table, (void*) &template);
if (ret) {
- erts_aint_t refc = erts_refc_inctest(&ret->refc, 1);
+ erts_aint_t refc = erts_smp_refc_inctest(&ret->refc, 1);
if (refc < 2) /* Pending delete */
- erts_refc_inc(&ret->refc, 1);
+ erts_smp_refc_inc(&ret->refc, 1);
}
erts_fun_read_unlock();
return ret;
@@ -180,11 +188,11 @@ erts_erase_fun_entry(ErlFunEntry* fe)
* We have to check refc again since someone might have looked up
* the fun entry and incremented refc after last check.
*/
- if (erts_refc_dectest(&fe->refc, -1) <= 0)
+ if (erts_smp_refc_dectest(&fe->refc, -1) <= 0)
#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",
@@ -195,14 +203,13 @@ erts_erase_fun_entry(ErlFunEntry* fe)
}
void
-erts_cleanup_funs_on_purge(BeamInstr* start, BeamInstr* end)
+erts_fun_purge_prepare(BeamInstr* start, BeamInstr* end)
{
int limit;
HashBucket** bucket;
- ErlFunEntry* to_delete = NULL;
int i;
- erts_fun_write_lock();
+ erts_fun_read_lock();
limit = erts_fun_table.size;
bucket = erts_fun_table.bucket;
for (i = 0; i < limit; i++) {
@@ -213,26 +220,69 @@ erts_cleanup_funs_on_purge(BeamInstr* start, BeamInstr* end)
BeamInstr* addr = fe->address;
if (start <= addr && addr < end) {
+ fe->pend_purge_address = addr;
+ ERTS_SMP_WRITE_MEMORY_BARRIER;
fe->address = unloaded_fun;
- if (erts_refc_dectest(&fe->refc, 0) == 0) {
- fe->address = (void *) to_delete;
- to_delete = fe;
- }
+#ifdef HIPE
+ fe->pend_purge_native_address = fe->native_address;
+ hipe_set_closure_stub(fe);
+#endif
+ erts_purge_state_add_fun(fe);
}
b = b->next;
}
}
+ erts_fun_read_unlock();
+}
+
+void
+erts_fun_purge_abort_prepare(ErlFunEntry **funs, Uint no)
+{
+ Uint ix;
- while (to_delete != NULL) {
- ErlFunEntry* next = (ErlFunEntry *) to_delete->address;
- erts_erase_fun_entry_unlocked(to_delete);
- to_delete = next;
+ for (ix = 0; ix < no; ix++) {
+ ErlFunEntry *fe = funs[ix];
+ if (fe->address == unloaded_fun) {
+ fe->address = fe->pend_purge_address;
+#ifdef HIPE
+ fe->native_address = fe->pend_purge_native_address;
+#endif
+ }
}
- erts_fun_write_unlock();
}
void
-erts_dump_fun_entries(int to, void *to_arg)
+erts_fun_purge_abort_finalize(ErlFunEntry **funs, Uint no)
+{
+ Uint ix;
+
+ for (ix = 0; ix < no; ix++) {
+ funs[ix]->pend_purge_address = NULL;
+#ifdef HIPE
+ funs[ix]->pend_purge_native_address = NULL;
+#endif
+ }
+}
+
+void
+erts_fun_purge_complete(ErlFunEntry **funs, Uint no)
+{
+ Uint ix;
+
+ for (ix = 0; ix < no; ix++) {
+ ErlFunEntry *fe = funs[ix];
+ fe->pend_purge_address = NULL;
+#ifdef HIPE
+ fe->pend_purge_native_address = NULL;
+#endif
+ if (erts_smp_refc_dectest(&fe->refc, 0) == 0)
+ erts_erase_fun_entry(fe);
+ }
+ ERTS_SMP_WRITE_MEMORY_BARRIER;
+}
+
+void
+erts_dump_fun_entries(fmtfn_t to, void *to_arg)
{
int limit;
HashBucket** bucket;
@@ -257,7 +307,7 @@ erts_dump_fun_entries(int to, void *to_arg)
#ifdef HIPE
erts_print(to, to_arg, "Native_address: %p\n", fe->native_address);
#endif
- erts_print(to, to_arg, "Refc: %ld\n", erts_refc_read(&fe->refc, 1));
+ erts_print(to, to_arg, "Refc: %ld\n", erts_smp_refc_read(&fe->refc, 1));
b = b->next;
}
}
@@ -288,10 +338,12 @@ fun_alloc(ErlFunEntry* template)
obj->old_uniq = template->old_uniq;
obj->old_index = template->old_index;
obj->module = template->module;
- erts_refc_init(&obj->refc, -1);
+ erts_smp_refc_init(&obj->refc, -1);
obj->address = unloaded_fun;
+ obj->pend_purge_address = NULL;
#ifdef HIPE
obj->native_address = NULL;
+ obj->pend_purge_native_address = NULL;
#endif
return obj;
}
diff --git a/erts/emulator/beam/erl_fun.h b/erts/emulator/beam/erl_fun.h
index b673ef6b3c..289d0d0b28 100644
--- a/erts/emulator/beam/erl_fun.h
+++ b/erts/emulator/beam/erl_fun.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2000-2012. All Rights Reserved.
+ * Copyright Ericsson AB 2000-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -41,8 +42,12 @@ typedef struct erl_fun_entry {
Uint arity; /* The arity of the fun. */
Eterm module; /* Tagged atom for module. */
- erts_refc_t refc; /* Reference count: One for code + one for each
+ erts_smp_refc_t refc; /* Reference count: One for code + one for each
fun object in each process. */
+ BeamInstr *pend_purge_address; /* address stored during a pending purge */
+#ifdef HIPE
+ UWord* pend_purge_native_address;
+#endif
} ErlFunEntry;
/*
@@ -55,9 +60,6 @@ typedef struct erl_fun_thing {
Eterm thing_word; /* Subtag FUN_SUBTAG. */
ErlFunEntry* fe; /* Pointer to fun entry. */
struct erl_off_heap_header* next;
-#ifdef HIPE
- UWord* native_address; /* Native code for the fun. */
-#endif
Uint arity; /* The arity of the fun. */
Uint num_free; /* Number of free variables (in env). */
/* -- The following may be compound Erlang terms ---------------------- */
@@ -69,7 +71,7 @@ typedef struct erl_fun_thing {
#define ERL_FUN_SIZE ((sizeof(ErlFunThing)/sizeof(Eterm))-1)
void erts_init_fun_table(void);
-void erts_fun_info(int, void *);
+void erts_fun_info(fmtfn_t, void *);
int erts_fun_table_sz(void);
ErlFunEntry* erts_put_fun_entry(Eterm mod, int uniq, int index);
@@ -80,7 +82,10 @@ ErlFunEntry* erts_put_fun_entry2(Eterm mod, int old_uniq, int old_index,
void erts_erase_fun_entry(ErlFunEntry* fe);
void erts_cleanup_funs(ErlFunThing* funp);
-void erts_cleanup_funs_on_purge(BeamInstr* start, BeamInstr* end);
-void erts_dump_fun_entries(int, void *);
+void erts_fun_purge_prepare(BeamInstr* start, BeamInstr* end);
+void erts_fun_purge_abort_prepare(ErlFunEntry **funs, Uint no);
+void erts_fun_purge_abort_finalize(ErlFunEntry **funs, Uint no);
+void erts_fun_purge_complete(ErlFunEntry **funs, Uint no);
+void erts_dump_fun_entries(fmtfn_t, void *);
#endif
diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index aa15d2cc57..8cb977a7f3 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2002-2014. All Rights Reserved.
+ * Copyright Ericsson AB 2002-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -20,6 +21,8 @@
# include "config.h"
#endif
+#define ERL_WANT_GC_INTERNALS__
+
#include "sys.h"
#include "erl_vm.h"
#include "global.h"
@@ -32,17 +35,35 @@
#include "error.h"
#include "big.h"
#include "erl_gc.h"
-#if HIPE
+#ifdef HIPE
#include "hipe_stack.h"
#include "hipe_mode_switch.h"
#endif
#include "dtrace-wrapper.h"
+#include "erl_bif_unique.h"
+#include "dist.h"
+#include "erl_nfunc_sched.h"
#define ERTS_INACT_WR_PB_LEAVE_MUCH_LIMIT 1
#define ERTS_INACT_WR_PB_LEAVE_MUCH_PERCENTAGE 20
#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
+
+#if defined(DEBUG) && 0
+# define HARDDEBUG 1
+#endif
+
/*
* Returns number of elements in an array.
*/
@@ -55,7 +76,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); \
}
@@ -63,10 +84,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
@@ -94,19 +115,35 @@ 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 Uint adjust_after_fullsweep(Process *p, Uint size_before,
- 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, int fcalls,
+ Uint max_young_gen_usage);
+static int major_collection(Process* p, ErlHeapFragment *live_hf_end,
+ int need, Eterm* objv, int nobj,
+ Uint ygen_usage, Uint *recl);
+static int minor_collection(Process* p, ErlHeapFragment *live_hf_end,
+ int need, Eterm* objv, int nobj,
+ Uint ygen_usage, 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);
@@ -116,16 +153,18 @@ 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 int reached_max_heap_size(Process *p, Uint total_heap_size,
+ Uint extra_heap_size, Uint extra_old_heap_size);
static void init_gc_info(ErtsGCInfo *gcip);
+static Uint64 next_vheap_size(Process* p, Uint64 vheap, Uint64 vheap_sz);
#ifdef HARDDEBUG
-static void disallow_heap_frag_ref_in_heap(Process* p);
+static void disallow_heap_frag_ref_in_heap(Process *p, Eterm *heap, Eterm *htop);
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
@@ -139,31 +178,36 @@ Uint erts_test_long_gc_sleep; /* Only used for testing... */
typedef struct {
Process *proc;
Eterm ref;
- Eterm ref_heap[REF_THING_SIZE];
+ Eterm ref_heap[ERTS_REF_THING_SIZE];
Uint req_sched;
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)
-{
- return erts_alloc(ERTS_ALC_T_GC_INFO_REQ,
- sizeof(ErtsGCInfoReq));
-}
+#ifdef ERTS_DIRTY_SCHEDULERS
+static struct {
+ erts_mtx_t mtx;
+ ErtsGCInfo info;
+} dirty_gc;
+#endif
-static ERTS_INLINE void
-gcireq_free(ErtsGCInfoReq *ptr)
+static ERTS_INLINE int
+gc_cost(Uint gc_moved_live_words, Uint resize_moved_words)
{
- erts_free(ERTS_ALC_T_GC_INFO_REQ, ptr);
+ Sint reds;
+
+ 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.
*/
@@ -173,15 +217,15 @@ erts_init_gc(void)
int i = 0, ix;
Sint max_heap_size = 0;
- ASSERT(offsetof(ProcBin,thing_word) == offsetof(struct erl_off_heap_header,thing_word));
- ASSERT(offsetof(ProcBin,thing_word) == offsetof(ErlFunThing,thing_word));
- ASSERT(offsetof(ProcBin,thing_word) == offsetof(ExternalThing,header));
- ASSERT(offsetof(ProcBin,size) == offsetof(struct erl_off_heap_header,size));
- ASSERT(offsetof(ProcBin,size) == offsetof(ErlSubBin,size));
- ASSERT(offsetof(ProcBin,size) == offsetof(ErlHeapBin,size));
- ASSERT(offsetof(ProcBin,next) == offsetof(struct erl_off_heap_header,next));
- ASSERT(offsetof(ProcBin,next) == offsetof(ErlFunThing,next));
- ASSERT(offsetof(ProcBin,next) == offsetof(ExternalThing,next));
+ ERTS_CT_ASSERT(offsetof(ProcBin,thing_word) == offsetof(struct erl_off_heap_header,thing_word));
+ ERTS_CT_ASSERT(offsetof(ProcBin,thing_word) == offsetof(ErlFunThing,thing_word));
+ ERTS_CT_ASSERT(offsetof(ProcBin,thing_word) == offsetof(ExternalThing,header));
+ ERTS_CT_ASSERT(offsetof(ProcBin,size) == offsetof(struct erl_off_heap_header,size));
+ ERTS_CT_ASSERT(offsetof(ProcBin,size) == offsetof(ErlSubBin,size));
+ ERTS_CT_ASSERT(offsetof(ProcBin,size) == offsetof(ErlHeapBin,size));
+ ERTS_CT_ASSERT(offsetof(ProcBin,next) == offsetof(struct erl_off_heap_header,next));
+ ERTS_CT_ASSERT(offsetof(ProcBin,next) == offsetof(ErlFunThing,next));
+ ERTS_CT_ASSERT(offsetof(ProcBin,next) == offsetof(ExternalThing,next));
erts_test_long_gc_sleep = 0;
@@ -205,7 +249,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]
*/
@@ -229,10 +273,13 @@ erts_init_gc(void)
init_gc_info(&esdp->gc_info);
}
-#if !HALFWORD_HEAP
- init_gcireq_alloc();
+#ifdef ERTS_DIRTY_SCHEDULERS
+ erts_smp_mtx_init(&dirty_gc.mtx, "dirty_gc_info", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
+ init_gc_info(&dirty_gc.info);
#endif
+ init_gcireq_alloc();
}
/*
@@ -265,7 +312,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;
}
@@ -348,32 +395,54 @@ 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 (!p->mbuf) {
+ /* Must have GC:d in BIF call... invalidate live_hf_end */
+ live_hf_end = ERTS_INVALID_HFRAG_PTR;
+ }
+
if (is_non_value(result)) {
if (p->freason == TRAP) {
- #if HIPE
+#ifdef HIPE
if (regs == NULL) {
- regs = ERTS_PROC_GET_SCHDATA(p)->x_reg_array;
+ regs = erts_proc_sched_data(p)->x_reg_array;
}
- #endif
- cost = erts_garbage_collect(p, 0, regs, p->arity);
+#endif
+ cost = garbage_collect(p, live_hf_end, 0, regs, p->arity, p->fcalls, 0);
} else {
- cost = erts_garbage_collect(p, 0, regs, arity);
+ cost = garbage_collect(p, live_hf_end, 0, regs, arity, p->fcalls, 0);
}
} 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, p->fcalls, 0);
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;
@@ -387,6 +456,192 @@ 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, int fcalls)
+{
+ 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) {
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (p->flags & (F_DIRTY_MAJOR_GC|F_DIRTY_MINOR_GC)) {
+ ASSERT(!ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(p)));
+ goto force_reschedule;
+ }
+#endif
+ 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);
+ 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 and
+ * save it into mbuf list...
+ */
+ ErlHeapFragment *hfrag = ((ErlHeapFragment *)
+ (((char *) orig_heap)
+ - offsetof(ErlHeapFragment, mem)));
+ Uint used = orig_htop - orig_heap;
+ hfrag->used_size = used;
+ p->mbuf_sz += used;
+ ASSERT(hfrag->used_size <= hfrag->alloc_size);
+ ASSERT(!hfrag->off_heap.first && !hfrag->off_heap.overhead);
+ hfrag->next = p->mbuf;
+ p->mbuf = hfrag;
+ }
+ 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
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+force_reschedule:
+#endif
+
+ /* Make sure that we do a proper GC as soon as possible... */
+ p->flags |= F_FORCE_GC;
+ reds_left = ERTS_REDS_LEFT(p, fcalls);
+ ASSERT(CONTEXT_REDS - reds_left >= erts_proc_sched_data(p)->virtual_reds);
+
+ if (reds_left > ERTS_ABANDON_HEAP_COST) {
+ int vreds = reds_left - ERTS_ABANDON_HEAP_COST;
+ erts_proc_sched_data((p))->virtual_reds += vreds;
+ }
+
+ ERTS_CHK_MBUF_SZ(p);
+
+ ASSERT(CONTEXT_REDS >= erts_proc_sched_data(p)->virtual_reds);
+ return reds_left;
+}
+
+static ERTS_FORCE_INLINE Uint
+young_gen_usage(Process *p)
+{
+ Uint hsz;
+ Eterm *aheap;
+
+ ERTS_CHK_MBUF_SZ(p);
+
+ hsz = p->mbuf_sz;
+
+ if (p->flags & F_ON_HEAP_MSGQ) {
+ ErtsMessage *mp;
+ for (mp = p->msg.first; mp; mp = mp->next) {
+ /*
+ * We leave not yet decoded distribution messages
+ * as they are in the queue since it is not
+ * possible to determine a maximum size until
+ * actual decoding. However, we use their estimated
+ * size when calculating need, and by this making
+ * it more likely that they will fit on the heap
+ * when actually decoded.
+ */
+ if (mp->data.attached)
+ hsz += erts_msg_attached_data_size(mp);
+ }
+ }
+
+ hsz += p->htop - p->heap;
+ aheap = p->abandoned_heap;
+ if (aheap) {
+ /* used in orig heap */
+ if (p->flags & F_ABANDONED_HEAP_USE)
+ hsz += aheap[p->heap_sz-1];
+ else
+ hsz += p->heap_sz;
+ }
+ 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)
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+
+static ERTS_INLINE void
+check_for_possibly_long_gc(Process *p, Uint ygen_usage)
+{
+ int major;
+ Uint sz;
+
+ major = (p->flags & F_NEED_FULLSWEEP) || GEN_GCS(p) >= MAX_GEN_GCS(p);
+
+ sz = ygen_usage;
+ sz += p->hend - p->stop;
+ if (p->flags & F_ON_HEAP_MSGQ)
+ sz += p->msg.len;
+ if (major)
+ sz += p->old_htop - p->old_heap;
+
+ if (sz >= ERTS_POTENTIALLY_LONG_GC_HSIZE) {
+ ASSERT(!(p->flags & (F_DISABLE_GC|F_DELAY_GC)));
+ p->flags |= major ? F_DIRTY_MAJOR_GC : F_DIRTY_MINOR_GC;
+ erts_schedule_dirty_sys_execution(p);
+ }
+}
+
+#endif
+
/*
* Garbage collect a process.
*
@@ -395,39 +650,62 @@ 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, int fcalls,
+ Uint max_young_gen_usage)
{
Uint reclaimed_now = 0;
- int done = 0;
- Uint ms1, s1, us1;
- ErtsSchedulerData *esdp;
+ Uint ygen_usage;
+ Eterm gc_trace_end_tag;
+ int reds;
+ ErtsMonotonicTime start_time;
+ ErtsSchedulerData *esdp = erts_proc_sched_data(p);
+ erts_aint32_t state;
+ 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;
+ ERTS_UNDEF(start_time, 0);
+ ERTS_CHK_MBUF_SZ(p);
+
+ ASSERT(CONTEXT_REDS - ERTS_REDS_LEFT(p, fcalls) >= esdp->virtual_reds);
+
+ state = erts_smp_atomic32_read_nob(&p->state);
+
+ if ((p->flags & (F_DISABLE_GC|F_DELAY_GC)) || state & ERTS_PSFLG_EXITING) {
+#ifdef ERTS_DIRTY_SCHEDULERS
+ delay_gc_before_start:
+#endif
+ return delay_garbage_collection(p, live_hf_end, need, fcalls);
}
- esdp = erts_get_scheduler_data();
+ ygen_usage = max_young_gen_usage ? max_young_gen_usage : young_gen_usage(p);
- if (IS_TRACED_FL(p, F_TRACE_GC)) {
- trace_gc(p, am_gc_start);
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
+ check_for_possibly_long_gc(p, ygen_usage);
+ if (p->flags & (F_DIRTY_MAJOR_GC|F_DIRTY_MINOR_GC))
+ goto delay_gc_before_start;
}
+#endif
+
+ 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);
erts_smp_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC);
- if (erts_system_monitor_long_gc != 0) {
- get_now(&ms1, &s1, &us1);
- }
+ 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)
@@ -440,17 +718,48 @@ 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)) {
+ if (IS_TRACED_FL(p, F_TRACE_GC)) {
+ trace_gc(p, am_gc_minor_start, need, THE_NON_VALUE);
+ }
+ DTRACE2(gc_minor_start, pidbuf, need);
+ reds = minor_collection(p, live_hf_end, need, objv, nobj,
+ ygen_usage, &reclaimed_now);
+ DTRACE2(gc_minor_end, pidbuf, reclaimed_now);
+ if (reds == -1) {
+ if (IS_TRACED_FL(p, F_TRACE_GC)) {
+ trace_gc(p, am_gc_minor_end, reclaimed_now, THE_NON_VALUE);
+ }
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
+ p->flags |= F_NEED_FULLSWEEP;
+ check_for_possibly_long_gc(p, ygen_usage);
+ if (p->flags & F_DIRTY_MAJOR_GC)
+ goto delay_gc_after_start;
+ }
+#endif
+ goto do_major_collection;
+ }
+ if (ERTS_SCHEDULER_IS_DIRTY(esdp))
+ p->flags &= ~F_DIRTY_MINOR_GC;
+ gc_trace_end_tag = am_gc_minor_end;
+ } else {
+do_major_collection:
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_GC_FULL);
+ if (IS_TRACED_FL(p, F_TRACE_GC)) {
+ trace_gc(p, am_gc_major_start, need, THE_NON_VALUE);
+ }
+ DTRACE2(gc_major_start, pidbuf, need);
+ reds = major_collection(p, live_hf_end, need, objv, nobj,
+ ygen_usage, &reclaimed_now);
+ if (ERTS_SCHEDULER_IS_DIRTY(esdp))
+ p->flags &= ~(F_DIRTY_MAJOR_GC|F_DIRTY_MINOR_GC);
+ DTRACE2(gc_major_end, pidbuf, reclaimed_now);
+ gc_trace_end_tag = am_gc_major_end;
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_GC);
}
+
reset_active_writer(p);
/*
@@ -461,23 +770,48 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj)
ErtsGcQuickSanityCheck(p);
+ /* Max heap size has been reached and the process was configured
+ to be killed, so we kill it and set it in a delayed garbage
+ collecting state. There should be no gc_end trace or
+ long_gc/large_gc triggers when this happens as process was
+ killed before a GC could be done. */
+ if (reds == -2) {
+ ErtsProcLocks locks = ERTS_PROC_LOCKS_ALL;
+ int res;
+
+ erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR);
+ erts_send_exit_signal(p, p->common.id, p, &locks,
+ am_kill, NIL, NULL, 0);
+ erts_smp_proc_unlock(p, locks & ERTS_PROC_LOCKS_ALL_MINOR);
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+ delay_gc_after_start:
+#endif
+ /* erts_send_exit_signal looks for ERTS_PSFLG_GC, so
+ we have to remove it after the signal is sent */
+ erts_smp_atomic32_read_band_nob(&p->state, ~ERTS_PSFLG_GC);
+
+ /* We have to make sure that we have space for need on the heap */
+ res = delay_garbage_collection(p, live_hf_end, need, fcalls);
+ ERTS_MSACC_POP_STATE_M();
+ return res;
+ }
+
erts_smp_atomic32_read_band_nob(&p->state, ~ERTS_PSFLG_GC);
if (IS_TRACED_FL(p, F_TRACE_GC)) {
- trace_gc(p, am_gc_end);
+ trace_gc(p, gc_trace_end_tag, reclaimed_now, THE_NON_VALUE);
}
if (erts_system_monitor_long_gc != 0) {
- Uint ms2, s2, us2;
- Sint t;
+ ErtsMonotonicTime end_time;
+ Uint gc_time;
if (erts_test_long_gc_sleep)
while (0 != erts_milli_sleep(erts_test_long_gc_sleep));
- get_now(&ms2, &s2, &us2);
- t = ms2 - ms1;
- t = t*1000000 + s2 - s1;
- t = t*1000 + ((Sint) (us2 - us1))/1000;
- if (t > 0 && (Uint)t > erts_system_monitor_long_gc) {
- monitor_long_gc(p, t);
+ end_time = erts_get_monotonic_time(esdp);
+ gc_time = (Uint) ERTS_MONOTONIC_TO_MSEC(end_time - start_time);
+ if (gc_time && gc_time > erts_system_monitor_long_gc) {
+ monitor_long_gc(p, gc_time);
}
}
if (erts_system_monitor_large_heap != 0) {
@@ -487,10 +821,24 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj)
monitor_large_heap(p);
}
- esdp->gc_info.garbage_cols++;
- esdp->gc_info.reclaimed += reclaimed_now;
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (ERTS_SCHEDULER_IS_DIRTY(esdp)) {
+ erts_mtx_lock(&dirty_gc.mtx);
+ dirty_gc.info.garbage_cols++;
+ dirty_gc.info.reclaimed += reclaimed_now;
+ erts_mtx_unlock(&dirty_gc.mtx);
+ }
+ else
+#endif
+ {
+ esdp->gc_info.garbage_cols++;
+ esdp->gc_info.reclaimed += reclaimed_now;
+ }
- FLAGS(p) &= ~F_FORCE_GC;
+ FLAGS(p) &= ~(F_FORCE_GC|F_HIBERNATED);
+ p->live_hf_end = ERTS_INVALID_HFRAG_PTR;
+
+ ERTS_MSACC_POP_STATE_M();
#ifdef CHECK_FOR_HOLES
/*
@@ -512,92 +860,98 @@ 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;
- }
+ ASSERT(!p->mbuf);
+ ASSERT(!ERTS_IS_GC_DESIRED(p));
+ ASSERT(need <= HEAP_LIMIT(p) - HEAP_TOP(p));
+
+ return reds;
}
+int
+erts_garbage_collect_nobump(Process* p, int need, Eterm* objv, int nobj, int fcalls)
+{
+ int reds = garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj, fcalls, 0);
+ int reds_left = ERTS_REDS_LEFT(p, fcalls);
+ if (reds > reds_left)
+ reds = reds_left;
+ ASSERT(CONTEXT_REDS - (reds_left - reds) >= erts_proc_sched_data(p)->virtual_reds);
+ return reds;
+}
+
+void
+erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj)
+{
+ int reds = garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj, p->fcalls, 0);
+ BUMP_REDS(p, reds);
+ ASSERT(CONTEXT_REDS - ERTS_BIF_REDS_LEFT(p)
+ >= erts_proc_sched_data(p)->virtual_reds);
+}
+
+
/*
* Place all living data on a the new heap; deallocate any old heap.
* Meant to be used by hibernate/3.
*/
-void
-erts_garbage_collect_hibernate(Process* p)
+static int
+garbage_collect_hibernate(Process* p, int check_long_gc)
{
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");
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(p)))
+ p->flags &= ~(F_DIRTY_GC_HIBERNATE|F_DIRTY_MAJOR_GC|F_DIRTY_MINOR_GC);
+ else if (check_long_gc) {
+ Uint flags = p->flags;
+ p->flags |= F_NEED_FULLSWEEP;
+ check_for_possibly_long_gc(p, (p->htop - p->heap) + p->mbuf_sz);
+ if (p->flags & (F_DIRTY_MAJOR_GC|F_DIRTY_MINOR_GC)) {
+ p->flags = flags|F_DIRTY_GC_HIBERNATE;
+ return 1;
+ }
+ p->flags = flags;
+ }
+#endif
/*
* Preliminaries.
*/
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. */
/*
* Do it.
*/
+ heap_size = p->heap_sz + (p->old_htop - p->old_heap) + p->mbuf_sz;
- heap_size = p->heap_sz + (p->old_htop - p->old_heap);
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);
- }
+#ifdef HARDDEBUG
+ disallow_heap_frag_ref_in_heap(p, heap, htop);
+#endif
- /*
- * 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;
- }
+ erts_deallocate_young_generation(p);
p->heap = heap;
p->high_water = htop;
@@ -612,6 +966,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.
@@ -658,16 +1013,80 @@ erts_garbage_collect_hibernate(Process* p)
ErtsGcQuickSanityCheck(p);
+ p->flags |= F_HIBERNATED;
+
erts_smp_atomic32_read_band_nob(&p->state, ~ERTS_PSFLG_GC);
-}
+ reds = gc_cost(actual_size, actual_size);
+ return reds;
+}
void
+erts_garbage_collect_hibernate(Process* p)
+{
+ int reds = garbage_collect_hibernate(p, 1);
+ BUMP_REDS(p, reds);
+}
+
+/*
+ * HiPE native code stack scanning procedures:
+ * - fullsweep_nstack()
+ * - gensweep_nstack()
+ * - offset_nstack()
+ * - sweep_literals_nstack()
+ */
+#if defined(HIPE)
+
+#define GENSWEEP_NSTACK(p,old_htop,n_htop) \
+ do { \
+ Eterm *tmp_old_htop = old_htop; \
+ Eterm *tmp_n_htop = n_htop; \
+ gensweep_nstack((p), &tmp_old_htop, &tmp_n_htop); \
+ old_htop = tmp_old_htop; \
+ n_htop = tmp_n_htop; \
+ } while(0)
+
+/*
+ * offset_nstack() can ignore the descriptor-based traversal the other
+ * nstack procedures use and simply call offset_heap_ptr() instead.
+ * This relies on two facts:
+ * 1. The only live non-Erlang terms on an nstack are return addresses,
+ * and they will be skipped thanks to the low/high range check.
+ * 2. Dead values, even if mistaken for pointers into the low/high area,
+ * can be offset safely since they won't be dereferenced.
+ *
+ * XXX: WARNING: If HiPE starts storing other non-Erlang values on the
+ * nstack, such as floats, then this will have to be changed.
+ */
+static ERTS_INLINE void offset_nstack(Process* p, Sint offs,
+ char* area, Uint area_size)
+{
+ if (p->hipe.nstack) {
+ ASSERT(p->hipe.nsp && p->hipe.nstend);
+ offset_heap_ptr(hipe_nstack_start(p), hipe_nstack_used(p),
+ offs, area, area_size);
+ }
+ else {
+ ASSERT(!p->hipe.nsp && !p->hipe.nstend);
+ }
+}
+
+#else /* !HIPE */
+
+#define fullsweep_nstack(p,n_htop) (n_htop)
+#define GENSWEEP_NSTACK(p,old_htop,n_htop) do{}while(0)
+#define offset_nstack(p,offs,area,area_size) do{}while(0)
+#define sweep_literals_nstack(p,old_htop,area,area_size) (old_htop)
+
+#endif /* HIPE */
+
+int
erts_garbage_collect_literals(Process* p, Eterm* literals,
- Uint lit_size,
- struct erl_off_heap_header* oh)
+ Uint byte_lit_size,
+ struct erl_off_heap_header* oh,
+ int fcalls)
{
- 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;
@@ -677,20 +1096,53 @@ erts_garbage_collect_literals(Process* p, Eterm* literals,
Uint area_size;
Eterm* old_htop;
Uint n;
- struct erl_off_heap_header** prev;
+ Uint ygen_usage = 0;
+ struct erl_off_heap_header** prev = NULL;
+ Sint64 reds;
+ int hibernated = !!(p->flags & F_HIBERNATED);
+
+ if (p->flags & (F_DISABLE_GC|F_DELAY_GC))
+ ERTS_INTERNAL_ERROR("GC disabled");
+
+ /*
+ * First an ordinary major collection...
+ */
+
+ p->flags |= F_NEED_FULLSWEEP;
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(p)))
+ p->flags &= ~F_DIRTY_CLA;
+ else {
+ Uint size = byte_lit_size/sizeof(Uint);
+ ygen_usage = young_gen_usage(p);
+ if (hibernated)
+ size = size*2 + 3*ygen_usage;
+ else
+ size = size + 2*ygen_usage;
+ check_for_possibly_long_gc(p, size);
+ if (p->flags & F_DIRTY_MAJOR_GC) {
+ p->flags |= F_DIRTY_CLA;
+ return 10;
+ }
+ }
+#endif
+
+ reds = (Sint64) garbage_collect(p, ERTS_INVALID_HFRAG_PTR, 0,
+ p->arg_reg, p->arity, fcalls,
+ ygen_usage);
+
+ ASSERT(!(p->flags & (F_DIRTY_MAJOR_GC|F_DIRTY_MINOR_GC)));
- if (p->flags & F_DISABLE_GC)
- return;
/*
* Set GC state.
*/
erts_smp_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC);
/*
- * We assume that the caller has already done a major collection
- * (which has discarded the old heap), so that we don't have to cope
- * with pointer to literals on the old heap. We will now allocate
- * an old heap to contain the literals.
+ * Just did a major collection (which has discarded the old heap),
+ * so that we don't have to cope with pointer to literals on the
+ * old heap. We will now allocate an old heap to contain the literals.
*/
ASSERT(p->old_heap == 0); /* Must NOT have an old heap yet. */
@@ -724,7 +1176,7 @@ erts_garbage_collect_literals(Process* p, Eterm* literals,
area_size = byte_lit_size;
n = setup_rootset(p, p->arg_reg, p->arity, &rootset);
roots = rootset.roots;
- old_htop = p->old_htop;
+ old_htop = sweep_literals_nstack(p, p->old_htop, area, area_size);
while (n--) {
Eterm* g_ptr = roots->v;
Uint g_sz = roots->sz;
@@ -743,8 +1195,8 @@ 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)) {
- MOVE_BOXED(ptr,val,old_htop,g_ptr++);
+ } else if (ErtsInArea(ptr, area, area_size)) {
+ move_boxed(&ptr,val,&old_htop,g_ptr++);
} else {
g_ptr++;
}
@@ -754,8 +1206,8 @@ 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)) {
- MOVE_CONS(ptr,val,old_htop,g_ptr++);
+ } else if (ErtsInArea(ptr, area, area_size)) {
+ move_cons(&ptr,val,&old_htop,g_ptr++);
} else {
g_ptr++;
}
@@ -774,8 +1226,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;
@@ -786,10 +1240,10 @@ erts_garbage_collect_literals(Process* p, Eterm* literals,
*/
if (oh) {
- prev = &MSO(p).first;
- while (*prev) {
- prev = &(*prev)->next;
- }
+ prev = &MSO(p).first;
+ while (*prev) {
+ prev = &(*prev)->next;
+ }
}
/*
@@ -811,13 +1265,17 @@ erts_garbage_collect_literals(Process* p, Eterm* literals,
* link it into the MSO list for the process.
*/
- erts_refc_inc(&bptr->refc, 1);
+ erts_refc_inc(&bptr->intern.refc, 1);
*prev = ptr;
prev = &ptr->next;
}
oh = oh->next;
}
+ if (prev) {
+ *prev = NULL;
+ }
+
/*
* We no longer need this temporary area.
*/
@@ -827,18 +1285,61 @@ erts_garbage_collect_literals(Process* p, Eterm* literals,
* Restore status.
*/
erts_smp_atomic32_read_band_nob(&p->state, ~ERTS_PSFLG_GC);
+
+ reds += (Sint64) gc_cost((p->htop - p->heap) + byte_lit_size/sizeof(Uint), 0);
+
+ if (hibernated) {
+ /* Restore the process into hibernated state... */
+ reds += garbage_collect_hibernate(p, 0);
+ }
+
+ if (reds > INT_MAX)
+ return INT_MAX;
+ return (int) reds;
}
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 ygen_usage, 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 = ygen_usage;
+
+ /*
+ * Check if we have gone past the max heap size limit
+ */
+
+ if (MAX_HEAP_SIZE_GET(p)) {
+ Uint heap_size = size_before,
+ /* Note that we also count the un-allocated area
+ in between the stack and heap */
+ stack_size = HEAP_END(p) - HEAP_TOP(p),
+ extra_heap_size,
+ extra_old_heap_size = 0;
+
+ /* Add potential old heap size */
+ if (OLD_HEAP(p) == NULL && mature_size != 0) {
+ extra_old_heap_size = erts_next_heap_size(size_before, 1);
+ heap_size += extra_old_heap_size;
+ } else if (OLD_HEAP(p))
+ heap_size += OLD_HEND(p) - OLD_HEAP(p);
+
+ /* Add potential new young heap size */
+ extra_heap_size = next_heap_size(p, stack_size + size_before, 0);
+ heap_size += extra_heap_size;
+
+ if (heap_size > MAX_HEAP_SIZE_GET(p))
+ if (reached_max_heap_size(p, heap_size, extra_heap_size, extra_old_heap_size))
+ return -2;
+ }
/*
* 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,
@@ -846,7 +1347,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,
@@ -862,35 +1363,34 @@ 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;
- Uint stack_size = STACK_SZ_ON_HEAP(p);
- Uint fragments = MBUF_SIZE(p) + combined_message_size(p);
- Uint size_before = fragments + (HEAP_TOP(p) - HEAP_START(p));
- Uint new_sz = next_heap_size(p, HEAP_SIZE(p) + fragments, 0);
-
- do_minor(p, new_sz, objv, nobj);
+ ((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);
+
+ 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);
+
+ 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) {
- erts_move_msg_attached_data_to_heap(&p->htop, &p->off_heap, msgp);
- ErtsGcQuickSanityCheck(p);
- }
- }
ErtsGcQuickSanityCheck(p);
GEN_GCS(p)++;
- size_after = HEAP_TOP(p) - HEAP_START(p);
- need_after = size_after + need + stack_size;
- *recl += (size_before - size_after);
+ need_after = ((HEAP_TOP(p) - HEAP_START(p))
+ + need
+ + stack_size);
/*
* Excessively large heaps should be shrunk, but
@@ -901,6 +1401,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))))) {
@@ -922,80 +1424,41 @@ 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));
- return 1; /* We are done. */
}
+ else if (need_after > HEAP_SIZE(p)) {
+ grow_new_heap(p, next_heap_size(p, need_after, 0), objv, nobj);
+ adjust_size = p->htop - p->heap;
+ }
+ /*else: The heap size turned out to be just right. We are 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));
- return 1;
- }
+ ASSERT(HEAP_SIZE(p) == next_heap_size(p, HEAP_SIZE(p), 0));
+
+ /* The heap usage during GC should be larger than what we end up
+ after a GC, even if we grow it. If this assertion is not true
+ we have to check size in grow_new_heap and potentially kill the
+ process from there */
+ ASSERT(!MAX_HEAP_SIZE_GET(p) ||
+ !(MAX_HEAP_SIZE_FLAGS_GET(p) & MAX_HEAP_SIZE_KILL) ||
+ MAX_HEAP_SIZE_GET(p) > (young_gen_usage(p) +
+ (OLD_HEND(p) - OLD_HEAP(p)) +
+ (HEAP_END(p) - HEAP_TOP(p))));
+
+ 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;
-}
-
-/*
- * HiPE native code stack scanning procedures:
- * - fullsweep_nstack()
- * - gensweep_nstack()
- * - offset_nstack()
- */
-#if defined(HIPE)
-
-#define GENSWEEP_NSTACK(p,old_htop,n_htop) \
- do { \
- Eterm *tmp_old_htop = old_htop; \
- Eterm *tmp_n_htop = n_htop; \
- gensweep_nstack((p), &tmp_old_htop, &tmp_n_htop); \
- old_htop = tmp_old_htop; \
- n_htop = tmp_n_htop; \
- } while(0)
-
-/*
- * offset_nstack() can ignore the descriptor-based traversal the other
- * nstack procedures use and simply call offset_heap_ptr() instead.
- * This relies on two facts:
- * 1. The only live non-Erlang terms on an nstack are return addresses,
- * and they will be skipped thanks to the low/high range check.
- * 2. Dead values, even if mistaken for pointers into the low/high area,
- * can be offset safely since they won't be dereferenced.
- *
- * XXX: WARNING: If HiPE starts storing other non-Erlang values on the
- * nstack, such as floats, then this will have to be changed.
- */
-static ERTS_INLINE void offset_nstack(Process* p, Sint offs,
- char* area, Uint area_size)
-{
- if (p->hipe.nstack) {
- ASSERT(p->hipe.nsp && p->hipe.nstend);
- offset_heap_ptr(hipe_nstack_start(p), hipe_nstack_used(p),
- offs, area, area_size);
- }
- else {
- ASSERT(!p->hipe.nsp && !p->hipe.nstend);
- }
+ return -1;
}
-#else /* !HIPE */
-
-#define fullsweep_nstack(p,n_htop) (n_htop)
-#define GENSWEEP_NSTACK(p,old_htop,n_htop) do{}while(0)
-#define offset_nstack(p,offs,area,area_size) do{}while(0)
-
-#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;
@@ -1004,17 +1467,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);
@@ -1037,10 +1507,10 @@ 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)) {
- MOVE_BOXED(ptr,val,old_htop,g_ptr++);
- } else if (in_area(ptr, heap, heap_size)) {
- MOVE_BOXED(ptr,val,n_htop,g_ptr++);
+ } else if (ErtsInArea(ptr, mature, mature_size)) {
+ move_boxed(&ptr,val,&old_htop,g_ptr++);
+ } else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) {
+ move_boxed(&ptr,val,&n_htop,g_ptr++);
} else {
g_ptr++;
}
@@ -1052,10 +1522,10 @@ 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)) {
- MOVE_CONS(ptr,val,old_htop,g_ptr++);
- } else if (in_area(ptr, heap, heap_size)) {
- MOVE_CONS(ptr,val,n_htop,g_ptr++);
+ } else if (ErtsInArea(ptr, mature, mature_size)) {
+ move_cons(&ptr,val,&old_htop,g_ptr++);
+ } else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) {
+ move_cons(&ptr,val,&n_htop,g_ptr++);
} else {
g_ptr++;
}
@@ -1079,7 +1549,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;
@@ -1096,10 +1566,10 @@ 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)) {
- MOVE_BOXED(ptr,val,old_htop,n_hp++);
- } else if (in_area(ptr, heap, heap_size)) {
- MOVE_BOXED(ptr,val,n_htop,n_hp++);
+ } else if (ErtsInArea(ptr, mature, mature_size)) {
+ move_boxed(&ptr,val,&old_htop,n_hp++);
+ } else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) {
+ move_boxed(&ptr,val,&n_htop,n_hp++);
} else {
n_hp++;
}
@@ -1110,10 +1580,10 @@ 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)) {
- MOVE_CONS(ptr,val,old_htop,n_hp++);
- } else if (in_area(ptr, heap, heap_size)) {
- MOVE_CONS(ptr,val,n_htop,n_hp++);
+ } else if (ErtsInArea(ptr, mature, mature_size)) {
+ move_cons(&ptr,val,&old_htop,n_hp++);
+ } else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) {
+ move_cons(&ptr,val,&n_htop,n_hp++);
} else {
n_hp++;
}
@@ -1132,11 +1602,11 @@ 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)) {
- MOVE_BOXED(ptr,val,old_htop,origptr);
+ } 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)) {
- MOVE_BOXED(ptr,val,n_htop,origptr);
+ } else if (ErtsInYoungGen(*origptr, ptr, oh, oh_size)) {
+ move_boxed(&ptr,val,&n_htop,origptr);
mb->base = binary_bytes(mb->orig);
}
}
@@ -1156,9 +1626,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;
@@ -1189,18 +1658,16 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
}
#endif
- ERTS_HEAP_FREE(ERTS_ALC_T_HEAP,
- (void*)HEAP_START(p),
- HEAP_SIZE(p) * sizeof(Eterm));
+#ifdef HARDDEBUG
+ disallow_heap_frag_ref_in_heap(p, n_heap, n_htop);
+#endif
+
+ erts_deallocate_young_generation(p);
+
HEAP_START(p) = n_heap;
HEAP_TOP(p) = n_htop;
HEAP_SIZE(p) = new_sz;
HEAP_END(p) = n_heap + new_sz;
-
-#ifdef HARDDEBUG
- disallow_heap_frag_ref_in_heap(p);
-#endif
- remove_message_buffers(p);
}
/*
@@ -1208,38 +1675,31 @@ 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 ygen_usage, Uint *recl)
{
- Rootset rootset;
- Roots* roots;
- Uint size_before;
+ 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 fragments = MBUF_SIZE(p) + combined_message_size(p);
- ErlMessage *msgp;
+ Uint new_sz, stk_sz;
+ int adjusted;
- size_before = fragments + (HEAP_TOP(p) - HEAP_START(p));
+ 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) + fragments + (OLD_HTOP(p) - OLD_HEAP(p));
- /*
- * We used to do
- *
- * new_sz += STACK_SZ_ON_HEAP(p);
- *
- * here for no obvious reason. (The stack size is already counted once
- * in HEAP_SIZE(p).)
- */
+ size_before = ygen_usage;
+ 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);
/*
@@ -1249,17 +1709,93 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
if (new_sz == HEAP_SIZE(p) && FLAGS(p) & F_HEAP_GROW) {
new_sz = next_heap_size(p, HEAP_SIZE(p), 1);
}
+
+
+ if (MAX_HEAP_SIZE_GET(p)) {
+ Uint heap_size = size_before;
+
+ /* Add unused space in old heap */
+ heap_size += OLD_HEND(p) - OLD_HTOP(p);
+
+ /* Add stack + unused space in young heap */
+ heap_size += HEAP_END(p) - HEAP_TOP(p);
+
+ /* Add size of new young heap */
+ heap_size += new_sz;
+
+ if (MAX_HEAP_SIZE_GET(p) < heap_size)
+ if (reached_max_heap_size(p, heap_size, new_sz, 0))
+ return -2;
+ }
+
FLAGS(p) &= ~(F_HEAP_GROW|F_NEED_FULLSWEEP);
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);
+ }
+
+ 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);
- if (MBUF(p) != NULL) {
- n_htop = collect_heap_frags(p, n_heap, n_htop, objv, nobj);
+ dtrace_proc_str(p, pidbuf);
+ DTRACE3(process_heap_grow, pidbuf, HEAP_SIZE(p), new_sz);
}
+#endif
+
+#ifdef HARDDEBUG
+ disallow_heap_frag_ref_in_heap(p, n_heap, n_htop);
+#endif
+
+ erts_deallocate_young_generation(p);
+
+ 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);
+
+ 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);
+
+ 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
@@ -1267,7 +1803,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;
@@ -1278,7 +1821,7 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
Eterm* ptr;
Eterm val;
Eterm gval = *g_ptr;
-
+
switch (primary_tag(gval)) {
case TAG_PRIMARY_BOXED: {
@@ -1287,8 +1830,8 @@ 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)) {
- MOVE_BOXED(ptr,val,n_htop,g_ptr++);
+ } else if (!erts_is_literal(gval, ptr)) {
+ move_boxed(&ptr,val,&n_htop,g_ptr++);
} else {
g_ptr++;
}
@@ -1300,8 +1843,8 @@ 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)) {
- MOVE_CONS(ptr,val,n_htop,g_ptr++);
+ } else if (!erts_is_literal(gval, ptr)) {
+ move_cons(&ptr,val,&n_htop,g_ptr++);
} else {
g_ptr++;
}
@@ -1325,74 +1868,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);
@@ -1405,73 +1881,26 @@ 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);
-
- /*
- * Copy newly received message onto the end of the new heap.
- */
- for (msgp = p->msg.first; msgp; msgp = msgp->next) {
- if (msgp->data.attached) {
- erts_move_msg_attached_data_to_heap(&p->htop, &p->off_heap, msgp);
- ErtsGcQuickSanityCheck(p);
- }
- }
-
- *recl += adjust_after_fullsweep(p, size_before, 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 Uint
-adjust_after_fullsweep(Process *p, Uint size_before, int need, Eterm *objv, int nobj)
+static int
+adjust_after_fullsweep(Process *p, int need, Eterm *objv, int nobj)
{
- Uint wanted, sz, size_after, need_after;
+ int adjusted = 0;
+ Uint wanted, sz, need_after;
Uint stack_size = STACK_SZ_ON_HEAP(p);
- Uint reclaimed_now;
-
- size_after = (HEAP_TOP(p) - HEAP_START(p));
- reclaimed_now = (size_before - size_after);
/*
* Resize the heap if needed.
*/
- need_after = size_after + need + stack_size;
+ need_after = (HEAP_TOP(p) - HEAP_START(p)) + need + stack_size;
if (HEAP_SIZE(p) < need_after) {
/* 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;
@@ -1488,42 +1917,62 @@ adjust_after_fullsweep(Process *p, Uint size_before, int need, Eterm *objv, int
if (sz < HEAP_SIZE(p)) {
shrink_new_heap(p, sz, objv, nobj);
+ adjusted = 1;
}
}
-
- return reclaimed_now;
+ return adjusted;
}
-/*
- * Return the size of all message buffers that are NOT linked in the
- * mbuf list.
- */
-static Uint
-combined_message_size(Process* p)
+void
+erts_deallocate_young_generation(Process *c_p)
{
- Uint sz = 0;
- ErlMessage *msgp;
+ Eterm *orig_heap;
- for (msgp = p->msg.first; msgp; msgp = msgp->next) {
- if (msgp->data.attached) {
- sz += erts_msg_attached_data_size(msgp);
- }
+ if (!c_p->abandoned_heap) {
+ orig_heap = c_p->heap;
+ ASSERT(!(c_p->flags & F_ABANDONED_HEAP_USE));
}
- return sz;
-}
+ else {
+ ErlHeapFragment *hfrag;
-/*
- * Remove all message buffers.
- */
-static void
-remove_message_buffers(Process* p)
-{
- if (MBUF(p) != NULL) {
- free_message_buffer(MBUF(p));
- MBUF(p) = NULL;
+ orig_heap = c_p->abandoned_heap;
+ c_p->abandoned_heap = NULL;
+ c_p->flags &= ~F_ABANDONED_HEAP_USE;
+
+ /*
+ * Temporary heap located in heap fragment
+ * only referred to by 'c_p->heap'. Add it to
+ * 'c_p->mbuf' list and deallocate it as any
+ * other heap fragment...
+ */
+ hfrag = ((ErlHeapFragment *)
+ (((char *) c_p->heap)
+ - offsetof(ErlHeapFragment, mem)));
+
+ ASSERT(!hfrag->off_heap.first);
+ ASSERT(!hfrag->off_heap.overhead);
+ ASSERT(!hfrag->next);
+ ASSERT(c_p->htop - c_p->heap <= hfrag->alloc_size);
+
+ hfrag->next = c_p->mbuf;
+ c_p->mbuf = hfrag;
+ }
+
+ if (c_p->mbuf) {
+ free_message_buffer(c_p->mbuf);
+ c_p->mbuf = NULL;
}
- MBUF_SIZE(p) = 0;
+ if (c_p->msg_frag) {
+ erts_cleanup_messages(c_p->msg_frag);
+ c_p->msg_frag = NULL;
+ }
+ c_p->mbuf_sz = 0;
+
+ ERTS_HEAP_FREE(ERTS_ALC_T_HEAP,
+ orig_heap,
+ c_p->heap_sz * sizeof(Eterm));
}
+
#ifdef HARDDEBUG
/*
@@ -1533,79 +1982,17 @@ 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)
+disallow_heap_frag_ref_in_heap(Process *p, Eterm *heap, Eterm *htop)
{
Eterm* hp;
- Eterm* htop;
- Eterm* heap;
Uint heap_size;
if (p->mbuf == 0) {
return;
}
- htop = p->htop;
- heap = p->heap;
heap_size = (htop - heap)*sizeof(Eterm);
hp = heap;
@@ -1618,9 +2005,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();
}
}
@@ -1628,9 +2015,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();
}
}
@@ -1672,26 +2059,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();
}
}
@@ -1700,7 +2087,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();
}
}
@@ -1710,66 +2097,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);
@@ -1781,8 +2132,8 @@ 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)) {
- MOVE_BOXED(ptr,val,n_htop,n_hp++);
+ } else if (ERTS_IS_IN_SWEEP_AREA(gval, ptr)) {
+ move_boxed(&ptr,val,&n_htop,n_hp++);
} else {
n_hp++;
}
@@ -1793,8 +2144,8 @@ 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)) {
- MOVE_CONS(ptr,val,n_htop,n_hp++);
+ } else if (ERTS_IS_IN_SWEEP_AREA(gval, ptr)) {
+ move_cons(&ptr,val,&n_htop,n_hp++);
} else {
n_hp++;
}
@@ -1807,15 +2158,15 @@ sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size)
if (header_is_bin_matchstate(gval)) {
ErlBinMatchState *ms = (ErlBinMatchState*) n_hp;
ErlBinMatchBuffer *mb = &(ms->mb);
- Eterm* origptr;
+ 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)) {
- MOVE_BOXED(ptr,val,n_htop,origptr);
+ } else if (ERTS_IS_IN_SWEEP_AREA(*origptr, ptr)) {
+ move_boxed(&ptr,val,&n_htop,origptr);
mb->base = binary_bytes(*origptr);
}
}
@@ -1829,10 +2180,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;
@@ -1846,8 +2228,8 @@ 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)) {
- MOVE_BOXED(ptr,val,htop,heap_ptr++);
+ } else if (ErtsInArea(ptr, src, src_size)) {
+ move_boxed(&ptr,val,&htop,heap_ptr++);
} else {
heap_ptr++;
}
@@ -1858,8 +2240,8 @@ 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)) {
- MOVE_CONS(ptr,val,htop,heap_ptr++);
+ } else if (ErtsInArea(ptr, src, src_size)) {
+ move_cons(&ptr,val,&htop,heap_ptr++);
} else {
heap_ptr++;
}
@@ -1869,6 +2251,21 @@ sweep_one_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop, char* src, Uint sr
if (!header_is_thing(gval)) {
heap_ptr++;
} else {
+ if (header_is_bin_matchstate(gval)) {
+ ErlBinMatchState *ms = (ErlBinMatchState*) heap_ptr;
+ 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 (ErtsInArea(ptr, src, src_size)) {
+ move_boxed(&ptr,val,&htop,origptr);
+ mb->base = binary_bytes(*origptr);
+ }
+ }
heap_ptr += (thing_arityval(gval)+1);
}
break;
@@ -1898,11 +2295,11 @@ move_one_area(Eterm* n_htop, char* src, Uint src_size)
ASSERT(val != ERTS_HOLE_MARKER);
if (is_header(val)) {
ASSERT(ptr + header_arity(val) < end);
- MOVE_BOXED(ptr, val, n_htop, &dummy_ref);
+ move_boxed(&ptr, val, &n_htop, &dummy_ref);
}
else { /* must be a cons cell */
ASSERT(ptr+1 < end);
- MOVE_CONS(ptr, val, n_htop, &dummy_ref);
+ move_cons(&ptr, val, &n_htop, &dummy_ref);
ptr += 2;
}
}
@@ -1915,32 +2312,22 @@ 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) {
frag_begin = (char *) qb->mem;
@@ -1951,12 +2338,178 @@ 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:
+ if (erts_is_literal(val,list_val(val))) {
+ *hp++ = val;
+ } else {
+ *hp++ = offset_ptr(val, offs);
+ }
+ break;
+ case TAG_PRIMARY_BOXED:
+ if (erts_is_literal(val,boxed_val(val))) {
+ *hp++ = val;
+ } else {
+ *hp++ = offset_ptr(val, offs);
+ }
+ break;
+ case TAG_PRIMARY_HEADER:
+ *hp++ = val;
+ switch (val & _HEADER_SUBTAG_MASK) {
+ case ARITYVAL_SUBTAG:
+ break;
+ case REF_SUBTAG:
+ if (is_ordinary_ref_thing(fhp - 1))
+ goto the_default;
+ 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:
+ the_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;
+ Uint64 pre_oh = MSO(p).overhead;
+
+ while (*mpp) {
+ ErtsMessage *mp = *mpp;
+
+ if (mp->data.attached) {
+ ErlHeapFragment *bp;
+
+ /*
+ * We leave not yet decoded distribution messages
+ * as they are in the queue since it is not
+ * possible to determine a maximum size until
+ * actual decoding...
+ */
+ if (is_value(ERL_MESSAGE_TERM(mp))) {
+
+ bp = erts_message_to_heap_frag(mp);
+
+ if (bp->next)
+ erts_move_multi_frags(&p->htop, &p->off_heap, bp,
+ mp->m, ERL_MESSAGE_REF_ARRAY_SZ, 0);
+ else
+ copy_one_frag(&p->htop, &p->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 *new_mp = erts_alloc_message(0, NULL);
+ sys_memcpy((void *) new_mp->m, (void *) mp->m,
+ sizeof(Eterm)*ERL_MESSAGE_REF_ARRAY_SZ);
+ erts_msgq_replace_msg_ref(&p->msg, new_mp, mpp);
+ mp->next = NULL;
+ erts_cleanup_messages(mp);
+ mp = new_mp;
+ }
+ }
+ }
+
+ mpp = &(*mpp)->next;
+ }
+
+ if (pre_oh != MSO(p).overhead) {
+ /* Got new binaries; update vheap size... */
+ BIN_VHEAP_SZ(p) = next_vheap_size(p, MSO(p).overhead, BIN_VHEAP_SZ(p));
+ }
+}
+
static Uint
setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset)
{
- Uint avail;
+ /*
+ * NOTE!
+ * Remember to update offset_rootset() when changing
+ * this function.
+ */
Roots* roots;
- ErlMessage* mp;
Uint n;
n = 0;
@@ -1968,8 +2521,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) {
@@ -1979,7 +2532,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;
@@ -1993,11 +2546,9 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset)
n++;
}
#endif
- ASSERT(is_nil(ERTS_TRACER_PROC(p)) ||
- is_internal_pid(ERTS_TRACER_PROC(p)) ||
- is_internal_port(ERTS_TRACER_PROC(p)));
+ ASSERT(IS_TRACER_VALID(ERTS_TRACER(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;
@@ -2018,33 +2569,56 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset)
roots[n].sz = 1;
n++;
}
+
+ /*
+ * If a NIF or BIF has saved arguments, they need to be added
+ */
+ if (erts_setup_nif_export_rootset(p, &roots[n].v, &roots[n].sz))
+ n++;
+
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;
@@ -2255,6 +2829,16 @@ link_live_proc_bin(struct shrink_cand_data *shrink,
*prevppp = &pbp->next;
}
+#ifdef ERTS_MAGIC_REF_THING_HEADER
+/*
+ * ERTS_MAGIC_REF_THING_HEADER only defined when there
+ * is a size difference between magic and ordinary references...
+ */
+# define ERTS_USED_MAGIC_REF_THING_HEADER__ ERTS_MAGIC_REF_THING_HEADER
+#else
+# define ERTS_USED_MAGIC_REF_THING_HEADER__ ERTS_REF_THING_HEADER
+#endif
+
static void
sweep_off_heap(Process *p, int fullsweep)
@@ -2279,16 +2863,17 @@ sweep_off_heap(Process *p, int fullsweep)
prev = &MSO(p).first;
ptr = MSO(p).first;
- /* Firts part of the list will reside on the (old) new-heap.
+ /* First part of the list will reside on the (old) new-heap.
* Keep if moved, otherwise deref.
*/
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);
+ switch (ptr->thing_word) {
+ case HEADER_PROC_BIN: {
+ 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);
@@ -2296,55 +2881,84 @@ sweep_off_heap(Process *p, int fullsweep)
BIN_OLD_VHEAP(p) += ptr->size / sizeof(Eterm); /* for binary gc (words)*/
}
link_live_proc_bin(&shrink, &prev, &ptr, to_new_heap);
- }
- else {
+ break;
+ }
+ case ERTS_USED_MAGIC_REF_THING_HEADER__: {
+ Uint size;
+ int to_new_heap = !ErtsInArea(ptr, oheap, oheap_sz);
+ ASSERT(is_magic_ref_thing(ptr));
+ ASSERT(to_new_heap == !seen_mature || (!to_new_heap && (seen_mature=1)));
+ size = (Uint) ((ErtsMRefThing *) ptr)->mb->orig_size;
+ if (to_new_heap)
+ bin_vheap += size / sizeof(Eterm);
+ else
+ BIN_OLD_VHEAP(p) += size / sizeof(Eterm); /* for binary gc (words)*/
+ /* fall through... */
+ }
+ default:
prev = &ptr->next;
ptr = ptr->next;
}
}
- else if (!in_area(ptr, oheap, oheap_sz)) {
+ else if (ErtsInArea(ptr, oheap, oheap_sz))
+ break; /* and let old-heap loop continue */
+ else {
/* garbage */
switch (thing_subtag(ptr->thing_word)) {
case REFC_BINARY_SUBTAG:
{
Binary* bptr = ((ProcBin*)ptr)->val;
- if (erts_refc_dectest(&bptr->refc, 0) == 0) {
- erts_bin_free(bptr);
- }
+ erts_bin_release(bptr);
break;
}
case FUN_SUBTAG:
{
ErlFunEntry* fe = ((ErlFunThing*)ptr)->fe;
- if (erts_refc_dectest(&fe->refc, 0) == 0) {
+ if (erts_smp_refc_dectest(&fe->refc, 0) == 0) {
erts_erase_fun_entry(fe);
}
break;
}
+ case REF_SUBTAG:
+ {
+ ErtsMagicBinary *bptr;
+ ASSERT(is_magic_ref_thing(ptr));
+ bptr = ((ErtsMRefThing *) ptr)->mb;
+ erts_bin_release((Binary *) bptr);
+ break;
+ }
default:
ASSERT(is_external_header(ptr->thing_word));
erts_deref_node_entry(((ExternalThing*)ptr)->node);
}
*prev = ptr = ptr->next;
}
- else break; /* and let old-heap loop continue */
}
/* The rest of the list resides on old-heap, and we just did a
* 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) {
+ switch (ptr->thing_word) {
+ case HEADER_PROC_BIN:
BIN_OLD_VHEAP(p) += ptr->size / sizeof(Eterm); /* for binary gc (words)*/
link_live_proc_bin(&shrink, &prev, &ptr, 0);
- }
- else {
- ASSERT(is_fun_header(ptr->thing_word) ||
- is_external_header(ptr->thing_word));
- prev = &ptr->next;
- ptr = ptr->next;
+ break;
+ case ERTS_USED_MAGIC_REF_THING_HEADER__:
+ ASSERT(is_magic_ref_thing(ptr));
+ BIN_OLD_VHEAP(p) +=
+ (((Uint) ((ErtsMRefThing *) ptr)->mb->orig_size)
+ / sizeof(Eterm)); /* for binary gc (words)*/
+ /* fall through... */
+ default:
+ ASSERT(is_fun_header(ptr->thing_word) ||
+ is_external_header(ptr->thing_word)
+ || is_magic_ref_thing(ptr));
+ prev = &ptr->next;
+ ptr = ptr->next;
+ break;
}
}
@@ -2353,7 +2967,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.
@@ -2386,7 +2999,6 @@ sweep_off_heap(Process *p, int fullsweep)
}
pb->val = erts_bin_realloc(pb->val, new_size);
- pb->val->orig_size = new_size;
pb->bytes = (byte *) pb->val->orig_bytes;
}
}
@@ -2425,7 +3037,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++;
@@ -2439,6 +3051,9 @@ offset_heap(Eterm* hp, Uint sz, Sint offs, char* area, Uint area_size)
}
tari = thing_arityval(val);
switch (thing_subtag(val)) {
+ case REF_SUBTAG:
+ if (is_ordinary_ref_thing(hp))
+ break;
case REFC_BINARY_SUBTAG:
case FUN_SUBTAG:
case EXTERNAL_PID_SUBTAG:
@@ -2447,7 +3062,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 */
}
@@ -2457,7 +3072,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);
}
@@ -2487,7 +3102,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++;
@@ -2502,7 +3117,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;
}
@@ -2514,35 +3129,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;
+ }
+
}
}
@@ -2550,9 +3169,11 @@ static void ERTS_INLINE
offset_one_rootset(Process *p, Sint offs, char* area, Uint area_size,
Eterm* objv, int nobj)
{
+ Eterm *v;
+ Uint sz;
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);
}
@@ -2570,6 +3191,8 @@ offset_one_rootset(Process *p, Sint offs, char* area, Uint area_size,
offset_heap_ptr(objv, nobj, offs, area, area_size);
}
offset_off_heap(p, offs, area, area_size);
+ if (erts_setup_nif_export_rootset(p, &v, &sz))
+ offset_heap_ptr(v, sz, offs, area, area_size);
}
static void
@@ -2601,12 +3224,24 @@ reply_gc_info(void *vgcirp)
Eterm **hpp;
Uint sz, *szp;
ErlOffHeap *ohp = NULL;
- ErlHeapFragment *bp = NULL;
+ ErtsMessage *mp = NULL;
ASSERT(esdp);
reclaimed = esdp->gc_info.reclaimed;
garbage_cols = esdp->gc_info.garbage_cols;
+#ifdef ERTS_DIRTY_SCHEDULERS
+ /*
+ * Add dirty schedulers info on requesting
+ * schedulers info
+ */
+ if (gcirp->req_sched == esdp->no) {
+ erts_mtx_lock(&dirty_gc.mtx);
+ reclaimed += dirty_gc.info.reclaimed;
+ garbage_cols += dirty_gc.info.garbage_cols;
+ erts_mtx_unlock(&dirty_gc.mtx);
+ }
+#endif
sz = 0;
hpp = NULL;
@@ -2616,7 +3251,7 @@ reply_gc_info(void *vgcirp)
if (hpp)
ref_copy = STORE_NC(hpp, ohp, gcirp->ref);
else
- *szp += REF_THING_SIZE;
+ *szp += ERTS_REF_THING_SIZE;
msg = erts_bld_tuple(hpp, szp, 3,
make_small(esdp->no),
@@ -2627,16 +3262,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
-#ifdef USE_VM_PROBES
- , NIL
-#endif
- );
+ erts_queue_message(rp, rp_locks, mp, msg, am_system);
if (gcirp->req_sched == esdp->no)
rp_locks &= ~ERTS_PROC_LOCK_MAIN;
@@ -2644,16 +3276,49 @@ reply_gc_info(void *vgcirp)
if (rp_locks)
erts_smp_proc_unlock(rp, rp_locks);
- erts_smp_proc_dec_refc(rp);
+ erts_proc_dec_refc(rp);
if (erts_smp_atomic32_dec_read_nob(&gcirp->refc) == 0)
gcireq_free(vgcirp);
}
+void erts_sub_binary_to_heap_binary(Eterm **pp, Eterm **hpp, Eterm *orig) {
+ Eterm *ptr = *pp;
+ Eterm *htop = *hpp;
+ Eterm gval;
+ ErlSubBin *sb = (ErlSubBin *)ptr;
+ ErlHeapBin *hb = (ErlHeapBin *)htop;
+ Eterm *real_bin;
+ byte *bs;
+
+ real_bin = binary_val(follow_moved(sb->orig, (Eterm)0));
+
+ if (*real_bin == HEADER_PROC_BIN) {
+ bs = ((ProcBin *) real_bin)->bytes + sb->offs;
+ } else {
+ bs = (byte *)(&(((ErlHeapBin *) real_bin)->data)) + sb->offs;
+ }
+
+ hb->thing_word = header_heap_bin(sb->size);
+ hb->size = sb->size;
+ sys_memcpy((byte *)hb->data, bs, sb->size);
+
+ gval = make_boxed(htop);
+ *orig = gval;
+ *ptr = gval;
+
+ ptr += ERL_SUB_BIN_SIZE;
+ htop += heap_bin_size(sb->size);
+
+ *hpp = htop;
+ *pp = ptr;
+}
+
+
Eterm
erts_gc_info_request(Process *c_p)
{
- ErtsSchedulerData *esdp = ERTS_PROC_GET_SCHDATA(c_p);
+ ErtsSchedulerData *esdp = erts_proc_sched_data(c_p);
Eterm ref;
ErtsGCInfoReq *gcirp;
Eterm *hp;
@@ -2668,7 +3333,7 @@ erts_gc_info_request(Process *c_p)
erts_smp_atomic32_init_nob(&gcirp->refc,
(erts_aint32_t) erts_no_schedulers);
- erts_smp_proc_add_refc(c_p, (Sint32) erts_no_schedulers);
+ erts_proc_add_refc(c_p, (Sint) erts_no_schedulers);
#ifdef ERTS_SMP
if (erts_no_schedulers > 1)
@@ -2683,48 +3348,251 @@ erts_gc_info_request(Process *c_p)
return ref;
}
-#if defined(DEBUG) || defined(ERTS_OFFHEAP_DEBUG)
+Eterm
+erts_process_gc_info(Process *p, Uint *sizep, Eterm **hpp,
+ Uint extra_heap_block,
+ Uint extra_old_heap_block_size)
+{
+ 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) + extra_old_heap_block_size
+ : extra_old_heap_block_size,
+ HEAP_SIZE(p) + extra_heap_block,
+ 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;
+ ErtsMessage *mp;
+
+ ERTS_CT_ASSERT(sizeof(values)/sizeof(*values) == sizeof(tags)/sizeof(*tags));
+ ERTS_CT_ASSERT(sizeof(values)/sizeof(*values) == ERTS_PROCESS_GC_INFO_MAX_TERMS);
+
+ if (p->abandoned_heap) {
+ Eterm *htop, *heap;
+ ERTS_GET_ORIG_HEAP(p, heap, htop);
+ values[3] = HIGH_WATER(p) - heap;
+ values[6] = htop - heap;
+ }
+
+ if (p->flags & F_ON_HEAP_MSGQ) {
+ /* If on heap messages in the internal queue are counted
+ as being part of the heap, so we have to add them to the
+ am_mbuf_size value. process_info(total_heap_size) should
+ be the same as adding old_heap_block_size + heap_block_size
+ + mbuf_size.
+ */
+ for (mp = p->msg.first; mp; mp = mp->next)
+ if (mp->data.attached)
+ values[2] += erts_msg_attached_data_size(mp);
+ }
+
+ res = erts_bld_atom_uword_2tup_list(hpp,
+ sizep,
+ sizeof(values)/sizeof(*values),
+ tags,
+ values);
+
+ return res;
+}
static int
-within2(Eterm *ptr, Process *p, Eterm *real_htop)
+reached_max_heap_size(Process *p, Uint total_heap_size,
+ Uint extra_heap_size, Uint extra_old_heap_size)
+{
+ Uint max_heap_flags = MAX_HEAP_SIZE_FLAGS_GET(p);
+ if (IS_TRACED_FL(p, F_TRACE_GC) ||
+ max_heap_flags & MAX_HEAP_SIZE_LOG) {
+ Eterm msg;
+ Uint size = 0;
+ Eterm *o_hp , *hp;
+ erts_process_gc_info(p, &size, NULL, extra_heap_size,
+ extra_old_heap_size);
+ o_hp = hp = erts_alloc(ERTS_ALC_T_TMP, size * sizeof(Eterm));
+ msg = erts_process_gc_info(p, NULL, &hp, extra_heap_size,
+ extra_old_heap_size);
+
+ if (max_heap_flags & MAX_HEAP_SIZE_LOG) {
+ int alive = erts_is_alive;
+ erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
+ Eterm *o_hp, *hp, args = NIL;
+
+ /* Build the format message */
+ erts_dsprintf(dsbufp, " Process: ~p ");
+ if (alive)
+ erts_dsprintf(dsbufp, "on node ~p");
+ erts_dsprintf(dsbufp, "~n Context: maximum heap size reached~n");
+ erts_dsprintf(dsbufp, " Max Heap Size: ~p~n");
+ erts_dsprintf(dsbufp, " Total Heap Size: ~p~n");
+ erts_dsprintf(dsbufp, " Kill: ~p~n");
+ erts_dsprintf(dsbufp, " Error Logger: ~p~n");
+ erts_dsprintf(dsbufp, " GC Info: ~p~n");
+
+ /* Build the args in reverse order */
+ o_hp = hp = erts_alloc(ERTS_ALC_T_TMP, 2*(alive ? 7 : 6) * sizeof(Eterm));
+ args = CONS(hp, msg, args); hp += 2;
+ args = CONS(hp, am_true, args); hp += 2;
+ args = CONS(hp, (max_heap_flags & MAX_HEAP_SIZE_KILL ? am_true : am_false), args); hp += 2;
+ args = CONS(hp, make_small(total_heap_size), args); hp += 2;
+ args = CONS(hp, make_small(MAX_HEAP_SIZE_GET(p)), args); hp += 2;
+ if (alive) {
+ args = CONS(hp, erts_this_node->sysname, args); hp += 2;
+ }
+ args = CONS(hp, p->common.id, args); hp += 2;
+
+ erts_send_error_term_to_logger(p->group_leader, dsbufp, args);
+ erts_free(ERTS_ALC_T_TMP, o_hp);
+ }
+
+ if (IS_TRACED_FL(p, F_TRACE_GC))
+ trace_gc(p, am_gc_max_heap_size, 0, msg);
+
+ erts_free(ERTS_ALC_T_TMP, o_hp);
+ }
+ /* returns true if we should kill the process */
+ return max_heap_flags & MAX_HEAP_SIZE_KILL;
+}
+
+Eterm
+erts_max_heap_size_map(Sint max_heap_size, Uint max_heap_flags,
+ Eterm **hpp, Uint *sz)
+{
+ if (!hpp) {
+ *sz += (2*3 + 1 + MAP_HEADER_FLATMAP_SZ);
+ return THE_NON_VALUE;
+ } else {
+ Eterm *hp = *hpp;
+ Eterm keys = TUPLE3(hp, am_error_logger, am_kill, am_size);
+ flatmap_t *mp;
+ hp += 4;
+ mp = (flatmap_t*) hp;
+ mp->thing_word = MAP_HEADER_FLATMAP;
+ mp->size = 3;
+ mp->keys = keys;
+ hp += MAP_HEADER_FLATMAP_SZ;
+ *hp++ = max_heap_flags & MAX_HEAP_SIZE_LOG ? am_true : am_false;
+ *hp++ = max_heap_flags & MAX_HEAP_SIZE_KILL ? am_true : am_false;
+ *hp++ = make_small(max_heap_size);
+ *hpp = hp;
+ return make_flatmap(mp);
+ }
+}
+
+int
+erts_max_heap_size(Eterm arg, Uint *max_heap_size, Uint *max_heap_flags)
+{
+ Sint sz;
+ *max_heap_flags = H_MAX_FLAGS;
+ if (is_small(arg)) {
+ sz = signed_val(arg);
+ *max_heap_flags = H_MAX_FLAGS;
+ } else if (is_map(arg)) {
+ const Eterm *size = erts_maps_get(am_size, arg);
+ const Eterm *kill = erts_maps_get(am_kill, arg);
+ const Eterm *log = erts_maps_get(am_error_logger, arg);
+ if (size && is_small(*size)) {
+ sz = signed_val(*size);
+ } else {
+ /* size is mandatory */
+ return 0;
+ }
+ if (kill) {
+ if (*kill == am_true)
+ *max_heap_flags |= MAX_HEAP_SIZE_KILL;
+ else if (*kill == am_false)
+ *max_heap_flags &= ~MAX_HEAP_SIZE_KILL;
+ else
+ return 0;
+ }
+ if (log) {
+ if (*log == am_true)
+ *max_heap_flags |= MAX_HEAP_SIZE_LOG;
+ else if (*log == am_false)
+ *max_heap_flags &= ~MAX_HEAP_SIZE_LOG;
+ else
+ return 0;
+ }
+ } else
+ return 0;
+ if (sz < 0)
+ return 0;
+ *max_heap_size = sz;
+ return 1;
+}
+
+#if defined(DEBUG) || defined(ERTS_OFFHEAP_DEBUG)
+
+int
+erts_dbg_within_proc(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);
+ if (heap <= ptr && ptr < htop)
+ return 1;
+ }
+
+ 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)
+
+ bp = erts_message_to_heap_frag(mp);
+ 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;
-}
-int
-within(Eterm *ptr, Process *p)
-{
- return within2(ptr, p, NULL);
+ return 0;
}
#endif
@@ -2734,16 +3602,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)
{
@@ -2757,22 +3625,26 @@ erts_check_off_heap2(Process *p, Eterm *htop)
erts_aint_t refc;
switch (thing_subtag(u.hdr->thing_word)) {
case REFC_BINARY_SUBTAG:
- refc = erts_refc_read(&u.pb->val->refc, 1);
+ refc = erts_refc_read(&u.pb->val->intern.refc, 1);
break;
case FUN_SUBTAG:
- refc = erts_refc_read(&u.fun->fe->refc, 1);
+ refc = erts_smp_refc_read(&u.fun->fe->refc, 1);
break;
case EXTERNAL_PID_SUBTAG:
case EXTERNAL_PORT_SUBTAG:
case EXTERNAL_REF_SUBTAG:
- refc = erts_refc_read(&u.ext->node->refc, 1);
+ refc = erts_smp_refc_read(&u.ext->node->refc, 1);
+ break;
+ case REF_SUBTAG:
+ ASSERT(is_magic_ref_thing(u.hdr));
+ refc = erts_refc_read(&u.mref->mb->intern.refc, 1);
break;
default:
ASSERT(!"erts_check_off_heap2: Invalid thing_word");
}
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) {
@@ -2781,11 +3653,11 @@ erts_check_off_heap2(Process *p, Eterm *htop)
else if (oheap <= u.ep && u.ep < ohtop)
old = 1;
else {
- ERTS_CHK_OFFHEAP_ASSERT(within2(u.ep, p, htop));
+ ERTS_CHK_OFFHEAP_ASSERT(erts_dbg_within_proc(u.ep, p, 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 5203dda263..6a529b8443 100644
--- a/erts/emulator/beam/erl_gc.h
+++ b/erts/emulator/beam/erl_gc.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2007-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2007-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -20,63 +21,87 @@
#ifndef __ERL_GC_H__
#define __ERL_GC_H__
-#include "erl_map.h"
+#if defined(ERL_WANT_GC_INTERNALS__) || defined(ERTS_DO_INCL_GLB_INLINE_FUNC_DEF)
/* GC declarations shared by beam/erl_gc.c and hipe/hipe_gc.c */
-#if defined(DEBUG) && !ERTS_GLB_INLINE_INCL_FUNC_DEF
-# define HARDDEBUG 1
-#endif
+#define ERTS_POTENTIALLY_LONG_GC_HSIZE (128*1024) /* Words */
+
+#include "erl_map.h"
+#include "erl_fun.h"
+#include "erl_bits.h"
#define IS_MOVED_BOXED(x) (!is_header((x)))
#define IS_MOVED_CONS(x) (is_non_value((x)))
+void erts_sub_binary_to_heap_binary(Eterm **pp, Eterm **hpp, Eterm *orig);
-#define MOVE_CONS(PTR,CAR,HTOP,ORIG) \
-do { \
- Eterm gval; \
- \
- HTOP[0] = CAR; /* copy car */ \
- HTOP[1] = PTR[1]; /* copy cdr */ \
- gval = make_list(HTOP); /* new location */ \
- *ORIG = gval; /* redirect original reference */ \
- PTR[0] = THE_NON_VALUE; /* store forwarding indicator */ \
- PTR[1] = gval; /* store forwarding address */ \
- HTOP += 2; /* update tospace htop */ \
-} while(0)
-
-#define MOVE_BOXED(PTR,HDR,HTOP,ORIG) \
-do { \
- Eterm gval; \
- Sint nelts; \
- \
- ASSERT(is_header(HDR)); \
- nelts = header_arity(HDR); \
- switch ((HDR) & _HEADER_SUBTAG_MASK) { \
- case SUB_BINARY_SUBTAG: nelts++; break; \
- case MAP_SUBTAG: nelts+=map_get_size(PTR) + 1; break; \
- case FUN_SUBTAG: nelts+=((ErlFunThing*)(PTR))->num_free+1; break; \
- } \
- gval = make_boxed(HTOP); \
- *ORIG = gval; \
- *HTOP++ = HDR; \
- *PTR++ = gval; \
- while (nelts--) *HTOP++ = *PTR++; \
- \
-} while(0)
-
-#define in_area(ptr,start,nbytes) \
- ((UWord)((char*)(ptr) - (char*)(start)) < (nbytes))
+ERTS_GLB_INLINE void move_cons(Eterm **pp, Eterm car, Eterm **hpp, Eterm *orig);
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+ERTS_GLB_INLINE void move_cons(Eterm **pp, Eterm car, Eterm **hpp, Eterm *orig)
+{
+ Eterm *ptr = *pp;
+ Eterm *htop = *hpp;
+ Eterm gval;
-extern Uint erts_test_long_gc_sleep;
+ htop[0] = car; /* copy car */
+ htop[1] = ptr[1]; /* copy cdr */
+ gval = make_list(htop); /* new location */
+ *orig = gval; /* redirect original reference */
+ ptr[0] = THE_NON_VALUE; /* store forwarding indicator */
+ ptr[1] = gval; /* store forwarding address */
+ *hpp += 2; /* update tospace htop */
+}
+#endif
-#if defined(DEBUG) || defined(ERTS_OFFHEAP_DEBUG)
-int within(Eterm *ptr, Process *p);
+ERTS_GLB_INLINE void move_boxed(Eterm **pp, Eterm hdr, Eterm **hpp, Eterm *orig);
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+ERTS_GLB_INLINE void move_boxed(Eterm **pp, Eterm hdr, Eterm **hpp, Eterm *orig)
+{
+ Eterm gval;
+ Sint nelts;
+ Eterm *ptr = *pp;
+ Eterm *htop = *hpp;
+
+ ASSERT(is_header(hdr));
+ nelts = header_arity(hdr);
+ switch ((hdr) & _HEADER_SUBTAG_MASK) {
+ case SUB_BINARY_SUBTAG:
+ {
+ ErlSubBin *sb = (ErlSubBin *)ptr;
+ /* convert sub-binary to heap-binary if applicable */
+ if (sb->bitsize == 0 && sb->bitoffs == 0 &&
+ sb->is_writable == 0 && sb->size <= sizeof(Eterm) * 3) {
+ erts_sub_binary_to_heap_binary(pp, hpp, orig);
+ return;
+ }
+ }
+ nelts++;
+ break;
+ case MAP_SUBTAG:
+ if (is_flatmap_header(hdr)) nelts+=flatmap_get_size(ptr) + 1;
+ else nelts += hashmap_bitcount(MAP_HEADER_VAL(hdr));
+ break;
+ case FUN_SUBTAG: nelts+=((ErlFunThing*)(ptr))->num_free+1; break;
+ }
+ gval = make_boxed(htop);
+ *orig = gval;
+ *htop++ = hdr;
+ *ptr++ = gval;
+ while (nelts--) *htop++ = *ptr++;
+
+ *hpp = htop;
+ *pp = ptr;
+}
#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)) {
@@ -84,17 +109,79 @@ 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__ */
+
+/*
+ * 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 {
+ Uint64 reclaimed;
+ 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 **, Uint, Uint);
+
+void erts_gc_info(ErtsGCInfo *gcip);
+void erts_init_gc(void);
+int erts_garbage_collect_nobump(struct process*, int, Eterm*, int, 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);
+int erts_garbage_collect_literals(struct process* p, Eterm* literals,
+ Uint lit_size,
+ struct erl_off_heap_header* oh,
+ int fcalls);
+Uint erts_next_heap_size(Uint, Uint);
+Eterm erts_heap_sizes(struct process* p);
+
+void erts_offset_off_heap(struct erl_off_heap*, Sint, Eterm*, Eterm*);
+void erts_offset_heap_ptr(Eterm*, Uint, Sint, Eterm*, Eterm*);
+void erts_offset_heap(Eterm*, Uint, Sint, Eterm*, Eterm*);
+void erts_free_heap_frags(struct process* p);
+Eterm erts_max_heap_size_map(Sint, Uint, Eterm **, Uint *);
+int erts_max_heap_size(Eterm, Uint *, Uint *);
+void erts_deallocate_young_generation(Process *c_p);
+#if defined(DEBUG) || defined(ERTS_OFFHEAP_DEBUG)
+int erts_dbg_within_proc(Eterm *ptr, Process *p, Eterm* real_htop);
#endif
#endif /* __ERL_GC_H__ */
diff --git a/erts/emulator/beam/erl_goodfit_alloc.c b/erts/emulator/beam/erl_goodfit_alloc.c
index e9d8249ee1..50aa41b4d2 100644
--- a/erts/emulator/beam/erl_goodfit_alloc.c
+++ b/erts/emulator/beam/erl_goodfit_alloc.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2003-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2003-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -167,7 +168,7 @@ static Block_t * get_free_block (Allctr_t *, Uint,
static void link_free_block (Allctr_t *, Block_t *);
static void unlink_free_block (Allctr_t *, Block_t *);
static void update_last_aux_mbc (Allctr_t *, Carrier_t *);
-static Eterm info_options (Allctr_t *, char *, int *,
+static Eterm info_options (Allctr_t *, char *, fmtfn_t *,
void *, Uint **, Uint *);
static void init_atoms (void);
@@ -550,7 +551,7 @@ add_2tup(Uint **hpp, Uint *szp, Eterm *lp, Eterm el1, Eterm el2)
static Eterm
info_options(Allctr_t *allctr,
char *prefix,
- int *print_to_p,
+ fmtfn_t *print_to_p,
void *print_to_arg,
Uint **hpp,
Uint *szp)
@@ -570,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_goodfit_alloc.h b/erts/emulator/beam/erl_goodfit_alloc.h
index 385de0da23..76dd558234 100644
--- a/erts/emulator/beam/erl_goodfit_alloc.h
+++ b/erts/emulator/beam/erl_goodfit_alloc.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2003-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2003-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/beam/erl_hl_timer.c b/erts/emulator/beam/erl_hl_timer.c
new file mode 100644
index 0000000000..6e5cc7b801
--- /dev/null
+++ b/erts/emulator/beam/erl_hl_timer.c
@@ -0,0 +1,3541 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2015-2017. 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: High level timers implementing BIF timers
+ * as well as process and port timers.
+ *
+ * Author: Rickard Green
+ */
+
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+/* #define ERTS_MAGIC_REF_BIF_TIMERS */
+
+#include "sys.h"
+#include "global.h"
+#include "bif.h"
+#include "erl_bif_unique.h"
+#define ERTS_WANT_TIMER_WHEEL_API
+#include "erl_time.h"
+#include "erl_hl_timer.h"
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+#include "erl_binary.h"
+#endif
+
+#define ERTS_TMR_CHECK_CANCEL_ON_CREATE 0
+
+#if 0
+# define ERTS_HLT_HARD_DEBUG
+#endif
+#if 0
+# define ERTS_HLT_DEBUG
+#endif
+
+#if defined(ERTS_HLT_HARD_DEBUG) || defined(DEBUG)
+# if defined(ERTS_HLT_HARD_DEBUG)
+# undef ERTS_RBT_HARD_DEBUG
+# define ERTS_RBT_HARD_DEBUG 1
+# endif
+# ifndef ERTS_HLT_DEBUG
+# define ERTS_HLT_DEBUG 1
+# endif
+#endif
+
+#undef ERTS_HLT_ASSERT
+#if defined(ERTS_HLT_DEBUG)
+# define ERTS_HLT_ASSERT(E) ERTS_ASSERT(E)
+# undef ERTS_RBT_DEBUG
+# define ERTS_RBT_DEBUG
+#else
+# define ERTS_HLT_ASSERT(E) ((void) 1)
+#endif
+
+#if defined(ERTS_HLT_HARD_DEBUG) && defined(__GNUC__)
+#warning "* * * * * * * * * * * * * * * * * *"
+#warning "* ERTS_HLT_HARD_DEBUG IS ENABLED! *"
+#warning "* * * * * * * * * * * * * * * * * *"
+#endif
+
+#ifdef ERTS_HLT_HARD_DEBUG
+# define ERTS_HLT_HDBG_CHK_SRV(SRV) hdbg_chk_srv((SRV))
+static void hdbg_chk_srv(ErtsHLTimerService *srv);
+#else
+# define ERTS_HLT_HDBG_CHK_SRV(SRV) ((void) 1)
+#endif
+
+#if ERTS_REF_NUMBERS != 3
+#error "ERTS_REF_NUMBERS changed. Update me..."
+#endif
+
+typedef enum {
+ ERTS_TMR_BIF,
+ ERTS_TMR_PROC,
+ ERTS_TMR_PORT,
+ ERTS_TMR_CALLBACK
+} ErtsTmrType;
+
+#define ERTS_BIF_TIMER_SHORT_TIME 5000
+
+#ifdef ERTS_SMP
+# define ERTS_HLT_SMP_MEMBAR_LoadLoad_LoadStore \
+ ETHR_MEMBAR(ETHR_LoadLoad|ETHR_LoadStore)
+#else
+# define ERTS_HLT_SMP_MEMBAR_LoadLoad_LoadStore
+#endif
+
+/* Bit 0 to 10 contains scheduler id (see mask below) */
+#define ERTS_TMR_ROFLG_HLT (((Uint32) 1) << 11)
+#define ERTS_TMR_ROFLG_BIF_TMR (((Uint32) 1) << 12)
+#define ERTS_TMR_ROFLG_PRE_ALC (((Uint32) 1) << 13)
+#define ERTS_TMR_ROFLG_REG_NAME (((Uint32) 1) << 14)
+#define ERTS_TMR_ROFLG_PROC (((Uint32) 1) << 15)
+#define ERTS_TMR_ROFLG_PORT (((Uint32) 1) << 16)
+#define ERTS_TMR_ROFLG_CALLBACK (((Uint32) 1) << 17)
+
+#define ERTS_TMR_ROFLG_SID_MASK \
+ (ERTS_TMR_ROFLG_HLT - (Uint32) 1)
+
+#define ERTS_TMR_STATE_ACTIVE ((erts_aint32_t) 0)
+#define ERTS_TMR_STATE_CANCELED ((erts_aint32_t) 1)
+#define ERTS_TMR_STATE_TIMED_OUT ((erts_aint32_t) 2)
+
+typedef struct ErtsHLTimer_ ErtsHLTimer;
+
+#define ERTS_HLT_PFLG_RED (((UWord) 1) << 0)
+#define ERTS_HLT_PFLG_SAME_TIME (((UWord) 1) << 1)
+
+#define ERTS_HLT_PFLGS_MASK \
+ (ERTS_HLT_PFLG_RED|ERTS_HLT_PFLG_SAME_TIME)
+
+#define ERTS_HLT_PFIELD_NOT_IN_TABLE (~((UWord) 0))
+
+typedef struct ErtsBifTimer_ ErtsBifTimer;
+
+typedef struct {
+ ErtsBifTimer *next;
+ ErtsBifTimer *prev;
+} ErtsBifTimerList;
+
+typedef struct {
+ UWord parent; /* parent pointer and flags... */
+ union {
+ struct {
+ ErtsHLTimer *right;
+ ErtsHLTimer *left;
+ } t;
+ struct {
+ ErtsHLTimer *prev;
+ ErtsHLTimer *next;
+ } l;
+ } u;
+ ErtsHLTimer *same_time;
+} ErtsHLTimerTimeTree;
+
+typedef struct {
+ UWord parent; /* parent pointer and flags... */
+ ErtsBifTimer *right;
+ ErtsBifTimer *left;
+} ErtsBifTimerTree;
+
+typedef struct {
+ Uint32 roflgs;
+ erts_smp_atomic32_t refc;
+ union {
+ void *arg;
+ erts_atomic_t next;
+ } u;
+ union {
+ Process *proc;
+ Port *port;
+ Eterm name;
+ void (*callback)(void *);
+ } receiver;
+} ErtsTmrHead;
+
+struct ErtsHLTimer_ {
+ ErtsTmrHead head; /* NEED to be first! */
+ ErtsMonotonicTime timeout;
+ union {
+ ErtsThrPrgrLaterOp cleanup;
+ ErtsHLTimerTimeTree tree;
+ } time;
+
+#ifdef ERTS_HLT_HARD_DEBUG
+ int pending_timeout;
+#endif
+};
+
+typedef struct {
+ ErtsTmrHead head; /* NEED to be first! */
+ union {
+ ErtsTWheelTimer tw_tmr;
+ ErtsThrPrgrLaterOp cleanup;
+ } u;
+} ErtsTWTimer;
+
+struct ErtsBifTimer_ {
+ union {
+ ErtsTmrHead head;
+ ErtsHLTimer hlt;
+ ErtsTWTimer twt;
+ } type;
+ struct {
+ erts_smp_atomic32_t state;
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+ ErtsMagicBinary *mbin;
+ ErtsHLTimerList proc_list;
+#else
+ Uint32 refn[ERTS_REF_NUMBERS];
+ ErtsBifTimerTree proc_tree;
+ ErtsBifTimerTree tree;
+#endif
+ Eterm message;
+ ErlHeapFragment *bp;
+ } btm;
+};
+
+typedef union {
+ ErtsTmrHead head;
+ ErtsHLTimer hlt;
+ ErtsTWTimer twt;
+ ErtsBifTimer btm;
+} ErtsTimer;
+
+typedef ErtsTimer *(*ErtsCreateTimerFunc)(ErtsSchedulerData *esdp,
+ ErtsMonotonicTime timeout_pos,
+ int short_time, ErtsTmrType type,
+ void *rcvrp, Eterm rcvr,
+ Eterm msg,
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+ ErtsMagicBinary *mbin,
+#else
+ Uint32 *refn,
+#endif
+ void (*callback)(void *), void *arg);
+
+#ifdef SMALL_MEMORY
+#define BIF_TIMER_PREALC_SZ 10
+#define PTIMER_PREALC_SZ 10
+#else
+#define BIF_TIMER_PREALC_SZ 100
+#define PTIMER_PREALC_SZ 100
+#endif
+
+ERTS_SCHED_PREF_PALLOC_IMPL(bif_timer_pre,
+ ErtsBifTimer,
+ BIF_TIMER_PREALC_SZ)
+
+ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(tw_timer,
+ ErtsTWTimer,
+ PTIMER_PREALC_SZ,
+ ERTS_ALC_T_LL_PTIMER)
+
+#ifdef ERTS_HLT_DEBUG
+#define ERTS_TMR_TIMEOUT_YIELD_LIMIT 5
+#else
+#define ERTS_TMR_TIMEOUT_YIELD_LIMIT 100
+#endif
+#define ERTS_TMR_CANCELED_TIMER_LIMIT 100
+#define ERTS_TMR_CANCELED_TIMER_SMALL_LIMIT 5
+
+#define ERTS_TMR_TIMEOUT_YIELD_STATE_T same_time_list_yield_state_t
+#define ERTS_TMR_YIELDING_TIMEOUT_STATE_INITER {NULL, {0}}
+typedef struct {
+ int dummy;
+} ERTS_TMR_TIMEOUT_YIELD_STATE_T;
+
+typedef struct {
+ ErtsTmrHead marker;
+ erts_atomic_t last;
+} ErtsHLTCncldTmrQTail;
+
+#ifdef ERTS_SMP
+
+typedef struct {
+ /*
+ * This structure needs to be cache line aligned for best
+ * performance.
+ */
+ union {
+ /*
+ * Modified by threads returning canceled
+ * timers to this timer service.
+ */
+ ErtsHLTCncldTmrQTail data;
+ char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(
+ sizeof(ErtsHLTCncldTmrQTail))];
+ } tail;
+ /*
+ * Everything below this point is *only* accessed by the
+ * thread managing this timer service.
+ */
+ struct {
+ ErtsTimer *first;
+ ErtsTimer *unref_end;
+ struct {
+ ErtsThrPrgrVal thr_progress;
+ int thr_progress_reached;
+ ErtsTimer *unref_end;
+ } next;
+ int used_marker;
+ } head;
+} ErtsHLTCncldTmrQ;
+
+#endif /* ERTS_SMP */
+
+typedef struct {
+ ErtsHLTimer *root;
+ ERTS_TMR_TIMEOUT_YIELD_STATE_T state;
+} ErtsYieldingTimeoutState;
+
+struct ErtsHLTimerService_ {
+#ifdef ERTS_SMP
+ ErtsHLTCncldTmrQ canceled_queue;
+#endif
+ ErtsHLTimer *time_tree;
+#ifndef ERTS_MAGIC_REF_BIF_TIMERS
+ ErtsBifTimer *btm_tree;
+#endif
+ ErtsHLTimer *next_timeout;
+ ErtsYieldingTimeoutState yield;
+ ErtsTWheelTimer service_timer;
+};
+
+#ifndef ERTS_MAGIC_REF_BIF_TIMERS
+
+static ERTS_INLINE int
+refn_is_lt(Uint32 *x, Uint32 *y)
+{
+ /* !0 if x < y */
+ if (x[2] < y[2])
+ return 1;
+ if (x[2] != y[2])
+ return 0;
+ if (x[1] < y[1])
+ return 1;
+ if (x[1] != y[1])
+ return 0;
+ return x[0] < y[0];
+}
+
+static ERTS_INLINE int
+refn_is_eq(Uint32 *x, Uint32 *y)
+{
+ return (x[0] == y[0]) & (x[1] == y[1]) & (x[2] == y[2]);
+}
+
+#endif
+
+#define ERTS_RBT_PREFIX time
+#define ERTS_RBT_T ErtsHLTimer
+#define ERTS_RBT_KEY_T ErtsMonotonicTime
+#define ERTS_RBT_FLAGS_T UWord
+#define ERTS_RBT_INIT_EMPTY_TNODE(T) \
+ do { \
+ (T)->time.tree.parent = (UWord) NULL; \
+ (T)->time.tree.u.t.right = NULL; \
+ (T)->time.tree.u.t.left = NULL; \
+ } while (0)
+#define ERTS_RBT_IS_RED(T) \
+ ((int) ((T)->time.tree.parent & ERTS_HLT_PFLG_RED))
+#define ERTS_RBT_SET_RED(T) \
+ ((T)->time.tree.parent |= ERTS_HLT_PFLG_RED)
+#define ERTS_RBT_IS_BLACK(T) \
+ (!ERTS_RBT_IS_RED((T)))
+#define ERTS_RBT_SET_BLACK(T) \
+ ((T)->time.tree.parent &= ~ERTS_HLT_PFLG_RED)
+#define ERTS_RBT_GET_FLAGS(T) \
+ ((T)->time.tree.parent & ERTS_HLT_PFLGS_MASK)
+#define ERTS_RBT_SET_FLAGS(T, F) \
+ do { \
+ ERTS_HLT_ASSERT((((UWord) (F)) & ~ERTS_HLT_PFLGS_MASK) == 0); \
+ (T)->time.tree.parent &= ~ERTS_HLT_PFLGS_MASK; \
+ (T)->time.tree.parent |= (F); \
+ } while (0)
+#define ERTS_RBT_GET_PARENT(T) \
+ ((ErtsHLTimer *) ((T)->time.tree.parent & ~ERTS_HLT_PFLGS_MASK))
+#define ERTS_RBT_SET_PARENT(T, P) \
+ do { \
+ ERTS_HLT_ASSERT((((UWord) (P)) & ERTS_HLT_PFLGS_MASK) == 0); \
+ (T)->time.tree.parent &= ERTS_HLT_PFLGS_MASK; \
+ (T)->time.tree.parent |= (UWord) (P); \
+ } while (0)
+#define ERTS_RBT_GET_RIGHT(T) ((T)->time.tree.u.t.right)
+#define ERTS_RBT_SET_RIGHT(T, R) ((T)->time.tree.u.t.right = (R))
+#define ERTS_RBT_GET_LEFT(T) ((T)->time.tree.u.t.left)
+#define ERTS_RBT_SET_LEFT(T, L) ((T)->time.tree.u.t.left = (L))
+#define ERTS_RBT_GET_KEY(T) ((T)->timeout)
+#define ERTS_RBT_IS_LT(KX, KY) ((KX) < (KY))
+#define ERTS_RBT_IS_EQ(KX, KY) ((KX) == (KY))
+#define ERTS_RBT_WANT_DELETE
+#define ERTS_RBT_WANT_SMALLEST
+#define ERTS_RBT_WANT_LOOKUP_INSERT
+#define ERTS_RBT_WANT_REPLACE
+#define ERTS_RBT_WANT_FOREACH
+#ifdef ERTS_HLT_HARD_DEBUG
+# define ERTS_RBT_WANT_LOOKUP
+#endif
+#define ERTS_RBT_UNDEF
+
+#include "erl_rbtree.h"
+
+/* Use circular list for timers at same time */
+
+static ERTS_INLINE void
+same_time_list_insert(ErtsHLTimer **root, ErtsHLTimer *tmr)
+{
+ ErtsHLTimer *first = *root;
+ if (!first) {
+ ERTS_HLT_ASSERT((((UWord) root) & ERTS_HLT_PFLG_SAME_TIME) == 0);
+ tmr->time.tree.parent = ((UWord) root) | ERTS_HLT_PFLG_SAME_TIME;
+ tmr->time.tree.u.l.next = tmr;
+ tmr->time.tree.u.l.prev = tmr;
+ *root = tmr;
+ }
+ else {
+ tmr->time.tree.parent = ERTS_HLT_PFLG_SAME_TIME;
+ tmr->time.tree.u.l.next = first;
+ tmr->time.tree.u.l.prev = first->time.tree.u.l.prev;
+ first->time.tree.u.l.prev = tmr;
+ tmr->time.tree.u.l.prev->time.tree.u.l.next = tmr;
+ }
+}
+
+static ERTS_INLINE void
+same_time_list_delete(ErtsHLTimer *tmr)
+{
+ ErtsHLTimer **root, *next;
+
+ root = (ErtsHLTimer **) (tmr->time.tree.parent & ~ERTS_HLT_PFLG_SAME_TIME);
+ next = tmr->time.tree.u.l.next;
+
+ ERTS_HLT_ASSERT((tmr->time.tree.parent
+ == (((UWord) root) | ERTS_HLT_PFLG_SAME_TIME))
+ || (tmr->time.tree.parent
+ == ERTS_HLT_PFLG_SAME_TIME));
+
+ if (next == tmr) {
+ ERTS_HLT_ASSERT(root && *root == tmr);
+ ERTS_HLT_ASSERT(tmr->time.tree.u.l.prev == tmr);
+ *root = NULL;
+ }
+ else {
+ if (root) {
+ ERTS_HLT_ASSERT(*root == tmr);
+ *root = next;
+ next->time.tree.parent = ((UWord) root) | ERTS_HLT_PFLG_SAME_TIME;
+ }
+ tmr->time.tree.u.l.next->time.tree.u.l.prev = tmr->time.tree.u.l.prev;
+ tmr->time.tree.u.l.prev->time.tree.u.l.next = next;
+ }
+}
+
+static ERTS_INLINE void
+same_time_list_new_root(ErtsHLTimer **root)
+{
+ ErtsHLTimer *tmr = *root;
+ if (tmr) {
+ ERTS_HLT_ASSERT(root);
+ tmr->time.tree.parent = ((UWord) root) | ERTS_HLT_PFLG_SAME_TIME;
+ }
+}
+
+static ERTS_INLINE int
+same_time_list_foreach_destroy_yielding(ErtsHLTimer **root,
+ void (*op)(ErtsHLTimer *, void *),
+ void *arg,
+ ERTS_TMR_TIMEOUT_YIELD_STATE_T *ys,
+ Sint ylimit)
+{
+ Sint ycnt = ylimit;
+ ErtsHLTimer *end, *tmr = *root;
+ if (!tmr)
+ return 0;
+
+ ERTS_HLT_ASSERT(tmr->time.tree.parent
+ == (((UWord) root) | ERTS_HLT_PFLG_SAME_TIME));
+
+ end = tmr->time.tree.u.l.prev;
+ end->time.tree.u.l.next = NULL;
+
+ while (1) {
+ ErtsHLTimer *op_tmr = tmr;
+
+ ERTS_HLT_ASSERT((tmr->time.tree.parent
+ == (((UWord) root) | ERTS_HLT_PFLG_SAME_TIME))
+ || (tmr->time.tree.parent
+ == ERTS_HLT_PFLG_SAME_TIME));
+
+ tmr = tmr->time.tree.u.l.next;
+ (*op)(op_tmr, arg);
+ if (!tmr) {
+ *root = NULL;
+ return 0;
+ }
+ if (--ycnt <= 0) {
+ /* Make new circle of timers left to process... */
+ *root = tmr;
+ end->time.tree.u.l.next = tmr;
+ tmr->time.tree.u.l.prev = end;
+ tmr->time.tree.parent = ((UWord) root) | ERTS_HLT_PFLG_SAME_TIME;
+ return 1;
+ }
+ }
+}
+
+static ERTS_INLINE void
+same_time_list_foreach(ErtsHLTimer *root,
+ void (*op)(ErtsHLTimer *, void *),
+ void *arg)
+{
+ if (root) {
+ ErtsHLTimer *tmr = root;
+ do {
+ (*op)(tmr, arg);
+ tmr = tmr->time.tree.u.l.next;
+ } while (root != tmr);
+ }
+}
+
+#ifdef ERTS_HLT_HARD_DEBUG
+
+static ERTS_INLINE ErtsHLTimer *
+same_time_list_lookup(ErtsHLTimer *root, ErtsHLTimer *x)
+{
+ if (root) {
+ ErtsHLTimer *tmr = root;
+ do {
+ if (tmr == x)
+ return tmr;
+ tmr = tmr->time.tree.u.l.next;
+ } while (root != tmr);
+ }
+ return NULL;
+}
+
+#endif /* ERTS_HLT_HARD_DEBUG */
+
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+#define ERTS_BTM_HLT2REFN(T) ((T)->btm.mbin->refn)
+#else
+#define ERTS_BTM_HLT2REFN(T) ((T)->btm.refn)
+#endif
+
+#ifndef ERTS_MAGIC_REF_BIF_TIMERS
+
+#define ERTS_RBT_PREFIX btm
+#define ERTS_RBT_T ErtsBifTimer
+#define ERTS_RBT_KEY_T Uint32 *
+#define ERTS_RBT_FLAGS_T UWord
+#define ERTS_RBT_INIT_EMPTY_TNODE(T) \
+ do { \
+ (T)->btm.tree.parent = (UWord) NULL; \
+ (T)->btm.tree.right = NULL; \
+ (T)->btm.tree.left = NULL; \
+ } while (0)
+#define ERTS_RBT_IS_RED(T) \
+ ((int) ((T)->btm.tree.parent & ERTS_HLT_PFLG_RED))
+#define ERTS_RBT_SET_RED(T) \
+ ((T)->btm.tree.parent |= ERTS_HLT_PFLG_RED)
+#define ERTS_RBT_IS_BLACK(T) \
+ (!ERTS_RBT_IS_RED((T)))
+#define ERTS_RBT_SET_BLACK(T) \
+ ((T)->btm.tree.parent &= ~ERTS_HLT_PFLG_RED)
+#define ERTS_RBT_GET_FLAGS(T) \
+ ((T)->btm.tree.parent & ERTS_HLT_PFLGS_MASK)
+#define ERTS_RBT_SET_FLAGS(T, F) \
+ do { \
+ ERTS_HLT_ASSERT((((UWord) (F)) & ~ERTS_HLT_PFLGS_MASK) == 0); \
+ (T)->btm.tree.parent &= ~ERTS_HLT_PFLGS_MASK; \
+ (T)->btm.tree.parent |= (F); \
+ } while (0)
+#define ERTS_RBT_GET_PARENT(T) \
+ ((ErtsBifTimer *) ((T)->btm.tree.parent & ~ERTS_HLT_PFLGS_MASK))
+#define ERTS_RBT_SET_PARENT(T, P) \
+ do { \
+ ERTS_HLT_ASSERT((((UWord) (P)) & ERTS_HLT_PFLGS_MASK) == 0); \
+ (T)->btm.tree.parent &= ERTS_HLT_PFLGS_MASK; \
+ (T)->btm.tree.parent |= (UWord) (P); \
+ } while (0)
+#define ERTS_RBT_GET_RIGHT(T) ((T)->btm.tree.right)
+#define ERTS_RBT_SET_RIGHT(T, R) ((T)->btm.tree.right = (R))
+#define ERTS_RBT_GET_LEFT(T) ((T)->btm.tree.left)
+#define ERTS_RBT_SET_LEFT(T, L) ((T)->btm.tree.left = (L))
+#define ERTS_RBT_GET_KEY(T) ERTS_BTM_HLT2REFN((T))
+#define ERTS_RBT_IS_LT(KX, KY) refn_is_lt((KX), (KY))
+#define ERTS_RBT_IS_EQ(KX, KY) refn_is_eq((KX), (KY))
+#define ERTS_RBT_WANT_DELETE
+#define ERTS_RBT_WANT_INSERT
+#ifndef ERTS_MAGIC_REF_BIF_TIMERS
+#define ERTS_RBT_WANT_LOOKUP
+#endif
+#define ERTS_RBT_WANT_FOREACH
+#define ERTS_RBT_UNDEF
+
+#include "erl_rbtree.h"
+
+#endif /* !ERTS_MAGIC_REF_BIF_TIMERS */
+
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+
+static ERTS_INLINE void
+proc_btm_list_insert(ErtsBifTimer **list, ErtsBifTimer *x)
+{
+ ErtsBifTimer *y = *list;
+ if (!y) {
+ x->btm.proc_list.next = x;
+ x->btm.proc_list.prev = x;
+ *list = x;
+ }
+ else {
+ ERTS_HLT_ASSERT(y->btm.proc_list.prev->btm.proc_list.next == y);
+ x->btm.proc_list.next = y;
+ x->btm.proc_list.prev = y->btm.proc_list.prev;
+ y->btm.proc_list.prev->btm.proc_list.next = x;
+ y->btm.proc_list.prev = x;
+ }
+}
+
+static ERTS_INLINE void
+proc_btm_list_delete(ErtsBifTimer **list, ErtsBifTimer *x)
+{
+ ErtsBifTimer *y = *list;
+ if (y == x && x->btm.proc_list.next == x) {
+ ERTS_HLT_ASSERT(x->btm.proc_list.prev == x);
+ *list = NULL;
+ }
+ else {
+ if (y == x)
+ *list = x->btm.proc_list.next;
+ ERTS_HLT_ASSERT(x->btm.proc_list.prev->btm.proc_list.next == x);
+ ERTS_HLT_ASSERT(x->btm.proc_list.next->btm.proc_list.prev == x);
+ x->btm.proc_list.prev->btm.proc_list.next = x->btm.proc_list.next;
+ x->btm.proc_list.next->btm.proc_list.prev = x->btm.proc_list.prev;
+ }
+ x->btm.proc_list.next = NULL;
+}
+
+static ERTS_INLINE int
+proc_btm_list_foreach_destroy_yielding(ErtsBifTimer **list,
+ void (*destroy)(ErtsBifTimer *, void *),
+ void *arg,
+ int limit)
+{
+ int i;
+ ErtsBifTimer *first, *last;
+
+ first = *list;
+ if (!first)
+ return 0;
+
+ last = first->btm.proc_list.prev;
+ for (i = 0; i < limit; i++) {
+ ErtsBifTimer *x = last;
+ last = last->btm.proc_list.prev;
+ (*destroy)(x, arg);
+ x->btm.proc_list.next = NULL;
+ if (x == first) {
+ *list = NULL;
+ return 0;
+ }
+ }
+
+ last->btm.proc_list.next = first;
+ first->btm.proc_list.prev = last;
+ return 1;
+}
+
+#else /* !ERTS_MAGIC_REF_BIF_TIMERS */
+
+#define ERTS_RBT_PREFIX proc_btm
+#define ERTS_RBT_T ErtsBifTimer
+#define ERTS_RBT_KEY_T Uint32 *
+#define ERTS_RBT_FLAGS_T UWord
+#define ERTS_RBT_INIT_EMPTY_TNODE(T) \
+ do { \
+ (T)->btm.proc_tree.parent = (UWord) NULL; \
+ (T)->btm.proc_tree.right = NULL; \
+ (T)->btm.proc_tree.left = NULL; \
+ } while (0)
+#define ERTS_RBT_IS_RED(T) \
+ ((int) ((T)->btm.proc_tree.parent & ERTS_HLT_PFLG_RED))
+#define ERTS_RBT_SET_RED(T) \
+ ((T)->btm.proc_tree.parent |= ERTS_HLT_PFLG_RED)
+#define ERTS_RBT_IS_BLACK(T) \
+ (!ERTS_RBT_IS_RED((T)))
+#define ERTS_RBT_SET_BLACK(T) \
+ ((T)->btm.proc_tree.parent &= ~ERTS_HLT_PFLG_RED)
+#define ERTS_RBT_GET_FLAGS(T) \
+ ((T)->btm.proc_tree.parent & ERTS_HLT_PFLGS_MASK)
+#define ERTS_RBT_SET_FLAGS(T, F) \
+ do { \
+ ERTS_HLT_ASSERT((((UWord) (F)) & ~ERTS_HLT_PFLGS_MASK) == 0); \
+ (T)->btm.proc_tree.parent &= ~ERTS_HLT_PFLGS_MASK; \
+ (T)->btm.proc_tree.parent |= (F); \
+ } while (0)
+#define ERTS_RBT_GET_PARENT(T) \
+ ((ErtsBifTimer *) ((T)->btm.proc_tree.parent & ~ERTS_HLT_PFLGS_MASK))
+#define ERTS_RBT_SET_PARENT(T, P) \
+ do { \
+ ERTS_HLT_ASSERT((((UWord) (P)) & ERTS_HLT_PFLGS_MASK) == 0); \
+ (T)->btm.proc_tree.parent &= ERTS_HLT_PFLGS_MASK; \
+ (T)->btm.proc_tree.parent |= (UWord) (P); \
+ } while (0)
+#define ERTS_RBT_GET_RIGHT(T) ((T)->btm.proc_tree.right)
+#define ERTS_RBT_SET_RIGHT(T, R) ((T)->btm.proc_tree.right = (R))
+#define ERTS_RBT_GET_LEFT(T) ((T)->btm.proc_tree.left)
+#define ERTS_RBT_SET_LEFT(T, L) ((T)->btm.proc_tree.left = (L))
+#define ERTS_RBT_GET_KEY(T) ERTS_BTM_HLT2REFN((T))
+#define ERTS_RBT_IS_LT(KX, KY) refn_is_lt((KX), (KY))
+#define ERTS_RBT_IS_EQ(KX, KY) refn_is_eq((KX), (KY))
+#define ERTS_RBT_WANT_DELETE
+#define ERTS_RBT_WANT_INSERT
+#ifndef ERTS_MAGIC_REF_BIF_TIMERS
+#define ERTS_RBT_WANT_LOOKUP
+#endif
+#define ERTS_RBT_WANT_FOREACH_DESTROY_YIELDING
+#define ERTS_RBT_UNDEF
+
+#include "erl_rbtree.h"
+
+#endif /* !ERTS_MAGIC_REF_BIF_TIMERS */
+
+#ifdef ERTS_SMP
+static void init_canceled_queue(ErtsHLTCncldTmrQ *cq);
+#endif
+
+void
+erts_hl_timer_init(void)
+{
+ init_tw_timer_alloc();
+ init_bif_timer_pre_alloc();
+}
+
+ErtsHLTimerService *
+erts_create_timer_service(void)
+{
+ ErtsYieldingTimeoutState init_yield = ERTS_TMR_YIELDING_TIMEOUT_STATE_INITER;
+ ErtsHLTimerService *srv;
+
+ srv = erts_alloc_permanent_cache_aligned(ERTS_ALC_T_TIMER_SERVICE,
+ sizeof(ErtsHLTimerService));
+ srv->time_tree = NULL;
+#ifndef ERTS_MAGIC_REF_BIF_TIMERS
+ srv->btm_tree = NULL;
+#endif
+ srv->next_timeout = NULL;
+ srv->yield = init_yield;
+ erts_twheel_init_timer(&srv->service_timer);
+
+#ifdef ERTS_SMP
+ init_canceled_queue(&srv->canceled_queue);
+#endif
+
+ return srv;
+}
+
+size_t
+erts_timer_type_size(ErtsAlcType_t type)
+{
+ switch (type) {
+ case ERTS_ALC_T_LL_PTIMER: return sizeof(ErtsTWTimer);
+ case ERTS_ALC_T_HL_PTIMER: return sizeof(ErtsHLTimer);
+ case ERTS_ALC_T_BIF_TIMER: return sizeof(ErtsBifTimer);
+ default: ERTS_INTERNAL_ERROR("Unknown type");
+ }
+ return 0;
+}
+
+static ERTS_INLINE ErtsMonotonicTime
+get_timeout_pos(ErtsMonotonicTime now, ErtsMonotonicTime msec)
+{
+ ErtsMonotonicTime timeout_pos;
+ if (msec <= 0)
+ return ERTS_MONOTONIC_TO_CLKTCKS(now);
+ timeout_pos = ERTS_MONOTONIC_TO_CLKTCKS(now-1);
+ timeout_pos += ERTS_MSEC_TO_CLKTCKS(msec) + 1;
+ return timeout_pos;
+}
+
+static ERTS_INLINE Sint64
+get_time_left(ErtsSchedulerData *esdp, ErtsMonotonicTime timeout_pos)
+{
+ ErtsMonotonicTime now = erts_get_monotonic_time(esdp);
+
+ now = ERTS_MONOTONIC_TO_CLKTCKS(now-1)+1;
+ if (timeout_pos <= now)
+ return (Sint64) 0;
+ return (Sint64) ERTS_CLKTCKS_TO_MSEC(timeout_pos - now);
+}
+
+static ERTS_INLINE int
+proc_timeout_common(Process *proc, void *tmr)
+{
+ if (tmr == (void *) erts_smp_atomic_cmpxchg_mb(&proc->common.timer,
+ ERTS_PTMR_TIMEDOUT,
+ (erts_aint_t) tmr)) {
+ erts_aint32_t state;
+ erts_smp_proc_lock(proc, ERTS_PROC_LOCKS_MSG_RECEIVE);
+ state = erts_smp_atomic32_read_acqb(&proc->state);
+ erts_smp_proc_unlock(proc, ERTS_PROC_LOCKS_MSG_RECEIVE);
+ if (!(state & (ERTS_PSFLG_ACTIVE|ERTS_PSFLG_EXITING)))
+ erts_schedule_process(proc, state, 0);
+ return 1;
+ }
+ return 0;
+}
+
+static ERTS_INLINE int
+port_timeout_common(Port *port, void *tmr)
+{
+ if (tmr == (void *) erts_smp_atomic_cmpxchg_mb(&port->common.timer,
+ ERTS_PTMR_TIMEDOUT,
+ (erts_aint_t) tmr)) {
+ erts_port_task_schedule(port->common.id,
+ &port->timeout_task,
+ ERTS_PORT_TASK_TIMEOUT);
+ return 1;
+ }
+ return 0;
+}
+
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+
+static erts_smp_atomic_t *
+mbin_to_btmref__(ErtsMagicBinary *mbin)
+{
+ return erts_smp_binary_to_magic_indirection((Binary *) mbin);
+}
+
+static ERTS_INLINE void
+magic_binary_init(ErtsMagicBinary *mbin, ErtsBifTimer *tmr)
+{
+ erts_smp_atomic_t *aptr = mbin_to_btmref__(mbin);
+ erts_smp_atomic_init_nob(aptr, (erts_aint_t) tmr);
+}
+
+static ERTS_INLINE ErtsBifTimer *
+magic_binary_to_btm(ErtsMagicBinary *mbin)
+{
+ erts_smp_atomic_t *aptr = mbin_to_btmref__(mbin);
+ ErtsBifTimer *tmr = (ErtsBifTimer *) erts_smp_atomic_read_nob(aptr);
+ ERTS_HLT_ASSERT(!tmr || tmr->btm.mbin == mbin);
+ return tmr;
+}
+
+#endif /* ERTS_MAGIC_REF_BIF_TIMERS */
+
+static ERTS_INLINE erts_aint_t
+init_btm_specifics(ErtsSchedulerData *esdp,
+ ErtsBifTimer *tmr, Eterm msg,
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+ ErtsMagicBinary *mbin
+#else
+ Uint32 *refn
+#endif
+ )
+{
+ Uint hsz = is_immed(msg) ? ((Uint) 0) : size_object(msg);
+ int refc;
+ if (!hsz) {
+ tmr->btm.message = msg;
+ tmr->btm.bp = NULL;
+ }
+ else {
+ ErlHeapFragment *bp = new_message_buffer(hsz);
+ Eterm *hp = bp->mem;
+ tmr->btm.message = copy_struct(msg, hsz, &hp, &bp->off_heap);
+ tmr->btm.bp = bp;
+ }
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+ refc = 1;
+ tmr->btm.mbin = mbin;
+ erts_refc_inc(&mbin->refc, 1);
+ magic_binary_init(mbin, tmr);
+ tmr->btm.proc_list.next = NULL;
+#else
+ refc = 0;
+ tmr->btm.refn[0] = refn[0];
+ tmr->btm.refn[1] = refn[1];
+ tmr->btm.refn[2] = refn[2];
+
+ tmr->btm.proc_tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE;
+
+ btm_rbt_insert(&esdp->timer_service->btm_tree, tmr);
+#endif
+
+ erts_smp_atomic32_init_nob(&tmr->btm.state, ERTS_TMR_STATE_ACTIVE);
+ return refc; /* refc from magic binary... */
+}
+
+static void tw_bif_timer_timeout(void *vbtmp);
+
+static ERTS_INLINE void
+timer_destroy(ErtsTimer *tmr, int twt, int btm)
+{
+ if (!btm) {
+ if (twt)
+ tw_timer_free(&tmr->twt);
+ else
+ erts_free(ERTS_ALC_T_HL_PTIMER, tmr);
+ }
+ else {
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+ Binary *bp = (Binary *) tmr->btm.btm.mbin;
+ if (erts_refc_dectest(&bp->refc, 0) == 0)
+ erts_bin_free(bp);
+#endif
+ if (tmr->head.roflgs & ERTS_TMR_ROFLG_PRE_ALC)
+ bif_timer_pre_free(&tmr->btm);
+ else
+ erts_free(ERTS_ALC_T_BIF_TIMER, &tmr->btm);
+ }
+}
+
+static ERTS_INLINE void
+timer_pre_dec_refc(ErtsTimer *tmr)
+{
+#ifdef ERTS_HLT_DEBUG
+ erts_aint_t refc;
+ refc = erts_smp_atomic32_dec_read_nob(&tmr->head.refc);
+ ERTS_HLT_ASSERT(refc > 0);
+#else
+ erts_smp_atomic32_dec_nob(&tmr->head.refc);
+#endif
+}
+
+/*
+ * Basic timer wheel timer stuff
+ */
+
+static void
+scheduled_tw_timer_destroy(void *vtmr)
+{
+ ErtsTimer * tmr = (ErtsTimer *) vtmr;
+ int btm = !!(tmr->head.roflgs & ERTS_TMR_ROFLG_BIF_TMR);
+ timer_destroy((ErtsTimer *) vtmr, 1, btm);
+}
+
+static void
+schedule_tw_timer_destroy(ErtsTWTimer *tmr)
+{
+ Uint size;
+ /*
+ * Reference to process/port can be
+ * dropped at once...
+ */
+ if (tmr->head.roflgs & ERTS_TMR_ROFLG_PROC)
+ erts_proc_dec_refc(tmr->head.receiver.proc);
+ else if (tmr->head.roflgs & ERTS_TMR_ROFLG_PORT)
+ erts_port_dec_refc(tmr->head.receiver.port);
+
+ if (!(tmr->head.roflgs & ERTS_TMR_ROFLG_BIF_TMR))
+ size = sizeof(ErtsHLTimer);
+ else {
+ /* Message buffer already dropped... */
+ size = sizeof(ErtsBifTimer);
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+ size += sizeof(ErtsMagicIndirectionWord);
+#endif
+ }
+
+ erts_schedule_thr_prgr_later_cleanup_op(
+ scheduled_tw_timer_destroy,
+ (void *) tmr,
+ &tmr->u.cleanup,
+ size);
+}
+
+static ERTS_INLINE void
+tw_timer_dec_refc(ErtsTWTimer *tmr)
+{
+ if (erts_smp_atomic32_dec_read_relb(&tmr->head.refc) == 0) {
+ ERTS_HLT_SMP_MEMBAR_LoadLoad_LoadStore;
+ schedule_tw_timer_destroy(tmr);
+ }
+}
+
+static void
+tw_proc_timeout(void *vtwtp)
+{
+ ErtsTWTimer *twtp = (ErtsTWTimer *) vtwtp;
+ Process *proc = twtp->head.receiver.proc;
+ if (proc_timeout_common(proc, vtwtp))
+ tw_timer_dec_refc(twtp);
+ tw_timer_dec_refc(twtp);
+}
+
+static void
+tw_port_timeout(void *vtwtp)
+{
+ ErtsTWTimer *twtp = (ErtsTWTimer *) vtwtp;
+ Port *port = twtp->head.receiver.port;
+ if (port_timeout_common(port, vtwtp))
+ tw_timer_dec_refc(twtp);
+ tw_timer_dec_refc(twtp);
+}
+
+static void
+cancel_tw_timer(ErtsSchedulerData *esdp, ErtsTWTimer *tmr)
+{
+ ERTS_HLT_ASSERT((tmr->head.roflgs & ERTS_TMR_ROFLG_SID_MASK)
+ == (Uint32) esdp->no);
+ erts_twheel_cancel_timer(esdp->timer_wheel, &tmr->u.tw_tmr);
+ tw_timer_dec_refc(tmr);
+}
+
+static void
+tw_callback_timeout(void *vtwtp)
+{
+ ErtsTWTimer *twtp = (ErtsTWTimer *) vtwtp;
+ void (*callback)(void *) = twtp->head.receiver.callback;
+ void *arg = twtp->head.u.arg;
+ tw_timer_dec_refc(twtp);
+ (*callback)(arg);
+}
+
+static ErtsTimer *
+create_tw_timer(ErtsSchedulerData *esdp,
+ ErtsMonotonicTime timeout_pos,
+ int short_time, ErtsTmrType type,
+ void *rcvrp, Eterm rcvr,
+ Eterm msg,
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+ ErtsMagicBinary *mbin,
+#else
+ Uint32 *refn,
+#endif
+ void (*callback)(void *), void *arg)
+{
+ ErtsTWTimer *tmr;
+ void (*timeout_func)(void *);
+ erts_aint32_t refc;
+
+ if (type != ERTS_TMR_BIF) {
+ tmr = tw_timer_alloc();
+ tmr->head.roflgs = 0;
+ }
+ else {
+ if (short_time) {
+ tmr = (ErtsTWTimer *) bif_timer_pre_alloc();
+ if (!tmr)
+ goto alloc_bif_timer;
+ tmr->head.roflgs = (ERTS_TMR_ROFLG_BIF_TMR
+ | ERTS_TMR_ROFLG_PRE_ALC);
+ }
+ else {
+ alloc_bif_timer:
+ tmr = (ErtsTWTimer *) erts_alloc(ERTS_ALC_T_BIF_TIMER,
+ sizeof(ErtsBifTimer));
+ tmr->head.roflgs = ERTS_TMR_ROFLG_BIF_TMR;
+ }
+ }
+
+ erts_twheel_init_timer(&tmr->u.tw_tmr);
+ tmr->head.roflgs |= (Uint32) esdp->no;
+ ERTS_HLT_ASSERT((((Uint32) esdp->no)
+ & ~ERTS_TMR_ROFLG_SID_MASK) == 0);
+
+ switch (type) {
+
+ case ERTS_TMR_PROC:
+ tmr->head.receiver.proc = (Process *) rcvrp;
+ tmr->head.roflgs |= ERTS_TMR_ROFLG_PROC;
+ timeout_func = tw_proc_timeout;
+ erts_proc_inc_refc((Process *) rcvrp);
+ refc = 2;
+ break;
+
+ case ERTS_TMR_PORT:
+ tmr->head.receiver.port = (Port *) rcvrp;
+ tmr->head.roflgs |= ERTS_TMR_ROFLG_PORT;
+ timeout_func = tw_port_timeout;
+ erts_port_inc_refc((Port *) rcvrp);
+ refc = 2;
+ break;
+
+ case ERTS_TMR_CALLBACK:
+ tmr->head.u.arg = arg;
+ tmr->head.receiver.callback = callback;
+
+ tmr->head.roflgs |= ERTS_TMR_ROFLG_CALLBACK;
+ timeout_func = tw_callback_timeout;
+ refc = 1;
+ break;
+
+ case ERTS_TMR_BIF:
+
+ timeout_func = tw_bif_timer_timeout;
+ if (is_internal_pid(rcvr)) {
+ tmr->head.roflgs |= ERTS_TMR_ROFLG_PROC;
+ tmr->head.receiver.proc = (Process *) rcvrp;
+ refc = 2;
+ }
+ else {
+ ERTS_HLT_ASSERT(is_atom(rcvr));
+ tmr->head.roflgs |= ERTS_TMR_ROFLG_REG_NAME;
+ tmr->head.receiver.name = (Eterm) rcvr;
+ refc = 1;
+ }
+
+ refc += init_btm_specifics(esdp,
+ (ErtsBifTimer *) tmr,
+ msg,
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+ mbin
+#else
+ refn
+#endif
+ );
+ break;
+
+ default:
+ ERTS_INTERNAL_ERROR("Unsupported timer type");
+ return NULL;
+ }
+
+ erts_smp_atomic32_init_nob(&tmr->head.refc, refc);
+
+ erts_twheel_set_timer(esdp->timer_wheel,
+ &tmr->u.tw_tmr,
+ timeout_func,
+ tmr,
+ timeout_pos);
+
+ return (ErtsTimer *) tmr;
+}
+
+/*
+ * Basic high level timer stuff
+ */
+
+static void
+scheduled_hl_timer_destroy(void *vtmr)
+{
+ ErtsTimer * tmr = (ErtsTimer *) vtmr;
+ int btm = !!(tmr->head.roflgs & ERTS_TMR_ROFLG_BIF_TMR);
+ timer_destroy((ErtsTimer *) vtmr, 0, btm);
+}
+
+static void
+schedule_hl_timer_destroy(ErtsHLTimer *tmr, Uint32 roflgs)
+{
+ UWord size;
+
+ /*
+ * Reference to process/port can be dropped
+ * at once...
+ */
+
+ ERTS_HLT_ASSERT(erts_smp_atomic32_read_nob(&tmr->head.refc) == 0);
+
+ if (roflgs & ERTS_TMR_ROFLG_REG_NAME) {
+ ERTS_HLT_ASSERT(is_atom(tmr->head.receiver.name));
+ }
+ else if (roflgs & ERTS_TMR_ROFLG_PROC) {
+ ERTS_HLT_ASSERT(tmr->head.receiver.proc);
+ erts_proc_dec_refc(tmr->head.receiver.proc);
+ }
+ else if (roflgs & ERTS_TMR_ROFLG_PORT) {
+ ERTS_HLT_ASSERT(tmr->head.receiver.port);
+ erts_port_dec_refc(tmr->head.receiver.port);
+ }
+
+ if (!(roflgs & ERTS_TMR_ROFLG_BIF_TMR))
+ size = sizeof(ErtsHLTimer);
+ else {
+ /* Message buffer already dropped... */
+ size = sizeof(ErtsBifTimer);
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+ size += sizeof(ErtsMagicIndirectionWord);
+#endif
+ }
+
+ erts_schedule_thr_prgr_later_cleanup_op(
+ scheduled_hl_timer_destroy, tmr,
+ &tmr->time.cleanup, size);
+}
+
+static ERTS_INLINE void
+hl_timer_dec_refc(ErtsHLTimer *tmr, Uint32 roflgs)
+{
+ if (erts_smp_atomic32_dec_read_relb(&tmr->head.refc) == 0) {
+ ERTS_HLT_SMP_MEMBAR_LoadLoad_LoadStore;
+ schedule_hl_timer_destroy(tmr, roflgs);
+ }
+}
+
+static void hlt_service_timeout(void *vesdp);
+#ifdef ERTS_SMP
+static void handle_canceled_queue(ErtsSchedulerData *esdp,
+ ErtsHLTCncldTmrQ *cq,
+ int use_limit,
+ int ops_limit,
+ int *need_thr_progress,
+ ErtsThrPrgrVal *thr_prgr_p,
+ int *need_more_work);
+#endif
+
+static ERTS_INLINE void
+check_canceled_queue(ErtsSchedulerData *esdp, ErtsHLTimerService *srv)
+{
+#if defined(ERTS_SMP) && ERTS_TMR_CHECK_CANCEL_ON_CREATE
+ ErtsHLTCncldTmrQ *cq = &srv->canceled_queue;
+ if (cq->head.first != cq->head.unref_end)
+ handle_canceled_queue(esdp, cq, 1,
+ ERTS_TMR_CANCELED_TIMER_SMALL_LIMIT,
+ NULL, NULL, NULL);
+#endif
+}
+
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+
+static int
+bif_timer_ref_destructor(Binary *unused)
+{
+ return 1;
+}
+
+static ERTS_INLINE void
+btm_clear_magic_binary(ErtsBifTimer *tmr)
+{
+ erts_smp_atomic_t *aptr = mbin_to_btmref__(tmr->btm.mbin);
+ Uint32 roflgs = tmr->type.head.roflgs;
+#ifdef ERTS_HLT_DEBUG
+ erts_aint_t tval = erts_smp_atomic_xchg_nob(aptr,
+ (erts_aint_t) NULL);
+ ERTS_HLT_ASSERT(tval == (erts_aint_t) tmr);
+#else
+ erts_smp_atomic_set_nob(aptr, (erts_aint_t) NULL);
+#endif
+ if (roflgs & ERTS_TMR_ROFLG_HLT)
+ hl_timer_dec_refc(&tmr->type.hlt, roflgs);
+ else
+ tw_timer_dec_refc(&tmr->type.twt);
+}
+
+#endif /* ERTS_MAGIC_REF_BIF_TIMERS */
+
+static ERTS_INLINE void
+bif_timer_timeout(ErtsHLTimerService *srv,
+ ErtsBifTimer *tmr,
+ Uint32 roflgs)
+{
+ erts_aint32_t state;
+
+ ERTS_HLT_ASSERT(tmr->type.head.roflgs == roflgs);
+ ERTS_HLT_ASSERT(roflgs & ERTS_TMR_ROFLG_BIF_TMR);
+
+ state = erts_smp_atomic32_cmpxchg_acqb(&tmr->btm.state,
+ ERTS_TMR_STATE_TIMED_OUT,
+ ERTS_TMR_STATE_ACTIVE);
+
+ ERTS_HLT_ASSERT(state == ERTS_TMR_STATE_CANCELED
+ || state == ERTS_TMR_STATE_ACTIVE);
+
+ if (state == ERTS_TMR_STATE_ACTIVE) {
+ Process *proc;
+
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+ btm_clear_magic_binary(tmr);
+#endif
+
+ if (roflgs & ERTS_TMR_ROFLG_REG_NAME) {
+ Eterm term;
+ term = tmr->type.head.receiver.name;
+ ERTS_HLT_ASSERT(is_atom(term));
+ term = erts_whereis_name_to_id(NULL, term);
+ proc = erts_proc_lookup(term);
+ }
+ else {
+ ERTS_HLT_ASSERT(roflgs & ERTS_TMR_ROFLG_PROC);
+ proc = tmr->type.head.receiver.proc;
+ ERTS_HLT_ASSERT(proc);
+ }
+ if (proc) {
+ int dec_refc = 0;
+ ErtsMessage *mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = tmr->btm.bp;
+ tmr->btm.bp = NULL;
+ erts_queue_message(proc, 0, mp, tmr->btm.message,
+ am_clock_service);
+ erts_smp_proc_lock(proc, ERTS_PROC_LOCK_BTM);
+ /* If the process is exiting do not disturb the cleanup... */
+ if (!ERTS_PROC_IS_EXITING(proc)) {
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+ if (tmr->btm.proc_list.next) {
+ proc_btm_list_delete(&proc->bif_timers, tmr);
+ dec_refc = 1;
+ }
+#else
+ if (tmr->btm.proc_tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE) {
+ proc_btm_rbt_delete(&proc->bif_timers, tmr);
+ tmr->btm.proc_tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE;
+ dec_refc = 1;
+ }
+#endif
+ }
+ erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_BTM);
+ if (dec_refc)
+ timer_pre_dec_refc((ErtsTimer *) tmr);
+ }
+ if (tmr->btm.bp)
+ free_message_buffer(tmr->btm.bp);
+ }
+
+#ifndef ERTS_MAGIC_REF_BIF_TIMERS
+ if (tmr->btm.tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE) {
+ btm_rbt_delete(&srv->btm_tree, tmr);
+ tmr->btm.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE;
+ }
+#endif
+
+
+}
+
+static void
+tw_bif_timer_timeout(void *vbtmp)
+{
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+ ErtsHLTimerService *srv = NULL;
+#else
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
+ ErtsHLTimerService *srv = esdp->timer_service;
+#endif
+ ErtsBifTimer *btmp = (ErtsBifTimer *) vbtmp;
+ bif_timer_timeout(srv, btmp, btmp->type.head.roflgs);
+ tw_timer_dec_refc(&btmp->type.twt);
+}
+
+static ErtsTimer *
+create_hl_timer(ErtsSchedulerData *esdp,
+ ErtsMonotonicTime timeout_pos,
+ int short_time, ErtsTmrType type,
+ void *rcvrp, Eterm rcvr,
+ Eterm msg,
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+ ErtsMagicBinary *mbin,
+#else
+ Uint32 *refn,
+#endif
+ void (*callback)(void *), void *arg)
+{
+ ErtsHLTimerService *srv = esdp->timer_service;
+ ErtsHLTimer *tmr, *st_tmr;
+ 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);
+
+ roflgs = ((Uint32) esdp->no) | ERTS_TMR_ROFLG_HLT;
+
+ if (type != ERTS_TMR_BIF) {
+
+ tmr = erts_alloc(ERTS_ALC_T_HL_PTIMER,
+ sizeof(ErtsHLTimer));
+ tmr->timeout = timeout_pos;
+
+ switch (type) {
+
+ case ERTS_TMR_PROC:
+ ERTS_HLT_ASSERT(is_internal_pid(rcvr));
+
+ erts_proc_inc_refc((Process *) rcvrp);
+ tmr->head.receiver.proc = (Process *) rcvrp;
+ roflgs |= ERTS_TMR_ROFLG_PROC;
+ refc = 2;
+ break;
+
+ case ERTS_TMR_PORT:
+ ERTS_HLT_ASSERT(is_internal_port(rcvr));
+ erts_port_inc_refc((Port *) rcvrp);
+ tmr->head.receiver.port = (Port *) rcvrp;
+ roflgs |= ERTS_TMR_ROFLG_PORT;
+ refc = 2;
+ break;
+
+ case ERTS_TMR_CALLBACK:
+ roflgs |= ERTS_TMR_ROFLG_CALLBACK;
+ tmr->head.receiver.callback = callback;
+ tmr->head.u.arg = arg;
+ refc = 1;
+ break;
+
+ default:
+ ERTS_INTERNAL_ERROR("Unsupported timer type");
+ return NULL;
+ }
+
+ }
+ else { /* ERTS_TMR_BIF */
+
+ if (short_time) {
+ tmr = (ErtsHLTimer *) bif_timer_pre_alloc();
+ if (!tmr)
+ goto alloc_bif_timer;
+ roflgs |= ERTS_TMR_ROFLG_PRE_ALC;
+ }
+ else {
+ alloc_bif_timer:
+ tmr = (ErtsHLTimer *) erts_alloc(ERTS_ALC_T_BIF_TIMER,
+ sizeof(ErtsBifTimer));
+ }
+
+ tmr->timeout = timeout_pos;
+
+ roflgs |= ERTS_TMR_ROFLG_BIF_TMR;
+ if (is_internal_pid(rcvr)) {
+ roflgs |= ERTS_TMR_ROFLG_PROC;
+ tmr->head.receiver.proc = (Process *) rcvrp;
+ refc = 2;
+ }
+ else {
+ ERTS_HLT_ASSERT(is_atom(rcvr));
+ roflgs |= ERTS_TMR_ROFLG_REG_NAME;
+ tmr->head.receiver.name = rcvr;
+ refc = 1;
+ }
+
+ refc += init_btm_specifics(esdp,
+ (ErtsBifTimer *) tmr,
+ msg,
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+ mbin
+#else
+ refn
+#endif
+ );
+ }
+
+ tmr->head.roflgs = roflgs;
+ erts_smp_atomic32_init_nob(&tmr->head.refc, refc);
+
+ if (!srv->next_timeout
+ || tmr->timeout < srv->next_timeout->timeout) {
+ if (srv->next_timeout)
+ erts_twheel_cancel_timer(esdp->timer_wheel,
+ &srv->service_timer);
+ erts_twheel_set_timer(esdp->timer_wheel,
+ &srv->service_timer,
+ hlt_service_timeout,
+ (void *) esdp,
+ tmr->timeout);
+ srv->next_timeout = tmr;
+ }
+
+ st_tmr = time_rbt_lookup_insert(&srv->time_tree, tmr);
+ tmr->time.tree.same_time = st_tmr;
+ if (st_tmr)
+ same_time_list_insert(&st_tmr->time.tree.same_time, tmr);
+
+#ifdef ERTS_HLT_HARD_DEBUG
+ tmr->pending_timeout = 0;
+#endif
+
+ ERTS_HLT_HDBG_CHK_SRV(srv);
+
+ return (ErtsTimer *) tmr;
+}
+
+static ERTS_INLINE void
+hlt_proc_timeout(ErtsHLTimer *tmr)
+{
+ if (proc_timeout_common(tmr->head.receiver.proc, (void *) tmr))
+ hl_timer_dec_refc(tmr, tmr->head.roflgs);
+}
+
+static ERTS_INLINE void
+hlt_port_timeout(ErtsHLTimer *tmr)
+{
+ if (port_timeout_common(tmr->head.receiver.port, (void *) tmr))
+ hl_timer_dec_refc(tmr, tmr->head.roflgs);
+}
+
+static void hlt_timeout(ErtsHLTimer *tmr, void *vsrv)
+{
+ ErtsHLTimerService *srv = (ErtsHLTimerService *) vsrv;
+ Uint32 roflgs;
+
+ ERTS_HLT_HDBG_CHK_SRV(srv);
+
+ roflgs = tmr->head.roflgs;
+ ERTS_HLT_ASSERT(roflgs & ERTS_TMR_ROFLG_HLT);
+
+ if (roflgs & ERTS_TMR_ROFLG_BIF_TMR)
+ bif_timer_timeout(srv, (ErtsBifTimer *) tmr, roflgs);
+ else if (roflgs & ERTS_TMR_ROFLG_PROC)
+ hlt_proc_timeout(tmr);
+ else if (roflgs & ERTS_TMR_ROFLG_PORT)
+ hlt_port_timeout(tmr);
+ else {
+ ERTS_HLT_ASSERT(roflgs & ERTS_TMR_ROFLG_CALLBACK);
+ (*tmr->head.receiver.callback)(tmr->head.u.arg);
+ }
+
+ tmr->time.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE;
+
+ ERTS_HLT_HDBG_CHK_SRV(srv);
+
+ hl_timer_dec_refc(tmr, roflgs);
+}
+
+#ifdef ERTS_HLT_HARD_DEBUG
+static void
+set_pending_timeout(ErtsHLTimer *tmr, void *unused)
+{
+ tmr->pending_timeout = -1;
+}
+#endif
+
+static void
+hlt_service_timeout(void *vesdp)
+{
+ ErtsSchedulerData *esdp = (ErtsSchedulerData *) vesdp;
+ ErtsHLTimerService *srv = esdp->timer_service;
+ ErtsHLTimer *tmr = srv->next_timeout;
+ int yield;
+
+ ERTS_HLT_HDBG_CHK_SRV(srv);
+
+ ERTS_HLT_ASSERT(esdp == erts_get_scheduler_data());
+
+ ERTS_HLT_ASSERT(!srv->yield.root || srv->yield.root == tmr);
+ ERTS_HLT_ASSERT(tmr);
+ ERTS_HLT_ASSERT(tmr->timeout <= erts_get_monotonic_time(esdp));
+
+ if (!srv->yield.root) {
+ ERTS_HLT_ASSERT(tmr->time.tree.parent
+ != ERTS_HLT_PFIELD_NOT_IN_TABLE);
+ time_rbt_delete(&srv->time_tree, tmr);
+ tmr->time.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE;
+#ifdef ERTS_HLT_HARD_DEBUG
+ tmr->pending_timeout = 1;
+ if (tmr->time.tree.same_time)
+ same_time_list_foreach(tmr->time.tree.same_time, set_pending_timeout, NULL);
+#endif
+ }
+
+ if (!tmr->time.tree.same_time && !srv->yield.root)
+ yield = 0;
+ else {
+ yield = same_time_list_foreach_destroy_yielding(
+ &tmr->time.tree.same_time, hlt_timeout, (void *) srv,
+ &srv->yield.state, ERTS_TMR_TIMEOUT_YIELD_LIMIT);
+ }
+
+ if (yield)
+ srv->yield.root = tmr;
+ else {
+ srv->yield.root = NULL;
+ hlt_timeout(tmr, (void *) srv);
+
+ tmr = time_rbt_smallest(srv->time_tree);
+ srv->next_timeout = tmr;
+ }
+
+ ERTS_HLT_HDBG_CHK_SRV(srv);
+
+ if (tmr)
+ erts_twheel_set_timer(esdp->timer_wheel,
+ &srv->service_timer,
+ hlt_service_timeout,
+ vesdp,
+ tmr->timeout);
+}
+
+static void
+hlt_delete_timer(ErtsSchedulerData *esdp, ErtsHLTimer *tmr)
+{
+ ErtsHLTimerService *srv = esdp->timer_service;
+
+ ERTS_HLT_HDBG_CHK_SRV(srv);
+
+ if (tmr->time.tree.parent == ERTS_HLT_PFIELD_NOT_IN_TABLE) {
+ /* Already removed... */
+ ERTS_HLT_HDBG_CHK_SRV(srv);
+ return;
+ }
+
+ if (tmr->time.tree.parent & ERTS_HLT_PFLG_SAME_TIME) {
+ same_time_list_delete(tmr);
+ }
+ else if (tmr->time.tree.same_time) {
+ ErtsHLTimer *st_container;
+
+ ERTS_HLT_ASSERT((tmr->time.tree.parent & ERTS_HLT_PFLG_SAME_TIME) == 0);
+ st_container = tmr->time.tree.same_time->time.tree.u.l.prev;
+
+ ERTS_HLT_ASSERT(st_container);
+ ERTS_HLT_ASSERT(st_container->time.tree.parent
+ & ERTS_HLT_PFLG_SAME_TIME);
+ ERTS_HLT_ASSERT(tmr->timeout == st_container->timeout);
+
+ same_time_list_delete(st_container);
+ st_container->time.tree.same_time = tmr->time.tree.same_time;
+ same_time_list_new_root(&st_container->time.tree.same_time);
+
+ time_rbt_replace(&srv->time_tree, tmr, st_container);
+ ERTS_HLT_ASSERT((st_container->time.tree.parent
+ & ERTS_HLT_PFLG_SAME_TIME) == 0);
+
+ if (srv->next_timeout == tmr)
+ srv->next_timeout = st_container;
+ }
+ else {
+ ERTS_HLT_ASSERT((tmr->time.tree.parent & ERTS_HLT_PFLG_SAME_TIME) == 0);
+ time_rbt_delete(&srv->time_tree, tmr);
+ if (tmr == srv->next_timeout) {
+ ErtsHLTimer *smlst;
+ erts_twheel_cancel_timer(esdp->timer_wheel,
+ &srv->service_timer);
+ smlst = time_rbt_smallest(srv->time_tree);
+ srv->next_timeout = smlst;
+ if (smlst) {
+ ERTS_HLT_ASSERT(smlst->timeout > tmr->timeout);
+ erts_twheel_set_timer(esdp->timer_wheel,
+ &srv->service_timer,
+ hlt_service_timeout,
+ (void *) esdp,
+ smlst->timeout);
+ }
+ }
+ }
+ tmr->time.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE;
+
+ hl_timer_dec_refc(tmr, tmr->head.roflgs);
+
+ ERTS_HLT_HDBG_CHK_SRV(srv);
+}
+
+/*
+ * Pass canceled timers back to originating scheduler
+ */
+
+static ERTS_INLINE void
+cleanup_sched_local_canceled_timer(ErtsSchedulerData *esdp,
+ ErtsTimer *tmr)
+{
+ Uint32 roflgs = tmr->head.roflgs;
+ ERTS_HLT_ASSERT(esdp == erts_get_scheduler_data());
+ ERTS_HLT_ASSERT((tmr->head.roflgs & ERTS_TMR_ROFLG_SID_MASK)
+ == (Uint32) esdp->no);
+
+#ifndef ERTS_MAGIC_REF_BIF_TIMERS
+ if (roflgs & ERTS_TMR_ROFLG_BIF_TMR) {
+ ErtsBifTimer *btm = (ErtsBifTimer *) tmr;
+ if (btm->btm.tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE) {
+ btm_rbt_delete(&esdp->timer_service->btm_tree, btm);
+ btm->btm.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE;
+ }
+ }
+#endif
+
+ if (roflgs & ERTS_TMR_ROFLG_HLT) {
+ hlt_delete_timer(esdp, &tmr->hlt);
+ hl_timer_dec_refc(&tmr->hlt, roflgs);
+ }
+ else {
+ cancel_tw_timer(esdp, &tmr->twt);
+ tw_timer_dec_refc(&tmr->twt);
+ }
+}
+
+#ifdef ERTS_SMP
+
+static void
+init_canceled_queue(ErtsHLTCncldTmrQ *cq)
+{
+ erts_atomic_init_nob(&cq->tail.data.marker.u.next, ERTS_AINT_NULL);
+ erts_atomic_init_nob(&cq->tail.data.last,
+ (erts_aint_t) &cq->tail.data.marker);
+ cq->head.first = (ErtsTimer *) &cq->tail.data.marker;
+ cq->head.unref_end = (ErtsTimer *) &cq->tail.data.marker;
+ cq->head.next.thr_progress = erts_thr_progress_current();
+ cq->head.next.thr_progress_reached = 1;
+ cq->head.next.unref_end = (ErtsTimer *) &cq->tail.data.marker;
+ cq->head.used_marker = 1;
+}
+
+static ERTS_INLINE int
+cq_enqueue(ErtsHLTCncldTmrQ *cq, ErtsTimer *tmr, int cinit)
+{
+ erts_aint_t itmp;
+ ErtsTimer *enq, *this = tmr;
+
+ erts_atomic_init_nob(&this->head.u.next, ERTS_AINT_NULL);
+ /* Enqueue at end of list... */
+
+ enq = (ErtsTimer *) erts_atomic_read_nob(&cq->tail.data.last);
+ itmp = erts_atomic_cmpxchg_relb(&enq->head.u.next,
+ (erts_aint_t) this,
+ ERTS_AINT_NULL);
+ if (itmp == ERTS_AINT_NULL) {
+ /* We are required to move last pointer */
+#ifdef DEBUG
+ ASSERT(ERTS_AINT_NULL == erts_atomic_read_nob(&this->head.u.next));
+ ASSERT(((erts_aint_t) enq)
+ == erts_atomic_xchg_relb(&cq->tail.data.last,
+ (erts_aint_t) this));
+#else
+ erts_atomic_set_relb(&cq->tail.data.last, (erts_aint_t) this);
+#endif
+ return 1;
+ }
+ else {
+ /*
+ * We *need* to insert element somewhere in between the
+ * last element we read earlier and the actual last element.
+ */
+ int i = cinit;
+
+ while (1) {
+ erts_aint_t itmp2;
+ erts_atomic_set_nob(&this->head.u.next, itmp);
+ itmp2 = erts_atomic_cmpxchg_relb(&enq->head.u.next,
+ (erts_aint_t) this,
+ itmp);
+ if (itmp == itmp2)
+ return 0; /* inserted this */
+ if ((i & 1) == 0)
+ itmp = itmp2;
+ else {
+ enq = (ErtsTimer *) itmp2;
+ itmp = erts_atomic_read_acqb(&enq->head.u.next);
+ ASSERT(itmp != ERTS_AINT_NULL);
+ }
+ i++;
+ }
+ }
+}
+
+static ERTS_INLINE erts_aint_t
+check_insert_marker(ErtsHLTCncldTmrQ *cq, erts_aint_t ilast)
+{
+ if (!cq->head.used_marker
+ && cq->head.unref_end == (ErtsTimer *) ilast) {
+ erts_aint_t itmp;
+ ErtsTimer *last = (ErtsTimer *) ilast;
+
+ erts_atomic_init_nob(&cq->tail.data.marker.u.next, ERTS_AINT_NULL);
+ itmp = erts_atomic_cmpxchg_relb(&last->head.u.next,
+ (erts_aint_t) &cq->tail.data.marker,
+ ERTS_AINT_NULL);
+ if (itmp == ERTS_AINT_NULL) {
+ ilast = (erts_aint_t) &cq->tail.data.marker;
+ cq->head.used_marker = !0;
+ erts_atomic_set_relb(&cq->tail.data.last, ilast);
+ }
+ }
+ return ilast;
+}
+
+static ERTS_INLINE ErtsTimer *
+cq_dequeue(ErtsHLTCncldTmrQ *cq)
+{
+ ErtsTimer *tmr;
+
+ if (cq->head.first == cq->head.unref_end)
+ return NULL;
+
+ tmr = cq->head.first;
+ if (tmr == (ErtsTimer *) &cq->tail.data.marker) {
+ ASSERT(cq->head.used_marker);
+ cq->head.used_marker = 0;
+ tmr = (ErtsTimer *) erts_atomic_read_nob(&tmr->head.u.next);
+ if (tmr == cq->head.unref_end) {
+ cq->head.first = tmr;
+ return NULL;
+ }
+ }
+
+ cq->head.first = (ErtsTimer *) erts_atomic_read_nob(&tmr->head.u.next);
+
+ ASSERT(cq->head.first);
+
+ return tmr;
+}
+
+static int
+cq_check_incoming(ErtsSchedulerData *esdp, ErtsHLTCncldTmrQ *cq)
+{
+ erts_aint_t ilast = erts_atomic_read_nob(&cq->tail.data.last);
+ if (((ErtsTimer *) ilast) == (ErtsTimer *) &cq->tail.data.marker
+ && cq->head.first == (ErtsTimer *) &cq->tail.data.marker) {
+ /* Nothing more to do... */
+ return 0;
+ }
+
+ if (cq->head.next.thr_progress_reached
+ || erts_thr_progress_has_reached(cq->head.next.thr_progress)) {
+ cq->head.next.thr_progress_reached = 1;
+ /* Move unreferenced end pointer forward... */
+
+ ERTS_HLT_SMP_MEMBAR_LoadLoad_LoadStore;
+
+ cq->head.unref_end = cq->head.next.unref_end;
+
+ ilast = check_insert_marker(cq, ilast);
+
+ if (cq->head.unref_end != (ErtsTimer *) ilast) {
+ cq->head.next.unref_end = (ErtsTimer *) ilast;
+ cq->head.next.thr_progress = erts_thr_progress_later(esdp);
+ cq->head.next.thr_progress_reached = 0;
+ }
+ }
+ return 1;
+}
+
+static ERTS_INLINE void
+store_earliest_thr_prgr(ErtsThrPrgrVal *prev_val, ErtsHLTCncldTmrQ *cq)
+{
+ if (!cq->head.next.thr_progress_reached
+ && (*prev_val == ERTS_THR_PRGR_INVALID
+ || erts_thr_progress_cmp(cq->head.next.thr_progress,
+ *prev_val) < 0)) {
+ *prev_val = cq->head.next.thr_progress;
+ }
+}
+
+static void
+handle_canceled_queue(ErtsSchedulerData *esdp,
+ ErtsHLTCncldTmrQ *cq,
+ int use_limit,
+ int ops_limit,
+ int *need_thr_progress,
+ ErtsThrPrgrVal *thr_prgr_p,
+ int *need_more_work)
+{
+ int need_thr_prgr = 0;
+ int need_mr_wrk = 0;
+ int have_checked_incoming = 0;
+ int ops = 0;
+
+ ERTS_HLT_ASSERT(cq == &esdp->timer_service->canceled_queue);
+
+ while (1) {
+ ErtsTimer *tmr = cq_dequeue(cq);
+
+ if (tmr)
+ cleanup_sched_local_canceled_timer(esdp, tmr);
+ else {
+ if (have_checked_incoming)
+ break;
+ need_thr_prgr = cq_check_incoming(esdp, cq);
+ if (need_thr_progress) {
+ *need_thr_progress |= need_thr_prgr;
+ if (need_thr_prgr)
+ store_earliest_thr_prgr(thr_prgr_p, cq);
+ }
+ have_checked_incoming = 1;
+ continue;
+ }
+
+ if (use_limit && ++ops >= ops_limit) {
+ if (cq->head.first != cq->head.unref_end) {
+ need_mr_wrk = 1;
+ if (need_more_work)
+ *need_more_work |= 1;
+ }
+ break;
+ }
+ }
+
+ if (need_thr_progress && !(need_thr_prgr | need_mr_wrk)) {
+ need_thr_prgr = cq_check_incoming(esdp, cq);
+ *need_thr_progress |= need_thr_prgr;
+ if (need_thr_prgr)
+ store_earliest_thr_prgr(thr_prgr_p, cq);
+ }
+}
+
+void
+erts_handle_canceled_timers(void *vesdp,
+ int *need_thr_progress,
+ ErtsThrPrgrVal *thr_prgr_p,
+ int *need_more_work)
+{
+ ErtsSchedulerData *esdp = (ErtsSchedulerData *) vesdp;
+ ERTS_HLT_ASSERT(esdp == erts_get_scheduler_data());
+
+ handle_canceled_queue(esdp, &esdp->timer_service->canceled_queue,
+ 1, ERTS_TMR_CANCELED_TIMER_LIMIT,
+ need_thr_progress, thr_prgr_p,
+ need_more_work);
+}
+
+#endif /* ERTS_SMP */
+
+static void
+queue_canceled_timer(ErtsSchedulerData *esdp, int rsched_id, ErtsTimer *tmr)
+{
+#ifdef ERTS_SMP
+ ErtsHLTCncldTmrQ *cq;
+ cq = &ERTS_SCHEDULER_IX(rsched_id-1)->timer_service->canceled_queue;
+ if (cq_enqueue(cq, tmr, rsched_id - (int) esdp->no))
+ erts_notify_canceled_timer(esdp, rsched_id);
+#else
+ ERTS_INTERNAL_ERROR("Unexpected enqueue of canceled timer");
+#endif
+}
+
+static void
+continue_cancel_ptimer(ErtsSchedulerData *esdp, ErtsTimer *tmr)
+{
+#ifdef ERTS_SMP
+ Uint32 sid = (tmr->head.roflgs & ERTS_TMR_ROFLG_SID_MASK);
+
+ if (esdp->no != sid)
+ queue_canceled_timer(esdp, sid, tmr);
+ else
+#endif
+ cleanup_sched_local_canceled_timer(esdp, tmr);
+}
+
+/*
+ * BIF timer specific
+ */
+
+
+Uint erts_bif_timer_memory_size(void)
+{
+ return (Uint) 0;
+}
+
+static BIF_RETTYPE
+setup_bif_timer(Process *c_p, int twheel, ErtsMonotonicTime timeout_pos,
+ int short_time, Eterm rcvr, Eterm msg, int wrap)
+{
+ BIF_RETTYPE ret;
+ Eterm ref, tmo_msg, *hp;
+ ErtsBifTimer *tmr;
+ ErtsSchedulerData *esdp;
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+ Binary *mbin;
+#endif
+ Eterm tmp_hp[4];
+ ErtsCreateTimerFunc create_timer;
+
+ if (is_not_internal_pid(rcvr) && is_not_atom(rcvr))
+ goto badarg;
+
+ esdp = erts_proc_sched_data(c_p);
+
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+ mbin = erts_create_magic_indirection(bif_timer_ref_destructor);
+ hp = HAlloc(c_p, ERTS_MAGIC_REF_THING_SIZE);
+ ref = erts_mk_magic_ref(&hp, &c_p->off_heap, mbin);
+ ASSERT(erts_get_ref_numbers_thr_id(((ErtsMagicBinary *)mbin)->refn)
+ == (Uint32) esdp->no);
+#else
+ hp = HAlloc(c_p, ERTS_REF_THING_SIZE);
+ ref = erts_sched_make_ref_in_buffer(esdp, hp);
+ ASSERT(erts_get_ref_numbers_thr_id(internal_ordinary_ref_numbers(ref))
+ == (Uint32) esdp->no);
+#endif
+
+ tmo_msg = wrap ? TUPLE3(tmp_hp, am_timeout, ref, msg) : msg;
+
+ create_timer = twheel ? create_tw_timer : create_hl_timer;
+ tmr = (ErtsBifTimer *) create_timer(esdp, timeout_pos,
+ short_time, ERTS_TMR_BIF,
+ NULL, rcvr, tmo_msg,
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+ (ErtsMagicBinary *) mbin,
+#else
+ internal_ordinary_ref_numbers(ref),
+#endif
+ NULL, NULL);
+
+ if (is_internal_pid(rcvr)) {
+ Process *proc = erts_pid2proc_opt(c_p, ERTS_PROC_LOCK_MAIN,
+ rcvr, ERTS_PROC_LOCK_BTM,
+ ERTS_P2P_FLG_INC_REFC);
+ if (!proc) {
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+ btm_clear_magic_binary(tmr);
+#else
+ if (tmr->btm.tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE) {
+ btm_rbt_delete(&esdp->timer_service->btm_tree, tmr);
+ tmr->btm.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE;
+ }
+#endif
+ if (tmr->btm.bp)
+ free_message_buffer(tmr->btm.bp);
+ if (twheel)
+ cancel_tw_timer(esdp, &tmr->type.twt);
+ else
+ hlt_delete_timer(esdp, &tmr->type.hlt);
+ timer_destroy((ErtsTimer *) tmr, twheel, 1);
+ }
+ else {
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+ proc_btm_list_insert(&proc->bif_timers, tmr);
+#else
+ proc_btm_rbt_insert(&proc->bif_timers, tmr);
+#endif
+ erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_BTM);
+ tmr->type.head.receiver.proc = proc;
+ }
+ }
+
+ ERTS_BIF_PREP_RET(ret, ref);
+ return ret;
+
+badarg:
+
+ ERTS_BIF_PREP_ERROR(ret, c_p, BADARG);
+ return ret;
+}
+
+static int
+cancel_bif_timer(ErtsBifTimer *tmr)
+{
+ erts_aint_t state;
+ Uint32 roflgs;
+ int res;
+
+ state = erts_smp_atomic32_cmpxchg_acqb(&tmr->btm.state,
+ ERTS_TMR_STATE_CANCELED,
+ ERTS_TMR_STATE_ACTIVE);
+ if (state != ERTS_TMR_STATE_ACTIVE)
+ return 0;
+
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+ btm_clear_magic_binary(tmr);
+#endif
+
+ if (tmr->btm.bp)
+ free_message_buffer(tmr->btm.bp);
+
+ res = -1;
+
+ roflgs = tmr->type.head.roflgs;
+ if (roflgs & ERTS_TMR_ROFLG_PROC) {
+ Process *proc;
+
+ proc = tmr->type.head.receiver.proc;
+ ERTS_HLT_ASSERT(!(tmr->type.head.roflgs & ERTS_TMR_ROFLG_REG_NAME));
+
+ erts_smp_proc_lock(proc, ERTS_PROC_LOCK_BTM);
+ /*
+ * If process is exiting, let it clean up
+ * the btm tree by itself (it may be in
+ * the middle of tree destruction).
+ */
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+ if (!ERTS_PROC_IS_EXITING(proc) && tmr->btm.proc_list.next) {
+ proc_btm_list_delete(&proc->bif_timers, tmr);
+ res = 1;
+ }
+#else
+ if (!ERTS_PROC_IS_EXITING(proc)
+ && tmr->btm.proc_tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE) {
+ proc_btm_rbt_delete(&proc->bif_timers, tmr);
+ tmr->btm.proc_tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE;
+ res = 1;
+ }
+#endif
+ erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_BTM);
+ }
+
+ return res;
+}
+
+static ERTS_INLINE Sint64
+access_btm(ErtsBifTimer *tmr, Uint32 sid, ErtsSchedulerData *esdp, int cancel)
+{
+ int cncl_res;
+ Sint64 time_left;
+ ErtsMonotonicTime timeout;
+ int is_hlt;
+
+ if (!tmr)
+ return -1;
+
+ is_hlt = !!(tmr->type.head.roflgs & ERTS_TMR_ROFLG_HLT);
+ timeout = (is_hlt
+ ? tmr->type.hlt.timeout
+ : erts_tweel_read_timeout(&tmr->type.twt.u.tw_tmr));
+
+ if (!cancel) {
+ erts_aint32_t state = erts_smp_atomic32_read_acqb(&tmr->btm.state);
+ if (state == ERTS_TMR_STATE_ACTIVE)
+ return get_time_left(esdp, timeout);
+ return -1;
+ }
+
+ cncl_res = cancel_bif_timer(tmr);
+ if (!cncl_res)
+ return -1;
+
+ time_left = get_time_left(esdp, timeout);
+
+ if (sid != (Uint32) esdp->no) {
+ if (cncl_res > 0)
+ queue_canceled_timer(esdp, sid, (ErtsTimer *) tmr);
+ }
+ else {
+#ifndef ERTS_MAGIC_REF_BIF_TIMERS
+ if (tmr->btm.tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE) {
+ btm_rbt_delete(&esdp->timer_service->btm_tree, tmr);
+ tmr->btm.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE;
+ }
+#endif
+ if (is_hlt) {
+ if (cncl_res > 0)
+ hl_timer_dec_refc(&tmr->type.hlt, tmr->type.hlt.head.roflgs);
+ hlt_delete_timer(esdp, &tmr->type.hlt);
+ }
+ else {
+ if (cncl_res > 0)
+ tw_timer_dec_refc(&tmr->type.twt);
+ cancel_tw_timer(esdp, &tmr->type.twt);
+ }
+ }
+
+ return time_left;
+}
+
+static ERTS_INLINE Eterm
+return_info(Process *c_p, Sint64 time_left)
+{
+ Uint hsz;
+ Eterm *hp;
+
+ if (time_left < 0)
+ return am_false;
+
+ if (time_left <= (Sint64) MAX_SMALL)
+ return make_small((Sint) time_left);
+
+ hsz = ERTS_SINT64_HEAP_SIZE(time_left);
+ hp = HAlloc(c_p, hsz);
+ return erts_sint64_to_big(time_left, &hp);
+}
+
+static ERTS_INLINE Eterm
+send_async_info(Process *proc, ErtsProcLocks initial_locks,
+ Eterm tref, int cancel, Sint64 time_left)
+{
+ ErtsProcLocks locks = initial_locks;
+ ErtsMessage *mp;
+ Eterm tag, res, msg, ref;
+ Uint hsz;
+ Eterm *hp;
+ ErlOffHeap *ohp;
+
+ hsz = 4;
+ hsz += NC_HEAP_SIZE(tref);
+
+ if (time_left > (Sint64) MAX_SMALL)
+ hsz += ERTS_SINT64_HEAP_SIZE(time_left);
+
+ mp = erts_alloc_message_heap(proc, &locks, hsz, &hp, &ohp);
+
+ if (cancel)
+ tag = am_cancel_timer;
+ else
+ tag = am_read_timer;
+
+ ref = STORE_NC(&hp, ohp, tref);
+
+ if (time_left < 0)
+ res = am_false;
+ else if (time_left <= (Sint64) MAX_SMALL)
+ res = make_small((Sint) time_left);
+ else
+ res = erts_sint64_to_big(time_left, &hp);
+
+ msg = TUPLE3(hp, tag, ref, res);
+
+ erts_queue_message(proc, locks, mp, msg, am_clock_service);
+
+ locks &= ~initial_locks;
+ if (locks)
+ erts_smp_proc_unlock(proc, locks);
+
+ return am_ok;
+}
+
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+
+static BIF_RETTYPE
+access_bif_timer(Process *c_p, Eterm tref, int cancel, int async, int info)
+{
+ BIF_RETTYPE ret;
+ Eterm res;
+ Sint64 time_left;
+
+ if (!is_internal_magic_ref(tref)) {
+ if (is_not_ref(tref)) {
+ ERTS_BIF_PREP_ERROR(ret, c_p, BADARG);
+ return ret;
+ }
+ time_left = -1;
+ }
+ else {
+ ErtsMagicBinary *mbin;
+ mbin = (ErtsMagicBinary *) erts_magic_ref2bin(tref);
+ if (mbin->destructor != bif_timer_ref_destructor)
+ time_left = -1;
+ else {
+ ErtsBifTimer *tmr;
+ Uint32 sid;
+ tmr = magic_binary_to_btm(mbin);
+ sid = erts_get_ref_numbers_thr_id(internal_magic_ref_numbers(tref));
+ ASSERT(1 <= sid && sid <= erts_no_schedulers);
+ time_left = access_btm(tmr, sid, erts_proc_sched_data(c_p), cancel);
+ }
+ }
+
+ if (!info)
+ res = am_ok;
+ else if (!async)
+ res = return_info(c_p, time_left);
+ else
+ res = send_async_info(c_p, ERTS_PROC_LOCK_MAIN,
+ tref, cancel, time_left);
+
+ ERTS_BIF_PREP_RET(ret, res);
+
+ return ret;
+}
+
+#else /* !ERTS_MAGIC_REF_BIF_TIMERS */
+
+static ERTS_INLINE Eterm
+send_sync_info(Process *proc, ErtsProcLocks initial_locks,
+ Uint32 *refn, int cancel, Sint64 time_left)
+{
+ ErtsProcLocks locks = initial_locks;
+ ErtsMessage *mp;
+ Eterm res, msg, ref;
+ Uint hsz;
+ Eterm *hp;
+ ErlOffHeap *ohp;
+
+ hsz = 3 + ERTS_REF_THING_SIZE;
+
+ if (time_left > (Sint64) MAX_SMALL)
+ hsz += ERTS_SINT64_HEAP_SIZE(time_left);
+
+ mp = erts_alloc_message_heap(proc, &locks, hsz, &hp, &ohp);
+
+ write_ref_thing(hp, refn[0], refn[1], refn[2]);
+ ref = make_internal_ref(hp);
+ hp += ERTS_REF_THING_SIZE;
+
+ if (time_left < 0)
+ res = am_false;
+ else if (time_left <= (Sint64) MAX_SMALL)
+ res = make_small((Sint) time_left);
+ else
+ res = erts_sint64_to_big(time_left, &hp);
+
+ msg = TUPLE2(hp, ref, res);
+
+ erts_queue_message(proc, locks, mp, msg, am_clock_service);
+
+ locks &= ~initial_locks;
+ if (locks)
+ erts_smp_proc_unlock(proc, locks);
+
+ return am_ok;
+}
+
+static ERTS_INLINE Eterm
+access_sched_local_btm(Process *c_p, Eterm pid,
+ Eterm tref, Uint32 *trefn,
+ Uint32 *rrefn,
+ int async, int cancel,
+ int return_res,
+ int info)
+{
+ ErtsSchedulerData *esdp;
+ ErtsHLTimerService *srv;
+ ErtsBifTimer *tmr;
+ Sint64 time_left;
+ Process *proc;
+ ErtsProcLocks proc_locks;
+
+ time_left = -1;
+
+ if (!c_p)
+ esdp = erts_get_scheduler_data();
+ else {
+ esdp = erts_proc_sched_data(c_p);
+ ERTS_HLT_ASSERT(esdp == erts_get_scheduler_data());
+ }
+
+ ERTS_HLT_ASSERT(erts_get_ref_numbers_thr_id(trefn)
+ == (Uint32) esdp->no);
+
+ srv = esdp->timer_service;
+
+ tmr = btm_rbt_lookup(srv->btm_tree, trefn);
+
+ time_left = access_btm(tmr, (Uint32) esdp->no, esdp, cancel);
+
+ if (!info)
+ return am_ok;
+
+ if (c_p) {
+ proc = c_p;
+ proc_locks = ERTS_PROC_LOCK_MAIN;
+ }
+ else {
+ proc = erts_proc_lookup(pid);
+ proc_locks = 0;
+ }
+
+ if (!async) {
+ if (c_p)
+ return return_info(c_p, time_left);
+
+ if (proc)
+ return send_sync_info(proc, proc_locks,
+ rrefn, cancel, time_left);
+ }
+ else if (proc) {
+ Eterm ref;
+ Eterm heap[ERTS_REF_THING_SIZE];
+ if (is_value(tref))
+ ref = tref;
+ else {
+ write_ref_thing(&heap[0], trefn[0], trefn[1], trefn[2]);
+ ref = make_internal_ref(&heap[0]);
+ }
+ return send_async_info(proc, proc_locks,
+ ref, cancel, time_left);
+ }
+
+ return am_ok;
+}
+
+#define ERTS_BTM_REQ_FLG_ASYNC (((Uint32) 1) << 0)
+#define ERTS_BTM_REQ_FLG_CANCEL (((Uint32) 1) << 1)
+#define ERTS_BTM_REQ_FLG_INFO (((Uint32) 1) << 2)
+
+typedef struct {
+ Eterm pid;
+ Uint32 trefn[ERTS_REF_NUMBERS];
+ Uint32 rrefn[ERTS_REF_NUMBERS];
+ Uint32 flags;
+} ErtsBifTimerRequest;
+
+static void
+bif_timer_access_request(void *vreq)
+{
+ ErtsBifTimerRequest *req = (ErtsBifTimerRequest *) vreq;
+ int async = (int) (req->flags & ERTS_BTM_REQ_FLG_ASYNC);
+ int cancel = (int) (req->flags & ERTS_BTM_REQ_FLG_CANCEL);
+ int info = (int) (req->flags & ERTS_BTM_REQ_FLG_INFO);
+ (void) access_sched_local_btm(NULL, req->pid, THE_NON_VALUE,
+ req->trefn, req->rrefn, async,
+ cancel, 0, info);
+ erts_free(ERTS_ALC_T_TIMER_REQUEST, vreq);
+}
+
+static int
+try_access_sched_remote_btm(ErtsSchedulerData *esdp,
+ Process *c_p, Uint32 sid,
+ Eterm tref, Uint32 *trefn,
+ int async, int cancel,
+ int info, Eterm *resp)
+{
+ ErtsBifTimer *tmr;
+ Sint64 time_left;
+
+ ERTS_HLT_ASSERT(c_p);
+
+ /*
+ * Check if the timer is aimed at current
+ * process...
+ */
+ erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_BTM);
+ tmr = proc_btm_rbt_lookup(c_p->bif_timers, trefn);
+ erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_BTM);
+ if (!tmr)
+ return 0;
+
+ time_left = access_btm(tmr, sid, esdp, cancel);
+
+ if (!info)
+ *resp = am_ok;
+ else if (!async)
+ *resp = return_info(c_p, time_left);
+ else
+ *resp = send_async_info(c_p, ERTS_PROC_LOCK_MAIN,
+ tref, cancel, time_left);
+
+ return 1;
+}
+
+static Eterm
+no_timer_result(Process *c_p, Eterm tref, int cancel, int async, int info)
+{
+ ErtsMessage *mp;
+ Uint hsz;
+ Eterm *hp, msg, ref, tag;
+ ErlOffHeap *ohp;
+ ErtsProcLocks locks;
+
+ if (!async)
+ return am_false;
+ if (!info)
+ return am_ok;
+
+ hsz = 4;
+ hsz += NC_HEAP_SIZE(tref);
+ locks = ERTS_PROC_LOCK_MAIN;
+ mp = erts_alloc_message_heap(c_p, &locks, hsz, &hp, &ohp);
+ ref = STORE_NC(&hp, ohp, tref);
+ tag = cancel ? am_cancel_timer : am_read_timer;
+ msg = TUPLE3(hp, tag, ref, am_false);
+ erts_queue_message(c_p, locks, mp, msg, am_clock_service);
+ locks &= ~ERTS_PROC_LOCK_MAIN;
+ if (locks)
+ erts_smp_proc_unlock(c_p, locks);
+ return am_ok;
+}
+
+static BIF_RETTYPE
+access_bif_timer(Process *c_p, Eterm tref, int cancel, int async, int info)
+{
+ BIF_RETTYPE ret;
+ ErtsSchedulerData *esdp;
+ Uint32 sid;
+ Uint32 *trefn;
+ Eterm res;
+
+ if (is_not_internal_ref(tref)) {
+ if (is_not_ref(tref))
+ goto badarg;
+ else
+ goto no_timer;
+ }
+
+ esdp = erts_proc_sched_data(c_p);
+
+ trefn = internal_ref_numbers(tref);
+ sid = erts_get_ref_numbers_thr_id(trefn);
+ if (sid < 1 || erts_no_schedulers < sid)
+ goto no_timer;
+
+ if (sid == (Uint32) esdp->no) {
+ res = access_sched_local_btm(c_p, c_p->common.id,
+ tref, trefn, NULL,
+ async, cancel, !async,
+ info);
+ ERTS_BIF_PREP_RET(ret, res);
+ }
+ else if (try_access_sched_remote_btm(esdp, c_p,
+ sid, tref, trefn,
+ async, cancel,
+ info, &res)) {
+ ERTS_BIF_PREP_RET(ret, res);
+ }
+ else {
+ /*
+ * Schedule access for execution on
+ * remote scheduler...
+ */
+ ErtsBifTimerRequest *req = erts_alloc(ERTS_ALC_T_TIMER_REQUEST,
+ sizeof(ErtsBifTimerRequest));
+
+ req->flags = 0;
+ if (cancel)
+ req->flags |= ERTS_BTM_REQ_FLG_CANCEL;
+ if (async)
+ req->flags |= ERTS_BTM_REQ_FLG_ASYNC;
+ if (info)
+ req->flags |= ERTS_BTM_REQ_FLG_INFO;
+
+ req->pid = c_p->common.id;
+
+ req->trefn[0] = trefn[0];
+ req->trefn[1] = trefn[1];
+ req->trefn[2] = trefn[2];
+
+ if (async)
+ ERTS_BIF_PREP_RET(ret, am_ok);
+ else {
+ Eterm *hp, rref;
+ Uint32 *rrefn;
+
+ hp = HAlloc(c_p, ERTS_REF_THING_SIZE);
+ rref = erts_sched_make_ref_in_buffer(esdp, hp);
+ rrefn = internal_ref_numbers(rref);
+
+ req->rrefn[0] = rrefn[0];
+ req->rrefn[1] = rrefn[1];
+ req->rrefn[2] = rrefn[2];
+
+ erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
+
+ if (ERTS_PROC_PENDING_EXIT(c_p))
+ ERTS_VBUMP_ALL_REDS(c_p);
+ else {
+ /*
+ * Caller needs to wait for a message containing
+ * the ref that we just created. No such message
+ * can exist in callers message queue at this time.
+ * We therefore move the save pointer of the
+ * callers message queue to the end of the queue.
+ *
+ * NOTE: It is of vital importance that the caller
+ * immediately do a receive unconditionaly
+ * waiting for the message with the reference;
+ * otherwise, next receive will *not* work
+ * as expected!
+ */
+ ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p);
+ c_p->msg.save = c_p->msg.last;
+ }
+ erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
+
+ ERTS_BIF_PREP_TRAP1(ret, erts_await_result, c_p, rref);
+ }
+
+ erts_schedule_misc_aux_work(sid,
+ bif_timer_access_request,
+ (void *) req);
+ }
+
+ return ret;
+
+badarg:
+ ERTS_BIF_PREP_ERROR(ret, c_p, BADARG);
+ return ret;
+
+no_timer:
+ return no_timer_result(c_p, tref, cancel, async, info);
+}
+
+#endif /* !ERTS_MAGIC_REF_BIF_TIMERS */
+
+static ERTS_INLINE int
+bool_arg(Eterm val, int *argp)
+{
+ switch (val) {
+ case am_true: *argp = 1; return 1;
+ case am_false: *argp = 0; return 1;
+ default: return 0;
+ }
+}
+
+static ERTS_INLINE int
+parse_bif_timer_options(Eterm option_list, int *async,
+ int *info, int *abs)
+{
+ Eterm list = option_list;
+
+ if (async)
+ *async = 0;
+ if (info)
+ *info = 1;
+ if (abs)
+ *abs = 0;
+
+ while (is_list(list)) {
+ Eterm *consp, *tp, opt;
+
+ consp = list_val(list);
+ opt = CAR(consp);
+ if (is_not_tuple(opt))
+ return 0;
+
+ tp = tuple_val(opt);
+ if (arityval(tp[0]) != 2)
+ return 0;
+
+ switch (tp[1]) {
+ case am_async:
+ if (!async || !bool_arg(tp[2], async))
+ return 0;
+ break;
+ case am_info:
+ if (!info || !bool_arg(tp[2], info))
+ return 0;
+ break;
+ case am_abs:
+ if (!abs || !bool_arg(tp[2], abs))
+ return 0;
+ break;
+ default:
+ return 0;
+ }
+
+ list = CDR(consp);
+ }
+
+ if (is_not_nil(list))
+ return 0;
+ return 1;
+}
+
+static void
+exit_cancel_bif_timer(ErtsBifTimer *tmr, void *vesdp)
+{
+ ErtsSchedulerData *esdp = (ErtsSchedulerData *) vesdp;
+ Uint32 sid, roflgs;
+ erts_aint_t state;
+ int is_hlt;
+
+ state = erts_smp_atomic32_cmpxchg_acqb(&tmr->btm.state,
+ ERTS_TMR_STATE_CANCELED,
+ ERTS_TMR_STATE_ACTIVE);
+
+ roflgs = tmr->type.head.roflgs;
+ sid = roflgs & ERTS_TMR_ROFLG_SID_MASK;
+ is_hlt = !!(roflgs & ERTS_TMR_ROFLG_HLT);
+
+ ERTS_HLT_ASSERT(sid == erts_get_ref_numbers_thr_id(ERTS_BTM_HLT2REFN(tmr)));
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+ ERTS_HLT_ASSERT(tmr->btm.proc_list.next);
+#else
+ ERTS_HLT_ASSERT(tmr->btm.proc_tree.parent
+ != ERTS_HLT_PFIELD_NOT_IN_TABLE);
+ tmr->btm.proc_tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE;
+#endif
+
+ if (state == ERTS_TMR_STATE_ACTIVE) {
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+ btm_clear_magic_binary(tmr);
+#endif
+ if (tmr->btm.bp)
+ free_message_buffer(tmr->btm.bp);
+
+ if (sid != (Uint32) esdp->no) {
+ queue_canceled_timer(esdp, sid, (ErtsTimer *) tmr);
+ return;
+ }
+
+#ifndef ERTS_MAGIC_REF_BIF_TIMERS
+ if (tmr->btm.tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE) {
+ btm_rbt_delete(&esdp->timer_service->btm_tree, tmr);
+ tmr->btm.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE;
+ }
+#endif
+ if (is_hlt)
+ hlt_delete_timer(esdp, &tmr->type.hlt);
+ else
+ cancel_tw_timer(esdp, &tmr->type.twt);
+ }
+ if (is_hlt)
+ hl_timer_dec_refc(&tmr->type.hlt, roflgs);
+ else
+ tw_timer_dec_refc(&tmr->type.twt);
+}
+
+#ifdef ERTS_HLT_DEBUG
+# define ERTS_BTM_MAX_DESTROY_LIMIT 2
+#else
+# define ERTS_BTM_MAX_DESTROY_LIMIT 50
+#endif
+
+#ifndef ERTS_MAGIC_REF_BIF_TIMERS
+typedef struct {
+ ErtsBifTimers *bif_timers;
+ union {
+ proc_btm_rbt_yield_state_t proc_btm_yield_state;
+ } u;
+} ErtsBifTimerYieldState;
+#endif
+
+int erts_cancel_bif_timers(Process *p, ErtsBifTimers **btm, void **vyspp)
+{
+ ErtsSchedulerData *esdp = erts_proc_sched_data(p);
+
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+
+ return proc_btm_list_foreach_destroy_yielding(btm,
+ exit_cancel_bif_timer,
+ (void *) esdp,
+ ERTS_BTM_MAX_DESTROY_LIMIT);
+
+#else /* !ERTS_MAGIC_REF_BIF_TIMERS */
+
+ ErtsBifTimerYieldState ys = {*btm, {ERTS_RBT_YIELD_STAT_INITER}};
+ ErtsBifTimerYieldState *ysp;
+ int res;
+
+ ysp = (ErtsBifTimerYieldState *) *vyspp;
+ if (!ysp)
+ ysp = &ys;
+
+ res = proc_btm_rbt_foreach_destroy_yielding(&ysp->bif_timers,
+ exit_cancel_bif_timer,
+ (void *) esdp,
+ &ysp->u.proc_btm_yield_state,
+ ERTS_BTM_MAX_DESTROY_LIMIT);
+
+ if (res == 0) {
+ if (ysp != &ys)
+ erts_free(ERTS_ALC_T_BTM_YIELD_STATE, ysp);
+ *vyspp = NULL;
+ }
+ else {
+
+ if (ysp == &ys) {
+ ysp = erts_alloc(ERTS_ALC_T_BTM_YIELD_STATE,
+ sizeof(ErtsBifTimerYieldState));
+ sys_memcpy((void *) ysp, (void *) &ys,
+ sizeof(ErtsBifTimerYieldState));
+ }
+
+ *vyspp = (void *) ysp;
+ }
+
+ return res;
+
+#endif /* !ERTS_MAGIC_REF_BIF_TIMERS */
+}
+
+static ERTS_INLINE int
+parse_timeout_pos(ErtsSchedulerData *esdp, Eterm arg,
+ ErtsMonotonicTime *conv_arg, int abs,
+ ErtsMonotonicTime *tposp, int *stimep,
+ ErtsMonotonicTime *msp)
+{
+ ErtsMonotonicTime t, now;
+
+ if (!term_to_Sint64(arg, &t)) {
+ ERTS_HLT_ASSERT(!is_small(arg));
+ if (!is_big(arg))
+ return -1;
+
+ if (abs || !big_sign(arg))
+ return 1;
+
+ return -1;
+ }
+
+ if (conv_arg)
+ *conv_arg = t;
+
+ now = erts_get_monotonic_time(esdp);
+
+ if (abs) {
+ t += -1*ERTS_MONOTONIC_OFFSET_MSEC; /* external to internal */
+ if (t < ERTS_MONOTONIC_TO_MSEC(ERTS_MONOTONIC_BEGIN))
+ return 1;
+ if (t > ERTS_MONOTONIC_TO_MSEC(ERTS_MONOTONIC_END))
+ return 1;
+ if (msp)
+ *msp = t - ERTS_MONOTONIC_TO_MSEC(now);
+
+ *stimep = (t - ERTS_MONOTONIC_TO_MSEC(esdp->last_monotonic_time)
+ < ERTS_BIF_TIMER_SHORT_TIME);
+ *tposp = ERTS_MSEC_TO_CLKTCKS(t);
+ }
+ else {
+ ErtsMonotonicTime ticks;
+
+ if (t < 0)
+ return -1;
+
+ if (msp)
+ *msp = t;
+
+ ticks = ERTS_MSEC_TO_CLKTCKS(t);
+
+ if (ERTS_CLKTCK_RESOLUTION > 1000 && ticks < 0)
+ return 1;
+
+ ERTS_HLT_ASSERT(ticks >= 0);
+
+ ticks += ERTS_MONOTONIC_TO_CLKTCKS(now-1);
+ ticks += 1;
+
+ if (ticks < ERTS_MONOTONIC_TO_CLKTCKS(ERTS_MONOTONIC_BEGIN))
+ return 1;
+ if (ticks > ERTS_MONOTONIC_TO_CLKTCKS(ERTS_MONOTONIC_END))
+ return 1;
+
+ *stimep = (t < ERTS_BIF_TIMER_SHORT_TIME);
+ *tposp = ticks;
+ }
+
+ return 0;
+}
+
+/*
+ *
+ * The BIF timer BIFs...
+ */
+
+BIF_RETTYPE send_after_3(BIF_ALIST_3)
+{
+ ErtsMonotonicTime timeout_pos, tmo;
+ int short_time, tres;
+
+ tres = parse_timeout_pos(erts_proc_sched_data(BIF_P), BIF_ARG_1,
+ NULL, 0, &timeout_pos, &short_time, &tmo);
+ if (tres != 0)
+ BIF_ERROR(BIF_P, BADARG);
+
+ return setup_bif_timer(BIF_P, tmo < ERTS_TIMER_WHEEL_MSEC,
+ timeout_pos, short_time, BIF_ARG_2,
+ BIF_ARG_3, 0);
+}
+
+BIF_RETTYPE send_after_4(BIF_ALIST_4)
+{
+ ErtsMonotonicTime timeout_pos, tmo;
+ int short_time, abs, tres;
+
+ if (!parse_bif_timer_options(BIF_ARG_4, NULL, NULL, &abs))
+ BIF_ERROR(BIF_P, BADARG);
+
+ tres = parse_timeout_pos(erts_proc_sched_data(BIF_P), BIF_ARG_1, NULL,
+ abs, &timeout_pos, &short_time, &tmo);
+ if (tres != 0)
+ BIF_ERROR(BIF_P, BADARG);
+
+ return setup_bif_timer(BIF_P, tmo < ERTS_TIMER_WHEEL_MSEC,
+ timeout_pos, short_time, BIF_ARG_2,
+ BIF_ARG_3, 0);
+}
+
+BIF_RETTYPE start_timer_3(BIF_ALIST_3)
+{
+ ErtsMonotonicTime timeout_pos, tmo;
+ int short_time, tres;
+
+ tres = parse_timeout_pos(erts_proc_sched_data(BIF_P), BIF_ARG_1, NULL,
+ 0, &timeout_pos, &short_time, &tmo);
+ if (tres != 0)
+ BIF_ERROR(BIF_P, BADARG);
+
+ return setup_bif_timer(BIF_P, tmo < ERTS_TIMER_WHEEL_MSEC,
+ timeout_pos, short_time, BIF_ARG_2,
+ BIF_ARG_3, !0);
+}
+
+BIF_RETTYPE start_timer_4(BIF_ALIST_4)
+{
+ ErtsMonotonicTime timeout_pos, tmo;
+ int short_time, abs, tres;
+
+ if (!parse_bif_timer_options(BIF_ARG_4, NULL, NULL, &abs))
+ BIF_ERROR(BIF_P, BADARG);
+
+ tres = parse_timeout_pos(erts_proc_sched_data(BIF_P), BIF_ARG_1, NULL,
+ abs, &timeout_pos, &short_time, &tmo);
+ if (tres != 0)
+ BIF_ERROR(BIF_P, BADARG);
+
+ return setup_bif_timer(BIF_P, tmo < ERTS_TIMER_WHEEL_MSEC,
+ timeout_pos, short_time, BIF_ARG_2,
+ BIF_ARG_3, !0);
+}
+
+BIF_RETTYPE cancel_timer_1(BIF_ALIST_1)
+{
+ return access_bif_timer(BIF_P, BIF_ARG_1, 1, 0, 1);
+}
+
+BIF_RETTYPE cancel_timer_2(BIF_ALIST_2)
+{
+ BIF_RETTYPE ret;
+ int async, info;
+
+ if (parse_bif_timer_options(BIF_ARG_2, &async, &info, NULL))
+ return access_bif_timer(BIF_P, BIF_ARG_1, 1, async, info);
+
+ ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG);
+ return ret;
+}
+
+BIF_RETTYPE read_timer_1(BIF_ALIST_1)
+{
+ return access_bif_timer(BIF_P, BIF_ARG_1, 0, 0, 1);
+}
+
+BIF_RETTYPE read_timer_2(BIF_ALIST_2)
+{
+ BIF_RETTYPE ret;
+ int async;
+
+ if (parse_bif_timer_options(BIF_ARG_2, &async, NULL, NULL))
+ return access_bif_timer(BIF_P, BIF_ARG_1, 0, async, 1);
+
+ ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG);
+ return ret;
+}
+
+static void
+start_callback_timer(ErtsSchedulerData *esdp,
+ int twt,
+ ErtsMonotonicTime timeout_pos,
+ void (*callback)(void *),
+ void *arg)
+
+{
+ ErtsCreateTimerFunc create_timer = (twt
+ ? create_tw_timer
+ : create_hl_timer);
+ (void) create_timer(esdp, timeout_pos, 0,
+ ERTS_TMR_CALLBACK, NULL,
+ NIL, THE_NON_VALUE, NULL,
+ callback, arg);
+}
+
+typedef struct {
+ int twt;
+ ErtsMonotonicTime timeout_pos;
+ void (*callback)(void *);
+ void *arg;
+} ErtsStartCallbackTimerRequest;
+
+static void
+scheduled_start_callback_timer(void *vsctr)
+{
+ ErtsStartCallbackTimerRequest *sctr
+ = (ErtsStartCallbackTimerRequest *) vsctr;
+
+ start_callback_timer(erts_get_scheduler_data(),
+ sctr->twt,
+ sctr->timeout_pos,
+ sctr->callback,
+ sctr->arg);
+
+ erts_free(ERTS_ALC_T_TIMER_REQUEST, vsctr);
+}
+
+void
+erts_start_timer_callback(ErtsMonotonicTime tmo,
+ void (*callback)(void *),
+ void *arg)
+{
+ ErtsSchedulerData *esdp;
+ ErtsMonotonicTime timeout_pos;
+ int twt;
+
+ esdp = erts_get_scheduler_data();
+ timeout_pos = get_timeout_pos(erts_get_monotonic_time(esdp),
+ tmo);
+ twt = tmo < ERTS_TIMER_WHEEL_MSEC;
+
+ if (esdp && !ERTS_SCHEDULER_IS_DIRTY(esdp))
+ start_callback_timer(esdp,
+ twt,
+ timeout_pos,
+ callback,
+ arg);
+ else {
+ ErtsStartCallbackTimerRequest *sctr;
+ sctr = erts_alloc(ERTS_ALC_T_TIMER_REQUEST,
+ sizeof(ErtsStartCallbackTimerRequest));
+ sctr->twt = twt;
+ sctr->timeout_pos = timeout_pos;
+ sctr->callback = callback;
+ sctr->arg = arg;
+ erts_schedule_misc_aux_work(1,
+ scheduled_start_callback_timer,
+ (void *) sctr);
+ }
+}
+
+/*
+ * Process and Port timer functionality.
+ *
+ * NOTE! These are only allowed to be called by a
+ * scheduler thread that currently is
+ * executing the process or port.
+ */
+
+static ERTS_INLINE void
+set_proc_timer_common(Process *c_p, ErtsSchedulerData *esdp, Sint64 tmo,
+ ErtsMonotonicTime timeout_pos, int short_time)
+{
+ void *tmr;
+ check_canceled_queue(esdp, esdp->timer_service);
+
+ if (tmo == 0)
+ c_p->flags |= F_TIMO;
+ else {
+ ErtsCreateTimerFunc create_timer;
+
+ c_p->flags |= F_INSLPQUEUE;
+ c_p->flags &= ~F_TIMO;
+
+ create_timer = (tmo < ERTS_TIMER_WHEEL_MSEC
+ ? create_tw_timer
+ : create_hl_timer);
+ tmr = (void *) create_timer(esdp, timeout_pos, short_time,
+ ERTS_TMR_PROC, (void *) c_p,
+ c_p->common.id, THE_NON_VALUE,
+ NULL, NULL, NULL);
+ erts_smp_atomic_set_relb(&c_p->common.timer, (erts_aint_t) tmr);
+ }
+}
+
+int
+erts_set_proc_timer_term(Process *c_p, Eterm etmo)
+{
+ ErtsSchedulerData *esdp = erts_proc_sched_data(c_p);
+ ErtsMonotonicTime tmo, timeout_pos;
+ int short_time, tres;
+
+ ERTS_HLT_ASSERT(erts_smp_atomic_read_nob(&c_p->common.timer)
+ == ERTS_PTMR_NONE);
+
+ tres = parse_timeout_pos(esdp, etmo, &tmo, 0,
+ &timeout_pos, &short_time, NULL);
+ if (tres != 0)
+ return tres;
+
+ if ((tmo >> 32) != 0)
+ return 1;
+
+ set_proc_timer_common(c_p, esdp, tmo, timeout_pos, short_time);
+ return 0;
+}
+
+void
+erts_set_proc_timer_uword(Process *c_p, UWord tmo)
+{
+ ErtsSchedulerData *esdp = erts_proc_sched_data(c_p);
+
+ ERTS_HLT_ASSERT(erts_smp_atomic_read_nob(&c_p->common.timer)
+ == ERTS_PTMR_NONE);
+
+#ifndef ARCH_32
+ ERTS_HLT_ASSERT((tmo >> 32) == (UWord) 0);
+#endif
+
+ if (tmo == 0)
+ c_p->flags |= F_TIMO;
+ else {
+ ErtsMonotonicTime timeout_pos;
+ timeout_pos = get_timeout_pos(erts_get_monotonic_time(esdp),
+ (ErtsMonotonicTime) tmo);
+ set_proc_timer_common(c_p, esdp, (ErtsMonotonicTime) tmo,
+ timeout_pos,
+ tmo < ERTS_BIF_TIMER_SHORT_TIME);
+ }
+}
+
+void
+erts_cancel_proc_timer(Process *c_p)
+{
+ erts_aint_t tval;
+ tval = erts_smp_atomic_xchg_acqb(&c_p->common.timer,
+ ERTS_PTMR_NONE);
+ c_p->flags &= ~(F_INSLPQUEUE|F_TIMO);
+ if (tval == ERTS_PTMR_NONE)
+ return;
+ if (tval == ERTS_PTMR_TIMEDOUT) {
+ erts_smp_atomic_set_nob(&c_p->common.timer, ERTS_PTMR_NONE);
+ return;
+ }
+ continue_cancel_ptimer(erts_proc_sched_data(c_p),
+ (ErtsTimer *) tval);
+}
+
+void
+erts_set_port_timer(Port *c_prt, Sint64 tmo)
+{
+ void *tmr;
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
+ ErtsMonotonicTime timeout_pos;
+ ErtsCreateTimerFunc create_timer;
+
+ if (erts_smp_atomic_read_nob(&c_prt->common.timer) != ERTS_PTMR_NONE)
+ erts_cancel_port_timer(c_prt);
+
+ check_canceled_queue(esdp, esdp->timer_service);
+
+ timeout_pos = get_timeout_pos(erts_get_monotonic_time(esdp), tmo);
+
+ create_timer = (tmo < ERTS_TIMER_WHEEL_MSEC
+ ? create_tw_timer
+ : create_hl_timer);
+ tmr = (void *) create_timer(esdp, timeout_pos, 0, ERTS_TMR_PORT,
+ (void *) c_prt, c_prt->common.id,
+ THE_NON_VALUE, NULL, NULL, NULL);
+ erts_smp_atomic_set_relb(&c_prt->common.timer, (erts_aint_t) tmr);
+}
+
+void
+erts_cancel_port_timer(Port *c_prt)
+{
+ erts_aint_t tval;
+ tval = erts_smp_atomic_xchg_acqb(&c_prt->common.timer,
+ ERTS_PTMR_NONE);
+ if (tval == ERTS_PTMR_NONE)
+ return;
+ if (tval == ERTS_PTMR_TIMEDOUT) {
+ while (!erts_port_task_is_scheduled(&c_prt->timeout_task))
+ erts_thr_yield();
+ erts_port_task_abort(&c_prt->timeout_task);
+ erts_smp_atomic_set_nob(&c_prt->common.timer, ERTS_PTMR_NONE);
+ return;
+ }
+ continue_cancel_ptimer(erts_get_scheduler_data(),
+ (ErtsTimer *) tval);
+}
+
+Sint64
+erts_read_port_timer(Port *c_prt)
+{
+ ErtsTimer *tmr;
+ erts_aint_t itmr;
+ ErtsMonotonicTime timeout_pos;
+
+ itmr = erts_smp_atomic_read_acqb(&c_prt->common.timer);
+ if (itmr == ERTS_PTMR_NONE)
+ return (Sint64) -1;
+ if (itmr == ERTS_PTMR_TIMEDOUT)
+ return (Sint64) 0;
+ tmr = (ErtsTimer *) itmr;
+ if (tmr->head.roflgs & ERTS_TMR_ROFLG_HLT)
+ timeout_pos = tmr->hlt.timeout;
+ else
+ timeout_pos = erts_tweel_read_timeout(&tmr->twt.u.tw_tmr);
+ return get_time_left(NULL, timeout_pos);
+}
+
+/*
+ * Debug stuff...
+ */
+
+typedef struct {
+ fmtfn_t to;
+ void *to_arg;
+ ErtsMonotonicTime now;
+} ErtsBTMPrint;
+
+static void
+btm_print(ErtsBifTimer *tmr, void *vbtmp, ErtsMonotonicTime tpos, int is_hlt)
+{
+ ErtsBTMPrint *btmp = (ErtsBTMPrint *) vbtmp;
+ ErtsMonotonicTime left;
+ Eterm receiver;
+
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+ if (!(tmr->type.head.roflgs & ERTS_TMR_ROFLG_BIF_TMR))
+ return;
+#endif
+
+ if (is_hlt) {
+ ERTS_HLT_ASSERT(tmr->type.head.roflgs & ERTS_TMR_ROFLG_HLT);
+ if (tmr->type.hlt.timeout <= btmp->now)
+ left = 0;
+ else
+ left = ERTS_CLKTCKS_TO_MSEC(tmr->type.hlt.timeout - btmp->now);
+ }
+ else {
+ ERTS_HLT_ASSERT(!(tmr->type.head.roflgs & ERTS_TMR_ROFLG_HLT));
+ if (tpos <= btmp->now)
+ left = 0;
+ else
+ left = ERTS_CLKTCKS_TO_MSEC(tpos - btmp->now);
+ }
+
+ receiver = ((tmr->type.head.roflgs & ERTS_TMR_ROFLG_REG_NAME)
+ ? tmr->type.head.receiver.name
+ : tmr->type.head.receiver.proc->common.id);
+
+ erts_print(btmp->to, btmp->to_arg,
+ "=timer:%T\n"
+ "Message: %T\n"
+ "Time left: %b64d\n",
+ receiver,
+ tmr->btm.message,
+ (Sint64) left);
+}
+
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+
+static void
+hlt_btm_print(ErtsHLTimer *tmr, void *vbtmp)
+{
+ btm_print((ErtsBifTimer *) tmr, vbtmp, 0, 1);
+}
+
+static void
+twt_btm_print(void *vbtmp, ErtsMonotonicTime tpos, void *vtwtp)
+{
+ btm_print((ErtsBifTimer *) vtwtp, vbtmp, tpos, 0);
+}
+
+#else
+
+static void
+btm_tree_print(ErtsBifTimer *tmr, void *vbtmp)
+{
+ int is_hlt = !!(tmr->type.head.roflgs & ERTS_TMR_ROFLG_HLT);
+ ErtsMonotonicTime tpos;
+ if (is_hlt)
+ tpos = 0;
+ else
+ tpos = erts_tweel_read_timeout(&tmr->type.twt.u.tw_tmr);
+ btm_print(tmr, vbtmp, tpos, is_hlt);
+}
+
+#endif
+
+void
+erts_print_bif_timer_info(fmtfn_t to, void *to_arg)
+{
+ ErtsBTMPrint btmp;
+ int six;
+
+ if (!ERTS_IS_CRASH_DUMPING)
+ ERTS_INTERNAL_ERROR("Not crash dumping");
+
+ btmp.to = to;
+ btmp.to_arg = to_arg;
+ btmp.now = erts_get_monotonic_time(NULL);
+ btmp.now = ERTS_MONOTONIC_TO_CLKTCKS(btmp.now);
+
+ for (six = 0; six < erts_no_schedulers; six++) {
+ ErtsHLTimerService *srv =
+ erts_aligned_scheduler_data[six].esd.timer_service;
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+ ErtsTimerWheel *twheel =
+ erts_aligned_scheduler_data[six].esd.timer_wheel;
+ erts_twheel_debug_foreach(twheel, tw_bif_timer_timeout,
+ twt_btm_print, (void *) &btmp);
+ time_rbt_foreach(srv->time_tree, hlt_btm_print, (void *) &btmp);
+#else
+ btm_rbt_foreach(srv->btm_tree, btm_tree_print, (void *) &btmp);
+#endif
+ }
+}
+
+typedef struct {
+ void (*func)(Eterm,
+ Eterm,
+ ErlHeapFragment *,
+ void *);
+ void *arg;
+} ErtsBTMForeachDebug;
+
+static void
+debug_btm_foreach(ErtsBifTimer *tmr, void *vbtmfd)
+{
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+ if (!(tmr->type.head.roflgs & ERTS_TMR_ROFLG_BIF_TMR))
+ return;
+#endif
+ if (erts_smp_atomic32_read_nob(&tmr->btm.state) == ERTS_TMR_STATE_ACTIVE) {
+ ErtsBTMForeachDebug *btmfd = (ErtsBTMForeachDebug *) vbtmfd;
+ Eterm id = ((tmr->type.head.roflgs & ERTS_TMR_ROFLG_REG_NAME)
+ ? tmr->type.head.receiver.name
+ : tmr->type.head.receiver.proc->common.id);
+ (*btmfd->func)(id, tmr->btm.message, tmr->btm.bp, btmfd->arg);
+ }
+}
+
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+
+static void
+hlt_debug_btm_foreach(ErtsHLTimer *tmr, void *vbtmfd)
+{
+ debug_btm_foreach((ErtsBifTimer *) tmr, vbtmfd);
+}
+
+static void
+twt_debug_btm_foreach(void *vbtmfd, ErtsMonotonicTime tpos, void *vtwtp)
+{
+ debug_btm_foreach((ErtsBifTimer *) vtwtp, vbtmfd);
+}
+
+#endif
+
+void
+erts_debug_bif_timer_foreach(void (*func)(Eterm,
+ Eterm,
+ ErlHeapFragment *,
+ void *),
+ void *arg)
+{
+ ErtsBTMForeachDebug btmfd;
+ int six;
+
+ btmfd.func = func;
+ btmfd.arg = arg;
+
+ if (!erts_smp_thr_progress_is_blocking())
+ ERTS_INTERNAL_ERROR("Not blocking thread progress");
+
+ for (six = 0; six < erts_no_schedulers; six++) {
+ ErtsHLTimerService *srv =
+ erts_aligned_scheduler_data[six].esd.timer_service;
+#ifdef ERTS_MAGIC_REF_BIF_TIMERS
+ ErtsTimerWheel *twheel =
+ erts_aligned_scheduler_data[six].esd.timer_wheel;
+ erts_twheel_debug_foreach(twheel, tw_bif_timer_timeout,
+ twt_debug_btm_foreach,
+ (void *) &btmfd);
+ time_rbt_foreach(srv->time_tree,
+ hlt_debug_btm_foreach,
+ (void *) &btmfd);
+#else
+ btm_rbt_foreach(srv->btm_tree,
+ debug_btm_foreach,
+ (void *) &btmfd);
+#endif
+ }
+}
+
+typedef struct {
+ void (*tclbk)(void *);
+ void (*func)(void *,
+ ErtsMonotonicTime,
+ void *);
+ void *arg;
+} ErtsDebugForeachCallbackTimer;
+
+static void
+debug_callback_timer_foreach_list(ErtsHLTimer *tmr, void *vdfct)
+{
+ ErtsDebugForeachCallbackTimer *dfct
+ = (ErtsDebugForeachCallbackTimer *) vdfct;
+
+ if ((tmr->head.roflgs & ERTS_TMR_ROFLG_CALLBACK)
+ && (tmr->head.receiver.callback == dfct->tclbk))
+ (*dfct->func)(dfct->arg,
+ tmr->timeout,
+ tmr->head.u.arg);
+}
+
+static void
+debug_callback_timer_foreach(ErtsHLTimer *tmr, void *vdfct)
+{
+ ErtsDebugForeachCallbackTimer *dfct
+ = (ErtsDebugForeachCallbackTimer *) vdfct;
+
+ if (tmr->time.tree.same_time)
+ same_time_list_foreach(tmr->time.tree.same_time,
+ debug_callback_timer_foreach_list,
+ vdfct);
+
+ if ((tmr->head.roflgs & ERTS_TMR_ROFLG_CALLBACK)
+ && (tmr->head.receiver.callback == dfct->tclbk))
+ (*dfct->func)(dfct->arg,
+ tmr->timeout,
+ tmr->head.u.arg);
+}
+
+static void
+debug_tw_callback_timer(void *vdfct,
+ ErtsMonotonicTime timeout_pos,
+ void *vtwtp)
+{
+ ErtsTWTimer *twtp = (ErtsTWTimer *) vtwtp;
+ ErtsDebugForeachCallbackTimer *dfct
+ = (ErtsDebugForeachCallbackTimer *) vdfct;
+
+ if (twtp->head.receiver.callback == dfct->tclbk)
+ (*dfct->func)(dfct->arg,
+ timeout_pos,
+ twtp->head.u.arg);
+}
+
+void
+erts_debug_callback_timer_foreach(void (*tclbk)(void *),
+ void (*func)(void *,
+ ErtsMonotonicTime,
+ void *),
+ void *arg)
+{
+ int six;
+ ErtsDebugForeachCallbackTimer dfct;
+
+ dfct.tclbk = tclbk;
+ dfct.func = func;
+ dfct.arg = arg;
+
+ if (!erts_smp_thr_progress_is_blocking())
+ ERTS_INTERNAL_ERROR("Not blocking thread progress");
+
+ for (six = 0; six < erts_no_schedulers; six++) {
+ ErtsHLTimerService *srv =
+ erts_aligned_scheduler_data[six].esd.timer_service;
+ ErtsTimerWheel *twheel =
+ erts_aligned_scheduler_data[six].esd.timer_wheel;
+
+ erts_twheel_debug_foreach(twheel,
+ tw_callback_timeout,
+ debug_tw_callback_timer,
+ (void *) &dfct);
+
+ if (srv->yield.root)
+ debug_callback_timer_foreach(srv->yield.root,
+ (void *) &dfct);
+
+ time_rbt_foreach(srv->time_tree,
+ debug_callback_timer_foreach,
+ (void *) &dfct);
+ }
+}
+
+#ifdef ERTS_HLT_HARD_DEBUG
+
+typedef struct {
+ ErtsHLTimerService *srv;
+ int found_root;
+ ErtsHLTimer **rootpp;
+} ErtsHdbgHLT;
+
+static void
+st_hdbg_func(ErtsHLTimer *tmr, void *vhdbg)
+{
+ ErtsHdbgHLT *hdbg = (ErtsHdbgHLT *) vhdbg;
+ ErtsHLTimer **rootpp;
+ ERTS_HLT_ASSERT(tmr->time.tree.parent & ERTS_HLT_PFLG_SAME_TIME);
+ if (tmr->time.tree.parent == ERTS_HLT_PFLG_SAME_TIME) {
+ ERTS_HLT_ASSERT(tmr != *hdbg->rootpp);
+ }
+ else {
+ rootpp = (ErtsHLTimer **) (tmr->time.tree.parent
+ & ~ERTS_HLT_PFLG_SAME_TIME);
+ ERTS_HLT_ASSERT(rootpp == hdbg->rootpp);
+ ERTS_HLT_ASSERT(tmr == *rootpp);
+ ERTS_HLT_ASSERT(!hdbg->found_root);
+ hdbg->found_root = 1;
+ }
+ ERTS_HLT_ASSERT(tmr->time.tree.u.l.next->time.tree.u.l.prev == tmr);
+ ERTS_HLT_ASSERT(tmr->time.tree.u.l.prev->time.tree.u.l.next == tmr);
+#ifndef ERTS_MAGIC_REF_BIF_TIMERS
+ ERTS_HLT_ASSERT(btm_rbt_lookup(hdbg->srv->btm_tree, ERTS_BTM_HLT2REFN(tmr)) == tmr);
+#endif
+}
+
+static void
+tt_hdbg_func(ErtsHLTimer *tmr, void *vhdbg)
+{
+ ErtsHdbgHLT *hdbg = (ErtsHdbgHLT *) vhdbg;
+ ErtsHLTimer *prnt;
+ ERTS_HLT_ASSERT((tmr->time.tree.parent & ERTS_HLT_PFLG_SAME_TIME) == 0);
+ prnt = (ErtsHLTimer *) (tmr->time.tree.parent & ~ERTS_HLT_PFLGS_MASK);
+ if (prnt) {
+ ERTS_HLT_ASSERT(prnt->time.tree.u.t.left == tmr
+ || prnt->time.tree.u.t.right == tmr);
+ }
+ else {
+ ERTS_HLT_ASSERT(!hdbg->found_root);
+ hdbg->found_root = 1;
+ ERTS_HLT_ASSERT(tmr == *hdbg->rootpp);
+ }
+ if (tmr->time.tree.u.t.left) {
+ prnt = (ErtsHLTimer *) (tmr->time.tree.u.t.left->time.tree.parent
+ & ~ERTS_HLT_PFLGS_MASK);
+ ERTS_HLT_ASSERT(tmr == prnt);
+ }
+ if (tmr->time.tree.u.t.right) {
+ prnt = (ErtsHLTimer *) (tmr->time.tree.u.t.right->time.tree.parent
+ & ~ERTS_HLT_PFLGS_MASK);
+ ERTS_HLT_ASSERT(tmr == prnt);
+ }
+#ifndef ERTS_MAGIC_REF_BIF_TIMERS
+ if (tmr->head.roflgs & ERTS_TMR_ROFLG_BIF_TMR)
+ ERTS_HLT_ASSERT(btm_rbt_lookup(hdbg->srv->btm_tree, ERTS_BTM_HLT2REFN(tmr)) == tmr);
+#endif
+ if (tmr->time.tree.same_time) {
+ ErtsHdbgHLT st_hdbg;
+ st_hdbg.srv = hdbg->srv;
+ st_hdbg.found_root = 0;
+ st_hdbg.rootpp = &tmr->time.tree.same_time;
+ same_time_list_foreach(tmr->time.tree.same_time, st_hdbg_func, (void *) &st_hdbg);
+ ERTS_HLT_ASSERT(st_hdbg.found_root);
+ }
+}
+
+static void
+bt_hdbg_func(ErtsHLTimer *tmr, void *vhdbg)
+{
+ ErtsHdbgHLT *hdbg = (ErtsHdbgHLT *) vhdbg;
+ ErtsHLTimer *prnt;
+ ERTS_HLT_ASSERT((tmr->btm.tree.parent & ERTS_HLT_PFLG_SAME_TIME) == 0);
+ prnt = (ErtsHLTimer *) (tmr->btm.tree.parent & ~ERTS_HLT_PFLGS_MASK);
+ if (prnt) {
+ ERTS_HLT_ASSERT(prnt->btm.tree.left == tmr
+ || prnt->btm.tree.right == tmr);
+ }
+ else {
+ ERTS_HLT_ASSERT(!hdbg->found_root);
+ hdbg->found_root = 1;
+ ERTS_HLT_ASSERT(tmr == *hdbg->rootpp);
+ }
+ if (tmr->btm.tree.left) {
+ prnt = (ErtsHLTimer *) (tmr->btm.tree.left->btm.tree.parent
+ & ~ERTS_HLT_PFLGS_MASK);
+ ERTS_HLT_ASSERT(tmr == prnt);
+ }
+ if (tmr->btm.tree.right) {
+ prnt = (ErtsHLTimer *) (tmr->btm.tree.right->btm.tree.parent
+ & ~ERTS_HLT_PFLGS_MASK);
+ ERTS_HLT_ASSERT(tmr == prnt);
+ }
+ if (tmr->pending_timeout) {
+ if (tmr->pending_timeout > 0) /* container > 0 */
+ ERTS_HLT_ASSERT(tmr->time.tree.parent == ERTS_HLT_PFIELD_NOT_IN_TABLE);
+ else {
+ ERTS_HLT_ASSERT(tmr->time.tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE);
+ ERTS_HLT_ASSERT(tmr->time.tree.parent & ERTS_HLT_PFLG_SAME_TIME);
+ }
+ }
+ else {
+ ErtsHLTimer *ttmr = time_rbt_lookup(hdbg->srv->time_tree, tmr->timeout);
+ ERTS_HLT_ASSERT(ttmr);
+ if (ttmr != tmr) {
+ ERTS_HLT_ASSERT(ttmr->time.tree.same_time);
+ ERTS_HLT_ASSERT(tmr == same_time_list_lookup(ttmr->time.tree.same_time, tmr));
+ }
+ }
+}
+
+static void
+hdbg_chk_srv(ErtsHLTimerService *srv)
+{
+ if (srv->time_tree) {
+ ErtsHdbgHLT hdbg;
+ hdbg.srv = srv;
+ hdbg.found_root = 0;
+ hdbg.rootpp = &srv->time_tree;
+ time_rbt_foreach(srv->time_tree, tt_hdbg_func, (void *) &hdbg);
+ ERTS_HLT_ASSERT(hdbg.found_root);
+ }
+#ifndef ERTS_MAGIC_REF_BIF_TIMERS
+ if (srv->btm_tree) {
+ ErtsHdbgHLT hdbg;
+ hdbg.srv = srv;
+ hdbg.found_root = 0;
+ hdbg.rootpp = &srv->btm_tree;
+ btm_rbt_foreach(srv->btm_tree, bt_hdbg_func, (void *) &hdbg);
+ ERTS_HLT_ASSERT(hdbg.found_root);
+ }
+#endif
+}
+
+#endif /* ERTS_HLT_HARD_DEBUG */
diff --git a/erts/emulator/beam/erl_hl_timer.h b/erts/emulator/beam/erl_hl_timer.h
new file mode 100644
index 0000000000..ff31f04cb9
--- /dev/null
+++ b/erts/emulator/beam/erl_hl_timer.h
@@ -0,0 +1,88 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2015-2017. 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_HL_TIMER_H__
+#define ERL_HL_TIMER_H__
+
+typedef struct ErtsBifTimer_ ErtsBifTimers;
+typedef struct ErtsHLTimerService_ ErtsHLTimerService;
+
+#include "sys.h"
+#include "erl_process.h"
+#define ERL_PORT_GET_PORT_TYPE_ONLY__
+#include "erl_port.h"
+#undef ERL_PORT_GET_PORT_TYPE_ONLY__
+#include "erl_message.h"
+#include "erl_alloc_types.h"
+
+#define ERTS_PTMR_NONE ((erts_aint_t) NULL)
+#define ERTS_PTMR_TIMEDOUT (ERTS_PTMR_NONE + ((erts_aint_t) 1))
+
+#define ERTS_PTMR_INIT(P) \
+ erts_smp_atomic_init_nob(&(P)->common.timer, ERTS_PTMR_NONE)
+#define ERTS_PTMR_IS_SET(P) \
+ (ERTS_PTMR_NONE != erts_smp_atomic_read_nob(&(P)->common.timer))
+#define ERTS_PTMR_IS_TIMED_OUT(P) \
+ (ERTS_PTMR_TIMEDOUT == erts_smp_atomic_read_nob(&(P)->common.timer))
+
+#define ERTS_PTMR_CLEAR(P) \
+ do { \
+ ASSERT(ERTS_PTMR_IS_TIMED_OUT((P))); \
+ erts_smp_atomic_set_nob(&(P)->common.timer, \
+ ERTS_PTMR_NONE); \
+ } while (0)
+
+size_t erts_timer_type_size(ErtsAlcType_t type);
+int erts_set_proc_timer_term(Process *, Eterm);
+void erts_set_proc_timer_uword(Process *, UWord);
+void erts_cancel_proc_timer(Process *);
+void erts_set_port_timer(Port *, Sint64);
+void erts_cancel_port_timer(Port *);
+Sint64 erts_read_port_timer(Port *);
+int erts_cancel_bif_timers(Process *, ErtsBifTimers **, void **);
+int erts_detach_accessor_bif_timers(Process *, ErtsBifTimers *, void **);
+ErtsHLTimerService *erts_create_timer_service(void);
+void erts_hl_timer_init(void);
+void erts_start_timer_callback(ErtsMonotonicTime,
+ void (*)(void *),
+ void *);
+#ifdef ERTS_SMP
+void
+erts_handle_canceled_timers(void *vesdp,
+ int *need_thr_progress,
+ ErtsThrPrgrVal *thr_prgr_p,
+ int *need_more_work);
+#endif
+
+Uint erts_bif_timer_memory_size(void);
+void erts_print_bif_timer_info(fmtfn_t to, void *to_arg);
+
+void erts_debug_bif_timer_foreach(void (*func)(Eterm,
+ Eterm,
+ ErlHeapFragment *,
+ void *),
+ void *arg);
+void
+erts_debug_callback_timer_foreach(void (*tclbk)(void *),
+ void (*func)(void *,
+ ErtsMonotonicTime,
+ void *),
+ void *arg);
+#endif /* ERL_HL_TIMER_H__ */
diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c
index d54658f1ea..5206d7564f 100644
--- a/erts/emulator/beam/erl_init.c
+++ b/erts/emulator/beam/erl_init.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1997-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1997-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -35,7 +36,7 @@
#include "dist.h"
#include "erl_mseg.h"
#include "erl_threads.h"
-#include "erl_bif_timer.h"
+#include "erl_hl_timer.h"
#include "erl_instrument.h"
#include "erl_printf_term.h"
#include "erl_misc_utils.h"
@@ -45,6 +46,9 @@
#include "erl_thr_queue.h"
#include "erl_async.h"
#include "erl_ptab.h"
+#include "erl_bif_unique.h"
+#define ERTS_WANT_TIMER_WHEEL_API
+#include "erl_time.h"
#ifdef HIPE
#include "hipe_mode_switch.h" /* for hipe_mode_switch_init() */
@@ -57,6 +61,10 @@
#define ERTS_DEFAULT_NO_ASYNC_THREADS 10
+#define ERTS_DEFAULT_SCHED_STACK_SIZE 128
+#define ERTS_DEFAULT_DCPU_SCHED_STACK_SIZE 40
+#define ERTS_DEFAULT_DIO_SCHED_STACK_SIZE 40
+
/*
* The variables below (prefixed with etp_) are for erts/etc/unix/etp-commands
* only. Do not remove even though they aren't used elsewhere in the emulator!
@@ -87,11 +95,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
@@ -112,11 +115,22 @@ const int etp_lock_check = 1;
#else
const int etp_lock_check = 0;
#endif
-#ifdef WORDS_BIGENDIAN
-const int etp_big_endian = 1;
+const int etp_endianness = ERTS_ENDIANNESS;
+const Eterm etp_ref_header = ERTS_REF_THING_HEADER;
+#ifdef ERTS_MAGIC_REF_THING_HEADER
+const Eterm etp_magic_ref_header = ERTS_MAGIC_REF_THING_HEADER;
+#else
+const Eterm etp_magic_ref_header = ERTS_REF_THING_HEADER;
+#endif
+const Eterm etp_the_non_value = THE_NON_VALUE;
+#ifdef ERTS_HOLE_MARKER
+const Eterm etp_hole_marker = ERTS_HOLE_MARKER;
#else
-const int etp_big_endian = 0;
+const Eterm etp_hole_marker = 0;
#endif
+
+static int modified_sched_thread_suggested_stack_size = 0;
+
/*
* Note about VxWorks: All variables must be initialized by executable code,
* not by an initializer. Otherwise a new instance of the emulator will
@@ -134,7 +148,11 @@ static void erl_init(int ncpu,
int legacy_proc_tab,
int port_tab_sz,
int port_tab_sz_ignore_files,
- int legacy_port_tab);
+ int legacy_port_tab,
+ int time_correction,
+ ErtsTimeWarpMode time_warp_mode,
+ int node_tab_delete_delay,
+ ErtsDbSpinCount db_spin_count);
static erts_atomic_t exiting;
@@ -147,7 +165,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;
@@ -159,11 +177,10 @@ int erts_use_sender_punish;
Uint display_items; /* no of items to display in traces etc */
int H_MIN_SIZE; /* The minimum heap grain */
int BIN_VH_MIN_SIZE; /* The minimum binary virtual*/
+int H_MAX_SIZE; /* The maximum heap size */
+int H_MAX_FLAGS; /* The maximum heap flags */
Uint32 erts_debug_flags; /* Debug flags. */
-#ifdef ERTS_OPCODE_COUNTER_SUPPORT
-int count_instructions;
-#endif
int erts_backtrace_depth; /* How many functions to show in a backtrace
* in error codes.
*/
@@ -188,12 +205,10 @@ static int no_dirty_io_schedulers;
Uint32 verbose; /* See erl_debug.h for information about verbose */
#endif
-int erts_disable_tolerant_timeofday; /* Time correction can be disabled it is
- * not and/or it is too slow.
- */
-
int erts_atom_table_size = ATOM_LIMIT; /* Maximum number of atoms */
+int erts_pd_initial_size = 8; /* must be power of 2 */
+
int erts_modified_timing_level;
int erts_no_crash_dump = 0; /* Use -d to suppress crash dump. */
@@ -206,15 +221,15 @@ int erts_no_line_info = 0; /* -L: Don't load line information */
ErtsModifiedTimings erts_modified_timings[] = {
/* 0 */ {make_small(0), CONTEXT_REDS, INPUT_REDUCTIONS},
- /* 1 */ {make_small(0), 2*CONTEXT_REDS, 2*INPUT_REDUCTIONS},
+ /* 1 */ {make_small(0), (3*CONTEXT_REDS)/4, 2*INPUT_REDUCTIONS},
/* 2 */ {make_small(0), CONTEXT_REDS/2, INPUT_REDUCTIONS/2},
- /* 3 */ {make_small(0), 3*CONTEXT_REDS, 3*INPUT_REDUCTIONS},
+ /* 3 */ {make_small(0), (7*CONTEXT_REDS)/8, 3*INPUT_REDUCTIONS},
/* 4 */ {make_small(0), CONTEXT_REDS/3, 3*INPUT_REDUCTIONS},
- /* 5 */ {make_small(0), 4*CONTEXT_REDS, INPUT_REDUCTIONS/2},
+ /* 5 */ {make_small(0), (10*CONTEXT_REDS)/11, INPUT_REDUCTIONS/2},
/* 6 */ {make_small(1), CONTEXT_REDS/4, 2*INPUT_REDUCTIONS},
- /* 7 */ {make_small(1), 5*CONTEXT_REDS, INPUT_REDUCTIONS/3},
+ /* 7 */ {make_small(1), (5*CONTEXT_REDS)/7, INPUT_REDUCTIONS/3},
/* 8 */ {make_small(10), CONTEXT_REDS/5, 3*INPUT_REDUCTIONS},
- /* 9 */ {make_small(10), 6*CONTEXT_REDS, INPUT_REDUCTIONS/4}
+ /* 9 */ {make_small(10), (6*CONTEXT_REDS)/7, INPUT_REDUCTIONS/4}
};
#define ERTS_MODIFIED_TIMING_LEVELS \
@@ -264,11 +279,24 @@ 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;
}
+static ERTS_INLINE void
+set_default_time_adj(int *time_correction_p, ErtsTimeWarpMode *time_warp_mode_p)
+{
+ *time_correction_p = 1;
+ *time_warp_mode_p = ERTS_NO_TIME_WARP_MODE;
+ if (!erts_check_time_adj_support(*time_correction_p,
+ *time_warp_mode_p)) {
+ *time_correction_p = 0;
+ ASSERT(erts_check_time_adj_support(*time_correction_p,
+ *time_warp_mode_p));
+ }
+}
+
/*
* Common error printout function, all error messages
* that don't go to the error logger go through here.
@@ -281,31 +309,21 @@ void erl_error(char *fmt, va_list args)
static int early_init(int *argc, char **argv);
-void
-erts_short_init(void)
-{
- int ncpu = early_init(NULL, NULL);
- erl_init(ncpu,
- ERTS_DEFAULT_MAX_PROCESSES,
- 0,
- ERTS_DEFAULT_MAX_PORTS,
- 0,
- 0);
- erts_initialized = 1;
-}
-
static void
erl_init(int ncpu,
int proc_tab_sz,
int legacy_proc_tab,
int port_tab_sz,
int port_tab_sz_ignore_files,
- int legacy_port_tab)
+ int legacy_port_tab,
+ int time_correction,
+ ErtsTimeWarpMode time_warp_mode,
+ int node_tab_delete_delay,
+ ErtsDbSpinCount db_spin_count)
{
- init_benchmarking();
-
+ erts_bif_unique_init();
erts_init_monitors();
- erts_init_time();
+ erts_init_time(time_correction, time_warp_mode);
erts_init_sys_common_misc();
erts_init_process(ncpu, proc_tab_sz, legacy_proc_tab);
erts_init_scheduling(no_schedulers,
@@ -316,6 +334,7 @@ erl_init(int ncpu,
no_dirty_io_schedulers
#endif
);
+ erts_late_init_time_sup();
erts_init_cpu_topology(); /* Must be after init_scheduling */
erts_init_gc(); /* Must be after init_scheduling */
erts_alloc_late_init();
@@ -324,7 +343,6 @@ erl_init(int ncpu,
BIN_VH_MIN_SIZE = erts_next_heap_size(BIN_VH_MIN_SIZE, 0);
erts_init_trace();
- erts_init_binary();
erts_init_bits();
erts_code_ix_init();
erts_init_fun_table();
@@ -337,10 +355,10 @@ erl_init(int ncpu,
erts_ddll_init();
init_emulator();
erts_ptab_init(); /* Must be after init_emulator() */
+ erts_init_binary(); /* Must be after init_emulator() */
erts_bp_init();
- init_db(); /* Must be after init_emulator */
- erts_bif_timer_init();
- erts_init_node_tables();
+ init_db(db_spin_count); /* Must be after init_emulator */
+ erts_init_node_tables(node_tab_delete_delay);
init_dist();
erl_drv_thr_init();
erts_init_async();
@@ -352,25 +370,30 @@ erl_init(int ncpu,
erts_init_bif_re();
erts_init_unicode(); /* after RE to get access to PCRE unicode */
erts_init_external();
+ erts_init_map();
+ erts_beam_bif_load_init();
erts_delay_trap = erts_export_put(am_erlang, am_delay_trap, 2);
erts_late_init_process();
#if HAVE_ERTS_MSEG
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 void
+static Eterm
erl_first_process_otp(char* modname, void* code, unsigned size, int argc, char** argv)
{
int i;
Eterm start_mod;
Eterm args;
+ Eterm res;
Eterm* hp;
Process parent;
ErlSpawnOpts so;
@@ -379,7 +402,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);
}
/*
@@ -400,12 +423,38 @@ erl_first_process_otp(char* modname, void* code, unsigned size, int argc, char**
hp += 2;
args = CONS(hp, env, args);
- so.flags = 0;
- (void) erl_create_process(&parent, start_mod, am_start, args, &so);
+ 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, int off_heap_msgq)
+{
+ 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;
+ if (off_heap_msgq)
+ so.flags |= SPO_OFF_HEAP_MSGQ;
+ 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)
{
@@ -475,12 +524,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++;
}
@@ -509,9 +558,9 @@ void erts_usage(void)
/* erts_fprintf(stderr, "-b func set the boot function (default boot)\n"); */
- erts_fprintf(stderr, "-c disable continuous date/time correction with\n");
- erts_fprintf(stderr, " respect to uptime\n");
-
+ erts_fprintf(stderr, "-c bool enable or disable time correction\n");
+ erts_fprintf(stderr, "-C mode set time warp mode; valid modes are:\n");
+ erts_fprintf(stderr, " no_time_warp|single_time_warp|multi_time_warp\n");
erts_fprintf(stderr, "-d don't write a crash dump for internally detected errors\n");
erts_fprintf(stderr, " (halt(String) will still produce a crash dump)\n");
erts_fprintf(stderr, "-fn[u|a|l] Control how filenames are interpreted\n");
@@ -519,6 +568,14 @@ void erts_usage(void)
H_DEFAULT_SIZE);
erts_fprintf(stderr, "-hmbs size set minimum binary virtual heap size in words (default %d)\n",
VH_DEFAULT_SIZE);
+ erts_fprintf(stderr, "-hmax size set maximum heap size in words (default %d)\n",
+ H_DEFAULT_MAX_SIZE);
+ erts_fprintf(stderr, "-hmaxk bool enable or disable kill at max heap size (default true)\n");
+ erts_fprintf(stderr, "-hmaxel bool enable or disable error_logger report at max heap size (default true)\n");
+ erts_fprintf(stderr, "-hpds size initial process dictionary size (default %d)\n",
+ erts_pd_initial_size);
+ erts_fprintf(stderr, "-hmqd val set default message queue data flag for processes,\n");
+ erts_fprintf(stderr, " valid values are: off_heap | on_heap\n");
/* erts_fprintf(stderr, "-i module set the boot module (default init)\n"); */
@@ -548,6 +605,8 @@ void erts_usage(void)
erts_fprintf(stderr, " see the erl(1) documentation for more info.\n");
erts_fprintf(stderr, "-sct cput set cpu topology,\n");
erts_fprintf(stderr, " see the erl(1) documentation for more info.\n");
+ erts_fprintf(stderr, "-secio bool enable/disable eager check I/O scheduling,\n");
+ erts_fprintf(stderr, " see the erl(1) documentation for more info.\n");
#if ERTS_HAVE_SCHED_UTIL_BALANCING_SUPPORT_OPT
erts_fprintf(stderr, "-sub bool enable/disable scheduler utilization balancing,\n");
#else
@@ -561,9 +620,22 @@ void erts_usage(void)
erts_fprintf(stderr, "-swt val set scheduler wakeup threshold, valid values are:\n");
erts_fprintf(stderr, " very_low|low|medium|high|very_high.\n");
erts_fprintf(stderr, "-sss size suggested stack size in kilo words for scheduler threads,\n");
- erts_fprintf(stderr, " valid range is [%d-%d]\n",
+ erts_fprintf(stderr, " valid range is [%d-%d] (default %d)\n",
+ ERTS_SCHED_THREAD_MIN_STACK_SIZE,
+ ERTS_SCHED_THREAD_MAX_STACK_SIZE,
+ ERTS_DEFAULT_SCHED_STACK_SIZE);
+#ifdef ERTS_DIRTY_SCHEDULERS
+ erts_fprintf(stderr, "-sssdcpu size suggested stack size in kilo words for dirty CPU scheduler\n");
+ erts_fprintf(stderr, " threads, valid range is [%d-%d] (default %d)\n",
ERTS_SCHED_THREAD_MIN_STACK_SIZE,
- ERTS_SCHED_THREAD_MAX_STACK_SIZE);
+ ERTS_SCHED_THREAD_MAX_STACK_SIZE,
+ ERTS_DEFAULT_DCPU_SCHED_STACK_SIZE);
+ erts_fprintf(stderr, "-sssdio size suggested stack size in kilo words for dirty IO scheduler\n");
+ erts_fprintf(stderr, " threads, valid range is [%d-%d] (default %d)\n",
+ ERTS_SCHED_THREAD_MIN_STACK_SIZE,
+ ERTS_SCHED_THREAD_MAX_STACK_SIZE,
+ ERTS_DEFAULT_DIO_SCHED_STACK_SIZE);
+#endif
erts_fprintf(stderr, "-spp Bool set port parallelism scheduling hint\n");
erts_fprintf(stderr, "-S n1:n2 set number of schedulers (n1), and number of\n");
erts_fprintf(stderr, " schedulers online (n2), maximum for both\n");
@@ -592,15 +664,22 @@ void erts_usage(void)
erts_fprintf(stderr, "-v turn on chatty mode (GCs will be reported etc)\n");
- erts_fprintf(stderr, "-W<i|w> set error logger warnings mapping,\n");
+ 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, "-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");
+ erts_fprintf(stderr, " valid values are infinity or intergers in the range [0-%d]\n",
+ ERTS_NODE_TAB_DELAY_GC_MAX);
+#if 0
+ erts_fprintf(stderr, "-zebwt val set ets busy wait threshold, valid values are:\n");
+ erts_fprintf(stderr, " none|very_short|short|medium|long|very_long|extremely_long\n");
+#endif
erts_fprintf(stderr, "\n");
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
@@ -675,17 +754,24 @@ 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;
erts_printf_eterm_func = erts_printf_term;
- erts_disable_tolerant_timeofday = 0;
display_items = 200;
erts_backtrace_depth = DEFAULT_BACKTRACE_SIZE;
erts_async_max_threads = ERTS_DEFAULT_NO_ASYNC_THREADS;
erts_async_thread_suggested_stack_size = ERTS_ASYNC_THREAD_MIN_STACK_SIZE;
H_MIN_SIZE = H_DEFAULT_SIZE;
BIN_VH_MIN_SIZE = VH_DEFAULT_SIZE;
+ H_MAX_SIZE = H_DEFAULT_MAX_SIZE;
+ H_MAX_FLAGS = MAX_HEAP_SIZE_KILL|MAX_HEAP_SIZE_LOG;
+
+ erts_term_init();
erts_initialized = 0;
@@ -715,9 +801,6 @@ early_init(int *argc, char **argv) /*
erts_thr_progress_pre_init();
#endif
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_init();
-#endif
#ifdef ERTS_SMP
erts_smp_atomic32_init_nob(&erts_writing_erl_crash_dump, 0L);
erts_tsd_key_create(&erts_is_crash_dumping_key,"erts_is_crash_dumping_key");
@@ -729,9 +812,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
@@ -1050,8 +1130,12 @@ early_init(int *argc, char **argv) /*
}
if (dirty_cpu_scheds > schdlrs)
dirty_cpu_scheds = schdlrs;
+ if (dirty_cpu_scheds < 1)
+ dirty_cpu_scheds = 1;
if (dirty_cpu_scheds_online > schdlrs_onln)
dirty_cpu_scheds_online = schdlrs_onln;
+ if (dirty_cpu_scheds_online < 1)
+ dirty_cpu_scheds_online = 1;
#endif
}
@@ -1064,6 +1148,8 @@ early_init(int *argc, char **argv) /*
no_schedulers_online = schdlrs_onln;
erts_no_schedulers = (Uint) no_schedulers;
+#else
+ erts_no_schedulers = 1;
#endif
#ifdef ERTS_DIRTY_SCHEDULERS
erts_no_dirty_cpu_schedulers = no_dirty_cpu_schedulers = dirty_cpu_scheds;
@@ -1125,6 +1211,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();
@@ -1151,24 +1238,38 @@ early_init(int *argc, char **argv) /*
}
#ifndef ERTS_SMP
+
+void *erts_scheduler_stack_limit;
+
+
static void set_main_stack_size(void)
{
- if (erts_sched_thread_suggested_stack_size > 0) {
+ char c;
+ UWord stacksize;
# if HAVE_DECL_GETRLIMIT && HAVE_DECL_SETRLIMIT && HAVE_DECL_RLIMIT_STACK
- struct rlimit rl;
- int bytes = erts_sched_thread_suggested_stack_size * sizeof(Uint) * 1024;
- if (getrlimit(RLIMIT_STACK, &rl) != 0 ||
- (rl.rlim_cur = bytes, setrlimit(RLIMIT_STACK, &rl) != 0)) {
- erts_fprintf(stderr, "failed to set stack size for scheduler "
- "thread to %d bytes\n", bytes);
- erts_usage();
- }
+ struct rlimit rl;
+ int bytes;
+ stacksize = erts_sched_thread_suggested_stack_size * sizeof(Uint) * 1024;
+ /* Add some extra pages... neede by some systems... */
+ bytes = (int) stacksize + 3*erts_sys_get_page_size();
+ if (getrlimit(RLIMIT_STACK, &rl) != 0 ||
+ (rl.rlim_cur = bytes, setrlimit(RLIMIT_STACK, &rl) != 0)) {
+ erts_fprintf(stderr, "failed to set stack size for scheduler "
+ "thread to %d bytes\n", bytes);
+ erts_usage();
+ }
# else
+ if (modified_sched_thread_suggested_stack_size) {
erts_fprintf(stderr, "no OS support for dynamic stack size limit\n");
- erts_usage();
-# endif
+ erts_usage();
}
+ /* Be conservative and hope it is not more than 64 kWords... */
+ stacksize = 64*1024*sizeof(void *);
+# endif
+
+ erts_scheduler_stack_limit = erts_calc_stacklimit(&c, stacksize);
}
+
#endif
void
@@ -1185,7 +1286,14 @@ erl_start(int argc, char **argv)
int port_tab_sz_ignore_files = 0;
int legacy_proc_tab = 0;
int legacy_port_tab = 0;
+ int time_correction;
+ 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);
envbufsz = sizeof(envbuf);
if (erts_sys_getenv_raw(ERL_MAX_ETS_TABLES_ENV, envbuf, &envbufsz) == 0)
@@ -1206,18 +1314,21 @@ erl_start(int argc, char **argv)
port_tab_sz_ignore_files = 1;
}
-#if (defined(__APPLE__) && defined(__MACH__)) || defined(__DARWIN__)
/*
- * The default stack size on MacOS X is too small for pcre.
+ * A default stack size suitable for pcre which might use quite
+ * a lot of stack.
*/
- erts_sched_thread_suggested_stack_size = 256;
+ erts_sched_thread_suggested_stack_size = ERTS_DEFAULT_SCHED_STACK_SIZE;
+#ifdef ERTS_DIRTY_SCHEDULERS
+ erts_dcpu_sched_thread_suggested_stack_size = ERTS_DEFAULT_DCPU_SCHED_STACK_SIZE;
+ erts_dio_sched_thread_suggested_stack_size = ERTS_DEFAULT_DIO_SCHED_STACK_SIZE;
#endif
#ifdef DEBUG
verbose = DEBUG_DEFAULT;
#endif
- erts_error_logger_warnings = am_error;
+ erts_error_logger_warnings = am_warning;
while (i < argc) {
if (argv[i][0] != '-') {
@@ -1352,6 +1463,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);
}
}
@@ -1364,6 +1476,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");
@@ -1392,7 +1505,7 @@ erl_start(int argc, char **argv)
}
erts_fprintf(stderr, "(" EMULATOR ") emulator version "
ERLANG_VERSION "\n");
- erl_exit(0, "");
+ erts_exit(0, "");
}
break;
@@ -1404,8 +1517,13 @@ erl_start(int argc, char **argv)
char *sub_param = argv[i]+2;
/* set default heap size
*
- * h|ms - min_heap_size
- * h|mbs - min_bin_vheap_size
+ * h|ms - min_heap_size
+ * h|mbs - min_bin_vheap_size
+ * h|pds - erts_pd_initial_size
+ * h|mqd - message_queue_data
+ * h|max - max_heap_size
+ * h|maxk - max_heap_kill
+ * h|maxel - max_heap_error_logger
*
*/
if (has_prefix("mbs", sub_param)) {
@@ -1423,6 +1541,64 @@ erl_start(int argc, char **argv)
erts_usage();
}
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_set_initial_size(atoi(arg))) {
+ erts_fprintf(stderr, "bad initial process dictionary size %s\n", arg);
+ erts_usage();
+ }
+ VERBOSE(DEBUG_SYSTEM, ("using initial process dictionary size %d\n",
+ erts_pd_initial_size));
+ } else if (has_prefix("mqd", sub_param)) {
+ arg = get_arg(sub_param+3, argv[i+1], &i);
+ 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 if (has_prefix("maxk", sub_param)) {
+ arg = get_arg(sub_param+4, argv[i+1], &i);
+ if (strcmp(arg,"true") == 0) {
+ H_MAX_FLAGS |= MAX_HEAP_SIZE_KILL;
+ } else if (strcmp(arg,"false") == 0) {
+ H_MAX_FLAGS &= ~MAX_HEAP_SIZE_KILL;
+ } else {
+ erts_fprintf(stderr, "bad max heap kill %s\n", arg);
+ erts_usage();
+ }
+ VERBOSE(DEBUG_SYSTEM, ("using max heap kill %d\n", H_MAX_FLAGS));
+ } else if (has_prefix("maxel", sub_param)) {
+ arg = get_arg(sub_param+5, argv[i+1], &i);
+ if (strcmp(arg,"true") == 0) {
+ H_MAX_FLAGS |= MAX_HEAP_SIZE_LOG;
+ } else if (strcmp(arg,"false") == 0) {
+ H_MAX_FLAGS &= ~MAX_HEAP_SIZE_LOG;
+ } else {
+ erts_fprintf(stderr, "bad max heap error logger %s\n", arg);
+ erts_usage();
+ }
+ VERBOSE(DEBUG_SYSTEM, ("using max heap log %d\n", H_MAX_FLAGS));
+ } else if (has_prefix("max", sub_param)) {
+ arg = get_arg(sub_param+3, argv[i+1], &i);
+ if ((H_MAX_SIZE = atoi(arg)) < 0) {
+ erts_fprintf(stderr, "bad max heap size %s\n", arg);
+ erts_usage();
+ }
+ if (H_MAX_SIZE < H_MIN_SIZE && H_MAX_SIZE) {
+ erts_fprintf(stderr, "max heap size (%s) is not allowed to be "
+ "smaller than min heap size (%d)\n",
+ arg, H_MIN_SIZE);
+ erts_usage();
+ }
+ VERBOSE(DEBUG_SYSTEM, ("using max heap size %d\n", H_MAX_SIZE));
} else {
/* backward compatibility */
arg = get_arg(argv[i]+2, argv[i+1], &i);
@@ -1674,6 +1850,22 @@ erl_start(int argc, char **argv)
erts_usage();
}
}
+ else if (has_prefix("ecio", sub_param)) {
+ arg = get_arg(sub_param+4, argv[i+1], &i);
+#ifndef __OSE__
+ if (sys_strcmp("true", arg) == 0)
+ erts_eager_check_io = 1;
+ else
+#endif
+ if (sys_strcmp("false", arg) == 0)
+ erts_eager_check_io = 0;
+ else {
+ erts_fprintf(stderr,
+ "bad schedule eager check I/O value '%s'\n",
+ arg);
+ erts_usage();
+ }
+ }
else if (has_prefix("pp", sub_param)) {
arg = get_arg(sub_param+2, argv[i+1], &i);
if (sys_strcmp(arg, "true") == 0)
@@ -1749,10 +1941,47 @@ erl_start(int argc, char **argv)
VERBOSE(DEBUG_SYSTEM,
("scheduler wakeup threshold: %s\n", arg));
}
+#ifdef ERTS_DIRTY_SCHEDULERS
+ else if (has_prefix("ssdcpu", sub_param)) {
+ /* suggested stack size (Kilo Words) for dirty CPU scheduler threads */
+ arg = get_arg(sub_param+6, argv[i+1], &i);
+ erts_dcpu_sched_thread_suggested_stack_size = atoi(arg);
+
+ if ((erts_dcpu_sched_thread_suggested_stack_size
+ < ERTS_SCHED_THREAD_MIN_STACK_SIZE)
+ || (erts_dcpu_sched_thread_suggested_stack_size >
+ ERTS_SCHED_THREAD_MAX_STACK_SIZE)) {
+ erts_fprintf(stderr, "bad stack size for dirty CPU scheduler threads %s\n",
+ arg);
+ erts_usage();
+ }
+ VERBOSE(DEBUG_SYSTEM,
+ ("suggested dirty CPU scheduler thread stack size %d kilo words\n",
+ erts_dcpu_sched_thread_suggested_stack_size));
+ }
+ else if (has_prefix("ssdio", sub_param)) {
+ /* suggested stack size (Kilo Words) for dirty IO scheduler threads */
+ arg = get_arg(sub_param+5, argv[i+1], &i);
+ erts_dio_sched_thread_suggested_stack_size = atoi(arg);
+
+ if ((erts_dio_sched_thread_suggested_stack_size
+ < ERTS_SCHED_THREAD_MIN_STACK_SIZE)
+ || (erts_dio_sched_thread_suggested_stack_size >
+ ERTS_SCHED_THREAD_MAX_STACK_SIZE)) {
+ erts_fprintf(stderr, "bad stack size for dirty IO scheduler threads %s\n",
+ arg);
+ erts_usage();
+ }
+ VERBOSE(DEBUG_SYSTEM,
+ ("suggested dirty IO scheduler thread stack size %d kilo words\n",
+ erts_dio_sched_thread_suggested_stack_size));
+ }
+#endif
else if (has_prefix("ss", sub_param)) {
/* suggested stack size (Kilo Words) for scheduler threads */
arg = get_arg(sub_param+2, argv[i+1], &i);
erts_sched_thread_suggested_stack_size = atoi(arg);
+ modified_sched_thread_suggested_stack_size = 1;
if ((erts_sched_thread_suggested_stack_size
< ERTS_SCHED_THREAD_MIN_STACK_SIZE)
@@ -1878,15 +2107,51 @@ erl_start(int argc, char **argv)
}
break;
}
+ case 'C':
+ arg = get_arg(argv[i]+2, argv[i+1], &i);
+ if (sys_strcmp(arg, "no_time_warp") == 0)
+ time_warp_mode = ERTS_NO_TIME_WARP_MODE;
+ else if (sys_strcmp(arg, "single_time_warp") == 0)
+ time_warp_mode = ERTS_SINGLE_TIME_WARP_MODE;
+ else if (sys_strcmp(arg, "multi_time_warp") == 0)
+ time_warp_mode = ERTS_MULTI_TIME_WARP_MODE;
+ else {
+ erts_fprintf(stderr,
+ "Invalid time warp mode: %s\n", arg);
+ erts_usage();
+ }
+ break;
case 'c':
- if (argv[i][2] == 0) { /* -c: documented option */
- erts_disable_tolerant_timeofday = 1;
+ if (sys_strcmp(argv[i]+2, "false") == 0)
+ goto time_correction_false;
+ else if (sys_strcmp(argv[i]+2, "true") == 0)
+ goto time_correction_true;
+ else if (argv[i][2] == '\0') {
+ if (i + 1 >= argc)
+ goto time_correction_false;
+ else {
+ if (sys_strcmp(argv[i+1], "false") == 0) {
+ (void) get_arg(argv[i]+2, argv[i+1], &i);
+ goto time_correction_false;
+ }
+ else if (sys_strcmp(argv[i+1], "true") == 0) {
+ (void) get_arg(argv[i]+2, argv[i+1], &i);
+ time_correction_true:
+ time_correction = 1;
+ break;
+ }
+ else {
+ time_correction_false:
+ time_correction = 0;
+ break;
+ }
+ }
}
-#ifdef ERTS_OPCODE_COUNTER_SUPPORT
- else if (argv[i][2] == 'i') { /* -ci: undcoumented option*/
- count_instructions = 1;
+ else {
+ arg = get_arg(argv[i]+2, argv[i+1], &i);
+ erts_fprintf(stderr, "Invalid time correnction value: %s\n", arg);
+ erts_usage();
}
-#endif
break;
case 'W':
arg = get_arg(argv[i]+2, argv[i+1], &i);
@@ -1894,11 +2159,12 @@ erl_start(int argc, char **argv)
case 'i':
erts_error_logger_warnings = am_info;
break;
+ case 'e':
+ erts_error_logger_warnings = am_error;
+ break;
case 'w':
erts_error_logger_warnings = am_warning;
break;
- case 'e': /* The default */
- erts_error_logger_warnings = am_error;
default:
erts_fprintf(stderr, "unrecognized warning_map option %s\n", arg);
erts_usage();
@@ -1907,9 +2173,9 @@ erl_start(int argc, char **argv)
case 'z': {
char *sub_param = argv[i]+2;
- int new_limit;
if (has_prefix("dbbl", sub_param)) {
+ int new_limit;
arg = get_arg(sub_param+4, argv[i+1], &i);
new_limit = atoi(arg);
if (new_limit < 1 || INT_MAX/1024 < new_limit) {
@@ -1918,7 +2184,48 @@ erl_start(int argc, char **argv)
} else {
erts_dist_buf_busy_limit = new_limit*1024;
}
- } else {
+ }
+ else if (has_prefix("dntgc", sub_param)) {
+ long secs;
+
+ arg = get_arg(sub_param+5, argv[i+1], &i);
+ if (sys_strcmp(arg, "infinity") == 0)
+ secs = ERTS_NODE_TAB_DELAY_GC_INFINITY;
+ else {
+ char *endptr;
+ errno = 0;
+ secs = strtol(arg, &endptr, 10);
+ if (errno != 0 || *arg == '\0' || *endptr != '\0'
+ || secs < 0 || ERTS_NODE_TAB_DELAY_GC_MAX < secs) {
+ erts_fprintf(stderr, "Invalid delayed node table gc: %s\n", arg);
+ erts_usage();
+ }
+ }
+ node_tab_delete_delay = (int) secs;
+ }
+ else if (has_prefix("ebwt", sub_param)) {
+ arg = get_arg(sub_param+4, argv[i+1], &i);
+ if (sys_strcmp(arg, "none") == 0)
+ db_spin_count = ERTS_DB_SPNCNT_NONE;
+ else if (sys_strcmp(arg, "very_short") == 0)
+ db_spin_count = ERTS_DB_SPNCNT_VERY_LOW;
+ else if (sys_strcmp(arg, "short") == 0)
+ db_spin_count = ERTS_DB_SPNCNT_LOW;
+ else if (sys_strcmp(arg, "medium") == 0)
+ db_spin_count = ERTS_DB_SPNCNT_NORMAL;
+ else if (sys_strcmp(arg, "long") == 0)
+ db_spin_count = ERTS_DB_SPNCNT_HIGH;
+ else if (sys_strcmp(arg, "very_long") == 0)
+ db_spin_count = ERTS_DB_SPNCNT_VERY_HIGH;
+ else if (sys_strcmp(arg, "extremely_long") == 0)
+ db_spin_count = ERTS_DB_SPNCNT_EXTREMELY_HIGH;
+ else {
+ erts_fprintf(stderr,
+ "Invalid ets busy wait threshold: %s\n", arg);
+ erts_usage();
+ }
+ }
+ else {
erts_fprintf(stderr, "bad -z option %s\n", argv[i]);
erts_usage();
}
@@ -1932,6 +2239,30 @@ erl_start(int argc, char **argv)
i++;
}
+ if (!erts_check_time_adj_support(time_correction, time_warp_mode)) {
+ char *time_correction_str = time_correction ? "Enabled" : "Disabled";
+ char *time_warp_str = "undefined";
+ switch (time_warp_mode) {
+ case ERTS_NO_TIME_WARP_MODE:
+ time_warp_str = "no";
+ break;
+ case ERTS_SINGLE_TIME_WARP_MODE:
+ time_warp_str = "single";
+ break;
+ case ERTS_MULTI_TIME_WARP_MODE:
+ time_warp_str = "multi";
+ break;
+ default:
+ time_warp_str = "undefined";
+ break;
+ }
+ erts_fprintf(stderr, "%s time correction with %s time warp mode "
+ "is not supported on this platform\n",
+ time_correction_str,
+ time_warp_str);
+ erts_usage();
+ }
+
/* Output format on windows for sprintf defaults to three exponents.
* We use two-exponent to mimic normal sprintf behaviour.
*/
@@ -1960,12 +2291,25 @@ erl_start(int argc, char **argv)
boot_argc = argc - i; /* Number of arguments to init */
boot_argv = &argv[i];
+ if (erts_sched_thread_suggested_stack_size < ERTS_SCHED_THREAD_MIN_STACK_SIZE)
+ erts_sched_thread_suggested_stack_size = ERTS_SCHED_THREAD_MIN_STACK_SIZE;
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (erts_dcpu_sched_thread_suggested_stack_size < ERTS_SCHED_THREAD_MIN_STACK_SIZE)
+ erts_dcpu_sched_thread_suggested_stack_size = ERTS_SCHED_THREAD_MIN_STACK_SIZE;
+ if (erts_dio_sched_thread_suggested_stack_size < ERTS_SCHED_THREAD_MIN_STACK_SIZE)
+ erts_dio_sched_thread_suggested_stack_size = ERTS_SCHED_THREAD_MIN_STACK_SIZE;
+#endif
+
erl_init(ncpu,
proc_tab_sz,
legacy_proc_tab,
port_tab_sz,
port_tab_sz_ignore_files,
- legacy_port_tab);
+ legacy_port_tab,
+ time_correction,
+ time_warp_mode,
+ node_tab_delete_delay,
+ db_spin_count);
load_preloaded();
erts_end_staging_code_ix();
@@ -1973,21 +2317,73 @@ erl_start(int argc, char **argv)
erts_initialized = 1;
- 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);
+
+ {
+ /*
+ * The erts_code_purger and the erts_literal_area_collector
+ * system processes are *always* alive. If they terminate
+ * they bring the whole VM down.
+ */
+ Eterm pid;
+
+ pid = erl_system_process_otp(otp_ring0_pid, "erts_code_purger", !0);
+ erts_code_purger
+ = (Process *) erts_ptab_pix2intptr_ddrb(&erts_proc,
+ internal_pid_index(pid));
+ ASSERT(erts_code_purger && erts_code_purger->common.id == pid);
+ erts_proc_inc_refc(erts_code_purger);
+
+ pid = erl_system_process_otp(otp_ring0_pid, "erts_literal_area_collector", !0);
+ erts_literal_area_collector
+ = (Process *) erts_ptab_pix2intptr_ddrb(&erts_proc,
+ internal_pid_index(pid));
+ ASSERT(erts_literal_area_collector
+ && erts_literal_area_collector->common.id == pid);
+ erts_proc_inc_refc(erts_literal_area_collector);
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+ pid = erl_system_process_otp(otp_ring0_pid, "erts_dirty_process_code_checker", !0);
+ erts_dirty_process_code_checker
+ = (Process *) erts_ptab_pix2intptr_ddrb(&erts_proc,
+ internal_pid_index(pid));
+ ASSERT(erts_dirty_process_code_checker
+ && erts_dirty_process_code_checker->common.id == pid);
+ erts_proc_inc_refc(erts_dirty_process_code_checker);
+#endif
+
+ }
#ifdef ERTS_SMP
erts_start_schedulers();
- /* Let system specific code decide what to do with the main thread... */
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ erts_lcnt_post_startup();
+#endif
+
+ /* Let system specific code decide what to do with the main thread... */
erts_sys_main_thread(); /* May or may not return! */
#else
- erts_thr_set_main_status(1, 1);
+ {
+ 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
- erts_get_scheduler_data()->aux_work_data.async_ready.queue
- = erts_get_async_ready_queue(1);
+ esdp->aux_work_data.async_ready.queue
+ = erts_get_async_ready_queue(1);
#endif
- set_main_stack_size();
- process_main();
+ set_main_stack_size();
+ erts_sched_init_time_sup(esdp);
+ erts_ets_sched_spec_data_init(esdp);
+ erts_aux_work_timeout_late_init(esdp);
+
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ erts_lcnt_post_startup();
+#endif
+
+ process_main(esdp->x_reg_array, esdp->f_reg_array);
+ }
#endif
}
@@ -2044,7 +2440,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;
@@ -2058,57 +2454,63 @@ system_cleanup(int flush_async)
erts_exit_flush_async();
}
+static int erts_exit_code;
+
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 (erts_mtrace_enabled)
+ erts_mtrace_exit((Uint32) n);
- an = abs(n);
+ if (fmt != NULL && *fmt != '\0')
+ erl_error(fmt, args2); /* Print error message. */
- if (erts_mtrace_enabled)
- erts_mtrace_exit((Uint32) an);
+ erts_exit_code = n;
- /* Produce an Erlang core dump if error */
- if (((n > 0 && erts_no_crash_dump == 0) || n == ERTS_DUMP_EXIT)
+ /* Produce an Erlang crash dump if error */
+ 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);
}
- if (fmt != NULL && *fmt != '\0')
- erl_error(fmt, args2); /* Print error message. */
+ erts_exit_epilogue();
+}
+
+__decl_noreturn void __noreturn erts_exit_epilogue(void)
+{
+ int n = erts_exit_code;
+
sys_tty_reset(n);
if (n == ERTS_INTR_EXIT)
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_instrument.c b/erts/emulator/beam/erl_instrument.c
index df7c443387..634509f880 100644
--- a/erts/emulator/beam/erl_instrument.c
+++ b/erts/emulator/beam/erl_instrument.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2003-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2003-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -538,7 +539,7 @@ map_stat_free(ErtsAlcType_t n, void *extra, void *ptr)
}
-static void dump_memory_map_to_stream(FILE *fp)
+static void dump_memory_map_to_stream(fmtfn_t to, void* to_arg)
{
ErtsAlcType_t n;
MapStatBlock_t *bp;
@@ -550,7 +551,7 @@ static void dump_memory_map_to_stream(FILE *fp)
/* Write header */
- fprintf(fp,
+ erts_cbprintf(to, to_arg,
"{instr_hdr,\n"
" %lu,\n"
" %lu,\n"
@@ -573,7 +574,7 @@ static void dump_memory_map_to_stream(FILE *fp)
else
astr = ERTS_ALC_A2AD(ERTS_ALC_A_SYSTEM);
- fprintf(fp,
+ erts_cbprintf(to, to_arg,
"%s{%s,%s,%s}%s",
(n == ERTS_ALC_N_MIN) ? "" : " ",
ERTS_ALC_N2TD(n),
@@ -582,12 +583,12 @@ static void dump_memory_map_to_stream(FILE *fp)
(n == ERTS_ALC_N_MAX) ? "" : ",\n");
}
- fprintf(fp, "}}.\n");
+ erts_cbprintf(to, to_arg, "}}.\n");
/* Write memory data */
for (bp = mem_anchor; bp; bp = bp->next) {
if (is_internal_pid(bp->pid))
- fprintf(fp,
+ erts_cbprintf(to, to_arg,
"{%lu, %lu, %lu, {%lu,%lu,%lu}}.\n",
(UWord) bp->type_no,
(UWord) bp->mem,
@@ -596,7 +597,7 @@ static void dump_memory_map_to_stream(FILE *fp)
(UWord) pid_number(bp->pid),
(UWord) pid_serial(bp->pid));
else
- fprintf(fp,
+ erts_cbprintf(to, to_arg,
"{%lu, %lu, %lu, undefined}.\n",
(UWord) bp->type_no,
(UWord) bp->mem,
@@ -607,40 +608,29 @@ static void dump_memory_map_to_stream(FILE *fp)
erts_mtx_unlock(&instr_mutex);
}
-int erts_instr_dump_memory_map_to_fd(int fd)
+int erts_instr_dump_memory_map_to(fmtfn_t to, void* to_arg)
{
- char buf[BUFSIZ];
- FILE *f;
-
if (!erts_instr_memory_map)
return 0;
- f = fdopen(fd, "w");
- if (f == NULL)
- return 0;
-
- /* Avoid allocating memory; we may have run out of it at this point. */
- setbuf(f, buf);
-
- dump_memory_map_to_stream(f);
- fflush(f);
+ dump_memory_map_to_stream(to, to_arg);
return 1;
}
int erts_instr_dump_memory_map(const char *name)
{
- FILE *f;
+ int fd;
if (!erts_instr_memory_map)
return 0;
- f = fopen(name, "w");
- if (f == NULL)
+ fd = open(name, O_WRONLY | O_CREAT | O_TRUNC, 0640);
+ if (fd < 0)
return 0;
- dump_memory_map_to_stream(f);
+ dump_memory_map_to_stream(erts_write_fd, (void*)&fd);
- fclose(f);
+ close(fd);
return 1;
}
@@ -997,19 +987,19 @@ erts_instr_get_stat(Process *proc, Eterm what, int begin_max_period)
}
static void
-dump_stat_to_stream(FILE *fp, int begin_max_period)
+dump_stat_to_stream(fmtfn_t to, void* to_arg, int begin_max_period)
{
ErtsAlcType_t i, a_max, a_min;
erts_mtx_lock(&instr_mutex);
- fprintf(fp,
+ erts_cbprintf(to, to_arg,
"{instr_vsn,%lu}.\n",
(unsigned long) ERTS_INSTR_VSN);
update_max_ever_values(&stats->tot, 0, 0);
- fprintf(fp,
+ erts_cbprintf(to, to_arg,
"{total,[{total,[{sizes,%lu,%lu,%lu},{blocks,%lu,%lu,%lu}]}]}.\n",
(UWord) stats->tot.size,
(UWord) stats->tot.max_size,
@@ -1037,7 +1027,7 @@ dump_stat_to_stream(FILE *fp, int begin_max_period)
for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) {
if (erts_allctrs_info[i].enabled) {
- fprintf(fp,
+ erts_cbprintf(to, to_arg,
"%s{%s,[{sizes,%lu,%lu,%lu},{blocks,%lu,%lu,%lu}]}%s",
i == a_min ? "{allocators,\n [" : " ",
ERTS_ALC_A2AD(i),
@@ -1054,7 +1044,7 @@ dump_stat_to_stream(FILE *fp, int begin_max_period)
update_max_ever_values(stats->c, ERTS_ALC_C_MIN, ERTS_ALC_C_MAX);
for (i = ERTS_ALC_C_MIN; i <= ERTS_ALC_C_MAX; i++) {
- fprintf(fp,
+ erts_cbprintf(to, to_arg,
"%s{%s,[{sizes,%lu,%lu,%lu},{blocks,%lu,%lu,%lu}]}%s",
i == ERTS_ALC_C_MIN ? "{classes,\n [" : " ",
ERTS_ALC_C2CD(i),
@@ -1070,7 +1060,7 @@ dump_stat_to_stream(FILE *fp, int begin_max_period)
update_max_ever_values(stats->n, ERTS_ALC_N_MIN, ERTS_ALC_N_MAX);
for (i = ERTS_ALC_N_MIN; i <= ERTS_ALC_N_MAX; i++) {
- fprintf(fp,
+ erts_cbprintf(to, to_arg,
"%s{%s,[{sizes,%lu,%lu,%lu},{blocks,%lu,%lu,%lu}]}%s",
i == ERTS_ALC_N_MIN ? "{types,\n [" : " ",
ERTS_ALC_N2TD(i),
@@ -1094,40 +1084,29 @@ dump_stat_to_stream(FILE *fp, int begin_max_period)
}
-int erts_instr_dump_stat_to_fd(int fd, int begin_max_period)
+int erts_instr_dump_stat_to(fmtfn_t to, void* to_arg, int begin_max_period)
{
- char buf[BUFSIZ];
- FILE *fp;
-
if (!erts_instr_stat)
return 0;
- fp = fdopen(fd, "w");
- if (fp == NULL)
- return 0;
-
- /* Avoid allocating memory; we may have run out of it at this point. */
- setbuf(fp, buf);
-
- dump_stat_to_stream(fp, begin_max_period);
- fflush(fp);
+ dump_stat_to_stream(to, to_arg, begin_max_period);
return 1;
}
int erts_instr_dump_stat(const char *name, int begin_max_period)
{
- FILE *file;
+ int fd;
if (!erts_instr_stat)
return 0;
- file = fopen(name, "w");
- if (file == NULL)
+ fd = open(name, O_WRONLY | O_CREAT | O_TRUNC,0640);
+ if (fd < 0)
return 0;
- dump_stat_to_stream(file, begin_max_period);
+ dump_stat_to_stream(erts_write_fd, (void*)&fd, begin_max_period);
- fclose(file);
+ close(fd);
return 1;
}
@@ -1221,12 +1200,13 @@ erts_instr_init(int stat, int map_stat)
stats = erts_alloc(ERTS_ALC_T_INSTR_INFO, sizeof(struct stats_));
- erts_mtx_init(&instr_mutex, "instr");
+ erts_mtx_init(&instr_mutex, "instr", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
mem_anchor = NULL;
/* Install instrumentation functions */
- ASSERT(sizeof(erts_allctrs) == sizeof(real_allctrs));
+ ERTS_CT_ASSERT(sizeof(erts_allctrs) == sizeof(real_allctrs));
sys_memcpy((void *)real_allctrs,(void *)erts_allctrs,sizeof(erts_allctrs));
@@ -1244,7 +1224,8 @@ erts_instr_init(int stat, int map_stat)
if (map_stat) {
- erts_mtx_init(&instr_x_mutex, "instr_x");
+ erts_mtx_init(&instr_x_mutex, "instr_x", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
erts_instr_memory_map = 1;
erts_instr_stat = 1;
diff --git a/erts/emulator/beam/erl_instrument.h b/erts/emulator/beam/erl_instrument.h
index 37b9b67139..351172b2fa 100644
--- a/erts/emulator/beam/erl_instrument.h
+++ b/erts/emulator/beam/erl_instrument.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2003-2009. All Rights Reserved.
+ * Copyright Ericsson AB 2003-2016. 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.
+ * 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%
*/
@@ -28,10 +29,10 @@ extern int erts_instr_memory_map;
extern int erts_instr_stat;
Uint erts_instr_init(int stat, int map_stat);
-int erts_instr_dump_memory_map_to_fd(int fd);
+int erts_instr_dump_memory_map_to(fmtfn_t to, void* to_arg);
int erts_instr_dump_memory_map(const char *name);
Eterm erts_instr_get_memory_map(Process *process);
-int erts_instr_dump_stat_to_fd(int fd, int begin_max_period);
+int erts_instr_dump_stat_to(fmtfn_t to, void* to_arg, int begin_max_period);
int erts_instr_dump_stat(const char *name, int begin_max_period);
Eterm erts_instr_get_stat(Process *proc, Eterm what, int begin_max_period);
Eterm erts_instr_get_type_info(Process *proc);
diff --git a/erts/emulator/beam/erl_io_queue.c b/erts/emulator/beam/erl_io_queue.c
new file mode 100644
index 0000000000..190ba6bbb9
--- /dev/null
+++ b/erts/emulator/beam/erl_io_queue.c
@@ -0,0 +1,1231 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2017. 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"
+
+#define ERL_WANT_HIPE_BIF_WRAPPER__
+#include "bif.h"
+#undef ERL_WANT_HIPE_BIF_WRAPPER__
+
+#include "erl_bits.h"
+#include "erl_io_queue.h"
+
+#define IOL2V_SMALL_BIN_LIMIT (ERL_ONHEAP_BIN_LIMIT * 4)
+
+static void free_binary(ErtsIOQBinary *b, int driver);
+static ErtsIOQBinary *alloc_binary(Uint size, char *source, void **iov_base, int driver);
+
+void erts_ioq_init(ErtsIOQueue *q, ErtsAlcType_t alct, int driver)
+{
+
+ ERTS_CT_ASSERT(offsetof(ErlNifIOVec,flags) == sizeof(ErtsIOVecCommon));
+ ERTS_CT_ASSERT(sizeof(ErlIOVec) == sizeof(ErtsIOVecCommon));
+ ERTS_CT_ASSERT(sizeof(size_t) == sizeof(ErlDrvSizeT));
+ ERTS_CT_ASSERT(sizeof(size_t) == sizeof(Uint));
+
+ q->alct = alct;
+ q->driver = driver;
+ q->size = 0;
+ q->v_head = q->v_tail = q->v_start = q->v_small;
+ q->v_end = q->v_small + ERTS_SMALL_IO_QUEUE;
+ q->b_head = q->b_tail = q->b_start = q->b_small;
+ q->b_end = q->b_small + ERTS_SMALL_IO_QUEUE;
+}
+
+void erts_ioq_clear(ErtsIOQueue *q)
+{
+ ErtsIOQBinary** binp = q->b_head;
+ int driver = q->driver;
+
+ if (q->v_start != q->v_small)
+ erts_free(q->alct, (void *) q->v_start);
+
+ while(binp < q->b_tail) {
+ if (*binp != NULL)
+ free_binary(*binp, driver);
+ binp++;
+ }
+ if (q->b_start != q->b_small)
+ erts_free(q->alct, (void *) q->b_start);
+ q->v_start = q->v_end = q->v_head = q->v_tail = NULL;
+ q->b_start = q->b_end = q->b_head = q->b_tail = NULL;
+ q->size = 0;
+}
+
+static void free_binary(ErtsIOQBinary *b, int driver)
+{
+ if (driver)
+ driver_free_binary(&b->driver);
+ else if (erts_refc_dectest(&b->nif.intern.refc, 0) == 0)
+ erts_bin_free(&b->nif);
+}
+
+static ErtsIOQBinary *alloc_binary(Uint size, char *source, void **iov_base, int driver)
+{
+ if (driver) {
+ ErlDrvBinary *bin = driver_alloc_binary(size);
+ if (!bin) return NULL;
+ sys_memcpy(bin->orig_bytes, source, size);
+ *iov_base = bin->orig_bytes;
+ return (ErtsIOQBinary *)bin;
+ } else {
+ /* This clause can be triggered in enif_ioq_enq_binary is used */
+ Binary *bin = erts_bin_nrml_alloc(size);
+ if (!bin) return NULL;
+ erts_refc_init(&bin->intern.refc, 1);
+ sys_memcpy(bin->orig_bytes, source, size);
+ *iov_base = bin->orig_bytes;
+ return (ErtsIOQBinary *)bin;
+ }
+}
+
+Uint erts_ioq_size(ErtsIOQueue *q)
+{
+ return q->size;
+}
+
+/* expand queue to hold n elements in tail or head */
+static int expandq(ErtsIOQueue* q, int n, int tail)
+/* tail: 0 if make room in head, make room in tail otherwise */
+{
+ int h_sz; /* room before header */
+ int t_sz; /* room after tail */
+ int q_sz; /* occupied */
+ int nvsz;
+ SysIOVec* niov;
+ ErtsIOQBinary** nbinv;
+
+ h_sz = q->v_head - q->v_start;
+ t_sz = q->v_end - q->v_tail;
+ q_sz = q->v_tail - q->v_head;
+
+ if (tail && (n <= t_sz)) /* do we need to expand tail? */
+ return 0;
+ else if (!tail && (n <= h_sz)) /* do we need to expand head? */
+ return 0;
+ else if (n > (h_sz + t_sz)) { /* need to allocate */
+ /* we may get little extra but it ok */
+ nvsz = (q->v_end - q->v_start) + n;
+
+ niov = erts_alloc_fnf(q->alct, nvsz * sizeof(SysIOVec));
+ if (!niov)
+ return -1;
+ nbinv = erts_alloc_fnf(q->alct, nvsz * sizeof(ErtsIOQBinary**));
+ if (!nbinv) {
+ erts_free(q->alct, (void *) niov);
+ return -1;
+ }
+ if (tail) {
+ sys_memcpy(niov, q->v_head, q_sz*sizeof(SysIOVec));
+ if (q->v_start != q->v_small)
+ erts_free(q->alct, (void *) q->v_start);
+ q->v_start = niov;
+ q->v_end = niov + nvsz;
+ q->v_head = q->v_start;
+ q->v_tail = q->v_head + q_sz;
+
+ sys_memcpy(nbinv, q->b_head, q_sz*sizeof(ErtsIOQBinary*));
+ if (q->b_start != q->b_small)
+ erts_free(q->alct, (void *) q->b_start);
+ q->b_start = nbinv;
+ q->b_end = nbinv + nvsz;
+ q->b_head = q->b_start;
+ q->b_tail = q->b_head + q_sz;
+ }
+ else {
+ sys_memcpy(niov+nvsz-q_sz, q->v_head, q_sz*sizeof(SysIOVec));
+ if (q->v_start != q->v_small)
+ erts_free(q->alct, (void *) q->v_start);
+ q->v_start = niov;
+ q->v_end = niov + nvsz;
+ q->v_tail = q->v_end;
+ q->v_head = q->v_tail - q_sz;
+
+ sys_memcpy(nbinv+nvsz-q_sz, q->b_head, q_sz*sizeof(ErtsIOQBinary*));
+ if (q->b_start != q->b_small)
+ erts_free(q->alct, (void *) q->b_start);
+ q->b_start = nbinv;
+ q->b_end = nbinv + nvsz;
+ q->b_tail = q->b_end;
+ q->b_head = q->b_tail - q_sz;
+ }
+ }
+ else if (tail) { /* move to beginning to make room in tail */
+ sys_memmove(q->v_start, q->v_head, q_sz*sizeof(SysIOVec));
+ q->v_head = q->v_start;
+ q->v_tail = q->v_head + q_sz;
+ sys_memmove(q->b_start, q->b_head, q_sz*sizeof(ErtsIOQBinary*));
+ q->b_head = q->b_start;
+ q->b_tail = q->b_head + q_sz;
+ }
+ else { /* move to end to make room */
+ sys_memmove(q->v_end-q_sz, q->v_head, q_sz*sizeof(SysIOVec));
+ q->v_tail = q->v_end;
+ q->v_head = q->v_tail-q_sz;
+ sys_memmove(q->b_end-q_sz, q->b_head, q_sz*sizeof(ErtsIOQBinary*));
+ q->b_tail = q->b_end;
+ q->b_head = q->b_tail-q_sz;
+ }
+
+ return 0;
+}
+
+static
+int skip(ErtsIOVec* vec, Uint skipbytes,
+ SysIOVec **iovp, ErtsIOQBinary ***binvp,
+ Uint *lenp)
+{
+ int n;
+ Uint len;
+ SysIOVec* iov;
+ ErtsIOQBinary** binv;
+
+ if (vec->common.size <= skipbytes)
+ return -1;
+
+ iov = vec->common.iov;
+ binv = vec->common.binv;
+ n = vec->common.vsize;
+ /* we use do here to strip iov_len=0 from beginning */
+ do {
+ len = iov->iov_len;
+ if (len <= skipbytes) {
+ skipbytes -= len;
+ iov++;
+ binv++;
+ n--;
+ }
+ else {
+ iov->iov_base = ((char *)(iov->iov_base)) + skipbytes;
+ iov->iov_len -= skipbytes;
+ skipbytes = 0;
+ }
+ } while(skipbytes > 0);
+
+ *binvp = binv;
+ *iovp = iov;
+ *lenp = len;
+
+ return n;
+}
+
+/* Put elements from vec at q tail */
+int erts_ioq_enqv(ErtsIOQueue *q, ErtsIOVec *eiov, Uint skipbytes)
+{
+ int n;
+ Uint len;
+ Uint size = eiov->common.size - skipbytes;
+ SysIOVec *iov;
+ ErtsIOQBinary** binv;
+ ErtsIOQBinary* b;
+
+ if (q == NULL)
+ return -1;
+
+ ASSERT(eiov->common.size >= skipbytes);
+ if (eiov->common.size <= skipbytes)
+ return 0;
+
+ n = skip(eiov, skipbytes, &iov, &binv, &len);
+
+ if (n < 0)
+ return n;
+
+ if (q->v_tail + n >= q->v_end)
+ if (expandq(q, n, 1))
+ return -1;
+
+ /* Queue and reference all binaries (remove zero length items) */
+ while(n--) {
+ if ((len = iov->iov_len) > 0) {
+ if ((b = *binv) == NULL) { /* special case create binary ! */
+ b = alloc_binary(len, iov->iov_base, (void**)&q->v_tail->iov_base,
+ q->driver);
+ if (!b) return -1;
+ *q->b_tail++ = b;
+ q->v_tail->iov_len = len;
+ q->v_tail++;
+ }
+ else {
+ if (q->driver)
+ driver_binary_inc_refc(&b->driver);
+ else
+ erts_refc_inc(&b->nif.intern.refc, 1);
+ *q->b_tail++ = b;
+ *q->v_tail++ = *iov;
+ }
+ }
+ iov++;
+ binv++;
+ }
+ q->size += size; /* update total size in queue */
+ return 0;
+}
+
+/* Put elements from vec at q head */
+int erts_ioq_pushqv(ErtsIOQueue *q, ErtsIOVec* vec, Uint skipbytes)
+{
+ int n;
+ Uint len;
+ Uint size = vec->common.size - skipbytes;
+ SysIOVec* iov;
+ ErtsIOQBinary** binv;
+ ErtsIOQBinary* b;
+
+ if (q == NULL)
+ return -1;
+
+ ASSERT(vec->common.size >= skipbytes);
+ if (vec->common.size <= skipbytes)
+ return 0;
+
+ n = skip(vec, skipbytes, &iov, &binv, &len);
+
+ if (n < 0)
+ return n;
+
+ if (q->v_head - n < q->v_start)
+ if (expandq(q, n, 0))
+ return -1;
+
+ /* Queue and reference all binaries (remove zero length items) */
+ iov += (n-1); /* move to end */
+ binv += (n-1); /* move to end */
+ while(n--) {
+ if ((len = iov->iov_len) > 0) {
+ if ((b = *binv) == NULL) { /* special case create binary ! */
+ if (q->driver) {
+ ErlDrvBinary *bin = driver_alloc_binary(len);
+ if (!bin) return -1;
+ sys_memcpy(bin->orig_bytes, iov->iov_base, len);
+ b = (ErtsIOQBinary *)bin;
+ q->v_head->iov_base = bin->orig_bytes;
+ }
+ *--q->b_head = b;
+ q->v_head--;
+ q->v_head->iov_len = len;
+ }
+ else {
+ if (q->driver)
+ driver_binary_inc_refc(&b->driver);
+ else
+ erts_refc_inc(&b->nif.intern.refc, 1);
+ *--q->b_head = b;
+ *--q->v_head = *iov;
+ }
+ }
+ iov--;
+ binv--;
+ }
+ q->size += size; /* update total size in queue */
+ return 0;
+}
+
+
+/*
+** Remove size bytes from queue head
+** Return number of bytes that remain in queue
+*/
+int erts_ioq_deq(ErtsIOQueue *q, Uint size)
+{
+ Uint len;
+
+ if ((q == NULL) || (q->size < size))
+ return -1;
+ q->size -= size;
+ while (size > 0) {
+ ASSERT(q->v_head != q->v_tail);
+
+ len = q->v_head->iov_len;
+ if (len <= size) {
+ size -= len;
+ free_binary(*q->b_head, q->driver);
+ *q->b_head++ = NULL;
+ q->v_head++;
+ }
+ else {
+ q->v_head->iov_base = ((char *)(q->v_head->iov_base)) + size;
+ q->v_head->iov_len -= size;
+ size = 0;
+ }
+ }
+
+ /* restart pointers (optimised for enq) */
+ if (q->v_head == q->v_tail) {
+ q->v_head = q->v_tail = q->v_start;
+ q->b_head = q->b_tail = q->b_start;
+ }
+ return 0;
+}
+
+
+Uint erts_ioq_peekqv(ErtsIOQueue *q, ErtsIOVec *ev) {
+ ASSERT(ev);
+
+ if (! q) {
+ return (Uint) -1;
+ } else {
+ if ((ev->common.vsize = q->v_tail - q->v_head) == 0) {
+ ev->common.size = 0;
+ ev->common.iov = NULL;
+ ev->common.binv = NULL;
+ } else {
+ ev->common.size = q->size;
+ ev->common.iov = q->v_head;
+ ev->common.binv = q->b_head;
+ }
+ return q->size;
+ }
+}
+
+SysIOVec* erts_ioq_peekq(ErtsIOQueue *q, int* vlenp) /* length of io-vector */
+{
+
+ if (q == NULL) {
+ *vlenp = -1;
+ return NULL;
+ }
+ if ((*vlenp = (q->v_tail - q->v_head)) == 0)
+ return NULL;
+ return q->v_head;
+}
+
+/* Fills a possibly deep list of chars and binaries into vec
+** Small characters are first stored in the buffer buf of length ln
+** binaries found are copied and linked into msoh
+** Return vector length on succsess,
+** -1 on overflow
+** -2 on type error
+*/
+
+static ERTS_INLINE void
+io_list_to_vec_set_vec(SysIOVec **iov, ErtsIOQBinary ***binv,
+ ErtsIOQBinary *bin, byte *ptr, Uint len,
+ int *vlen)
+{
+ while (len > MAX_SYSIOVEC_IOVLEN) {
+ (*iov)->iov_base = ptr;
+ (*iov)->iov_len = MAX_SYSIOVEC_IOVLEN;
+ ptr += MAX_SYSIOVEC_IOVLEN;
+ len -= MAX_SYSIOVEC_IOVLEN;
+ (*iov)++;
+ (*vlen)++;
+ *(*binv)++ = bin;
+ }
+ (*iov)->iov_base = ptr;
+ (*iov)->iov_len = len;
+ *(*binv)++ = bin;
+ (*iov)++;
+ (*vlen)++;
+}
+
+int
+erts_ioq_iolist_to_vec(Eterm obj, /* io-list */
+ SysIOVec* iov, /* io vector */
+ ErtsIOQBinary** binv, /* binary reference vector */
+ ErtsIOQBinary* cbin, /* binary to store characters */
+ Uint bin_limit, /* small binaries limit */
+ int driver)
+{
+ DECLARE_ESTACK(s);
+ Eterm* objp;
+ byte *buf = NULL;
+ Uint len = 0;
+ Uint csize = 0;
+ int vlen = 0;
+ byte* cptr;
+
+ if (cbin) {
+ if (driver) {
+ buf = (byte*)cbin->driver.orig_bytes;
+ len = cbin->driver.orig_size;
+ } else {
+ buf = (byte*)cbin->nif.orig_bytes;
+ len = cbin->nif.orig_size;
+ }
+ }
+ cptr = buf;
+
+ goto L_jump_start; /* avoid push */
+
+ while (!ESTACK_ISEMPTY(s)) {
+ obj = ESTACK_POP(s);
+ L_jump_start:
+ if (is_list(obj)) {
+ L_iter_list:
+ objp = list_val(obj);
+ obj = CAR(objp);
+ if (is_byte(obj)) {
+ if (len == 0)
+ goto L_overflow;
+ *buf++ = unsigned_val(obj);
+ csize++;
+ len--;
+ } else if (is_binary(obj)) {
+ ESTACK_PUSH(s, CDR(objp));
+ goto handle_binary;
+ } else if (is_list(obj)) {
+ ESTACK_PUSH(s, CDR(objp));
+ goto L_iter_list; /* on head */
+ } else if (!is_nil(obj)) {
+ goto L_type_error;
+ }
+ obj = CDR(objp);
+ if (is_list(obj))
+ goto L_iter_list; /* on tail */
+ else if (is_binary(obj)) {
+ goto handle_binary;
+ } else if (!is_nil(obj)) {
+ goto L_type_error;
+ }
+ } else if (is_binary(obj)) {
+ Eterm real_bin;
+ Uint offset;
+ Eterm* bptr;
+ Uint size;
+ int bitoffs;
+ int bitsize;
+
+ handle_binary:
+ size = binary_size(obj);
+ ERTS_GET_REAL_BIN(obj, real_bin, offset, bitoffs, bitsize);
+ ASSERT(bitsize == 0);
+ bptr = binary_val(real_bin);
+ if (*bptr == HEADER_PROC_BIN) {
+ ProcBin* pb = (ProcBin *) bptr;
+ if (bitoffs != 0) {
+ if (len < size) {
+ goto L_overflow;
+ }
+ erts_copy_bits(pb->bytes+offset, bitoffs, 1,
+ (byte *) buf, 0, 1, size*8);
+ csize += size;
+ buf += size;
+ len -= size;
+ } else if (bin_limit && size < bin_limit) {
+ if (len < size) {
+ goto L_overflow;
+ }
+ sys_memcpy(buf, pb->bytes+offset, size);
+ csize += size;
+ buf += size;
+ len -= size;
+ } else {
+ ErtsIOQBinary *qbin;
+ if (csize != 0) {
+ io_list_to_vec_set_vec(&iov, &binv, cbin,
+ cptr, csize, &vlen);
+ cptr = buf;
+ csize = 0;
+ }
+ if (pb->flags) {
+ erts_emasculate_writable_binary(pb);
+ }
+ if (driver)
+ qbin = (ErtsIOQBinary*)Binary2ErlDrvBinary(pb->val);
+ else
+ qbin = (ErtsIOQBinary*)pb->val;
+
+ io_list_to_vec_set_vec(
+ &iov, &binv, qbin,
+ pb->bytes+offset, size, &vlen);
+ }
+ } else {
+ ErlHeapBin* hb = (ErlHeapBin *) bptr;
+ if (len < size) {
+ goto L_overflow;
+ }
+ copy_binary_to_buffer(buf, 0,
+ ((byte *) hb->data)+offset, bitoffs,
+ 8*size);
+ csize += size;
+ buf += size;
+ len -= size;
+ }
+ } else if (!is_nil(obj)) {
+ goto L_type_error;
+ }
+ }
+
+ if (csize != 0) {
+ io_list_to_vec_set_vec(&iov, &binv, cbin, cptr, csize, &vlen);
+ }
+
+ DESTROY_ESTACK(s);
+ return vlen;
+
+ L_type_error:
+ DESTROY_ESTACK(s);
+ return -2;
+
+ L_overflow:
+ DESTROY_ESTACK(s);
+ return -1;
+}
+
+static ERTS_INLINE int
+io_list_vec_count(Eterm obj, Uint *v_size,
+ Uint *c_size, Uint *b_size, Uint *in_clist,
+ Uint *p_v_size, Uint *p_c_size, Uint *p_in_clist,
+ Uint blimit)
+{
+ Uint size = binary_size(obj);
+ Eterm real;
+ ERTS_DECLARE_DUMMY(Uint offset);
+ int bitoffs;
+ int bitsize;
+ ERTS_GET_REAL_BIN(obj, real, offset, bitoffs, bitsize);
+ if (bitsize != 0) return 1;
+ if (thing_subtag(*binary_val(real)) == REFC_BINARY_SUBTAG &&
+ bitoffs == 0) {
+ *b_size += size;
+ if (*b_size < size) return 2;
+ *in_clist = 0;
+ ++*v_size;
+ /* If iov_len is smaller then Uint we split the binary into*/
+ /* multiple smaller (2GB) elements in the iolist.*/
+ *v_size += size / MAX_SYSIOVEC_IOVLEN;
+ if (size >= blimit) {
+ *p_in_clist = 0;
+ ++*p_v_size;
+ } else {
+ *p_c_size += size;
+ if (!*p_in_clist) {
+ *p_in_clist = 1;
+ ++*p_v_size;
+ }
+ }
+ } else {
+ *c_size += size;
+ if (*c_size < size) return 2;
+ if (!*in_clist) {
+ *in_clist = 1;
+ ++*v_size;
+ }
+ *p_c_size += size;
+ if (!*p_in_clist) {
+ *p_in_clist = 1;
+ ++*p_v_size;
+ }
+ }
+ return 0;
+}
+
+#define IO_LIST_VEC_COUNT(obj) \
+ do { \
+ switch (io_list_vec_count(obj, &v_size, &c_size, \
+ &b_size, &in_clist, \
+ &p_v_size, &p_c_size, &p_in_clist, \
+ blimit)) { \
+ case 1: goto L_type_error; \
+ case 2: goto L_overflow_error; \
+ default: break; \
+ } \
+ } while(0)
+
+/*
+ * Returns 0 if successful and a non-zero value otherwise.
+ *
+ * Return values through pointers:
+ * *vsize - SysIOVec size needed for a writev
+ * *csize - Number of bytes not in binary (in the common binary)
+ * *pvsize - SysIOVec size needed if packing small binaries
+ * *pcsize - Number of bytes in the common binary if packing
+ * *total_size - Total size of iolist in bytes
+ */
+int
+erts_ioq_iolist_vec_len(Eterm obj, int* vsize, Uint* csize,
+ Uint* pvsize, Uint* pcsize,
+ Uint* total_size, Uint blimit)
+{
+ DECLARE_ESTACK(s);
+ Eterm* objp;
+ Uint v_size = 0;
+ Uint c_size = 0;
+ Uint b_size = 0;
+ Uint in_clist = 0;
+ Uint p_v_size = 0;
+ Uint p_c_size = 0;
+ Uint p_in_clist = 0;
+ Uint total;
+
+ goto L_jump_start; /* avoid a push */
+
+ while (!ESTACK_ISEMPTY(s)) {
+ obj = ESTACK_POP(s);
+ L_jump_start:
+ if (is_list(obj)) {
+ L_iter_list:
+ objp = list_val(obj);
+ obj = CAR(objp);
+
+ if (is_byte(obj)) {
+ c_size++;
+ if (c_size == 0) {
+ goto L_overflow_error;
+ }
+ if (!in_clist) {
+ in_clist = 1;
+ v_size++;
+ }
+ p_c_size++;
+ if (!p_in_clist) {
+ p_in_clist = 1;
+ p_v_size++;
+ }
+ }
+ else if (is_binary(obj)) {
+ IO_LIST_VEC_COUNT(obj);
+ }
+ else if (is_list(obj)) {
+ ESTACK_PUSH(s, CDR(objp));
+ goto L_iter_list; /* on head */
+ }
+ else if (!is_nil(obj)) {
+ goto L_type_error;
+ }
+
+ obj = CDR(objp);
+ if (is_list(obj))
+ goto L_iter_list; /* on tail */
+ else if (is_binary(obj)) { /* binary tail is OK */
+ IO_LIST_VEC_COUNT(obj);
+ }
+ else if (!is_nil(obj)) {
+ goto L_type_error;
+ }
+ }
+ else if (is_binary(obj)) {
+ IO_LIST_VEC_COUNT(obj);
+ }
+ else if (!is_nil(obj)) {
+ goto L_type_error;
+ }
+ }
+
+ total = c_size + b_size;
+ if (total < c_size) {
+ goto L_overflow_error;
+ }
+ *total_size = total;
+
+ DESTROY_ESTACK(s);
+ *vsize = v_size;
+ *csize = c_size;
+ *pvsize = p_v_size;
+ *pcsize = p_c_size;
+ return 0;
+
+ L_type_error:
+ L_overflow_error:
+ DESTROY_ESTACK(s);
+ return 1;
+}
+
+typedef struct {
+ Eterm result_head;
+ Eterm result_tail;
+ Eterm input_list;
+
+ UWord acc_size;
+ Binary *acc;
+
+ /* We yield after copying this many bytes into the accumulator (Minus
+ * eating a few on consing etc). Large binaries will only count to the
+ * extent their split (if any) resulted in a copy op. */
+ UWord bytereds_available;
+ UWord bytereds_spent;
+
+ Process *process;
+ ErtsEStack estack;
+
+ Eterm magic_reference;
+} iol2v_state_t;
+
+static int iol2v_state_destructor(Binary *data) {
+ iol2v_state_t *state = ERTS_MAGIC_BIN_UNALIGNED_DATA(data);
+
+ DESTROY_SAVED_ESTACK(&state->estack);
+
+ if (state->acc != NULL) {
+ erts_bin_free(state->acc);
+ }
+
+ return 1;
+}
+
+static void iol2v_init(iol2v_state_t *state, Process *process, Eterm input) {
+ state->process = process;
+
+ state->result_head = NIL;
+ state->result_tail = NIL;
+ state->input_list = input;
+
+ state->magic_reference = NIL;
+ state->acc_size = 0;
+ state->acc = NULL;
+
+ CLEAR_SAVED_ESTACK(&state->estack);
+}
+
+static Eterm iol2v_make_sub_bin(iol2v_state_t *state, Eterm bin_term,
+ UWord offset, UWord size) {
+ Uint byte_offset, bit_offset, bit_size;
+ ErlSubBin *sb;
+ Eterm orig_pb_term;
+
+ sb = (ErlSubBin*)HAlloc(state->process, ERL_SUB_BIN_SIZE);
+
+ ERTS_GET_REAL_BIN(bin_term, orig_pb_term,
+ byte_offset, bit_offset, bit_size);
+
+ (void)bit_offset;
+ (void)bit_size;
+
+ sb->thing_word = HEADER_SUB_BIN;
+ sb->bitsize = 0;
+ sb->bitoffs = 0;
+ sb->orig = orig_pb_term;
+ sb->is_writable = 0;
+
+ sb->offs = byte_offset + offset;
+ sb->size = size;
+
+ return make_binary(sb);
+}
+
+static Eterm iol2v_promote_acc(iol2v_state_t *state) {
+ ProcBin *pb;
+
+ state->acc = erts_bin_realloc(state->acc, state->acc_size);
+
+ pb = (ProcBin*)HAlloc(state->process, PROC_BIN_SIZE);
+ pb->thing_word = HEADER_PROC_BIN;
+ pb->size = state->acc_size;
+ pb->val = state->acc;
+ pb->bytes = (byte*)(state->acc)->orig_bytes;
+ pb->flags = 0;
+ pb->next = MSO(state->process).first;
+ OH_OVERHEAD(&(MSO(state->process)), pb->size / sizeof(Eterm));
+ MSO(state->process).first = (struct erl_off_heap_header*)pb;
+
+ state->acc_size = 0;
+ state->acc = NULL;
+
+ return make_binary(pb);
+}
+
+/* Destructively enqueues a term to the result list, saving us the hassle of
+ * having to reverse it later. This is safe since GC is disabled and we never
+ * leak the unfinished term to the outside. */
+static void iol2v_enqueue_result(iol2v_state_t *state, Eterm term) {
+ Eterm prev_tail;
+ Eterm *hp;
+
+ prev_tail = state->result_tail;
+
+ hp = HAlloc(state->process, 2);
+ state->result_tail = CONS(hp, term, NIL);
+
+ if(prev_tail != NIL) {
+ Eterm *prev_cell = list_val(prev_tail);
+ CDR(prev_cell) = state->result_tail;
+ } else {
+ state->result_head = state->result_tail;
+ }
+
+ state->bytereds_spent += 1;
+}
+
+#ifndef DEBUG
+ #define ACC_REALLOCATION_LIMIT (IOL2V_SMALL_BIN_LIMIT * 32)
+#else
+ #define ACC_REALLOCATION_LIMIT (IOL2V_SMALL_BIN_LIMIT * 4)
+#endif
+
+static void iol2v_expand_acc(iol2v_state_t *state, UWord extra) {
+ UWord required_bytes, acc_alloc_size;
+
+ ERTS_CT_ASSERT(ERTS_UWORD_MAX > ACC_REALLOCATION_LIMIT / 2);
+ ASSERT(extra >= 1);
+
+ acc_alloc_size = state->acc != NULL ? (state->acc)->orig_size : 0;
+ required_bytes = state->acc_size + extra;
+
+ if (state->acc == NULL) {
+ UWord new_size = MAX(required_bytes, IOL2V_SMALL_BIN_LIMIT);
+
+ state->acc = erts_bin_nrml_alloc(new_size);
+ } else if (required_bytes > acc_alloc_size) {
+ Binary *prev_acc;
+ UWord new_size;
+
+ if (acc_alloc_size >= ACC_REALLOCATION_LIMIT) {
+ /* We skip reallocating once we hit a certain point; it often
+ * results in extra copying and we're very likely to overallocate
+ * on anything other than absurdly long byte/heapbin sequences. */
+ iol2v_enqueue_result(state, iol2v_promote_acc(state));
+ iol2v_expand_acc(state, extra);
+ return;
+ }
+
+ new_size = MAX(required_bytes, acc_alloc_size * 2);
+ prev_acc = state->acc;
+
+ state->acc = erts_bin_realloc(prev_acc, new_size);
+
+ if (prev_acc != state->acc) {
+ state->bytereds_spent += state->acc_size;
+ }
+ }
+
+ state->bytereds_spent += extra;
+}
+
+static int iol2v_append_byte_seq(iol2v_state_t *state, Eterm seq_start, Eterm *seq_end) {
+ Eterm lookahead, iterator;
+ Uint observed_bits;
+ SWord seq_length;
+ char *acc_data;
+
+ lookahead = seq_start;
+ seq_length = 0;
+
+ ASSERT(state->bytereds_available > state->bytereds_spent);
+
+ while (is_list(lookahead)) {
+ Eterm *cell = list_val(lookahead);
+
+ if (!is_small(CAR(cell))) {
+ break;
+ }
+
+ if (seq_length * 2 >= (state->bytereds_available - state->bytereds_spent)) {
+ break;
+ }
+
+ lookahead = CDR(cell);
+ seq_length += 1;
+ }
+
+ ASSERT(seq_length >= 1);
+
+ iol2v_expand_acc(state, seq_length);
+
+ /* Bump a few extra reductions to account for list traversal. */
+ state->bytereds_spent += seq_length;
+
+ acc_data = &(state->acc)->orig_bytes[state->acc_size];
+ state->acc_size += seq_length;
+
+ iterator = seq_start;
+ observed_bits = 0;
+
+ while (iterator != lookahead) {
+ Eterm *cell;
+ Uint byte;
+
+ cell = list_val(iterator);
+ iterator = CDR(cell);
+
+ byte = unsigned_val(CAR(cell));
+ observed_bits |= byte;
+
+ ASSERT(acc_data < &(state->acc)->orig_bytes[state->acc_size]);
+ *(acc_data++) = byte;
+ }
+
+ if (observed_bits > UCHAR_MAX) {
+ return 0;
+ }
+
+ ASSERT(acc_data == &(state->acc)->orig_bytes[state->acc_size]);
+ *seq_end = iterator;
+
+ return 1;
+}
+
+static int iol2v_append_binary(iol2v_state_t *state, Eterm bin_term) {
+ int is_acc_small, is_bin_small;
+ UWord combined_size;
+ UWord binary_size;
+
+ Uint byte_offset, bit_offset, bit_size;
+ byte *binary_data;
+
+ Eterm *parent_header;
+ Eterm parent_binary;
+
+ ASSERT(state->bytereds_available > state->bytereds_spent);
+
+ ERTS_GET_REAL_BIN(bin_term, parent_binary, byte_offset, bit_offset, bit_size);
+ parent_header = binary_val(parent_binary);
+ binary_size = binary_size(bin_term);
+
+ if (bit_offset != 0 || bit_size != 0) {
+ return 0;
+ } else if (binary_size == 0) {
+ state->bytereds_spent += 1;
+ return 1;
+ }
+
+ is_acc_small = state->acc_size < IOL2V_SMALL_BIN_LIMIT;
+ is_bin_small = binary_size < IOL2V_SMALL_BIN_LIMIT;
+ combined_size = binary_size + state->acc_size;
+
+ if (thing_subtag(*parent_header) == REFC_BINARY_SUBTAG) {
+ ProcBin *pb = (ProcBin*)parent_header;
+
+ if (pb->flags) {
+ erts_emasculate_writable_binary(pb);
+ }
+
+ binary_data = &((byte*)pb->bytes)[byte_offset];
+ } else {
+ ErlHeapBin *hb = (ErlHeapBin*)parent_header;
+
+ ASSERT(thing_subtag(*parent_header) == HEAP_BINARY_SUBTAG);
+ ASSERT(is_bin_small);
+
+ binary_data = &((byte*)&hb->data)[byte_offset];
+ }
+
+ if (!is_bin_small && (state->acc_size == 0 || !is_acc_small)) {
+ /* Avoid combining if we encounter an acceptably large binary while the
+ * accumulator is either empty or large enough to be returned on its
+ * own. */
+ if (state->acc_size != 0) {
+ iol2v_enqueue_result(state, iol2v_promote_acc(state));
+ }
+
+ iol2v_enqueue_result(state, bin_term);
+ } else if (is_bin_small || combined_size < (IOL2V_SMALL_BIN_LIMIT * 2)) {
+ /* If the candidate is small or we can't split the combination in two,
+ * then just copy it into the accumulator. */
+ iol2v_expand_acc(state, binary_size);
+
+ sys_memcpy(&(state->acc)->orig_bytes[state->acc_size],
+ binary_data, binary_size);
+
+ state->acc_size += binary_size;
+ } else {
+ /* Otherwise, append enough data for the accumulator to be valid, and
+ * then return the rest as a sub-binary. */
+ UWord spill = IOL2V_SMALL_BIN_LIMIT - state->acc_size;
+ Eterm binary_tail;
+
+ iol2v_expand_acc(state, spill);
+
+ sys_memcpy(&(state->acc)->orig_bytes[state->acc_size],
+ binary_data, spill);
+
+ state->acc_size += spill;
+
+ binary_tail = iol2v_make_sub_bin(state, bin_term, spill,
+ binary_size - spill);
+
+ iol2v_enqueue_result(state, iol2v_promote_acc(state));
+ iol2v_enqueue_result(state, binary_tail);
+ }
+
+ return 1;
+}
+
+static BIF_RETTYPE iol2v_yield(iol2v_state_t *state) {
+ if (is_nil(state->magic_reference)) {
+ iol2v_state_t *boxed_state;
+ Binary *magic_binary;
+ Eterm *hp;
+
+ magic_binary = erts_create_magic_binary_x(sizeof(*state),
+ &iol2v_state_destructor, ERTS_ALC_T_BINARY, 1);
+
+ boxed_state = ERTS_MAGIC_BIN_UNALIGNED_DATA(magic_binary);
+ sys_memcpy(boxed_state, state, sizeof(*state));
+
+ hp = HAlloc(boxed_state->process, ERTS_MAGIC_REF_THING_SIZE);
+ boxed_state->magic_reference =
+ erts_mk_magic_ref(&hp, &MSO(boxed_state->process), magic_binary);
+
+ state = boxed_state;
+ }
+
+ ERTS_BIF_YIELD1(bif_export[BIF_iolist_to_iovec_1],
+ state->process, state->magic_reference);
+}
+
+static BIF_RETTYPE iol2v_continue(iol2v_state_t *state) {
+ Eterm iterator;
+
+ DECLARE_ESTACK(s);
+ ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK);
+
+ state->bytereds_available =
+ ERTS_BIF_REDS_LEFT(state->process) * IOL2V_SMALL_BIN_LIMIT;
+ state->bytereds_spent = 0;
+
+ if (state->estack.start) {
+ ESTACK_RESTORE(s, &state->estack);
+ }
+
+ iterator = state->input_list;
+
+ for(;;) {
+ if (state->bytereds_spent >= state->bytereds_available) {
+ ESTACK_SAVE(s, &state->estack);
+ state->input_list = iterator;
+
+ return iol2v_yield(state);
+ }
+
+ while (is_list(iterator)) {
+ Eterm *cell;
+ Eterm head;
+
+ cell = list_val(iterator);
+ head = CAR(cell);
+
+ if (is_binary(head)) {
+ if (!iol2v_append_binary(state, head)) {
+ goto l_badarg;
+ }
+
+ iterator = CDR(cell);
+ } else if (is_small(head)) {
+ Eterm seq_end;
+
+ if (!iol2v_append_byte_seq(state, iterator, &seq_end)) {
+ goto l_badarg;
+ }
+
+ iterator = seq_end;
+ } else if (is_list(head) || is_nil(head)) {
+ Eterm tail = CDR(cell);
+
+ if (!is_nil(tail)) {
+ ESTACK_PUSH(s, tail);
+ }
+
+ state->bytereds_spent += 1;
+ iterator = head;
+ } else {
+ goto l_badarg;
+ }
+
+ if (state->bytereds_spent >= state->bytereds_available) {
+ ESTACK_SAVE(s, &state->estack);
+ state->input_list = iterator;
+
+ return iol2v_yield(state);
+ }
+ }
+
+ if (is_binary(iterator)) {
+ if (!iol2v_append_binary(state, iterator)) {
+ goto l_badarg;
+ }
+ } else if (!is_nil(iterator)) {
+ goto l_badarg;
+ }
+
+ if(ESTACK_ISEMPTY(s)) {
+ break;
+ }
+
+ iterator = ESTACK_POP(s);
+ }
+
+ if (state->acc_size != 0) {
+ iol2v_enqueue_result(state, iol2v_promote_acc(state));
+ }
+
+ BUMP_REDS(state->process, state->bytereds_spent / IOL2V_SMALL_BIN_LIMIT);
+
+ CLEAR_SAVED_ESTACK(&state->estack);
+ DESTROY_ESTACK(s);
+
+ BIF_RET(state->result_head);
+
+l_badarg:
+ CLEAR_SAVED_ESTACK(&state->estack);
+ DESTROY_ESTACK(s);
+
+ if (state->acc != NULL) {
+ erts_bin_free(state->acc);
+ state->acc = NULL;
+ }
+
+ BIF_ERROR(state->process, BADARG);
+}
+
+HIPE_WRAPPER_BIF_DISABLE_GC(iolist_to_iovec, 1)
+
+BIF_RETTYPE iolist_to_iovec_1(BIF_ALIST_1) {
+ BIF_RETTYPE result;
+
+ if (is_nil(BIF_ARG_1)) {
+ BIF_RET(NIL);
+ } else if (is_binary(BIF_ARG_1)) {
+ if (binary_size(BIF_ARG_1) != 0) {
+ Eterm *hp = HAlloc(BIF_P, 2);
+
+ BIF_RET(CONS(hp, BIF_ARG_1, NIL));
+ } else {
+ BIF_RET(NIL);
+ }
+ } else if (is_internal_magic_ref(BIF_ARG_1)) {
+ iol2v_state_t *state;
+ Binary *magic;
+
+ magic = erts_magic_ref2bin(BIF_ARG_1);
+
+ if (ERTS_MAGIC_BIN_DESTRUCTOR(magic) != &iol2v_state_destructor) {
+ ASSERT(!(BIF_P->flags & F_DISABLE_GC));
+ BIF_ERROR(BIF_P, BADARG);
+ }
+
+ ASSERT(BIF_P->flags & F_DISABLE_GC);
+
+ state = ERTS_MAGIC_BIN_UNALIGNED_DATA(magic);
+ result = iol2v_continue(state);
+ } else if (!is_list(BIF_ARG_1)) {
+ ASSERT(!(BIF_P->flags & F_DISABLE_GC));
+ BIF_ERROR(BIF_P, BADARG);
+ } else {
+ iol2v_state_t state;
+
+ iol2v_init(&state, BIF_P, BIF_ARG_1);
+
+ erts_set_gc_state(BIF_P, 0);
+
+ result = iol2v_continue(&state);
+ }
+
+ if (result != THE_NON_VALUE || BIF_P->freason != TRAP) {
+ erts_set_gc_state(BIF_P, 1);
+ }
+
+ BIF_RET(result);
+}
diff --git a/erts/emulator/beam/erl_io_queue.h b/erts/emulator/beam/erl_io_queue.h
new file mode 100644
index 0000000000..51abe99510
--- /dev/null
+++ b/erts/emulator/beam/erl_io_queue.h
@@ -0,0 +1,201 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2017. 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: A queue used for storing binary data that should be
+ * passed to writev or similar functions. Used by both
+ * the nif and driver api.
+ *
+ * Author: Lukas Larsson
+ */
+
+#ifndef ERL_IO_QUEUE_H__TYPES__
+#define ERL_IO_QUEUE_H__TYPES__
+
+#define ERTS_BINARY_TYPES_ONLY__
+#include "erl_binary.h"
+#undef ERTS_BINARY_TYPES_ONLY__
+#include "erl_nif.h"
+
+#ifdef DEBUG
+#define MAX_SYSIOVEC_IOVLEN (1ull << (32 - 1))
+#else
+#define MAX_SYSIOVEC_IOVLEN (1ull << (sizeof(((SysIOVec*)0)->iov_len) * 8 - 1))
+#endif
+
+#define ERTS_SMALL_IO_QUEUE 5
+
+typedef union {
+ ErlDrvBinary driver;
+ Binary nif;
+} ErtsIOQBinary;
+
+typedef struct {
+ int vsize; /* length of vectors */
+ Uint size; /* total size in bytes */
+ SysIOVec* iov;
+ ErtsIOQBinary** binv;
+} ErtsIOVecCommon;
+
+typedef union {
+ ErtsIOVecCommon common;
+ ErlIOVec driver;
+ ErlNifIOVec nif;
+} ErtsIOVec;
+
+/* head/tail represent the data in the queue
+ * start/end represent the edges of the allocated queue
+ * small is used when the number of iovec elements is < SMALL_IO_QUEUE
+ */
+typedef struct erts_io_queue {
+ ErtsAlcType_t alct;
+ int driver;
+ Uint size; /* total size in bytes */
+
+ SysIOVec* v_start;
+ SysIOVec* v_end;
+ SysIOVec* v_head;
+ SysIOVec* v_tail;
+ SysIOVec v_small[ERTS_SMALL_IO_QUEUE];
+
+ ErtsIOQBinary **b_start;
+ ErtsIOQBinary **b_end;
+ ErtsIOQBinary **b_head;
+ ErtsIOQBinary **b_tail;
+ ErtsIOQBinary *b_small[ERTS_SMALL_IO_QUEUE];
+
+} ErtsIOQueue;
+
+#endif /* ERL_IO_QUEUE_H__TYPES__ */
+
+#if !defined(ERL_IO_QUEUE_H) && !defined(ERTS_IO_QUEUE_TYPES_ONLY__)
+#define ERL_IO_QUEUE_H
+
+#include "erl_binary.h"
+#include "erl_bits.h"
+
+void erts_ioq_init(ErtsIOQueue *q, ErtsAlcType_t alct, int driver);
+void erts_ioq_clear(ErtsIOQueue *q);
+Uint erts_ioq_size(ErtsIOQueue *q);
+int erts_ioq_enqv(ErtsIOQueue *q, ErtsIOVec *vec, Uint skip);
+int erts_ioq_pushqv(ErtsIOQueue *q, ErtsIOVec *vec, Uint skip);
+int erts_ioq_deq(ErtsIOQueue *q, Uint Uint);
+Uint erts_ioq_peekqv(ErtsIOQueue *q, ErtsIOVec *ev);
+SysIOVec *erts_ioq_peekq(ErtsIOQueue *q, int *vlenp);
+Uint erts_ioq_sizeq(ErtsIOQueue *q);
+
+int erts_ioq_iolist_vec_len(Eterm obj, int* vsize, Uint* csize,
+ Uint* pvsize, Uint* pcsize,
+ Uint* total_size, Uint blimit);
+int erts_ioq_iolist_to_vec(Eterm obj, SysIOVec* iov,
+ ErtsIOQBinary** binv, ErtsIOQBinary* cbin,
+ Uint bin_limit, int driver_binary);
+
+ERTS_GLB_INLINE
+int erts_ioq_iodata_vec_len(Eterm obj, int* vsize, Uint* csize,
+ Uint* pvsize, Uint* pcsize,
+ Uint* total_size, Uint blimit);
+ERTS_GLB_INLINE
+int erts_ioq_iodata_to_vec(Eterm obj, SysIOVec* iov,
+ ErtsIOQBinary** binv, ErtsIOQBinary* cbin,
+ Uint bin_limit, int driver_binary);
+
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_INLINE
+int erts_ioq_iodata_vec_len(Eterm obj, int* vsize, Uint* csize,
+ Uint* pvsize, Uint* pcsize,
+ Uint* total_size, Uint blimit) {
+ if (is_binary(obj)) {
+ /* We optimize for when we get a procbin without a bit-offset
+ * that fits in one iov slot
+ */
+ Eterm real_bin;
+ byte bitoffs;
+ byte bitsize;
+ ERTS_DECLARE_DUMMY(Uint offset);
+ Uint size = binary_size(obj);
+ ERTS_GET_REAL_BIN(obj, real_bin, offset, bitoffs, bitsize);
+ if (size < MAX_SYSIOVEC_IOVLEN && bitoffs == 0 && bitsize == 0) {
+ *vsize = 1;
+ *pvsize = 1;
+ if (thing_subtag(*binary_val(real_bin)) == REFC_BINARY_SUBTAG) {
+ *csize = 0;
+ *pcsize = 0;
+ } else {
+ *csize = size;
+ *pcsize = size;
+ }
+ *total_size = size;
+ return 0;
+ }
+ }
+
+ return erts_ioq_iolist_vec_len(obj, vsize, csize,
+ pvsize, pcsize, total_size, blimit);
+}
+
+ERTS_GLB_INLINE
+int erts_ioq_iodata_to_vec(Eterm obj,
+ SysIOVec *iov,
+ ErtsIOQBinary **binv,
+ ErtsIOQBinary *cbin,
+ Uint bin_limit,
+ int driver)
+{
+ if (is_binary(obj)) {
+ Eterm real_bin;
+ byte bitoffs;
+ byte bitsize;
+ Uint offset;
+ Uint size = binary_size(obj);
+ ERTS_GET_REAL_BIN(obj, real_bin, offset, bitoffs, bitsize);
+ if (size < MAX_SYSIOVEC_IOVLEN && bitoffs == 0 && bitsize == 0) {
+ Eterm *bptr = binary_val(real_bin);
+ if (thing_subtag(*bptr) == REFC_BINARY_SUBTAG) {
+ ProcBin *pb = (ProcBin *)bptr;
+ if (pb->flags)
+ erts_emasculate_writable_binary(pb);
+ iov[0].iov_base = pb->bytes+offset;
+ iov[0].iov_len = size;
+ if (driver)
+ binv[0] = (ErtsIOQBinary*)Binary2ErlDrvBinary(pb->val);
+ else
+ binv[0] = (ErtsIOQBinary*)pb->val;
+ return 1;
+ } else {
+ ErlHeapBin* hb = (ErlHeapBin *)bptr;
+ byte *buf = driver ? (byte*)cbin->driver.orig_bytes :
+ (byte*)cbin->nif.orig_bytes;
+ copy_binary_to_buffer(buf, 0, ((byte *) hb->data)+offset, 0, 8*size);
+ iov[0].iov_base = buf;
+ iov[0].iov_len = size;
+ binv[0] = cbin;
+ return 1;
+ }
+ }
+ }
+ return erts_ioq_iolist_to_vec(obj, iov, binv, cbin, bin_limit, driver);
+}
+
+#endif
+
+#endif /* ERL_IO_QUEUE_H */
diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c
index 7e3a90779d..189c88ac4a 100644
--- a/erts/emulator/beam/erl_lock_check.c
+++ b/erts/emulator/beam/erl_lock_check.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2005-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2005-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -88,19 +89,22 @@ static erts_lc_lock_order_t erts_lock_order[] = {
{ "hipe_mfait_lock", NULL },
#endif
{ "nodes_monitors", NULL },
+#ifdef ERTS_SMP
+ { "resource_monitors", "address" },
+#endif
{ "driver_list", NULL },
{ "proc_link", "pid" },
{ "proc_msgq", "pid" },
+ { "proc_btm", "pid" },
{ "dist_entry", "address" },
{ "dist_entry_links", "address" },
{ "code_write_permission", NULL },
- { "proc_status", "pid" },
- { "ports_snapshot", NULL },
+ { "purge_state", NULL },
{ "meta_name_tab", "address" },
- { "meta_main_tab_slot", "address" },
{ "db_tab", "address" },
+ { "proc_status", "pid" },
+ { "proc_trace", "pid" },
{ "db_tab_fix", "address" },
- { "meta_main_tab_main", NULL },
{ "db_hash_slot", "address" },
{ "node_table", NULL },
{ "dist_table", NULL },
@@ -109,11 +113,9 @@ static erts_lc_lock_order_t erts_lock_order[] = {
{ "export_tab", NULL },
{ "fun_tab", NULL },
{ "environ", NULL },
+ { "release_literal_areas", 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" },
@@ -125,6 +127,8 @@ static erts_lc_lock_order_t erts_lock_order[] = {
{ "run_queue", "address" },
#ifdef ERTS_DIRTY_SCHEDULERS
{ "dirty_run_queue_sleep_list", "address" },
+ { "dirty_gc_info", NULL },
+ { "dirty_break_point_index", NULL },
#endif
{ "process_table", NULL },
{ "cpu_info", NULL },
@@ -138,38 +142,39 @@ 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
- { "sys_msg_q", NULL },
{ "atom_tab", NULL },
- { "make_ref", NULL },
{ "misc_op_list_pre_alloc_lock", "address" },
{ "message_pre_alloc_lock", "address" },
{ "ptimer_pre_alloc_lock", "address", },
{ "btm_pre_alloc_lock", NULL, },
{ "dist_entry_out_queue", "address" },
{ "port_sched_lock", "port_id" },
+ { "sys_msg_q", NULL },
+ { "tracer_mtx", NULL },
{ "port_table", NULL },
#endif
+ { "magic_ref_table", "address" },
{ "mtrace_op", NULL },
{ "instr_x", NULL },
{ "instr", NULL },
+#ifdef ERTS_SMP
+ { "pollsets_lock", NULL },
+#endif
{ "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" },
{ "xports_list_pre_alloc_lock", "address" },
{ "inet_buffer_stack_lock", NULL },
- { "gc_info", NULL },
- { "io_wake", NULL },
- { "timer_wheel", NULL },
{ "system_block", NULL },
- { "timeofday", NULL },
+ { "get_time", NULL },
+ { "get_corrected_time", NULL },
+ { "runtime", NULL },
{ "breakpoints", NULL },
- { "pollsets_lock", NULL },
{ "pix_lock", "address" },
{ "run_queues_lists", NULL },
{ "sched_stat", NULL },
@@ -184,10 +189,8 @@ static erts_lc_lock_order_t erts_lock_order[] = {
{ "efile_drv dtrace mutex", NULL },
#endif
{ "mtrace_buf", NULL },
-#ifdef __WIN32__
#ifdef ERTS_SMP
- { "sys_gethrtime", NULL },
-#endif
+ { "os_monotonic_time", NULL },
#endif
{ "erts_alloc_hard_debug", NULL },
{ "hard_dbg_mseg", NULL },
@@ -197,42 +200,20 @@ static erts_lc_lock_order_t erts_lock_order[] = {
#define ERTS_LOCK_ORDER_SIZE \
(sizeof(erts_lock_order)/sizeof(erts_lc_lock_order_t))
-#define LOCK_IS_TYPE_ORDER_VIOLATION(LCK_FLG, LCKD_FLG) \
- (((LCKD_FLG) & (ERTS_LC_FLG_LT_SPINLOCK|ERTS_LC_FLG_LT_RWSPINLOCK)) \
- && ((LCK_FLG) \
- & ERTS_LC_FLG_LT_ALL \
- & ~(ERTS_LC_FLG_LT_SPINLOCK|ERTS_LC_FLG_LT_RWSPINLOCK)))
+#define LOCK_IS_TYPE_ORDER_VIOLATION(LCK_FLG, LCKD_FLG) \
+ (((LCKD_FLG) & ERTS_LOCK_FLAGS_MASK_TYPE) == ERTS_LOCK_FLAGS_TYPE_SPINLOCK \
+ && \
+ ((LCK_FLG) & ERTS_LOCK_FLAGS_MASK_TYPE) != ERTS_LOCK_FLAGS_TYPE_SPINLOCK)
static __decl_noreturn void __noreturn lc_abort(void);
-static char *
-lock_type(Uint16 flags)
+static const char *rw_op_str(erts_lock_options_t options)
{
- switch (flags & ERTS_LC_FLG_LT_ALL) {
- case ERTS_LC_FLG_LT_SPINLOCK: return "[spinlock]";
- case ERTS_LC_FLG_LT_RWSPINLOCK: return "[rw(spin)lock]";
- case ERTS_LC_FLG_LT_MUTEX: return "[mutex]";
- case ERTS_LC_FLG_LT_RWMUTEX: return "[rwmutex]";
- case ERTS_LC_FLG_LT_PROCLOCK: return "[proclock]";
- default: return "";
+ if(options == ERTS_LOCK_OPTIONS_WRITE) {
+ ERTS_INTERNAL_ERROR("Only write flag present");
}
-}
-static char *
-rw_op_str(Uint16 flags)
-{
- switch (flags & ERTS_LC_FLG_LO_READ_WRITE) {
- case ERTS_LC_FLG_LO_READ_WRITE:
- return " (rw)";
- case ERTS_LC_FLG_LO_READ:
- return " (r)";
- case ERTS_LC_FLG_LO_WRITE:
- erts_fprintf(stderr, "\nInternal error\n");
- lc_abort();
- default:
- break;
- }
- return "";
+ return erts_lock_options_get_short_desc(options);
}
typedef struct erts_lc_locked_lock_t_ erts_lc_locked_lock_t;
@@ -243,7 +224,8 @@ struct erts_lc_locked_lock_t_ {
Sint16 id;
char *file;
unsigned int line;
- Uint16 flags;
+ erts_lock_flags_t flags;
+ erts_lock_options_t taken_options;
};
typedef struct {
@@ -270,9 +252,9 @@ union erts_lc_free_block_t_ {
static ethr_tsd_key locks_key;
-static erts_lc_locked_locks_t *erts_locked_locks;
+static erts_lc_locked_locks_t *erts_locked_locks = NULL;
-static erts_lc_free_block_t *free_blocks;
+static erts_lc_free_block_t *free_blocks = NULL;
#ifdef ERTS_LC_STATIC_ALLOC
#define ERTS_LC_FB_CHUNK_SIZE 10000
@@ -311,8 +293,7 @@ static ERTS_INLINE void lc_free(void *p)
static void *lc_core_alloc(void)
{
lc_unlock();
- erts_fprintf(stderr, "Lock checker out of memory!\n");
- lc_abort();
+ ERTS_INTERNAL_ERROR("Lock checker out of memory!\n");
}
#else
@@ -325,8 +306,7 @@ static void *lc_core_alloc(void)
fbs = (erts_lc_free_block_t *) malloc(sizeof(erts_lc_free_block_t)
* ERTS_LC_FB_CHUNK_SIZE);
if (!fbs) {
- erts_fprintf(stderr, "Lock checker failed to allocate memory!\n");
- lc_abort();
+ ERTS_INTERNAL_ERROR("Lock checker failed to allocate memory!");
}
for (i = 1; i < ERTS_LC_FB_CHUNK_SIZE - 1; i++) {
#ifdef DEBUG
@@ -366,11 +346,11 @@ create_locked_locks(char *thread_name)
{
erts_lc_locked_locks_t *l_lcks = malloc(sizeof(erts_lc_locked_locks_t));
if (!l_lcks)
- lc_abort();
+ ERTS_INTERNAL_ERROR("Lock checker failed to allocate memory!");
l_lcks->thread_name = strdup(thread_name ? thread_name : "unknown");
if (!l_lcks->thread_name)
- lc_abort();
+ ERTS_INTERNAL_ERROR("Lock checker failed to allocate memory!");
l_lcks->emu_thread = 0;
l_lcks->tid = erts_thr_self();
@@ -432,7 +412,7 @@ make_my_locked_locks(void)
}
static ERTS_INLINE erts_lc_locked_lock_t *
-new_locked_lock(erts_lc_lock_t *lck, Uint16 op_flags,
+new_locked_lock(erts_lc_lock_t *lck, erts_lock_options_t options,
char *file, unsigned int line)
{
erts_lc_locked_lock_t *l_lck = (erts_lc_locked_lock_t *) lc_alloc();
@@ -442,12 +422,13 @@ new_locked_lock(erts_lc_lock_t *lck, Uint16 op_flags,
l_lck->extra = lck->extra;
l_lck->file = file;
l_lck->line = line;
- l_lck->flags = lck->flags | op_flags;
+ l_lck->flags = lck->flags;
+ l_lck->taken_options = options;
return l_lck;
}
static void
-raw_print_lock(char *prefix, Sint16 id, Wterm extra, Uint16 flags,
+raw_print_lock(char *prefix, Sint16 id, Wterm extra, erts_lock_flags_t flags,
char* file, unsigned int line, char *suffix)
{
char *lname = (0 <= id && id < ERTS_LOCK_ORDER_SIZE
@@ -459,16 +440,16 @@ raw_print_lock(char *prefix, Sint16 id, Wterm extra, Uint16 flags,
erts_fprintf(stderr,"%p",_unchecked_boxed_val(extra));
else
erts_fprintf(stderr,"%T",extra);
- erts_fprintf(stderr,"%s",lock_type(flags));
+ erts_fprintf(stderr,"[%s]",erts_lock_flags_get_type_name(flags));
if (file)
erts_fprintf(stderr,"(%s:%d)",file,line);
- erts_fprintf(stderr,"'%s%s",rw_op_str(flags),suffix);
+ erts_fprintf(stderr,"'(%s)%s",rw_op_str(flags),suffix);
}
static void
-print_lock2(char *prefix, Sint16 id, Wterm extra, Uint16 flags, char *suffix)
+print_lock2(char *prefix, Sint16 id, Wterm extra, erts_lock_flags_t flags, char *suffix)
{
raw_print_lock(prefix, id, extra, flags, NULL, 0, suffix);
}
@@ -523,9 +504,9 @@ uninitialized_lock(void)
static void
lock_twice(char *prefix, erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck,
- Uint16 op_flags)
+ erts_lock_options_t options)
{
- erts_fprintf(stderr, "%s%s", prefix, rw_op_str(op_flags));
+ erts_fprintf(stderr, "%s (%s)", prefix, rw_op_str(options));
print_lock(" ", lck, " lock which is already locked by thread!\n");
print_curr_locks(l_lcks);
lc_abort();
@@ -533,9 +514,9 @@ lock_twice(char *prefix, erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck,
static void
unlock_op_mismatch(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck,
- Uint16 op_flags)
+ erts_lock_options_t options)
{
- erts_fprintf(stderr, "Unlocking%s ", rw_op_str(op_flags));
+ erts_fprintf(stderr, "Unlocking (%s) ", rw_op_str(options));
print_lock("", lck, " lock which mismatch previous lock operation!\n");
print_curr_locks(l_lcks);
lc_abort();
@@ -691,7 +672,7 @@ erts_lc_set_thread_name(char *thread_name)
free((void *) l_lcks->thread_name);
l_lcks->thread_name = strdup(thread_name ? thread_name : "unknown");
if (!l_lcks->thread_name)
- lc_abort();
+ ERTS_INTERNAL_ERROR("strdup failed");
}
l_lcks->emu_thread = 1;
}
@@ -746,84 +727,128 @@ erts_lc_get_lock_order_id(char *name)
return (Sint16) -1;
}
+static int compare_locked_by_id(erts_lc_locked_lock_t *locked_lock, erts_lc_lock_t *comparand)
+{
+ if(locked_lock->id < comparand->id) {
+ return -1;
+ } else if(locked_lock->id > comparand->id) {
+ return 1;
+ }
-static int
-find_lock(erts_lc_locked_lock_t **l_lcks, erts_lc_lock_t *lck)
+ return 0;
+}
+
+static int compare_locked_by_id_extra(erts_lc_locked_lock_t *locked_lock, erts_lc_lock_t *comparand)
{
- erts_lc_locked_lock_t *l_lck = *l_lcks;
+ int order = compare_locked_by_id(locked_lock, comparand);
+
+ if(order) {
+ return order;
+ } else if(locked_lock->extra < comparand->extra) {
+ return -1;
+ } else if(locked_lock->extra > comparand->extra) {
+ return 1;
+ }
- if (l_lck) {
- if (l_lck->id == lck->id && l_lck->extra == lck->extra) {
- if ((l_lck->flags & lck->flags) == lck->flags)
- return 1;
- return 0;
- }
- else if (l_lck->id < lck->id
- || (l_lck->id == lck->id
- && l_lck->extra < lck->extra)) {
- for (l_lck = l_lck->next; l_lck; l_lck = l_lck->next) {
- if (l_lck->id > lck->id
- || (l_lck->id == lck->id
- && l_lck->extra >= lck->extra)) {
- *l_lcks = l_lck;
- if (l_lck->id == lck->id
- && l_lck->extra == lck->extra
- && ((l_lck->flags & lck->flags) == lck->flags))
- return 1;
- return 0;
- }
- }
- }
- else {
- for (l_lck = l_lck->prev; l_lck; l_lck = l_lck->prev) {
- if (l_lck->id < lck->id
- || (l_lck->id == lck->id
- && l_lck->extra <= lck->extra)) {
- *l_lcks = l_lck;
- if (l_lck->id == lck->id
- && l_lck->extra == lck->extra
- && ((l_lck->flags & lck->flags) == lck->flags))
- return 1;
- return 0;
- }
- }
- }
+ return 0;
+}
+
+typedef int (*locked_compare_func)(erts_lc_locked_lock_t *, erts_lc_lock_t *);
+
+/* Searches through a list of taken locks, bailing when it hits an entry whose
+ * order relative to the search template is the opposite of the one at the
+ * start of the search. (*closest_neighbor) is either set to the exact match,
+ * or the one closest to it in the sort order. */
+static int search_locked_list(locked_compare_func compare,
+ erts_lc_locked_lock_t *locked_locks,
+ erts_lc_lock_t *search_template,
+ erts_lc_locked_lock_t **closest_neighbor)
+{
+ erts_lc_locked_lock_t *iterator = locked_locks;
+
+ (*closest_neighbor) = iterator;
+
+ if(iterator) {
+ int relative_order = compare(iterator, search_template);
+
+ if(relative_order < 0) {
+ while((iterator = iterator->next) != NULL) {
+ relative_order = compare(iterator, search_template);
+
+ if(relative_order >= 0) {
+ (*closest_neighbor) = iterator;
+ break;
+ }
+ }
+ } else if(relative_order > 0) {
+ while((iterator = iterator->prev) != NULL) {
+ relative_order = compare(iterator, search_template);
+
+ if(relative_order <= 0) {
+ (*closest_neighbor) = iterator;
+ break;
+ }
+ }
+ }
+
+ return relative_order == 0;
}
+
return 0;
}
+/* Searches for a lock in the given list that matches search_template, and sets
+ * (*locked_locks) to the closest lock in the sort order. */
static int
-find_id(erts_lc_locked_lock_t **l_lcks, Sint16 id)
-{
- erts_lc_locked_lock_t *l_lck = *l_lcks;
-
- if (l_lck) {
- if (l_lck->id == id)
- return 1;
- else if (l_lck->id < id) {
- for (l_lck = l_lck->next; l_lck; l_lck = l_lck->next) {
- if (l_lck->id >= id) {
- *l_lcks = l_lck;
- if (l_lck->id == id)
- return 1;
- return 0;
- }
- }
- }
- else {
- for (l_lck = l_lck->prev; l_lck; l_lck = l_lck->prev) {
- if (l_lck->id <= id) {
- *l_lcks = l_lck;
- if (l_lck->id == id)
- return 1;
- return 0;
- }
- }
- }
+find_lock(erts_lc_locked_lock_t **locked_locks, erts_lc_lock_t *search_template)
+{
+ erts_lc_locked_lock_t *closest_neighbor;
+ int found_lock;
+
+ found_lock = search_locked_list(compare_locked_by_id_extra,
+ (*locked_locks),
+ search_template,
+ &closest_neighbor);
+
+ (*locked_locks) = closest_neighbor;
+
+ if(found_lock) {
+ erts_lock_options_t relevant_options;
+ erts_lock_flags_t relevant_flags;
+
+ /* We only care about the options and flags that are set in the
+ * template. */
+ relevant_options = (closest_neighbor->taken_options & search_template->taken_options);
+ relevant_flags = (closest_neighbor->flags & search_template->flags);
+
+ return search_template->taken_options == relevant_options &&
+ search_template->flags == relevant_flags;
}
+
return 0;
}
+/* Searches for a lock in the given list by id, and sets (*locked_locks) to the
+ * closest lock in the sort order. */
+static int
+find_id(erts_lc_locked_lock_t **locked_locks, Sint16 id)
+{
+ erts_lc_locked_lock_t *closest_neighbor;
+ erts_lc_lock_t search_template;
+ int found_lock;
+
+ search_template.id = id;
+
+ found_lock = search_locked_list(compare_locked_by_id,
+ (*locked_locks),
+ &search_template,
+ &closest_neighbor);
+
+ (*locked_locks) = closest_neighbor;
+
+ return found_lock;
+}
+
void
erts_lc_have_locks(int *resv, erts_lc_lock_t *locks, int len)
{
@@ -919,17 +944,17 @@ erts_lc_check_exact(erts_lc_lock_t *have, int have_len)
}
void
-erts_lc_check_no_locked_of_type(Uint16 flags)
+erts_lc_check_no_locked_of_type(erts_lock_flags_t type)
{
erts_lc_locked_locks_t *l_lcks = get_my_locked_locks();
if (l_lcks) {
erts_lc_locked_lock_t *l_lck = l_lcks->locked.first;
for (l_lck = l_lcks->locked.first; l_lck; l_lck = l_lck->next) {
- if (l_lck->flags & flags) {
+ if ((l_lck->flags & ERTS_LOCK_FLAGS_MASK_TYPE) == type) {
erts_fprintf(stderr,
"Locked lock of type %s found which isn't "
"allowed here!\n",
- lock_type(l_lck->flags));
+ erts_lock_flags_get_type_name(l_lck->flags));
print_curr_locks(l_lcks);
lc_abort();
}
@@ -938,7 +963,7 @@ erts_lc_check_no_locked_of_type(Uint16 flags)
}
int
-erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, Uint16 op_flags)
+erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, erts_lock_options_t options)
{
#ifdef ERTS_LC_DO_NOT_FORCE_BUSY_TRYLOCK_ON_LOCK_ORDER_VIOLATION
return 0;
@@ -987,7 +1012,7 @@ erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, Uint16 op_flags)
if (tl_lck->id < lck->id
|| (tl_lck->id == lck->id && tl_lck->extra <= lck->extra)) {
if (tl_lck->id == lck->id && tl_lck->extra == lck->extra)
- lock_twice("Trylocking", l_lcks, lck, op_flags);
+ lock_twice("Trylocking", l_lcks, lck, options);
break;
}
}
@@ -1009,7 +1034,7 @@ erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, Uint16 op_flags)
#endif
}
-void erts_lc_trylock_flg_x(int locked, erts_lc_lock_t *lck, Uint16 op_flags,
+void erts_lc_trylock_flg_x(int locked, erts_lc_lock_t *lck, erts_lock_options_t options,
char *file, unsigned int line)
{
erts_lc_locked_locks_t *l_lcks;
@@ -1022,7 +1047,7 @@ void erts_lc_trylock_flg_x(int locked, erts_lc_lock_t *lck, Uint16 op_flags,
return;
l_lcks = make_my_locked_locks();
- l_lck = locked ? new_locked_lock(lck, op_flags, file, line) : NULL;
+ l_lck = locked ? new_locked_lock(lck, options, file, line) : NULL;
if (!l_lcks->locked.last) {
ASSERT(!l_lcks->locked.first);
@@ -1040,7 +1065,7 @@ void erts_lc_trylock_flg_x(int locked, erts_lc_lock_t *lck, Uint16 op_flags,
if (tl_lck->id < lck->id
|| (tl_lck->id == lck->id && tl_lck->extra <= lck->extra)) {
if (tl_lck->id == lck->id && tl_lck->extra == lck->extra)
- lock_twice("Trylocking", l_lcks, lck, op_flags);
+ lock_twice("Trylocking", l_lcks, lck, options);
if (locked) {
l_lck->next = tl_lck->next;
l_lck->prev = tl_lck;
@@ -1063,14 +1088,14 @@ void erts_lc_trylock_flg_x(int locked, erts_lc_lock_t *lck, Uint16 op_flags,
}
-void erts_lc_require_lock_flg(erts_lc_lock_t *lck, Uint16 op_flags,
+void erts_lc_require_lock_flg(erts_lc_lock_t *lck, erts_lock_options_t options,
char *file, unsigned int line)
{
erts_lc_locked_locks_t *l_lcks = make_my_locked_locks();
erts_lc_locked_lock_t *l_lck = l_lcks->locked.first;
if (!find_lock(&l_lck, lck))
required_not_locked(l_lcks, lck);
- l_lck = new_locked_lock(lck, op_flags, file, line);
+ l_lck = new_locked_lock(lck, options, file, line);
if (!l_lcks->required.last) {
ASSERT(!l_lcks->required.first);
l_lck->next = l_lck->prev = NULL;
@@ -1110,7 +1135,7 @@ void erts_lc_require_lock_flg(erts_lc_lock_t *lck, Uint16 op_flags,
}
}
-void erts_lc_unrequire_lock_flg(erts_lc_lock_t *lck, Uint16 op_flags)
+void erts_lc_unrequire_lock_flg(erts_lc_lock_t *lck, erts_lock_options_t options)
{
erts_lc_locked_locks_t *l_lcks = make_my_locked_locks();
erts_lc_locked_lock_t *l_lck = l_lcks->locked.first;
@@ -1138,7 +1163,7 @@ void erts_lc_unrequire_lock_flg(erts_lc_lock_t *lck, Uint16 op_flags)
lc_free((void *) l_lck);
}
-void erts_lc_lock_flg_x(erts_lc_lock_t *lck, Uint16 op_flags,
+void erts_lc_lock_flg_x(erts_lc_lock_t *lck, erts_lock_options_t options,
char *file, unsigned int line)
{
erts_lc_locked_locks_t *l_lcks;
@@ -1151,7 +1176,7 @@ void erts_lc_lock_flg_x(erts_lc_lock_t *lck, Uint16 op_flags,
return;
l_lcks = make_my_locked_locks();
- l_lck = new_locked_lock(lck, op_flags, file, line);
+ l_lck = new_locked_lock(lck, options, file, line);
if (!l_lcks->locked.last) {
ASSERT(!l_lcks->locked.first);
@@ -1167,12 +1192,12 @@ void erts_lc_lock_flg_x(erts_lc_lock_t *lck, Uint16 op_flags,
l_lcks->locked.last = l_lck;
}
else if (l_lcks->locked.last->id == lck->id && l_lcks->locked.last->extra == lck->extra)
- lock_twice("Locking", l_lcks, lck, op_flags);
+ lock_twice("Locking", l_lcks, lck, options);
else
lock_order_violation(l_lcks, lck);
}
-void erts_lc_unlock_flg(erts_lc_lock_t *lck, Uint16 op_flags)
+void erts_lc_unlock_flg(erts_lc_lock_t *lck, erts_lock_options_t options)
{
erts_lc_locked_locks_t *l_lcks;
erts_lc_locked_lock_t *l_lck;
@@ -1193,8 +1218,8 @@ void erts_lc_unlock_flg(erts_lc_lock_t *lck, Uint16 op_flags)
for (l_lck = l_lcks ? l_lcks->locked.last : NULL; l_lck; l_lck = l_lck->prev) {
if (l_lck->id == lck->id && l_lck->extra == lck->extra) {
- if ((l_lck->flags & ERTS_LC_FLG_LO_ALL) != op_flags)
- unlock_op_mismatch(l_lcks, lck, op_flags);
+ if ((l_lck->taken_options & ERTS_LOCK_OPTIONS_RDWR) != options)
+ unlock_op_mismatch(l_lcks, lck, options);
if (l_lck->prev)
l_lck->prev->next = l_lck->next;
else
@@ -1211,7 +1236,7 @@ void erts_lc_unlock_flg(erts_lc_lock_t *lck, Uint16 op_flags)
unlock_of_not_locked(l_lcks, lck);
}
-void erts_lc_might_unlock_flg(erts_lc_lock_t *lck, Uint16 op_flags)
+void erts_lc_might_unlock_flg(erts_lc_lock_t *lck, erts_lock_options_t options)
{
erts_lc_locked_locks_t *l_lcks;
erts_lc_locked_lock_t *l_lck;
@@ -1275,23 +1300,25 @@ void erts_lc_unrequire_lock(erts_lc_lock_t *lck)
}
void
-erts_lc_init_lock(erts_lc_lock_t *lck, char *name, Uint16 flags)
+erts_lc_init_lock(erts_lc_lock_t *lck, char *name, erts_lock_flags_t flags)
{
lck->id = erts_lc_get_lock_order_id(name);
lck->extra = (UWord) &lck->extra;
ASSERT(is_not_immed(lck->extra));
lck->flags = flags;
+ lck->taken_options = 0;
lck->inited = ERTS_LC_INITITALIZED;
}
void
-erts_lc_init_lock_x(erts_lc_lock_t *lck, char *name, Uint16 flags, Eterm extra)
+erts_lc_init_lock_x(erts_lc_lock_t *lck, char *name, erts_lock_flags_t flags, Eterm extra)
{
lck->id = erts_lc_get_lock_order_id(name);
lck->extra = extra;
ASSERT(is_immed(lck->extra));
lck->flags = flags;
+ lck->taken_options = 0;
lck->inited = ERTS_LC_INITITALIZED;
}
@@ -1305,6 +1332,7 @@ erts_lc_destroy_lock(erts_lc_lock_t *lck)
lck->id = -1;
lck->extra = THE_NON_VALUE;
lck->flags = 0;
+ lck->taken_options = 0;
}
void
@@ -1330,7 +1358,7 @@ erts_lc_init(void)
#endif /* #ifdef ERTS_LC_STATIC_ALLOC */
if (ethr_spinlock_init(&free_blocks_lock) != 0)
- lc_abort();
+ ERTS_INTERNAL_ERROR("spinlock_init failed");
erts_tsd_key_create(&locks_key,"erts_lock_check_key");
}
diff --git a/erts/emulator/beam/erl_lock_check.h b/erts/emulator/beam/erl_lock_check.h
index 3f7f417e61..8c754a8dfa 100644
--- a/erts/emulator/beam/erl_lock_check.h
+++ b/erts/emulator/beam/erl_lock_check.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2005-2012. All Rights Reserved.
+ * Copyright Ericsson AB 2005-2016. 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.
+ * 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%
*/
@@ -35,6 +36,8 @@
#ifdef ERTS_ENABLE_LOCK_CHECK
+#include "erl_lock_flags.h"
+
#ifndef ERTS_ENABLE_LOCK_POSITION
/* Enable in order for _x variants of mtx functions to be used. */
#define ERTS_ENABLE_LOCK_POSITION 1
@@ -43,36 +46,14 @@
typedef struct {
int inited;
Sint16 id;
- Uint16 flags;
+ erts_lock_flags_t flags;
+ erts_lock_options_t taken_options;
UWord extra;
} erts_lc_lock_t;
#define ERTS_LC_INITITALIZED 0x7f7f7f7f
-
-#define ERTS_LC_FLG_LT_SPINLOCK (((Uint16) 1) << 0)
-#define ERTS_LC_FLG_LT_RWSPINLOCK (((Uint16) 1) << 1)
-#define ERTS_LC_FLG_LT_MUTEX (((Uint16) 1) << 2)
-#define ERTS_LC_FLG_LT_RWMUTEX (((Uint16) 1) << 3)
-#define ERTS_LC_FLG_LT_PROCLOCK (((Uint16) 1) << 4)
-
-#define ERTS_LC_FLG_LO_READ (((Uint16) 1) << 5)
-#define ERTS_LC_FLG_LO_WRITE (((Uint16) 1) << 6)
-
-#define ERTS_LC_FLG_LO_READ_WRITE (ERTS_LC_FLG_LO_READ \
- | ERTS_LC_FLG_LO_WRITE)
-
-#define ERTS_LC_FLG_LT_ALL (ERTS_LC_FLG_LT_SPINLOCK \
- | ERTS_LC_FLG_LT_RWSPINLOCK \
- | ERTS_LC_FLG_LT_MUTEX \
- | ERTS_LC_FLG_LT_RWMUTEX \
- | ERTS_LC_FLG_LT_PROCLOCK)
-
-#define ERTS_LC_FLG_LO_ALL (ERTS_LC_FLG_LO_READ \
- | ERTS_LC_FLG_LO_WRITE)
-
-
-#define ERTS_LC_LOCK_INIT(ID, X, F) {ERTS_LC_INITITALIZED, (ID), (F), (X)}
+#define ERTS_LC_LOCK_INIT(ID, X, F) {ERTS_LC_INITITALIZED, (ID), (F), 0, (X)}
void erts_lc_init(void);
void erts_lc_late_init(void);
@@ -82,31 +63,31 @@ void erts_lc_check(erts_lc_lock_t *have, int have_len,
void erts_lc_check_exact(erts_lc_lock_t *have, int have_len);
void erts_lc_have_locks(int *resv, erts_lc_lock_t *lcks, int len);
void erts_lc_have_lock_ids(int *resv, int *ids, int len);
-void erts_lc_check_no_locked_of_type(Uint16 flags);
-int erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, Uint16 op_flags);
-void erts_lc_trylock_flg_x(int locked, erts_lc_lock_t *lck, Uint16 op_flags,
+void erts_lc_check_no_locked_of_type(erts_lock_flags_t flags);
+int erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, erts_lock_options_t options);
+void erts_lc_trylock_flg_x(int locked, erts_lc_lock_t *lck, erts_lock_options_t options,
char *file, unsigned int line);
-void erts_lc_lock_flg_x(erts_lc_lock_t *lck, Uint16 op_flags,
+void erts_lc_lock_flg_x(erts_lc_lock_t *lck, erts_lock_options_t options,
char *file, unsigned int line);
-void erts_lc_unlock_flg(erts_lc_lock_t *lck, Uint16 op_flags);
-void erts_lc_might_unlock_flg(erts_lc_lock_t *lck, Uint16 op_flags);
+void erts_lc_unlock_flg(erts_lc_lock_t *lck, erts_lock_options_t options);
+void erts_lc_might_unlock_flg(erts_lc_lock_t *lck, erts_lock_options_t options);
int erts_lc_trylock_force_busy(erts_lc_lock_t *lck);
void erts_lc_trylock_x(int locked, erts_lc_lock_t *lck,
char* file, unsigned int line);
void erts_lc_lock_x(erts_lc_lock_t *lck, char* file, unsigned int line);
void erts_lc_unlock(erts_lc_lock_t *lck);
void erts_lc_might_unlock(erts_lc_lock_t *lck);
-void erts_lc_init_lock(erts_lc_lock_t *lck, char *name, Uint16 flags);
-void erts_lc_init_lock_x(erts_lc_lock_t *lck, char *name, Uint16 flags, Eterm extra);
+void erts_lc_init_lock(erts_lc_lock_t *lck, char *name, erts_lock_flags_t flags);
+void erts_lc_init_lock_x(erts_lc_lock_t *lck, char *name, erts_lock_flags_t flags, Eterm extra);
void erts_lc_destroy_lock(erts_lc_lock_t *lck);
void erts_lc_fail(char *fmt, ...);
int erts_lc_assert_failed(char *file, int line, char *assertion);
void erts_lc_set_thread_name(char *thread_name);
void erts_lc_pll(void);
-void erts_lc_require_lock_flg(erts_lc_lock_t *lck, Uint16 op_flags,
+void erts_lc_require_lock_flg(erts_lc_lock_t *lck, erts_lock_options_t options,
char *file, unsigned int line);
-void erts_lc_unrequire_lock_flg(erts_lc_lock_t *lck, Uint16 op_flags);
+void erts_lc_unrequire_lock_flg(erts_lc_lock_t *lck, erts_lock_options_t options);
void erts_lc_require_lock(erts_lc_lock_t *lck, char *file, unsigned int line);
void erts_lc_unrequire_lock(erts_lc_lock_t *lck);
diff --git a/erts/emulator/beam/erl_lock_count.c b/erts/emulator/beam/erl_lock_count.c
index 6f44bf097b..d2e8f47d59 100644
--- a/erts/emulator/beam/erl_lock_count.c
+++ b/erts/emulator/beam/erl_lock_count.c
@@ -1,676 +1,681 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2008-2012. All Rights Reserved.
+ * Copyright Ericsson AB 2008-2017. 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/.
+ * 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
*
- * 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.
+ * http://www.apache.org/licenses/LICENSE-2.0
*
- * %CopyrightEnd%
- */
-
-/*
- * Description: Statistics for locks.
+ * 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.
*
- * Author: Bj�rn-Egil Dahlberg
- * Date: 2008-07-03
+ * %CopyrightEnd%
*/
#ifdef HAVE_CONFIG_H
# include "config.h"
#endif
-/* Needed for VxWorks va_arg */
+#ifdef ERTS_ENABLE_LOCK_COUNT
+
#include "sys.h"
-#ifdef ERTS_ENABLE_LOCK_COUNT
+#include "global.h"
#include "erl_lock_count.h"
-#include "ethread.h"
-#include "erl_term.h"
-#include "atom.h"
-#include <stdio.h>
+#include "erl_thr_progress.h"
+
+#include "erl_node_tables.h"
+#include "erl_alloc_util.h"
+#include "erl_check_io.h"
+#include "erl_poll.h"
+#include "erl_db.h"
-/* globals, dont access these without locks or blocks */
+#define LCNT_MAX_CARRIER_ENTRIES 255
-ethr_mutex lcnt_data_lock;
-erts_lcnt_data_t *erts_lcnt_data;
-Uint16 erts_lcnt_rt_options;
-erts_lcnt_time_t timer_start;
-const char *str_undefined = "undefined";
+/* - Locals that are shared with the header implementation - */
+
+#ifdef DEBUG
+int lcnt_initialization_completed__;
+#endif
-static ethr_tsd_key lcnt_thr_data_key;
-static int lcnt_n_thr;
-static erts_lcnt_thread_data_t *lcnt_thread_data[4096];
+erts_lock_flags_t lcnt_category_mask__;
+ethr_tsd_key lcnt_thr_data_key__;
+
+const int lcnt_log2_tab64__[64] = {
+ 63, 0, 58, 1, 59, 47, 53, 2,
+ 60, 39, 48, 27, 54, 33, 42, 3,
+ 61, 51, 37, 40, 49, 18, 28, 20,
+ 55, 30, 34, 11, 43, 14, 22, 4,
+ 62, 57, 46, 52, 38, 26, 32, 41,
+ 50, 36, 17, 19, 29, 10, 13, 21,
+ 56, 45, 25, 31, 35, 16, 9, 12,
+ 44, 24, 15, 8, 23, 7, 6, 5};
+
+/* - Local variables - */
+
+typedef struct lcnt_static_lock_ref_ {
+ erts_lcnt_ref_t *reference;
+
+ erts_lock_flags_t flags;
+ const char *name;
+ Eterm id;
+
+ struct lcnt_static_lock_ref_ *next;
+} lcnt_static_lock_ref_t;
+
+static ethr_atomic_t lcnt_static_lock_registry;
+
+static erts_lcnt_lock_info_list_t lcnt_current_lock_list;
+static erts_lcnt_lock_info_list_t lcnt_deleted_lock_list;
+
+static erts_lcnt_time_t lcnt_timer_start;
+
+static int lcnt_preserve_info;
/* local functions */
-static ERTS_INLINE void lcnt_lock(void) {
- ethr_mutex_lock(&lcnt_data_lock);
-}
+static void lcnt_clear_stats(erts_lcnt_lock_info_t *info) {
+ size_t i;
-static ERTS_INLINE void lcnt_unlock(void) {
- ethr_mutex_unlock(&lcnt_data_lock);
-}
+ for(i = 0; i < ERTS_LCNT_MAX_LOCK_LOCATIONS; i++) {
+ erts_lcnt_lock_stats_t *stats = &info->location_stats[i];
+ sys_memzero(&stats->wait_time_histogram, sizeof(stats->wait_time_histogram));
-static char* lcnt_lock_type(Uint16 flag) {
- switch(flag & ERTS_LCNT_LT_ALL) {
- case ERTS_LCNT_LT_SPINLOCK: return "spinlock";
- case ERTS_LCNT_LT_RWSPINLOCK: return "rw_spinlock";
- case ERTS_LCNT_LT_MUTEX: return "mutex";
- case ERTS_LCNT_LT_RWMUTEX: return "rw_mutex";
- case ERTS_LCNT_LT_PROCLOCK: return "proclock";
- default: return "";
- }
-}
+ stats->total_time_waited.s = 0;
+ stats->total_time_waited.ns = 0;
-static void lcnt_clear_stats(erts_lcnt_lock_stats_t *stats) {
- ethr_atomic_set(&stats->tries, 0);
- ethr_atomic_set(&stats->colls, 0);
- stats->timer.s = 0;
- stats->timer.ns = 0;
- stats->timer_n = 0;
- stats->file = (char *)str_undefined;
- stats->line = 0;
-}
-
-static void lcnt_time(erts_lcnt_time_t *time) {
-#ifdef HAVE_GETHRTIME
- SysHrTime hr_time;
- hr_time = sys_gethrtime();
- time->s = (unsigned long)(hr_time / 1000000000LL);
- time->ns = (unsigned long)(hr_time - 1000000000LL*time->s);
-#else
- SysTimeval tv;
- sys_gettimeofday(&tv);
- time->s = tv.tv_sec;
- time->ns = tv.tv_usec*1000LL;
-#endif
-}
+ stats->times_waited = 0;
+
+ stats->file = NULL;
+ stats->line = 0;
-static void lcnt_time_diff(erts_lcnt_time_t *d, erts_lcnt_time_t *t1, erts_lcnt_time_t *t0) {
- long ds;
- long dns;
-
- ds = t1->s - t0->s;
- dns = t1->ns - t0->ns;
-
- /* the difference should not be able to get bigger than 1 sec in ns*/
-
- if (dns < 0) {
- ds -= 1;
- dns += 1000000000LL;
+ ethr_atomic_set(&stats->attempts, 0);
+ ethr_atomic_set(&stats->collisions, 0);
}
- d->s = ds;
- d->ns = dns;
+ info->location_count = 1;
}
-/* difference d must be positive */
-
-static void lcnt_time_add(erts_lcnt_time_t *t, erts_lcnt_time_t *d) {
- unsigned long ngns = 0;
-
- t->s += d->s;
- t->ns += d->ns;
+static lcnt_thread_data_t__ *lcnt_thread_data_alloc(void) {
+ lcnt_thread_data_t__ *eltd =
+ (lcnt_thread_data_t__*)malloc(sizeof(lcnt_thread_data_t__));
- ngns = t->ns / 1000000000LL;
- t->ns = t->ns % 1000000000LL;
-
- t->s += ngns;
-}
+ if(!eltd) {
+ ERTS_INTERNAL_ERROR("Failed to allocate lcnt thread data.");
+ }
-static erts_lcnt_thread_data_t *lcnt_thread_data_alloc(void) {
- erts_lcnt_thread_data_t *eltd;
-
- eltd = (erts_lcnt_thread_data_t*)malloc(sizeof(erts_lcnt_thread_data_t));
eltd->timer_set = 0;
eltd->lock_in_conflict = 0;
- eltd->id = lcnt_n_thr++;
- /* set thread data to array */
- lcnt_thread_data[eltd->id] = eltd;
-
return eltd;
-}
-
-static erts_lcnt_thread_data_t *lcnt_get_thread_data(void) {
- return (erts_lcnt_thread_data_t *)ethr_tsd_get(lcnt_thr_data_key);
}
+/* - List operations -
+ *
+ * Info entries are kept in a doubly linked list where each entry is locked
+ * with its neighbors rather than a global lock. Deletion is rather quick, but
+ * insertion is still serial since the head becomes a de facto global lock.
+ *
+ * We rely on ad-hoc spinlocks to avoid "recursing" into this module. */
-/* debug */
+#define LCNT_SPINLOCK_YIELD_ITERATIONS 50
-#if 0
-static char* lock_opt(Uint16 flag) {
- if ((flag & ERTS_LCNT_LO_WRITE) && (flag & ERTS_LCNT_LO_READ)) return "rw";
- if (flag & ERTS_LCNT_LO_READ ) return "r ";
- if (flag & ERTS_LCNT_LO_WRITE) return " w";
- return "--";
+#define LCNT_SPINLOCK_HELPER_INIT \
+ Uint failed_spin_count = 0;
+
+#define LCNT_SPINLOCK_HELPER_YIELD \
+ do { \
+ failed_spin_count++; \
+ if(!(failed_spin_count % LCNT_SPINLOCK_YIELD_ITERATIONS)) { \
+ erts_thr_yield(); \
+ } else { \
+ ERTS_SPIN_BODY; \
+ } \
+ } while(0)
+
+static void lcnt_unlock_list_entry(erts_lcnt_lock_info_t *info) {
+ ethr_atomic32_set_relb(&info->lock, 0);
}
-static void print_lock_x(erts_lcnt_lock_t *lock, Uint16 flag, char *action, char *extra) {
- erts_aint_t colls, tries, w_state, r_state;
- erts_lcnt_lock_stats_t *stats = NULL;
-
- char *type;
- int i;
-
- type = lcnt_lock_type(lock->flag);
- r_state = ethr_atomic_read(&lock->r_state);
- w_state = ethr_atomic_read(&lock->w_state);
-
-
- if (lock->flag & flag) {
- erts_printf("%20s [%30s] [r/w state %4ld/%4ld] id %T %s\r\n",
- action,
- lock->name,
- r_state,
- w_state,
- lock->id,
- extra);
- }
+static int lcnt_try_lock_list_entry(erts_lcnt_lock_info_t *info) {
+ return ethr_atomic32_cmpxchg_acqb(&info->lock, 1, 0) == 0;
}
-static void print_lock(erts_lcnt_lock_t *lock, char *action) {
- if (strcmp(lock->name, "proc_main") == 0) {
- print_lock_x(lock, ERTS_LCNT_LT_ALL, action, "");
+static void lcnt_lock_list_entry(erts_lcnt_lock_info_t *info) {
+ LCNT_SPINLOCK_HELPER_INIT;
+
+ while(!lcnt_try_lock_list_entry(info)) {
+ LCNT_SPINLOCK_HELPER_YIELD;
}
}
-#endif
+static void lcnt_lock_list_entry_with_neighbors(erts_lcnt_lock_info_t *info) {
+ LCNT_SPINLOCK_HELPER_INIT;
-static erts_lcnt_lock_stats_t *lcnt_get_lock_stats(erts_lcnt_lock_t *lock, char *file, unsigned int line) {
- unsigned int i;
- erts_lcnt_lock_stats_t *stats = NULL;
-
- for (i = 0; i < lock->n_stats; i++) {
- if ((lock->stats[i].file == file) && (lock->stats[i].line == line)) {
- return &(lock->stats[i]);
- }
- }
- if (lock->n_stats < ERTS_LCNT_MAX_LOCK_LOCATIONS) {
- stats = &lock->stats[lock->n_stats];
- lock->n_stats++;
+ for(;;) {
+ if(!lcnt_try_lock_list_entry(info))
+ goto retry_after_entry_failed;
+ if(!lcnt_try_lock_list_entry(info->next))
+ goto retry_after_next_failed;
+ if(!lcnt_try_lock_list_entry(info->prev))
+ goto retry_after_prev_failed;
+
+ return;
- stats->file = file;
- stats->line = line;
- return stats;
+ retry_after_prev_failed:
+ lcnt_unlock_list_entry(info->next);
+ retry_after_next_failed:
+ lcnt_unlock_list_entry(info);
+ retry_after_entry_failed:
+ LCNT_SPINLOCK_HELPER_YIELD;
}
- return &lock->stats[0];
+}
+static void lcnt_unlock_list_entry_with_neighbors(erts_lcnt_lock_info_t *info) {
+ lcnt_unlock_list_entry(info->prev);
+ lcnt_unlock_list_entry(info->next);
+ lcnt_unlock_list_entry(info);
}
-static void lcnt_update_stats(erts_lcnt_lock_stats_t *stats, int lock_in_conflict, erts_lcnt_time_t *time_wait) {
-
- ethr_atomic_inc(&stats->tries);
+static void lcnt_insert_list_entry(erts_lcnt_lock_info_list_t *list, erts_lcnt_lock_info_t *info) {
+ erts_lcnt_lock_info_t *next, *prev;
- if (lock_in_conflict)
- ethr_atomic_inc(&stats->colls);
+ prev = &list->head;
- if (time_wait) {
- lcnt_time_add(&(stats->timer), time_wait);
- stats->timer_n++;
- }
+ lcnt_lock_list_entry(prev);
+
+ next = prev->next;
+
+ lcnt_lock_list_entry(next);
+
+ info->next = next;
+ info->prev = prev;
+
+ prev->next = info;
+ next->prev = info;
+
+ lcnt_unlock_list_entry(next);
+ lcnt_unlock_list_entry(prev);
}
-/*
- * interface
- */
+static void lcnt_insert_list_carrier(erts_lcnt_lock_info_list_t *list,
+ erts_lcnt_lock_info_carrier_t *carrier) {
+ erts_lcnt_lock_info_t *next, *prev;
+ size_t i;
+
+ for(i = 0; i < carrier->entry_count; i++) {
+ erts_lcnt_lock_info_t *info = &carrier->entries[i];
-void erts_lcnt_init() {
- erts_lcnt_thread_data_t *eltd = NULL;
-
- /* init lock */
- if (ethr_mutex_init(&lcnt_data_lock) != 0) abort();
+ info->prev = &carrier->entries[i - 1];
+ info->next = &carrier->entries[i + 1];
+ }
- /* init tsd */
- lcnt_n_thr = 0;
+ prev = &list->head;
- ethr_tsd_key_create(&lcnt_thr_data_key,"lcnt_data");
+ lcnt_lock_list_entry(prev);
- lcnt_lock();
+ next = prev->next;
- erts_lcnt_rt_options = ERTS_LCNT_OPT_PROCLOCK | ERTS_LCNT_OPT_LOCATION;
-
- eltd = lcnt_thread_data_alloc();
+ lcnt_lock_list_entry(next);
- ethr_tsd_set(lcnt_thr_data_key, eltd);
-
- /* init lcnt structure */
- erts_lcnt_data = (erts_lcnt_data_t*)malloc(sizeof(erts_lcnt_data_t));
- erts_lcnt_data->current_locks = erts_lcnt_list_init();
- erts_lcnt_data->deleted_locks = erts_lcnt_list_init();
+ next->prev = &carrier->entries[carrier->entry_count - 1];
+ carrier->entries[carrier->entry_count - 1].next = next;
- lcnt_unlock();
+ prev->next = &carrier->entries[0];
+ carrier->entries[0].prev = prev;
- /* set start timer and zero statistics */
- erts_lcnt_clear_counters();
+ lcnt_unlock_list_entry(next);
+ lcnt_unlock_list_entry(prev);
}
-void erts_lcnt_late_init() {
- erts_thr_install_exit_handler(erts_lcnt_thread_exit_handler);
+static void lcnt_init_list(erts_lcnt_lock_info_list_t *list) {
+ /* Ensure that ref_count operations explode when touching the sentinels in
+ * DEBUG mode. */
+ ethr_atomic_init(&(list->head.ref_count), -1);
+ ethr_atomic_init(&(list->tail.ref_count), -1);
+
+ ethr_atomic32_init(&(list->head.lock), 0);
+ (list->head).next = &list->tail;
+ (list->head).prev = &list->tail;
+
+ ethr_atomic32_init(&(list->tail.lock), 0);
+ (list->tail).next = &list->head;
+ (list->tail).prev = &list->head;
}
-/* list operations */
+/* - Carrier operations - */
-/* BEGIN ASSUMPTION: lcnt_data_lock taken */
+int lcnt_thr_progress_unmanaged_delay__(void) {
+ return erts_thr_progress_unmanaged_delay();
+}
+
+void lcnt_thr_progress_unmanaged_continue__(int handle) {
+ return erts_thr_progress_unmanaged_continue(handle);
+}
-erts_lcnt_lock_list_t *erts_lcnt_list_init(void) {
- erts_lcnt_lock_list_t *list;
-
- list = (erts_lcnt_lock_list_t*)malloc(sizeof(erts_lcnt_lock_list_t));
- list->head = NULL;
- list->tail = NULL;
- list->n = 0;
- return list;
+void lcnt_deallocate_carrier__(erts_lcnt_lock_info_carrier_t *carrier) {
+ ASSERT(ethr_atomic_read(&carrier->ref_count) == 0);
+ erts_free(ERTS_ALC_T_LCNT_CARRIER, (void*)carrier);
}
-/* only do this on the list with the deleted locks! */
-void erts_lcnt_list_clear(erts_lcnt_lock_list_t *list) {
- erts_lcnt_lock_t *lock = NULL,
- *next = NULL;
+static void lcnt_thr_prg_cleanup_carrier(void *data) {
+ erts_lcnt_lock_info_carrier_t *carrier = data;
+ size_t entry_count, i;
- lock = list->head;
-
- while(lock != NULL) {
- next = lock->next;
- free(lock);
- lock = next;
+ /* carrier->entry_count will be replaced with garbage if it's deallocated
+ * on the final iteration, so we'll tuck it away to get a clean exit. */
+ entry_count = carrier->entry_count;
+
+ for(i = 0; i < entry_count; i++) {
+ ASSERT(ethr_atomic_read(&carrier->ref_count) >= (entry_count - i));
+
+ erts_lcnt_release_lock_info(&carrier->entries[i]);
}
+}
+
+static void lcnt_schedule_carrier_cleanup(void *data) {
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
+
+ /* We can't issue cleanup jobs on anything other than normal schedulers, so
+ * we move to the first scheduler if required. */
+
+ if(!esdp || esdp->type != ERTS_SCHED_NORMAL) {
+ erts_schedule_misc_aux_work(1, &lcnt_schedule_carrier_cleanup, data);
+ } else {
+ erts_lcnt_lock_info_carrier_t *carrier = data;
+ size_t carrier_size;
+
+ carrier_size = sizeof(erts_lcnt_lock_info_carrier_t) +
+ sizeof(erts_lcnt_lock_info_t) * carrier->entry_count;
- list->head = NULL;
- list->tail = NULL;
- list->n = 0;
+ erts_schedule_thr_prgr_later_cleanup_op(&lcnt_thr_prg_cleanup_carrier,
+ data, (ErtsThrPrgrLaterOp*)&carrier->release_entries, carrier_size);
+ }
+}
+
+static void lcnt_info_deallocate(erts_lcnt_lock_info_t *info) {
+ lcnt_release_carrier__(info->carrier);
}
-void erts_lcnt_list_insert(erts_lcnt_lock_list_t *list, erts_lcnt_lock_t *lock) {
- erts_lcnt_lock_t *tail = NULL;
+static void lcnt_info_dispose(erts_lcnt_lock_info_t *info) {
+ ASSERT(ethr_atomic_read(&info->ref_count) == 0);
- tail = list->tail;
- if (tail) {
- tail->next = lock;
- lock->prev = tail;
+ if(lcnt_preserve_info) {
+ ethr_atomic_set(&info->ref_count, 1);
+
+ /* Move straight to deallocation the next time around. */
+ info->dispose = &lcnt_info_deallocate;
+
+ lcnt_insert_list_entry(&lcnt_deleted_lock_list, info);
} else {
- list->head = lock;
- lock->prev = NULL;
- ASSERT(!lock->next);
+ lcnt_info_deallocate(info);
}
- lock->next = NULL;
- list->tail = lock;
-
- list->n++;
}
-void erts_lcnt_list_delete(erts_lcnt_lock_list_t *list, erts_lcnt_lock_t *lock) {
+static void lcnt_lock_info_init_helper(erts_lcnt_lock_info_t *info) {
+ ethr_atomic_init(&info->ref_count, 1);
+ ethr_atomic32_init(&info->lock, 0);
+
+ ethr_atomic_init(&info->r_state, 0);
+ ethr_atomic_init(&info->w_state, 0);
- if (lock->next) lock->next->prev = lock->prev;
- if (lock->prev) lock->prev->next = lock->next;
- if (list->head == lock) list->head = lock->next;
- if (list->tail == lock) list->tail = lock->prev;
-
- lock->prev = NULL;
- lock->next = NULL;
- list->n--;
+ info->dispose = &lcnt_info_dispose;
+
+ lcnt_clear_stats(info);
}
-/* END ASSUMPTION: lcnt_data_lock taken */
+erts_lcnt_lock_info_carrier_t *erts_lcnt_create_lock_info_carrier(int entry_count) {
+ erts_lcnt_lock_info_carrier_t *result;
+ size_t carrier_size, i;
+
+ ASSERT(entry_count > 0 && entry_count <= LCNT_MAX_CARRIER_ENTRIES);
+ ASSERT(lcnt_initialization_completed__);
+
+ carrier_size = sizeof(erts_lcnt_lock_info_carrier_t) +
+ sizeof(erts_lcnt_lock_info_t) * entry_count;
+
+ result = (erts_lcnt_lock_info_carrier_t*)erts_alloc(ERTS_ALC_T_LCNT_CARRIER, carrier_size);
+ result->entry_count = entry_count;
+
+ ethr_atomic_init(&result->ref_count, entry_count);
-/* lock operations */
+ for(i = 0; i < entry_count; i++) {
+ erts_lcnt_lock_info_t *info = &result->entries[i];
-/* interface to erl_threads.h */
-/* only lock on init and destroy, all others should use atomics */
-void erts_lcnt_init_lock(erts_lcnt_lock_t *lock, char *name, Uint16 flag ) {
- erts_lcnt_init_lock_x(lock, name, flag, am_undefined);
+ lcnt_lock_info_init_helper(info);
+
+ info->carrier = result;
+ }
+
+ return result;
}
-void erts_lcnt_init_lock_x(erts_lcnt_lock_t *lock, char *name, Uint16 flag, Eterm id) {
+
+void erts_lcnt_install(erts_lcnt_ref_t *ref, erts_lcnt_lock_info_carrier_t *carrier) {
+ ethr_sint_t swapped_carrier;
+
+#ifdef DEBUG
int i;
- if (!name) {
- lock->flag = 0;
- return;
+
+ /* Verify that all locks share the same categories/static property; all
+ * other flags are fair game. */
+ for(i = 1; i < carrier->entry_count; i++) {
+ const erts_lock_flags_t SIGNIFICANT_DIFF_MASK =
+ ERTS_LOCK_FLAGS_MASK_CATEGORY | ERTS_LOCK_FLAGS_PROPERTY_STATIC;
+
+ erts_lcnt_lock_info_t *previous, *current;
+
+ previous = &carrier->entries[i - 1];
+ current = &carrier->entries[i];
+
+ ASSERT(!((previous->flags ^ current->flags) & SIGNIFICANT_DIFF_MASK));
}
- lcnt_lock();
-
- lock->next = NULL;
- lock->prev = NULL;
- lock->flag = flag;
- lock->name = name;
- lock->id = id;
+#endif
+
+ swapped_carrier = ethr_atomic_cmpxchg_mb(ref, (ethr_sint_t)carrier, (ethr_sint_t)NULL);
- ethr_atomic_init(&lock->r_state, 0);
- ethr_atomic_init(&lock->w_state, 0);
-
+ if(swapped_carrier != (ethr_sint_t)NULL) {
#ifdef DEBUG
- ethr_atomic_init(&lock->flowstate, 0);
+ ASSERT(ethr_atomic_read(&carrier->ref_count) == carrier->entry_count);
+ ethr_atomic_set(&carrier->ref_count, 0);
#endif
-
- lock->n_stats = 1;
- for (i = 0; i < ERTS_LCNT_MAX_LOCK_LOCATIONS; i++) {
- lcnt_clear_stats(&lock->stats[i]);
+ lcnt_deallocate_carrier__(carrier);
+ } else {
+ lcnt_insert_list_carrier(&lcnt_current_lock_list, carrier);
}
+}
+
+void erts_lcnt_uninstall(erts_lcnt_ref_t *ref) {
+ ethr_sint_t previous_carrier, swapped_carrier;
+
+ previous_carrier = ethr_atomic_read(ref);
+ swapped_carrier = ethr_atomic_cmpxchg_mb(ref, (ethr_sint_t)NULL, previous_carrier);
- erts_lcnt_list_insert(erts_lcnt_data->current_locks, lock);
-
- lcnt_unlock();
+ if(previous_carrier && previous_carrier == swapped_carrier) {
+ lcnt_schedule_carrier_cleanup((void*)previous_carrier);
+ }
}
-void erts_lcnt_destroy_lock(erts_lcnt_lock_t *lock) {
- erts_lcnt_lock_t *deleted_lock;
+/* - Static lock registry -
+ *
+ * Since static locks can be trusted to never disappear, we can track them
+ * pretty cheaply and won't need to bother writing an "erts_lcnt_update_xx"
+ * variant. */
- if (!ERTS_LCNT_LOCK_TYPE(lock)) return;
+static void lcnt_init_static_lock_registry(void) {
+ ethr_atomic_init(&lcnt_static_lock_registry, (ethr_sint_t)NULL);
+}
- lcnt_lock();
+static void lcnt_update_static_locks(void) {
+ lcnt_static_lock_ref_t *iterator =
+ (lcnt_static_lock_ref_t*)ethr_atomic_read(&lcnt_static_lock_registry);
- if (erts_lcnt_rt_options & ERTS_LCNT_OPT_COPYSAVE) {
- /* copy structure and insert the copy */
+ while(iterator != NULL) {
+ if(!erts_lcnt_check_enabled(iterator->flags)) {
+ erts_lcnt_uninstall(iterator->reference);
+ } else if(!erts_lcnt_check_ref_installed(iterator->reference)) {
+ erts_lcnt_lock_info_carrier_t *carrier = erts_lcnt_create_lock_info_carrier(1);
- deleted_lock = (erts_lcnt_lock_t*)malloc(sizeof(erts_lcnt_lock_t));
- memcpy(deleted_lock, lock, sizeof(erts_lcnt_lock_t));
+ erts_lcnt_init_lock_info_idx(carrier, 0, iterator->name, iterator->id, iterator->flags);
- deleted_lock->next = NULL;
- deleted_lock->prev = NULL;
+ erts_lcnt_install(iterator->reference, carrier);
+ }
- erts_lcnt_list_insert(erts_lcnt_data->deleted_locks, deleted_lock);
+ iterator = iterator->next;
}
- /* delete original */
- erts_lcnt_list_delete(erts_lcnt_data->current_locks, lock);
- lock->flag = 0;
-
- lcnt_unlock();
}
-/* lock */
+void lcnt_register_static_lock__(erts_lcnt_ref_t *reference, const char *name, Eterm id,
+ erts_lock_flags_t flags) {
+ lcnt_static_lock_ref_t *lock = malloc(sizeof(lcnt_static_lock_ref_t));
+ int retry_insertion;
-void erts_lcnt_lock_opt(erts_lcnt_lock_t *lock, Uint16 option) {
- erts_aint_t r_state = 0, w_state = 0;
- erts_lcnt_thread_data_t *eltd;
-
- if (erts_lcnt_rt_options & ERTS_LCNT_OPT_SUSPEND) return;
- if (!ERTS_LCNT_LOCK_TYPE(lock)) return;
+ ASSERT(flags & ERTS_LOCK_FLAGS_PROPERTY_STATIC);
- eltd = lcnt_get_thread_data();
+ lock->reference = reference;
+ lock->flags = flags;
+ lock->name = name;
+ lock->id = id;
- ASSERT(eltd);
-
- w_state = ethr_atomic_read(&lock->w_state);
-
- if (option & ERTS_LCNT_LO_WRITE) {
- r_state = ethr_atomic_read(&lock->r_state);
- ethr_atomic_inc( &lock->w_state);
- }
- if (option & ERTS_LCNT_LO_READ) {
- ethr_atomic_inc( &lock->r_state);
- }
-
- /* we cannot acquire w_lock if either w or r are taken */
- /* we cannot acquire r_lock if w_lock is taken */
-
- if ((w_state > 0) || (r_state > 0)) {
- eltd->lock_in_conflict = 1;
- if (eltd->timer_set == 0)
- lcnt_time(&eltd->timer);
- eltd->timer_set++;
- } else {
- eltd->lock_in_conflict = 0;
- }
-}
+ do {
+ ethr_sint_t swapped_head;
-void erts_lcnt_lock(erts_lcnt_lock_t *lock) {
- erts_aint_t w_state;
- erts_lcnt_thread_data_t *eltd;
-
- if (erts_lcnt_rt_options & ERTS_LCNT_OPT_SUSPEND) return;
- if (!ERTS_LCNT_LOCK_TYPE(lock)) return;
+ lock->next = (lcnt_static_lock_ref_t*)ethr_atomic_read(&lcnt_static_lock_registry);
- w_state = ethr_atomic_read(&lock->w_state);
- ethr_atomic_inc( &lock->w_state);
+ swapped_head = ethr_atomic_cmpxchg_acqb(
+ &lcnt_static_lock_registry,
+ (ethr_sint_t)lock,
+ (ethr_sint_t)lock->next);
- eltd = lcnt_get_thread_data();
+ retry_insertion = (swapped_head != (ethr_sint_t)lock->next);
+ } while(retry_insertion);
+}
- ASSERT(eltd);
+/* - Initialization - */
- if (w_state > 0) {
- eltd->lock_in_conflict = 1;
- /* only set the timer if nobody else has it
- * This should only happen when proc_locks aquires several locks
- * 'atomicly'. All other locks will block the thread if w_state > 0
- * i.e. locked.
- */
- if (eltd->timer_set == 0)
- lcnt_time(&eltd->timer);
- eltd->timer_set++;
+void erts_lcnt_pre_thr_init() {
+ /* Ensure that the dependency hack mentioned in the header doesn't
+ * explode at runtime. */
+ ERTS_CT_ASSERT(sizeof(LcntThrPrgrLaterOp) >= sizeof(ErtsThrPrgrLaterOp));
+ ERTS_CT_ASSERT(ERTS_THR_PRGR_DHANDLE_MANAGED ==
+ (ErtsThrPrgrDelayHandle)LCNT_THR_PRGR_DHANDLE_MANAGED);
- } else {
- eltd->lock_in_conflict = 0;
- }
+ lcnt_init_list(&lcnt_current_lock_list);
+ lcnt_init_list(&lcnt_deleted_lock_list);
+
+ lcnt_init_static_lock_registry();
}
-/* if a lock wasn't really a lock operation, bad bad process locks */
+void erts_lcnt_post_thr_init() {
+ /* ASSUMPTION: this is safe since it runs prior to the creation of other
+ * threads (Directly after ethread init). */
-void erts_lcnt_lock_unaquire(erts_lcnt_lock_t *lock) {
- /* should check if this thread was "waiting" */
-
- if (erts_lcnt_rt_options & ERTS_LCNT_OPT_SUSPEND) return;
- if (!ERTS_LCNT_LOCK_TYPE(lock)) return;
+ ethr_tsd_key_create(&lcnt_thr_data_key__, "lcnt_data");
- ethr_atomic_dec( &lock->w_state);
+ erts_lcnt_thread_setup();
}
-/* erts_lcnt_lock_post
- * used when we get a lock (i.e. directly after a lock operation)
- * if the timer was set then we had to wait for the lock
- * lock_post will calculate the wait time.
- */
-void erts_lcnt_lock_post(erts_lcnt_lock_t *lock) {
- erts_lcnt_lock_post_x(lock, (char*)str_undefined, 0);
-}
+void erts_lcnt_late_init() {
+ /* Set start timer and zero all statistics */
+ erts_lcnt_clear_counters();
+ erts_thr_install_exit_handler(erts_lcnt_thread_exit_handler);
-void erts_lcnt_lock_post_x(erts_lcnt_lock_t *lock, char *file, unsigned int line) {
- erts_lcnt_thread_data_t *eltd;
- erts_lcnt_time_t timer;
- erts_lcnt_time_t time_wait;
- erts_lcnt_lock_stats_t *stats;
#ifdef DEBUG
- erts_aint_t flowstate;
+ /* It's safe to use erts_alloc and thread progress past this point. */
+ lcnt_initialization_completed__ = 1;
#endif
+}
- if (erts_lcnt_rt_options & ERTS_LCNT_OPT_SUSPEND) return;
- if (!ERTS_LCNT_LOCK_TYPE(lock)) return;
-
-#ifdef DEBUG
- if (!(lock->flag & (ERTS_LCNT_LT_RWMUTEX | ERTS_LCNT_LT_RWSPINLOCK))) {
- flowstate = ethr_atomic_read(&lock->flowstate);
- ASSERT(flowstate == 0);
- ethr_atomic_inc( &lock->flowstate);
- }
-#endif
-
- eltd = lcnt_get_thread_data();
-
- ASSERT(eltd);
+void erts_lcnt_post_startup(void) {
+ /* Default to capturing everything to match the behavior of the old lock
+ * counter build. */
+ erts_lcnt_set_category_mask(ERTS_LOCK_FLAGS_MASK_CATEGORY);
+}
- /* if lock was in conflict, time it */
-
- if (erts_lcnt_rt_options & ERTS_LCNT_OPT_LOCATION) {
- stats = lcnt_get_lock_stats(lock, file, line);
- } else {
- stats = &lock->stats[0];
- }
+void erts_lcnt_thread_setup() {
+ lcnt_thread_data_t__ *eltd = lcnt_thread_data_alloc();
- if (eltd->timer_set) {
- lcnt_time(&timer);
-
- lcnt_time_diff(&time_wait, &timer, &(eltd->timer));
- lcnt_update_stats(stats, eltd->lock_in_conflict, &time_wait);
-
- eltd->timer_set--;
- ASSERT(eltd->timer_set >= 0);
- } else {
- lcnt_update_stats(stats, eltd->lock_in_conflict, NULL);
- }
+ ASSERT(eltd);
+ ethr_tsd_set(lcnt_thr_data_key__, eltd);
}
-/* unlock */
+void erts_lcnt_thread_exit_handler() {
+ lcnt_thread_data_t__ *eltd = lcnt_get_thread_data__();
-void erts_lcnt_unlock_opt(erts_lcnt_lock_t *lock, Uint16 option) {
- if (erts_lcnt_rt_options & ERTS_LCNT_OPT_SUSPEND) return;
- if (!ERTS_LCNT_LOCK_TYPE(lock)) return;
- if (option & ERTS_LCNT_LO_WRITE) ethr_atomic_dec(&lock->w_state);
- if (option & ERTS_LCNT_LO_READ ) ethr_atomic_dec(&lock->r_state);
+ if (eltd) {
+ free(eltd);
+ }
}
-void erts_lcnt_unlock(erts_lcnt_lock_t *lock) {
-#ifdef DEBUG
- erts_aint_t w_state;
- erts_aint_t flowstate;
-#endif
- if (erts_lcnt_rt_options & ERTS_LCNT_OPT_SUSPEND) return;
- if (!ERTS_LCNT_LOCK_TYPE(lock)) return;
+/* - BIF interface - */
+
+void erts_lcnt_retain_lock_info(erts_lcnt_lock_info_t *info) {
#ifdef DEBUG
- /* flowstate */
- flowstate = ethr_atomic_read(&lock->flowstate);
- ASSERT(flowstate == 1);
- ethr_atomic_dec( &lock->flowstate);
-
- /* write state */
- w_state = ethr_atomic_read(&lock->w_state);
- ASSERT(w_state > 0)
+ ASSERT(ethr_atomic_inc_read_acqb(&info->ref_count) >= 2);
+#else
+ ethr_atomic_inc_acqb(&info->ref_count);
#endif
- ethr_atomic_dec(&lock->w_state);
}
-/* trylock */
+void erts_lcnt_release_lock_info(erts_lcnt_lock_info_t *info) {
+ ethr_sint_t count;
+
+ /* We need to acquire the lock before decrementing ref_count to avoid
+ * racing with list iteration; there's a short window between reading the
+ * reference to info and increasing its ref_count. */
+ lcnt_lock_list_entry_with_neighbors(info);
-void erts_lcnt_trylock_opt(erts_lcnt_lock_t *lock, int res, Uint16 option) {
- if (erts_lcnt_rt_options & ERTS_LCNT_OPT_SUSPEND) return;
- if (!ERTS_LCNT_LOCK_TYPE(lock)) return;
- /* Determine lock_state via res instead of state */
- if (res != EBUSY) {
- if (option & ERTS_LCNT_LO_WRITE) ethr_atomic_inc(&lock->w_state);
- if (option & ERTS_LCNT_LO_READ ) ethr_atomic_inc(&lock->r_state);
- lcnt_update_stats(&(lock->stats[0]), 0, NULL);
+ count = ethr_atomic_dec_read(&info->ref_count);
+
+ ASSERT(count >= 0);
+
+ if(count > 0) {
+ lcnt_unlock_list_entry_with_neighbors(info);
} else {
- ethr_atomic_inc(&lock->stats[0].tries);
- ethr_atomic_inc(&lock->stats[0].colls);
+ (info->next)->prev = info->prev;
+ (info->prev)->next = info->next;
+
+ lcnt_unlock_list_entry_with_neighbors(info);
+
+ info->dispose(info);
}
}
-
-void erts_lcnt_trylock(erts_lcnt_lock_t *lock, int res) {
- /* Determine lock_state via res instead of state */
-#ifdef DEBUG
- erts_aint_t flowstate;
-#endif
- if (erts_lcnt_rt_options & ERTS_LCNT_OPT_SUSPEND) return;
- if (!ERTS_LCNT_LOCK_TYPE(lock)) return;
- if (res != EBUSY) {
-
-#ifdef DEBUG
- flowstate = ethr_atomic_read(&lock->flowstate);
- ASSERT(flowstate == 0);
- ethr_atomic_inc( &lock->flowstate);
+erts_lock_flags_t erts_lcnt_get_category_mask() {
+ return lcnt_category_mask__;
+}
+
+#ifdef ERTS_ENABLE_KERNEL_POLL
+/* erl_poll/erl_check_io only exports one of these variants at a time, and we
+ * may need to use either one depending on emulator startup flags. */
+void erts_lcnt_update_pollset_locks_nkp(int);
+void erts_lcnt_update_pollset_locks_kp(int);
+
+void erts_lcnt_update_cio_locks_nkp(int);
+void erts_lcnt_update_cio_locks_kp(int);
#endif
- ethr_atomic_inc(&lock->w_state);
-
- lcnt_update_stats(&(lock->stats[0]), 0, NULL);
- } else {
- ethr_atomic_inc(&lock->stats[0].tries);
- ethr_atomic_inc(&lock->stats[0].colls);
+void erts_lcnt_set_category_mask(erts_lock_flags_t mask) {
+ erts_lock_flags_t changed_categories;
+
+ ASSERT(!(mask & ~ERTS_LOCK_FLAGS_MASK_CATEGORY));
+ ASSERT(lcnt_initialization_completed__);
+
+ changed_categories = (lcnt_category_mask__ ^ mask);
+ lcnt_category_mask__ = mask;
+
+ if(changed_categories) {
+ lcnt_update_static_locks();
}
-}
-/* thread operations */
+ if(changed_categories & ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION) {
+ erts_lcnt_update_distribution_locks(mask & ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
+ }
-void erts_lcnt_thread_setup(void) {
- erts_lcnt_thread_data_t *eltd;
+ if(changed_categories & ERTS_LOCK_FLAGS_CATEGORY_ALLOCATOR) {
+ erts_lcnt_update_allocator_locks(mask & ERTS_LOCK_FLAGS_CATEGORY_ALLOCATOR);
+ }
- lcnt_lock();
- /* lock for thread id global update */
- eltd = lcnt_thread_data_alloc();
- lcnt_unlock();
- ASSERT(eltd);
- ethr_tsd_set(lcnt_thr_data_key, eltd);
-}
+ if(changed_categories & ERTS_LOCK_FLAGS_CATEGORY_PROCESS) {
+ erts_lcnt_update_process_locks(mask & ERTS_LOCK_FLAGS_CATEGORY_PROCESS);
+ }
-void erts_lcnt_thread_exit_handler() {
- erts_lcnt_thread_data_t *eltd;
+ if(changed_categories & ERTS_LOCK_FLAGS_CATEGORY_IO) {
+#ifdef ERTS_ENABLE_KERNEL_POLL
+ if(erts_use_kernel_poll) {
+ erts_lcnt_update_pollset_locks_kp(mask & ERTS_LOCK_FLAGS_CATEGORY_IO);
+ erts_lcnt_update_cio_locks_kp(mask & ERTS_LOCK_FLAGS_CATEGORY_IO);
+ } else {
+ erts_lcnt_update_pollset_locks_nkp(mask & ERTS_LOCK_FLAGS_CATEGORY_IO);
+ erts_lcnt_update_cio_locks_nkp(mask & ERTS_LOCK_FLAGS_CATEGORY_IO);
+ }
+#else
+ erts_lcnt_update_pollset_locks(mask & ERTS_LOCK_FLAGS_CATEGORY_IO);
+ erts_lcnt_update_cio_locks(mask & ERTS_LOCK_FLAGS_CATEGORY_IO);
+#endif
- eltd = ethr_tsd_get(lcnt_thr_data_key);
+ erts_lcnt_update_driver_locks(mask & ERTS_LOCK_FLAGS_CATEGORY_IO);
+ erts_lcnt_update_port_locks(mask & ERTS_LOCK_FLAGS_CATEGORY_IO);
+ }
- if (eltd) {
- free(eltd);
+ if(changed_categories & ERTS_LOCK_FLAGS_CATEGORY_DB) {
+ erts_lcnt_update_db_locks(mask & ERTS_LOCK_FLAGS_CATEGORY_DB);
}
}
-/* bindings for bifs */
-
-Uint16 erts_lcnt_set_rt_opt(Uint16 opt) {
- Uint16 prev;
- prev = (erts_lcnt_rt_options & opt);
- erts_lcnt_rt_options |= opt;
- return prev;
+void erts_lcnt_set_preserve_info(int enable) {
+ lcnt_preserve_info = enable;
}
-Uint16 erts_lcnt_clear_rt_opt(Uint16 opt) {
- Uint16 prev;
- prev = (erts_lcnt_rt_options & opt);
- erts_lcnt_rt_options &= ~opt;
- return prev;
+int erts_lcnt_get_preserve_info() {
+ return lcnt_preserve_info;
}
void erts_lcnt_clear_counters(void) {
- erts_lcnt_lock_t *lock;
- erts_lcnt_lock_list_t *list;
- erts_lcnt_lock_stats_t *stats;
- int i;
+ erts_lcnt_lock_info_t *iterator;
- lcnt_lock();
+ lcnt_time__(&lcnt_timer_start);
- list = erts_lcnt_data->current_locks;
-
- for (lock = list->head; lock != NULL; lock = lock->next) {
- for( i = 0; i < ERTS_LCNT_MAX_LOCK_LOCATIONS; i++) {
- stats = &lock->stats[i];
- lcnt_clear_stats(stats);
- }
- lock->n_stats = 1;
+ iterator = NULL;
+ while(erts_lcnt_iterate_list(&lcnt_current_lock_list, &iterator)) {
+ lcnt_clear_stats(iterator);
}
- /* empty deleted locks in lock list */
- erts_lcnt_list_clear(erts_lcnt_data->deleted_locks);
-
- lcnt_time(&timer_start);
-
- lcnt_unlock();
+ iterator = NULL;
+ while(erts_lcnt_iterate_list(&lcnt_deleted_lock_list, &iterator)) {
+ erts_lcnt_release_lock_info(iterator);
+ }
}
-erts_lcnt_data_t *erts_lcnt_get_data(void) {
+erts_lcnt_data_t erts_lcnt_get_data(void) {
erts_lcnt_time_t timer_stop;
-
- lcnt_lock();
-
- lcnt_time(&timer_stop);
- lcnt_time_diff(&(erts_lcnt_data->duration), &timer_stop, &timer_start);
-
- lcnt_unlock();
-
- return erts_lcnt_data;
+ erts_lcnt_data_t result;
+
+ lcnt_time__(&timer_stop);
+
+ result.timer_start = lcnt_timer_start;
+
+ result.current_locks = &lcnt_current_lock_list;
+ result.deleted_locks = &lcnt_deleted_lock_list;
+
+ lcnt_time_diff__(&result.duration, &timer_stop, &result.timer_start);
+
+ return result;
}
-char *erts_lcnt_lock_type(Uint16 type) {
- return lcnt_lock_type(type);
+int erts_lcnt_iterate_list(erts_lcnt_lock_info_list_t *list, erts_lcnt_lock_info_t **iterator) {
+ erts_lcnt_lock_info_t *current, *next;
+
+ current = *iterator ? *iterator : &list->head;
+
+ ASSERT(current != &list->tail);
+
+ lcnt_lock_list_entry(current);
+
+ next = current->next;
+
+ if(next != &list->tail) {
+ erts_lcnt_retain_lock_info(next);
+ }
+
+ lcnt_unlock_list_entry(current);
+
+ if(current != &list->head) {
+ erts_lcnt_release_lock_info(current);
+ }
+
+ *iterator = next;
+
+ return next != &list->tail;
}
-#endif /* ifdef ERTS_ENABLE_LOCK_COUNT */
+#endif /* #ifdef ERTS_ENABLE_LOCK_COUNT */
diff --git a/erts/emulator/beam/erl_lock_count.h b/erts/emulator/beam/erl_lock_count.h
index 75f7cd028b..89d95a73cf 100644
--- a/erts/emulator/beam/erl_lock_count.h
+++ b/erts/emulator/beam/erl_lock_count.h
@@ -1,214 +1,928 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2008-2012. All Rights Reserved.
+ * Copyright Ericsson AB 2008-2017. 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/.
+ * 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
*
- * 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.
+ * 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: Statistics for locks.
- *
- * Author: Bj�rn-Egil Dahlberg
- * Date: 2008-07-03
- * Abstract:
- * Locks statistics internal representation.
- *
- * Conceptual representation,
- * - set name
- * | - id (the unique lock)
- * | | - lock type
- * | | - statistics
- * | | | - location (file and line number)
- * | | | - tries
- * | | | - collisions (including trylock busy)
- * | | | - timer (time spent in waiting for lock)
- * | | | - n_timer (collisions excluding trylock busy)
- *
- * Each instance of a lock is the unique lock, i.e. set and id in that set.
- * For each lock there is a set of statistics with where and what impact
- * the lock aqusition had.
- *
- * Runtime options
- * - suspend, used when internal lock-counting can't be applied. For instance
- * when allocating a term for the outside and halloc needs to be used.
- * Default: off.
- * - location, reserved and not used.
- * - proclock, disable proclock counting. Used when performance might be an
- * issue. Accessible from erts_debug:lock_counters({process_locks, bool()}).
- * Default: off.
- * - copysave, enable saving of destroyed locks (and thereby its statistics).
- * If memory constraints is an issue this need to be disabled.
- * Accessible from erts_debug:lock_counters({copy_save, bool()}).
- * Default: off.
+/**
+ * @description Statistics for locks.
+ * @file erl_lock_count.h
+ *
+ * @author Björn-Egil Dahlberg
+ * @author John Högberg
*
+ * Conceptual representation:
+ *
+ * - set name
+ * | - id (the unique lock)
+ * | | - lock type
+ * | | - statistics
+ * | | | - location (file and line number)
+ * | | | - attempts
+ * | | | - collisions (including trylock busy)
+ * | | | - timer (time spent in waiting for lock)
+ * | | | - n_timer (collisions excluding trylock busy)
+ * | | | - histogram
+ * | | | | - # 0 = log2(lock wait_time ns)
+ * | | | | - ...
+ * | | | | - # n = log2(lock wait_time ns)
+ *
+ * Each instance of a lock is the unique lock, i.e. set and id in that set.
+ * For each lock there is a set of statistics with where and what impact
+ * the lock acquisition had.
*/
-#include "sys.h"
-
#ifndef ERTS_LOCK_COUNT_H__
#define ERTS_LOCK_COUNT_H__
#ifdef ERTS_ENABLE_LOCK_COUNT
#ifndef ERTS_ENABLE_LOCK_POSITION
-/* Enable in order for _x variants of mtx functions to be used. */
+/** @brief Controls whether _x variants of mtx functions are used. */
#define ERTS_ENABLE_LOCK_POSITION 1
#endif
+#include "sys.h"
#include "ethread.h"
+#include "erl_term.h"
+#include "erl_lock_flags.h"
-#define ERTS_LCNT_MAX_LOCK_LOCATIONS (10)
-
-#define ERTS_LCNT_LT_SPINLOCK (((Uint16) 1) << 0)
-#define ERTS_LCNT_LT_RWSPINLOCK (((Uint16) 1) << 1)
-#define ERTS_LCNT_LT_MUTEX (((Uint16) 1) << 2)
-#define ERTS_LCNT_LT_RWMUTEX (((Uint16) 1) << 3)
-#define ERTS_LCNT_LT_PROCLOCK (((Uint16) 1) << 4)
-#define ERTS_LCNT_LT_ALLOC (((Uint16) 1) << 5)
-
-#define ERTS_LCNT_LO_READ (((Uint16) 1) << 6)
-#define ERTS_LCNT_LO_WRITE (((Uint16) 1) << 7)
-
-#define ERTS_LCNT_LO_READ_WRITE ( ERTS_LCNT_LO_READ \
- | ERTS_LCNT_LO_WRITE )
+#define ERTS_LCNT_MAX_LOCK_LOCATIONS (5)
-#define ERTS_LCNT_LT_ALL ( ERTS_LCNT_LT_SPINLOCK \
- | ERTS_LCNT_LT_RWSPINLOCK \
- | ERTS_LCNT_LT_MUTEX \
- | ERTS_LCNT_LT_RWMUTEX \
- | ERTS_LCNT_LT_PROCLOCK )
-/* runtime options */
-
-#define ERTS_LCNT_OPT_SUSPEND (((Uint16) 1) << 0)
-#define ERTS_LCNT_OPT_LOCATION (((Uint16) 1) << 1)
-#define ERTS_LCNT_OPT_PROCLOCK (((Uint16) 1) << 2)
-#define ERTS_LCNT_OPT_COPYSAVE (((Uint16) 1) << 3)
-#define ERTS_LCNT_OPT_PORTLOCK (((Uint16) 1) << 4)
+#define ERTS_LCNT_HISTOGRAM_MAX_NS (((unsigned long)1LL << 28) - 1)
+#if 0 || defined(ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT)
+#define ERTS_LCNT_HISTOGRAM_SLOT_SIZE (30)
+#define ERTS_LCNT_HISTOGRAM_RSHIFT (0)
+#else
+#define ERTS_LCNT_HISTOGRAM_SLOT_SIZE (20)
+#define ERTS_LCNT_HISTOGRAM_RSHIFT (10)
+#endif
typedef struct {
unsigned long s;
unsigned long ns;
} erts_lcnt_time_t;
-
-extern erts_lcnt_time_t timer_start;
-typedef struct erts_lcnt_lock_stats_s {
- /* "tries" and "colls" needs to be atomic since
- * trylock busy does not aquire a lock and there
- * is no post action to rectify the situation
- */
+typedef struct {
+ /* @brief log2 array of nano seconds occurences */
+ Uint32 ns[ERTS_LCNT_HISTOGRAM_SLOT_SIZE];
+} erts_lcnt_hist_t;
+
+typedef struct {
+ /** @brief In which file the lock was taken. May be NULL. */
+ const char *file;
+ /** @brief Line number in \c file */
+ unsigned int line;
- char *file; /* which file the lock was taken */
- unsigned int line; /* line number in file */
-
- ethr_atomic_t tries; /* n tries to get lock */
- ethr_atomic_t colls; /* n collisions of tries to get lock */
-
- unsigned long timer_n; /* #times waited for lock */
- erts_lcnt_time_t timer; /* total wait time for lock */
+ /* "attempts" and "collisions" need to be atomic since try_lock busy does
+ * not acquire a lock and there is no post action to rectify the
+ * situation. */
+
+ ethr_atomic_t attempts;
+ ethr_atomic_t collisions;
+
+ erts_lcnt_time_t total_time_waited;
+ Uint64 times_waited;
+
+ erts_lcnt_hist_t wait_time_histogram;
} erts_lcnt_lock_stats_t;
-/* rw locks uses both states, other locks only uses w_state */
-typedef struct erts_lcnt_lock_s {
- char *name; /* lock name */
- Uint16 flag; /* lock type */
- Eterm id; /* id if possible */
+typedef struct lcnt_lock_info_t_ {
+ erts_lock_flags_t flags;
+ const char *name;
+ /** @brief Id if possible, must be an immediate */
+ Eterm id;
-#ifdef DEBUG
- ethr_atomic_t flowstate;
-#endif
+ /* The first entry is reserved as a fallback for when location information
+ * is missing, and when the lock is used in more than (MAX_LOCK_LOCATIONS
+ * - 1) different places. */
+ erts_lcnt_lock_stats_t location_stats[ERTS_LCNT_MAX_LOCK_LOCATIONS];
+ unsigned int location_count;
- /* lock states */
- ethr_atomic_t w_state; /* 0 not taken, otherwise n threads waiting */
- ethr_atomic_t r_state; /* 0 not taken, > 0 -> writes will wait */
+ /* -- Everything below is internal to this module ---------------------- */
- /* statistics */
- unsigned int n_stats;
- erts_lcnt_lock_stats_t stats[ERTS_LCNT_MAX_LOCK_LOCATIONS]; /* first entry is "undefined"*/
-
- /* chains for list handling */
- /* data is hold by lcnt_lock */
- struct erts_lcnt_lock_s *prev;
- struct erts_lcnt_lock_s *next;
-} erts_lcnt_lock_t;
+ /* Lock states; rw locks uses both states, other locks only uses w_state */
-typedef struct {
- erts_lcnt_lock_t *head;
- erts_lcnt_lock_t *tail;
- unsigned long n;
-} erts_lcnt_lock_list_t;
-
-typedef struct {
- erts_lcnt_time_t duration; /* time since last clear */
- erts_lcnt_lock_list_t *current_locks;
- erts_lcnt_lock_list_t *deleted_locks;
-} erts_lcnt_data_t;
+ /** @brief Write state. 0 = not taken, otherwise n threads waiting */
+ ethr_atomic_t w_state;
+ /** @brief Read state. 0 = not taken, > 0 -> writes will wait */
+ ethr_atomic_t r_state;
+
+ struct lcnt_lock_info_t_ *prev;
+ struct lcnt_lock_info_t_ *next;
+
+ /** @brief Used in place of erts_refc_t to avoid a circular dependency. */
+ ethr_atomic_t ref_count;
+ ethr_atomic32_t lock;
+
+ /** @brief Deletion hook called once \c ref_count reaches 0; may defer
+ * deletion by modifying \c ref_count. */
+ void (*dispose)(struct lcnt_lock_info_t_ *);
+
+ struct lcnt_lock_info_carrier_ *carrier;
+} erts_lcnt_lock_info_t;
+
+typedef struct lcnt_lock_info_list_ {
+ erts_lcnt_lock_info_t head;
+ erts_lcnt_lock_info_t tail;
+} erts_lcnt_lock_info_list_t;
typedef struct {
- int id;
+ erts_lcnt_time_t timer_start; /**< Time of last clear */
+ erts_lcnt_time_t duration; /**< Time since last clear */
- erts_lcnt_time_t timer; /* timer */
- int timer_set; /* bool */
- int lock_in_conflict; /* bool */
-} erts_lcnt_thread_data_t;
+ erts_lcnt_lock_info_list_t *current_locks;
+ erts_lcnt_lock_info_list_t *deleted_locks;
+} erts_lcnt_data_t;
-/* globals */
+typedef struct lcnt_lock_info_carrier_ erts_lcnt_lock_info_carrier_t;
-extern Uint16 erts_lcnt_rt_options;
+typedef ethr_atomic_t erts_lcnt_ref_t;
-/* function declerations */
+/* -- Globals -------------------------------------------------------------- */
-void erts_lcnt_init(void);
+/** @brief Checks whether counting is enabled for any of the given
+ * categories. */
+#define erts_lcnt_check_enabled(flags) \
+ (lcnt_category_mask__ & flags)
+
+/* -- Lock operations ------------------------------------------------------
+ *
+ * All of these will nop if there's nothing "installed" on the given reference,
+ * in order to transparently support enable/disable at runtime. */
+
+/** @brief Records that a lock is being acquired. */
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_lock(erts_lcnt_ref_t *ref);
+
+/** @copydoc erts_lcnt_lock
+ * @param option Notes whether the lock is a read or write lock. */
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_lock_opt(erts_lcnt_ref_t *ref, erts_lock_options_t option);
+
+/** @brief Records that a lock has been acquired. */
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_lock_post(erts_lcnt_ref_t *ref);
+
+/** @copydoc erts_lcnt_lock_post.
+ * @param file The name of the file where the lock was acquired.
+ * @param line The line at which the lock was acquired. */
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_lock_post_x(erts_lcnt_ref_t *ref, char *file, unsigned int line);
+
+/** @brief Records that a lock has been released. */
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_unlock(erts_lcnt_ref_t *ref);
+
+/** @copydoc erts_lcnt_unlock_opt
+ * @param option Whether the lock is a read or write lock. */
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_unlock_opt(erts_lcnt_ref_t *ref, erts_lock_options_t option);
+
+/** @brief Rectifies the case where a lock wasn't actually a lock operation.
+ *
+ * Only used for process locks at the moment. */
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_lock_unacquire(erts_lcnt_ref_t *ref);
+
+/** @brief Records the result of a trylock, placing the queried lock status in
+ * \c result. */
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_trylock(erts_lcnt_ref_t *ref, int result);
+
+/** @copydoc erts_lcnt_trylock
+ * @param option Whether the lock is a read or write lock. */
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_trylock_opt(erts_lcnt_ref_t *ref, int result, erts_lock_options_t option);
+
+/* Indexed variants of the standard lock operations, for use when a single
+ * reference contains many counters (eg. process locks).
+ *
+ * erts_lcnt_open_ref must be used to safely extract the installed carrier,
+ * which must released with erts_lcnt_close_reference on success.
+ *
+ * Refer to \c erts_lcnt_lock for example usage. */
+
+ERTS_GLB_INLINE
+void erts_lcnt_lock_idx(erts_lcnt_lock_info_carrier_t *carrier, int index);
+ERTS_GLB_INLINE
+void erts_lcnt_lock_opt_idx(erts_lcnt_lock_info_carrier_t *carrier, int index, erts_lock_options_t option);
+
+ERTS_GLB_INLINE
+void erts_lcnt_lock_post_idx(erts_lcnt_lock_info_carrier_t *carrier, int index);
+ERTS_GLB_INLINE
+void erts_lcnt_lock_post_x_idx(erts_lcnt_lock_info_carrier_t *carrier, int index, char *file, unsigned int line);
+
+ERTS_GLB_INLINE
+void erts_lcnt_lock_unacquire_idx(erts_lcnt_lock_info_carrier_t *carrier, int index);
+
+ERTS_GLB_INLINE
+void erts_lcnt_unlock_idx(erts_lcnt_lock_info_carrier_t *carrier, int index);
+ERTS_GLB_INLINE
+void erts_lcnt_unlock_opt_idx(erts_lcnt_lock_info_carrier_t *carrier, int index, erts_lock_options_t option);
+
+ERTS_GLB_INLINE
+void erts_lcnt_trylock_idx(erts_lcnt_lock_info_carrier_t *carrier, int index, int result);
+ERTS_GLB_INLINE
+void erts_lcnt_trylock_opt_idx(erts_lcnt_lock_info_carrier_t *carrier, int index, int result, erts_lock_options_t option);
+
+/* -- Reference operations ------------------------------------------------- */
+
+/** @brief Registers a lock counter reference; this must be called prior to
+ * using any other functions in this module. */
+ERTS_GLB_INLINE
+void erts_lcnt_init_ref(erts_lcnt_ref_t *ref);
+
+/** @brief As \c erts_lcnt_init_ref, but also enables lock counting right
+ * away if appropriate to reduce noise.
+ * @param id An immediate erlang term with whatever extra data you want to
+ * identify this lock with. */
+ERTS_GLB_INLINE
+void erts_lcnt_init_ref_x(erts_lcnt_ref_t *ref, const char *name,
+ Eterm id, erts_lock_flags_t flags);
+
+/** @brief Checks whether counting is enabled on the given reference. */
+ERTS_GLB_FORCE_INLINE
+int erts_lcnt_check_ref_installed(erts_lcnt_ref_t *ref);
+
+/** @brief Convenience macro to re/enable counting on an already initialized
+ * reference. Don't forget to specify the lock type in \c flags! */
+#define erts_lcnt_install_new_lock_info(ref, name, id, flags) \
+ if(!erts_lcnt_check_ref_installed(ref)) { \
+ erts_lcnt_lock_info_carrier_t *__carrier; \
+ __carrier = erts_lcnt_create_lock_info_carrier(1);\
+ erts_lcnt_init_lock_info_idx(__carrier, 0, name, id, flags); \
+ erts_lcnt_install(ref, __carrier);\
+ } while(0)
+
+erts_lcnt_lock_info_carrier_t *erts_lcnt_create_lock_info_carrier(int count);
+
+/* @brief Initializes the lock info at the given index.
+ * @param id An immediate erlang term with whatever extra data you want to
+ * identify this lock with.
+ * @param flags The flags the lock itself was initialized with. Keep in mind
+ * that all locks in a carrier must share the same category/static property. */
+ERTS_GLB_INLINE
+void erts_lcnt_init_lock_info_idx(erts_lcnt_lock_info_carrier_t *carrier, int index,
+ const char *name, Eterm id, erts_lock_flags_t flags);
+
+/** @brief Atomically installs the given lock counters. Nops (and releases the
+ * provided carrier) if something was already installed. */
+void erts_lcnt_install(erts_lcnt_ref_t *ref, erts_lcnt_lock_info_carrier_t *carrier);
+
+/** @brief Atomically removes the currently installed lock counters. Nops if
+ * nothing was installed. */
+void erts_lcnt_uninstall(erts_lcnt_ref_t *ref);
+
+ERTS_GLB_FORCE_INLINE
+int erts_lcnt_open_ref(erts_lcnt_ref_t *ref, int *handle, erts_lcnt_lock_info_carrier_t **result);
+
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_close_ref(int handle, erts_lcnt_lock_info_carrier_t *carrier);
+
+/* -- Module initialization ------------------------------------------------ */
+
+void erts_lcnt_pre_thr_init(void);
+void erts_lcnt_post_thr_init(void);
void erts_lcnt_late_init(void);
-/* thread operations */
+/* @brief Called after everything in the system has been initialized, including
+ * the schedulers. This is mainly a backwards compatibility shim for matching
+ * the old lcnt behavior where all lock counting was enabled by default. */
+void erts_lcnt_post_startup(void);
+
void erts_lcnt_thread_setup(void);
void erts_lcnt_thread_exit_handler(void);
-/* list operations (local) */
-erts_lcnt_lock_list_t *erts_lcnt_list_init(void);
+/* -- BIF interface -------------------------------------------------------- */
+
+/** @brief Safely iterates through all entries in the given list.
+ *
+ * The referenced item will be valid until the next call to
+ * \c erts_lcnt_iterate_list after which point it may be destroyed; call
+ * erts_lcnt_retain_lock_info if you wish to hang on to it beyond that point.
+ *
+ * Iteration can be cancelled by calling erts_lcnt_release_lock_info on the
+ * iterator and breaking out of the loop.
+ *
+ * @param iterator The iteration variable; set the pointee to NULL to start
+ * iteration.
+ * @return 1 while the iterator is valid, 0 at the end of the list. */
+int erts_lcnt_iterate_list(erts_lcnt_lock_info_list_t *list, erts_lcnt_lock_info_t **iterator);
+
+/** @brief Clears the counter state of all locks, and releases all locks
+ * preserved through erts_lcnt_set_preserve_info (if any). */
+void erts_lcnt_clear_counters(void);
+
+/** @brief Retrieves the global lock counter state.
+ *
+ * Note that the lists may be modified while you're mucking around with them.
+ * Always use \c erts_lcnt_iterate_list to enumerate them. */
+erts_lcnt_data_t erts_lcnt_get_data(void);
+
+void erts_lcnt_retain_lock_info(erts_lcnt_lock_info_t *info);
+void erts_lcnt_release_lock_info(erts_lcnt_lock_info_t *info);
+
+/** @brief Sets whether to preserve the info of destroyed/uninstalled locks.
+ *
+ * This option makes no distinction whether the lock was destroyed or if lock
+ * counting was simply disabled, so erts_lcnt_set_category_mask must not be
+ * used while this option is active. */
+void erts_lcnt_set_preserve_info(int enable);
+
+int erts_lcnt_get_preserve_info(void);
+
+/** @brief Updates the category mask, enabling or disabling counting on the
+ * affected locks as necessary.
+ *
+ * This is not guaranteed to find all existing locks; only those that are
+ * flagged as static locks and those reachable through other means can be
+ * altered. */
+void erts_lcnt_set_category_mask(erts_lock_flags_t mask);
+
+erts_lock_flags_t erts_lcnt_get_category_mask(void);
+
+/* -- Inline implementation ------------------------------------------------ */
+
+/* The following is a hack to get the things we need from erl_thr_progress.h,
+ * which we can't #include without dependency hell breaking loose.
+ *
+ * The size of LcntThrPrgrLaterOp and value of the constant are verified at
+ * compile-time in erts_lcnt_pre_thr_init. */
+
+int lcnt_thr_progress_unmanaged_delay__(void);
+void lcnt_thr_progress_unmanaged_continue__(int handle);
+typedef struct { Uint64 _[4]; } LcntThrPrgrLaterOp;
+#define LCNT_THR_PRGR_DHANDLE_MANAGED -1
+
+struct lcnt_lock_info_carrier_ {
+ ethr_atomic_t ref_count;
+
+ LcntThrPrgrLaterOp release_entries;
+
+ unsigned char entry_count;
+ erts_lcnt_lock_info_t entries[];
+};
+
+typedef struct {
+ erts_lcnt_time_t timer; /* timer */
+ int timer_set; /* bool */
+ int lock_in_conflict; /* bool */
+} lcnt_thread_data_t__;
+
+extern const int lcnt_log2_tab64__[];
+
+extern ethr_tsd_key lcnt_thr_data_key__;
+extern erts_lock_flags_t lcnt_category_mask__;
+
+#ifdef DEBUG
+extern int lcnt_initialization_completed__;
+#endif
+
+void lcnt_register_static_lock__(erts_lcnt_ref_t *reference, const char *name, Eterm id,
+ erts_lock_flags_t flags);
+
+void lcnt_deallocate_carrier__(erts_lcnt_lock_info_carrier_t *carrier);
+
+ERTS_GLB_INLINE
+int lcnt_log2__(Uint64 v);
+
+ERTS_GLB_INLINE
+void lcnt_update_wait_histogram__(erts_lcnt_hist_t *hist, erts_lcnt_time_t *time_waited);
+
+ERTS_GLB_INLINE
+void lcnt_update_stats__(erts_lcnt_lock_stats_t *stats, int lock_in_conflict, erts_lcnt_time_t *time_waited);
+
+ERTS_GLB_INLINE
+erts_lcnt_lock_stats_t *lcnt_get_lock_stats__(erts_lcnt_lock_info_t *info, char *file, unsigned int line);
+
+ERTS_GLB_INLINE
+void lcnt_dec_lock_state__(ethr_atomic_t *l_state);
+
+ERTS_GLB_INLINE
+void lcnt_time__(erts_lcnt_time_t *time);
+
+ERTS_GLB_INLINE
+void lcnt_time_add__(erts_lcnt_time_t *t, erts_lcnt_time_t *d);
+
+ERTS_GLB_INLINE
+void lcnt_time_diff__(erts_lcnt_time_t *d, erts_lcnt_time_t *t1, erts_lcnt_time_t *t0);
+
+ERTS_GLB_INLINE
+void lcnt_retain_carrier__(erts_lcnt_lock_info_carrier_t *carrier);
+
+ERTS_GLB_INLINE
+void lcnt_release_carrier__(erts_lcnt_lock_info_carrier_t *carrier);
+
+ERTS_GLB_INLINE
+lcnt_thread_data_t__ *lcnt_get_thread_data__(void);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_INLINE
+void lcnt_time__(erts_lcnt_time_t *time) {
+ /*
+ * erts_sys_hrtime() is the highest resolution
+ * we could find, it may or may not be monotonic...
+ */
+ ErtsMonotonicTime mtime = erts_sys_hrtime();
+ time->s = (unsigned long) (mtime / 1000000000LL);
+ time->ns = (unsigned long) (mtime - 1000000000LL*time->s);
+}
+
+/* difference d must be non-negative */
+
+ERTS_GLB_INLINE
+void lcnt_time_add__(erts_lcnt_time_t *t, erts_lcnt_time_t *d) {
+ t->s += d->s;
+ t->ns += d->ns;
+
+ t->s += t->ns / 1000000000LL;
+ t->ns = t->ns % 1000000000LL;
+}
+
+ERTS_GLB_INLINE
+void lcnt_time_diff__(erts_lcnt_time_t *d, erts_lcnt_time_t *t1, erts_lcnt_time_t *t0) {
+ long ds;
+ long dns;
+
+ ds = t1->s - t0->s;
+ dns = t1->ns - t0->ns;
+
+ /* the difference should not be able to get bigger than 1 sec in ns*/
+
+ if (dns < 0) {
+ ds -= 1;
+ dns += 1000000000LL;
+ }
+
+ ASSERT(ds >= 0);
+
+ d->s = ds;
+ d->ns = dns;
+}
+
+ERTS_GLB_INLINE
+int lcnt_log2__(Uint64 v) {
+ v |= v >> 1;
+ v |= v >> 2;
+ v |= v >> 4;
+ v |= v >> 8;
+ v |= v >> 16;
+ v |= v >> 32;
+
+ return lcnt_log2_tab64__[((Uint64)((v - (v >> 1))*0x07EDD5E59A4E28C2)) >> 58];
+}
+
+ERTS_GLB_INLINE
+void lcnt_update_wait_histogram__(erts_lcnt_hist_t *hist, erts_lcnt_time_t *time_waited) {
+ int idx;
+
+ if(time_waited->s > 0 || time_waited->ns > ERTS_LCNT_HISTOGRAM_MAX_NS) {
+ idx = ERTS_LCNT_HISTOGRAM_SLOT_SIZE - 1;
+ } else {
+ unsigned long r = time_waited->ns >> ERTS_LCNT_HISTOGRAM_RSHIFT;
+
+ idx = r ? lcnt_log2__(r) : 0;
+ }
+
+ hist->ns[idx]++;
+}
+
+ERTS_GLB_INLINE
+void lcnt_update_stats__(erts_lcnt_lock_stats_t *stats, int lock_in_conflict, erts_lcnt_time_t *time_waited) {
+ ethr_atomic_inc(&stats->attempts);
+
+ if(lock_in_conflict) {
+ ethr_atomic_inc(&stats->collisions);
+ }
+
+ if(time_waited) {
+ stats->times_waited++;
+
+ lcnt_time_add__(&stats->total_time_waited, time_waited);
+ lcnt_update_wait_histogram__(&stats->wait_time_histogram, time_waited);
+ }
+}
+
+/* If we were installed while the lock was held, r/w_state will be 0 and we
+ * can't tell which unlock or unacquire operation was the last. To get around
+ * this we assume that all excess operations go *towards* zero rather than down
+ * to zero, eventually becoming consistent with the actual state once the lock
+ * is fully released.
+ *
+ * Conflicts might not be counted until the recorded state is fully consistent
+ * with the actual state, but there should be no other ill effects. */
+
+ERTS_GLB_INLINE
+void lcnt_dec_lock_state__(ethr_atomic_t *l_state) {
+ ethr_sint_t state = ethr_atomic_dec_read_acqb(l_state);
+
+ /* We can not assume that state is >= -1 here; unlock and unacquire might
+ * bring it below -1 and race to increment it back. */
+
+ if(state < 0) {
+ ethr_atomic_inc_acqb(l_state);
+ }
+}
+
+ERTS_GLB_INLINE
+erts_lcnt_lock_stats_t *lcnt_get_lock_stats__(erts_lcnt_lock_info_t *info, char *file, unsigned int line) {
+ unsigned int i;
+
+ ASSERT(info->location_count >= 1 && info->location_count <= ERTS_LCNT_MAX_LOCK_LOCATIONS);
-void erts_lcnt_list_clear( erts_lcnt_lock_list_t *list);
-void erts_lcnt_list_insert(erts_lcnt_lock_list_t *list, erts_lcnt_lock_t *lock);
-void erts_lcnt_list_delete(erts_lcnt_lock_list_t *list, erts_lcnt_lock_t *lock);
+ for(i = 0; i < info->location_count; i++) {
+ erts_lcnt_lock_stats_t *stats = &info->location_stats[i];
-/* lock operations (global) */
-void erts_lcnt_init_lock(erts_lcnt_lock_t *lock, char *name, Uint16 flag);
-void erts_lcnt_init_lock_x(erts_lcnt_lock_t *lock, char *name, Uint16 flag, Eterm id);
-void erts_lcnt_destroy_lock(erts_lcnt_lock_t *lock);
+ if(stats->file == file && stats->line == line) {
+ return stats;
+ }
+ }
-void erts_lcnt_lock(erts_lcnt_lock_t *lock);
-void erts_lcnt_lock_opt(erts_lcnt_lock_t *lock, Uint16 option);
-void erts_lcnt_lock_post(erts_lcnt_lock_t *lock);
-void erts_lcnt_lock_post_x(erts_lcnt_lock_t *lock, char *file, unsigned int line);
-void erts_lcnt_lock_unaquire(erts_lcnt_lock_t *lock);
+ if(info->location_count < ERTS_LCNT_MAX_LOCK_LOCATIONS) {
+ erts_lcnt_lock_stats_t *stats = &info->location_stats[info->location_count];
-void erts_lcnt_unlock(erts_lcnt_lock_t *lock);
-void erts_lcnt_unlock_opt(erts_lcnt_lock_t *lock, Uint16 option);
+ stats->file = file;
+ stats->line = line;
-void erts_lcnt_trylock_opt(erts_lcnt_lock_t *lock, int res, Uint16 option);
-void erts_lcnt_trylock(erts_lcnt_lock_t *lock, int res);
+ info->location_count++;
-/* bif interface */
-Uint16 erts_lcnt_set_rt_opt(Uint16 opt);
-Uint16 erts_lcnt_clear_rt_opt(Uint16 opt);
-void erts_lcnt_clear_counters(void);
-char *erts_lcnt_lock_type(Uint16 type);
-erts_lcnt_data_t *erts_lcnt_get_data(void);
+ return stats;
+ }
-#define ERTS_LCNT_LOCK_TYPE(lockp) ((lockp)->flag & ERTS_LCNT_LT_ALL)
+ return &info->location_stats[0];
+}
+
+ERTS_GLB_INLINE
+lcnt_thread_data_t__ *lcnt_get_thread_data__(void) {
+ lcnt_thread_data_t__ *eltd = (lcnt_thread_data_t__ *)ethr_tsd_get(lcnt_thr_data_key__);
+
+ ASSERT(eltd);
+
+ return eltd;
+}
+
+ERTS_GLB_FORCE_INLINE
+int erts_lcnt_open_ref(erts_lcnt_ref_t *ref, int *handle, erts_lcnt_lock_info_carrier_t **result) {
+ if(ERTS_LIKELY(!erts_lcnt_check_ref_installed(ref))) {
+ return 0;
+ }
+
+ ASSERT(lcnt_initialization_completed__);
+
+ (*handle) = lcnt_thr_progress_unmanaged_delay__();
+ (*result) = (erts_lcnt_lock_info_carrier_t*)ethr_atomic_read(ref);
+
+ if(*result) {
+ if(*handle != LCNT_THR_PRGR_DHANDLE_MANAGED) {
+ lcnt_retain_carrier__(*result);
+ lcnt_thr_progress_unmanaged_continue__(*handle);
+ }
+
+ return 1;
+ } else if(*handle != LCNT_THR_PRGR_DHANDLE_MANAGED) {
+ lcnt_thr_progress_unmanaged_continue__(*handle);
+ }
+
+ return 0;
+}
+
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_close_ref(int handle, erts_lcnt_lock_info_carrier_t *carrier) {
+ if(handle != LCNT_THR_PRGR_DHANDLE_MANAGED) {
+ lcnt_release_carrier__(carrier);
+ }
+}
+
+ERTS_GLB_INLINE
+void erts_lcnt_init_ref(erts_lcnt_ref_t *ref) {
+ ethr_atomic_init(ref, (ethr_sint_t)NULL);
+}
+
+ERTS_GLB_INLINE
+void erts_lcnt_init_ref_x(erts_lcnt_ref_t *ref, const char *name,
+ Eterm id, erts_lock_flags_t flags) {
+ erts_lcnt_init_ref(ref);
+
+ if(flags & ERTS_LOCK_FLAGS_PROPERTY_STATIC) {
+ lcnt_register_static_lock__(ref, name, id, flags);
+ }
+
+ if(erts_lcnt_check_enabled(flags)) {
+ erts_lcnt_install_new_lock_info(ref, name, id, flags);
+ }
+}
+
+ERTS_GLB_FORCE_INLINE
+int erts_lcnt_check_ref_installed(erts_lcnt_ref_t *ref) {
+ return (!!*ethr_atomic_addr(ref));
+}
+
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_lock(erts_lcnt_ref_t *ref) {
+ erts_lcnt_lock_info_carrier_t *carrier;
+ int handle;
+
+ if(erts_lcnt_open_ref(ref, &handle, &carrier)) {
+ erts_lcnt_lock_idx(carrier, 0);
+
+ erts_lcnt_close_ref(handle, carrier);
+ }
+}
+
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_lock_opt(erts_lcnt_ref_t *ref, erts_lock_options_t option) {
+ erts_lcnt_lock_info_carrier_t *carrier;
+ int handle;
+
+ if(erts_lcnt_open_ref(ref, &handle, &carrier)) {
+ erts_lcnt_lock_opt_idx(carrier, 0, option);
+
+ erts_lcnt_close_ref(handle, carrier);
+ }
+}
+
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_lock_post(erts_lcnt_ref_t *ref) {
+ erts_lcnt_lock_info_carrier_t *carrier;
+ int handle;
+
+ if(erts_lcnt_open_ref(ref, &handle, &carrier)) {
+ erts_lcnt_lock_post_idx(carrier, 0);
+
+ erts_lcnt_close_ref(handle, carrier);
+ }
+}
+
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_lock_post_x(erts_lcnt_ref_t *ref, char *file, unsigned int line) {
+ erts_lcnt_lock_info_carrier_t *carrier;
+ int handle;
+
+ if(erts_lcnt_open_ref(ref, &handle, &carrier)) {
+ erts_lcnt_lock_post_x_idx(carrier, 0, file, line);
+
+ erts_lcnt_close_ref(handle, carrier);
+ }
+}
+
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_lock_unacquire(erts_lcnt_ref_t *ref) {
+ erts_lcnt_lock_info_carrier_t *carrier;
+ int handle;
+
+ if(erts_lcnt_open_ref(ref, &handle, &carrier)) {
+ erts_lcnt_lock_unacquire_idx(carrier, 0);
+
+ erts_lcnt_close_ref(handle, carrier);
+ }
+}
+
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_unlock(erts_lcnt_ref_t *ref) {
+ erts_lcnt_lock_info_carrier_t *carrier;
+ int handle;
+
+ if(erts_lcnt_open_ref(ref, &handle, &carrier)) {
+ erts_lcnt_unlock_idx(carrier, 0);
+
+ erts_lcnt_close_ref(handle, carrier);
+ }
+}
+
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_unlock_opt(erts_lcnt_ref_t *ref, erts_lock_options_t option) {
+ erts_lcnt_lock_info_carrier_t *carrier;
+ int handle;
+
+ if(erts_lcnt_open_ref(ref, &handle, &carrier)) {
+ erts_lcnt_unlock_opt_idx(carrier, 0, option);
+
+ erts_lcnt_close_ref(handle, carrier);
+ }
+}
+
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_trylock(erts_lcnt_ref_t *ref, int result) {
+ erts_lcnt_lock_info_carrier_t *carrier;
+ int handle;
+
+ if(erts_lcnt_open_ref(ref, &handle, &carrier)) {
+ erts_lcnt_trylock_idx(carrier, 0, result);
+
+ erts_lcnt_close_ref(handle, carrier);
+ }
+}
+
+ERTS_GLB_FORCE_INLINE
+void erts_lcnt_trylock_opt(erts_lcnt_ref_t *ref, int result, erts_lock_options_t option) {
+ erts_lcnt_lock_info_carrier_t *carrier;
+ int handle;
+
+ if(erts_lcnt_open_ref(ref, &handle, &carrier)) {
+ erts_lcnt_trylock_opt_idx(carrier, 0, result, option);
+
+ erts_lcnt_close_ref(handle, carrier);
+ }
+}
+
+ERTS_GLB_INLINE
+void erts_lcnt_lock_idx(erts_lcnt_lock_info_carrier_t *carrier, int index) {
+ erts_lcnt_lock_opt_idx(carrier, index, ERTS_LOCK_OPTIONS_WRITE);
+}
+
+ERTS_GLB_INLINE
+void erts_lcnt_lock_opt_idx(erts_lcnt_lock_info_carrier_t *carrier, int index, erts_lock_options_t option) {
+ erts_lcnt_lock_info_t *info = &carrier->entries[index];
+
+ lcnt_thread_data_t__ *eltd = lcnt_get_thread_data__();
+
+ ASSERT(index < carrier->entry_count);
+
+ ASSERT((option & ERTS_LOCK_OPTIONS_READ) || (option & ERTS_LOCK_OPTIONS_WRITE));
+
+ if(option & ERTS_LOCK_OPTIONS_WRITE) {
+ ethr_sint_t w_state, r_state;
+
+ w_state = ethr_atomic_inc_read(&info->w_state) - 1;
+ r_state = ethr_atomic_read(&info->r_state);
+
+ /* We cannot acquire w_lock if either w or r are taken */
+ eltd->lock_in_conflict = (w_state > 0) || (r_state > 0);
+ } else {
+ ethr_sint_t w_state = ethr_atomic_read(&info->w_state);
+
+ /* We cannot acquire r_lock if w_lock is taken */
+ eltd->lock_in_conflict = (w_state > 0);
+ }
+
+ if(option & ERTS_LOCK_OPTIONS_READ) {
+ ASSERT(info->flags & ERTS_LOCK_FLAGS_PROPERTY_READ_WRITE);
+ ethr_atomic_inc(&info->r_state);
+ }
+
+ if(eltd->lock_in_conflict) {
+ /* Only set the timer if nobody else has it. This should only happen
+ * when proc_locks acquires several locks "atomically." All other locks
+ * will block the thread when locked (w_state > 0) */
+ if(eltd->timer_set == 0) {
+ lcnt_time__(&eltd->timer);
+ }
+
+ eltd->timer_set++;
+ }
+}
+
+ERTS_GLB_INLINE
+void erts_lcnt_lock_post_idx(erts_lcnt_lock_info_carrier_t *carrier, int index) {
+ erts_lcnt_lock_post_x_idx(carrier, index, NULL, 0);
+}
+
+ERTS_GLB_INLINE
+void erts_lcnt_lock_post_x_idx(erts_lcnt_lock_info_carrier_t *carrier, int index, char *file, unsigned int line) {
+ erts_lcnt_lock_info_t *info = &carrier->entries[index];
+
+ lcnt_thread_data_t__ *eltd = lcnt_get_thread_data__();
+ erts_lcnt_lock_stats_t *stats;
+
+ ASSERT(index < carrier->entry_count);
+
+ /* If the lock was in conflict, update the time spent waiting. */
+ stats = lcnt_get_lock_stats__(info, file, line);
+ if(eltd->timer_set) {
+ erts_lcnt_time_t time_wait;
+ erts_lcnt_time_t timer;
+
+ lcnt_time__(&timer);
+
+ lcnt_time_diff__(&time_wait, &timer, &eltd->timer);
+ lcnt_update_stats__(stats, eltd->lock_in_conflict, &time_wait);
+
+ eltd->timer_set--;
+
+ ASSERT(eltd->timer_set >= 0);
+ } else {
+ lcnt_update_stats__(stats, eltd->lock_in_conflict, NULL);
+ }
+}
+
+ERTS_GLB_INLINE
+void erts_lcnt_unlock_idx(erts_lcnt_lock_info_carrier_t *carrier, int index) {
+ ASSERT(index < carrier->entry_count);
+
+ erts_lcnt_unlock_opt_idx(carrier, index, ERTS_LOCK_OPTIONS_WRITE);
+}
+
+ERTS_GLB_INLINE
+void erts_lcnt_unlock_opt_idx(erts_lcnt_lock_info_carrier_t *carrier, int index, erts_lock_options_t option) {
+ erts_lcnt_lock_info_t *info = &carrier->entries[index];
+
+ ASSERT(index < carrier->entry_count);
+
+ ASSERT((option & ERTS_LOCK_OPTIONS_READ) || (option & ERTS_LOCK_OPTIONS_WRITE));
+
+ if(option & ERTS_LOCK_OPTIONS_WRITE) {
+ lcnt_dec_lock_state__(&info->w_state);
+ }
+
+ if(option & ERTS_LOCK_OPTIONS_READ) {
+ ASSERT(info->flags & ERTS_LOCK_FLAGS_PROPERTY_READ_WRITE);
+ lcnt_dec_lock_state__(&info->r_state);
+ }
+}
+
+ERTS_GLB_INLINE
+void erts_lcnt_lock_unacquire_idx(erts_lcnt_lock_info_carrier_t *carrier, int index) {
+ erts_lcnt_lock_info_t *info = &carrier->entries[index];
+
+ ASSERT(index < carrier->entry_count);
+
+ lcnt_dec_lock_state__(&info->w_state);
+}
+
+ERTS_GLB_INLINE
+void erts_lcnt_trylock_idx(erts_lcnt_lock_info_carrier_t *carrier, int index, int result) {
+ ASSERT(index < carrier->entry_count);
+
+ erts_lcnt_trylock_opt_idx(carrier, index, result, ERTS_LOCK_OPTIONS_WRITE);
+}
+
+ERTS_GLB_INLINE
+void erts_lcnt_trylock_opt_idx(erts_lcnt_lock_info_carrier_t *carrier, int index, int result, erts_lock_options_t option) {
+ erts_lcnt_lock_info_t *info = &carrier->entries[index];
+
+ ASSERT(index < carrier->entry_count);
+
+ ASSERT((option & ERTS_LOCK_OPTIONS_READ) || (option & ERTS_LOCK_OPTIONS_WRITE));
+
+ if(result != EBUSY) {
+ if(option & ERTS_LOCK_OPTIONS_WRITE) {
+ ethr_atomic_inc(&info->w_state);
+ }
+
+ if(option & ERTS_LOCK_OPTIONS_READ) {
+ ASSERT(info->flags & ERTS_LOCK_FLAGS_PROPERTY_READ_WRITE);
+ ethr_atomic_inc(&info->r_state);
+ }
+
+ lcnt_update_stats__(&info->location_stats[0], 0, NULL);
+ } else {
+ ethr_atomic_inc(&info->location_stats[0].attempts);
+ ethr_atomic_inc(&info->location_stats[0].collisions);
+ }
+}
+
+ERTS_GLB_INLINE
+void erts_lcnt_init_lock_info_idx(erts_lcnt_lock_info_carrier_t *carrier, int index,
+ const char *name, Eterm id, erts_lock_flags_t flags) {
+ erts_lcnt_lock_info_t *info = &carrier->entries[index];
+
+ ASSERT(is_immed(id));
+
+ ASSERT(flags & ERTS_LOCK_FLAGS_MASK_TYPE);
+ ASSERT(flags & ERTS_LOCK_FLAGS_MASK_CATEGORY);
+
+ info->flags = flags;
+ info->name = name;
+ info->id = id;
+}
+
+ERTS_GLB_INLINE
+void lcnt_retain_carrier__(erts_lcnt_lock_info_carrier_t *carrier) {
+#ifdef DEBUG
+ ASSERT(ethr_atomic_inc_read_acqb(&carrier->ref_count) >= 2);
+#else
+ ethr_atomic_inc_acqb(&carrier->ref_count);
+#endif
+}
+
+ERTS_GLB_INLINE
+void lcnt_release_carrier__(erts_lcnt_lock_info_carrier_t *carrier) {
+ ethr_sint_t count = ethr_atomic_dec_read_relb(&carrier->ref_count);
+
+ ASSERT(count >= 0);
+
+ if(count == 0) {
+ lcnt_deallocate_carrier__(carrier);
+ }
+}
+
+#endif
#endif /* ifdef ERTS_ENABLE_LOCK_COUNT */
#endif /* ifndef ERTS_LOCK_COUNT_H__ */
diff --git a/erts/emulator/beam/erl_lock_flags.c b/erts/emulator/beam/erl_lock_flags.c
new file mode 100644
index 0000000000..e0a0e95c09
--- /dev/null
+++ b/erts/emulator/beam/erl_lock_flags.c
@@ -0,0 +1,59 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2017. 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 "erl_lock_flags.h"
+
+const char *erts_lock_flags_get_type_name(erts_lock_flags_t flags) {
+ switch(flags & ERTS_LOCK_FLAGS_MASK_TYPE) {
+ case ERTS_LOCK_FLAGS_TYPE_PROCLOCK:
+ return "proclock";
+ case ERTS_LOCK_FLAGS_TYPE_MUTEX:
+ if(flags & ERTS_LOCK_FLAGS_PROPERTY_READ_WRITE) {
+ return "rw_mutex";
+ }
+
+ return "mutex";
+ case ERTS_LOCK_FLAGS_TYPE_SPINLOCK:
+ if(flags & ERTS_LOCK_FLAGS_PROPERTY_READ_WRITE) {
+ return "rw_spinlock";
+ }
+
+ return "spinlock";
+ default:
+ return "garbage";
+ }
+}
+
+const char *erts_lock_options_get_short_desc(erts_lock_options_t options) {
+ switch(options) {
+ case ERTS_LOCK_OPTIONS_RDWR:
+ return "rw";
+ case ERTS_LOCK_OPTIONS_READ:
+ return "r";
+ case ERTS_LOCK_OPTIONS_WRITE:
+ return "w";
+ default:
+ return "none";
+ }
+}
diff --git a/erts/emulator/beam/erl_lock_flags.h b/erts/emulator/beam/erl_lock_flags.h
new file mode 100644
index 0000000000..d711f69456
--- /dev/null
+++ b/erts/emulator/beam/erl_lock_flags.h
@@ -0,0 +1,78 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2017. 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 ERTS_LOCK_FLAGS_H__
+#define ERTS_LOCK_FLAGS_H__
+
+#define ERTS_LOCK_OPTIONS_READ (1 << 1)
+#define ERTS_LOCK_OPTIONS_WRITE (1 << 2)
+
+#define ERTS_LOCK_OPTIONS_RDWR (ERTS_LOCK_OPTIONS_READ | ERTS_LOCK_OPTIONS_WRITE)
+
+/* Property/category are bitfields to simplify their use in masks. */
+#define ERTS_LOCK_FLAGS_MASK_CATEGORY (0xFFC0)
+#define ERTS_LOCK_FLAGS_MASK_PROPERTY (0x0030)
+
+/* Type is a plain number. */
+#define ERTS_LOCK_FLAGS_MASK_TYPE (0x000F)
+
+#define ERTS_LOCK_FLAGS_TYPE_SPINLOCK (1)
+#define ERTS_LOCK_FLAGS_TYPE_MUTEX (2)
+#define ERTS_LOCK_FLAGS_TYPE_PROCLOCK (3)
+
+/* "Static" guarantees that the lock will never be destroyed once created. */
+#define ERTS_LOCK_FLAGS_PROPERTY_STATIC (1 << 4)
+#define ERTS_LOCK_FLAGS_PROPERTY_READ_WRITE (1 << 5)
+
+#define ERTS_LOCK_FLAGS_CATEGORY_ALLOCATOR (1 << 6)
+#define ERTS_LOCK_FLAGS_CATEGORY_PROCESS (1 << 7)
+#define ERTS_LOCK_FLAGS_CATEGORY_IO (1 << 8)
+#define ERTS_LOCK_FLAGS_CATEGORY_DB (1 << 9)
+#define ERTS_LOCK_FLAGS_CATEGORY_DEBUG (1 << 10)
+#define ERTS_LOCK_FLAGS_CATEGORY_SCHEDULER (1 << 11)
+#define ERTS_LOCK_FLAGS_CATEGORY_GENERIC (1 << 12)
+#define ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION (1 << 13)
+
+#define ERTS_LOCK_TYPE_SPINLOCK \
+ (ERTS_LOCK_FLAGS_TYPE_SPINLOCK)
+#define ERTS_LOCK_TYPE_RWSPINLOCK \
+ (ERTS_LOCK_TYPE_SPINLOCK | \
+ ERTS_LOCK_FLAGS_PROPERTY_READ_WRITE)
+#define ERTS_LOCK_TYPE_MUTEX \
+ (ERTS_LOCK_FLAGS_TYPE_MUTEX)
+#define ERTS_LOCK_TYPE_RWMUTEX \
+ (ERTS_LOCK_TYPE_MUTEX | \
+ ERTS_LOCK_FLAGS_PROPERTY_READ_WRITE)
+#define ERTS_LOCK_TYPE_PROCLOCK \
+ (ERTS_LOCK_FLAGS_CATEGORY_PROCESS | \
+ ERTS_LOCK_FLAGS_TYPE_PROCLOCK)
+
+/* -- -- */
+
+typedef unsigned short erts_lock_flags_t;
+typedef unsigned short erts_lock_options_t;
+
+/* @brief Gets the type name of the lock, honoring the RW flag if supplied. */
+const char *erts_lock_flags_get_type_name(erts_lock_flags_t flags);
+
+/* @brief Gets a short-form description of the given lock options. (rw/r/w) */
+const char *erts_lock_options_get_short_desc(erts_lock_options_t options);
+
+#endif /* ERTS_LOCK_FLAGS_H__ */
diff --git a/erts/emulator/beam/erl_map.c b/erts/emulator/beam/erl_map.c
index fdd2d0c0f6..f0c54e05f7 100644
--- a/erts/emulator/beam/erl_map.c
+++ b/erts/emulator/beam/erl_map.c
@@ -1,21 +1,25 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2014. All Rights Reserved.
+ * Copyright Ericsson AB 2014-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*
+ * hashmaps are an adaption of Rich Hickeys Persistent HashMaps
+ * which were an adaption of Phil Bagwells - Hash Array Mapped Tries
+ *
* Author: Björn-Egil Dahlberg
*/
@@ -28,7 +32,10 @@
#include "global.h"
#include "erl_process.h"
#include "error.h"
+#define ERL_WANT_HIPE_BIF_WRAPPER__
#include "bif.h"
+#undef ERL_WANT_HIPE_BIF_WRAPPER__
+#include "erl_binary.h"
#include "erl_map.h"
@@ -47,6 +54,7 @@
* - maps:new/0
* - maps:put/3
* - maps:remove/2
+ * - maps:take/2
* - maps:to_list/1
* - maps:update/3
* - maps:values/1
@@ -58,41 +66,91 @@
* - maps:size/1
* - maps:without/2
*
+ * DEBUG: for sharing calculation
+ * - erts_internal:map_to_tuple_keys/1
*/
+#ifndef DECL_AM
+#define DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1)
+#endif
+
+/* for hashmap_from_list/1 */
+typedef struct {
+ Uint32 hx;
+ Uint32 skip;
+ Uint i;
+ Eterm val;
+} hxnode_t;
+
+
+static Eterm flatmap_merge(Process *p, Eterm nodeA, Eterm nodeB);
+static BIF_RETTYPE map_merge_mixed(Process *p, Eterm flat, Eterm tree, int swap_args);
+struct HashmapMergeContext_;
+static BIF_RETTYPE hashmap_merge(Process *p, Eterm nodeA, Eterm nodeB, int swap_args,
+ struct HashmapMergeContext_*);
+static Export hashmap_merge_trap_export;
+static BIF_RETTYPE maps_merge_trap_1(BIF_ALIST_1);
+static Uint hashmap_subtree_size(Eterm node);
+static Eterm hashmap_to_list(Process *p, Eterm map, Sint n);
+static Eterm hashmap_keys(Process *p, Eterm map);
+static Eterm hashmap_values(Process *p, Eterm map);
+static Eterm hashmap_delete(Process *p, Uint32 hx, Eterm key, Eterm node, Eterm *value);
+static Eterm flatmap_from_validated_list(Process *p, Eterm list, Uint size);
+static Eterm hashmap_from_validated_list(Process *p, Eterm list, Uint size);
+static Eterm hashmap_from_unsorted_array(ErtsHeapFactory*, hxnode_t *hxns, Uint n, int reject_dupkeys);
+static Eterm hashmap_from_sorted_unique_array(ErtsHeapFactory*, hxnode_t *hxns, Uint n, int is_root);
+static Eterm hashmap_from_chunked_array(ErtsHeapFactory*, hxnode_t *hxns, Uint n, Uint size, int is_root);
+static Eterm hashmap_info(Process *p, Eterm node);
+static Eterm hashmap_bld_tuple_uint(Uint **hpp, Uint *szp, Uint n, Uint nums[]);
+static int hxnodecmp(hxnode_t* a, hxnode_t* b);
+static int hxnodecmpkey(hxnode_t* a, hxnode_t* b);
+
+
+void erts_init_map(void) {
+ erts_init_trap_export(&hashmap_merge_trap_export,
+ am_maps, am_merge_trap, 1,
+ &maps_merge_trap_1);
+ return;
+}
+
+
/* erlang:map_size/1
* the corresponding instruction is implemented in:
* beam/erl_bif_guard.c
*/
BIF_RETTYPE map_size_1(BIF_ALIST_1) {
- if (is_map(BIF_ARG_1)) {
- Eterm *hp;
- Uint hsz = 0;
- map_t *mp = (map_t*)map_val(BIF_ARG_1);
- Uint n = map_get_size(mp);
-
- erts_bld_uint(NULL, &hsz, n);
+ if (is_flatmap(BIF_ARG_1)) {
+ flatmap_t *mp = (flatmap_t*)flatmap_val(BIF_ARG_1);
+ BIF_RET(make_small(flatmap_get_size(mp)));
+ } else if (is_hashmap(BIF_ARG_1)) {
+ Eterm *head, *hp, res;
+ Uint size, hsz=0;
+
+ head = hashmap_val(BIF_ARG_1);
+ size = head[1];
+ (void) erts_bld_uint(NULL, &hsz, size);
hp = HAlloc(BIF_P, hsz);
- BIF_RET(erts_bld_uint(&hp, NULL, n));
+ res = erts_bld_uint(&hp, NULL, size);
+ BIF_RET(res);
}
- BIF_ERROR(BIF_P, BADARG);
+ BIF_P->fvalue = BIF_ARG_1;
+ BIF_ERROR(BIF_P, BADMAP);
}
-/* maps:to_list/1
- */
+/* maps:to_list/1 */
BIF_RETTYPE maps_to_list_1(BIF_ALIST_1) {
- if (is_map(BIF_ARG_1)) {
+ if (is_flatmap(BIF_ARG_1)) {
Uint n;
Eterm* hp;
Eterm *ks,*vs, res, tup;
- map_t *mp = (map_t*)map_val(BIF_ARG_1);
+ flatmap_t *mp = (flatmap_t*)flatmap_val(BIF_ARG_1);
- ks = map_get_keys(mp);
- vs = map_get_values(mp);
- n = map_get_size(mp);
+ ks = flatmap_get_keys(mp);
+ vs = flatmap_get_values(mp);
+ n = flatmap_get_size(mp);
hp = HAlloc(BIF_P, (2 + 3) * n);
res = NIL;
@@ -102,108 +160,142 @@ BIF_RETTYPE maps_to_list_1(BIF_ALIST_1) {
}
BIF_RET(res);
+ } else if (is_hashmap(BIF_ARG_1)) {
+ return hashmap_to_list(BIF_P, BIF_ARG_1, -1);
}
+ BIF_P->fvalue = BIF_ARG_1;
+ BIF_ERROR(BIF_P, BADMAP);
+}
+
+/* erts_internal:maps_to_list/2
+ *
+ * This function should be removed once iterators are in place.
+ * Never document it.
+ * Never encourage its usage.
+ *
+ * A negative value in ARG 2 means the entire map.
+ */
+
+BIF_RETTYPE erts_internal_maps_to_list_2(BIF_ALIST_2) {
+ Sint m;
+ if (term_to_Sint(BIF_ARG_2, &m)) {
+ if (is_flatmap(BIF_ARG_1)) {
+ Uint n;
+ Eterm* hp;
+ Eterm *ks,*vs, res, tup;
+ flatmap_t *mp = (flatmap_t*)flatmap_val(BIF_ARG_1);
+
+ ks = flatmap_get_keys(mp);
+ vs = flatmap_get_values(mp);
+ n = flatmap_get_size(mp);
+
+ if (m >= 0) {
+ n = m < n ? m : n;
+ }
+
+ hp = HAlloc(BIF_P, (2 + 3) * n);
+ res = NIL;
+
+ while(n--) {
+ tup = TUPLE2(hp, ks[n], vs[n]); hp += 3;
+ res = CONS(hp, tup, res); hp += 2;
+ }
+
+ BIF_RET(res);
+ } else if (is_hashmap(BIF_ARG_1)) {
+ return hashmap_to_list(BIF_P, BIF_ARG_1, m);
+ }
+ BIF_P->fvalue = BIF_ARG_1;
+ BIF_ERROR(BIF_P, BADMAP);
+ }
BIF_ERROR(BIF_P, BADARG);
}
+
/* maps:find/2
* return value if key *matches* a key in the map
*/
-int erts_maps_find(Eterm key, Eterm map, Eterm *value) {
-
- Eterm *ks,*vs;
- map_t *mp;
- Uint n,i;
+const Eterm *
+erts_maps_get(Eterm key, Eterm map)
+{
+ Uint32 hx;
+ if (is_flatmap(map)) {
+ Eterm *ks, *vs;
+ flatmap_t *mp;
+ Uint n, i;
- mp = (map_t*)map_val(map);
- n = map_get_size(mp);
- ks = map_get_keys(mp);
- vs = map_get_values(mp);
+ mp = (flatmap_t *)flatmap_val(map);
+ n = flatmap_get_size(mp);
- for( i = 0; i < n; i++) {
- if (EQ(ks[i], key)) {
- *value = vs[i];
- return 1;
+ if (n == 0) {
+ return NULL;
}
+
+ ks = (Eterm *)tuple_val(mp->keys) + 1;
+ vs = flatmap_get_values(mp);
+
+ if (is_immed(key)) {
+ for (i = 0; i < n; i++) {
+ if (ks[i] == key) {
+ return &vs[i];
+ }
+ }
+ } else {
+ for (i = 0; i < n; i++) {
+ if (EQ(ks[i], key)) {
+ return &vs[i];
+ }
+ }
+ }
+ return NULL;
}
- return 0;
+ ASSERT(is_hashmap(map));
+ hx = hashmap_make_hash(key);
+
+ return erts_hashmap_get(hx, key, map);
}
BIF_RETTYPE maps_find_2(BIF_ALIST_2) {
if (is_map(BIF_ARG_2)) {
- Eterm *hp, value,res;
+ Eterm *hp, res;
+ const Eterm *value;
- if (erts_maps_find(BIF_ARG_1, BIF_ARG_2, &value)) {
+ value = erts_maps_get(BIF_ARG_1, BIF_ARG_2);
+ if (value) {
hp = HAlloc(BIF_P, 3);
res = make_tuple(hp);
*hp++ = make_arityval(2);
*hp++ = am_ok;
- *hp++ = value;
+ *hp++ = *value;
BIF_RET(res);
}
-
BIF_RET(am_error);
}
- BIF_ERROR(BIF_P, BADARG);
+ BIF_P->fvalue = BIF_ARG_2;
+ BIF_ERROR(BIF_P, BADMAP);
}
+
/* maps:get/2
* return value if key *matches* a key in the map
- * exception bad_key if none matches
+ * exception badkey if none matches
*/
-
-int erts_maps_get(Eterm key, Eterm map, Eterm *value) {
- Eterm *ks,*vs;
- map_t *mp;
- Uint n,i;
-
- mp = (map_t*)map_val(map);
- n = map_get_size(mp);
-
- if (n == 0)
- return 0;
-
- ks = map_get_keys(mp);
- vs = map_get_values(mp);
-
- if (is_immed(key)) {
- for( i = 0; i < n; i++) {
- if (ks[i] == key) {
- *value = vs[i];
- return 1;
- }
- }
- }
-
- for( i = 0; i < n; i++) {
- if (EQ(ks[i], key)) {
- *value = vs[i];
- return 1;
- }
- }
- return 0;
-}
-
BIF_RETTYPE maps_get_2(BIF_ALIST_2) {
if (is_map(BIF_ARG_2)) {
- Eterm *hp;
- Eterm value, error;
- char *s_error;
+ const Eterm *value;
- if (erts_maps_get(BIF_ARG_1, BIF_ARG_2, &value)) {
- BIF_RET(value);
+ value = erts_maps_get(BIF_ARG_1, BIF_ARG_2);
+ if (value) {
+ BIF_RET(*value);
}
- s_error = "bad_key";
- error = am_atom_put(s_error, sys_strlen(s_error));
-
- hp = HAlloc(BIF_P, 3);
- BIF_P->fvalue = TUPLE2(hp, error, BIF_ARG_1);
- BIF_ERROR(BIF_P, EXC_ERROR_2);
+ BIF_P->fvalue = BIF_ARG_1;
+ BIF_ERROR(BIF_P, BADKEY);
}
- BIF_ERROR(BIF_P, BADARG);
+ BIF_P->fvalue = BIF_ARG_2;
+ BIF_ERROR(BIF_P, BADMAP);
}
/* maps:from_list/1
@@ -211,13 +303,8 @@ BIF_RETTYPE maps_get_2(BIF_ALIST_2) {
*/
BIF_RETTYPE maps_from_list_1(BIF_ALIST_1) {
- Eterm *kv, item = BIF_ARG_1;
- Eterm *hp, *thp,*vs, *ks, keys, res;
- map_t *mp;
- Uint size = 0, unused_size = 0;
- Sint c = 0;
- Sint idx = 0;
-
+ Eterm item = BIF_ARG_1, res, *kv;
+ Uint size = 0;
if (is_list(item) || is_nil(item)) {
/* Calculate size and check validity */
@@ -238,486 +325,1426 @@ BIF_RETTYPE maps_from_list_1(BIF_ALIST_1) {
if (is_not_nil(item))
goto error;
- hp = HAlloc(BIF_P, 3 + 1 + (2 * size));
- thp = hp;
+ if (size > MAP_SMALL_MAP_LIMIT) {
+ BIF_RET(hashmap_from_validated_list(BIF_P, BIF_ARG_1, size));
+ } else {
+ BIF_RET(flatmap_from_validated_list(BIF_P, BIF_ARG_1, size));
+ }
+ }
+
+error:
+
+ BIF_ERROR(BIF_P, BADARG);
+}
+
+static Eterm flatmap_from_validated_list(Process *p, Eterm list, Uint size) {
+ Eterm *kv, item = list;
+ Eterm *hp, *thp,*vs, *ks, keys, res;
+ flatmap_t *mp;
+ Uint unused_size = 0;
+ Sint c = 0;
+ Sint idx = 0;
+
+
+ hp = HAlloc(p, 3 + 1 + (2 * size));
+ thp = hp;
+ keys = make_tuple(hp);
+ *hp++ = make_arityval(size);
+ ks = hp;
+ hp += size;
+ mp = (flatmap_t*)hp;
+ res = make_flatmap(mp);
+ hp += MAP_HEADER_FLATMAP_SZ;
+ vs = hp;
+
+ mp->thing_word = MAP_HEADER_FLATMAP;
+ mp->size = size; /* set later, might shrink*/
+ mp->keys = keys;
+
+ if (size == 0)
+ return res;
+
+ /* first entry */
+ kv = tuple_val(CAR(list_val(item)));
+ ks[0] = kv[1];
+ vs[0] = kv[2];
+ size = 1;
+ item = CDR(list_val(item));
+
+ /* insert sort key/value pairs */
+ while(is_list(item)) {
+
+ kv = tuple_val(CAR(list_val(item)));
+
+ /* compare ks backwards
+ * idx represent word index to be written (hole position).
+ * We cannot copy the elements when searching since we might
+ * have an equal key. So we search for just the index first =(
+ *
+ * It is perhaps faster to move the values in the first pass.
+ * Check for uniqueness during insert phase and then have a
+ * second phace compacting the map if duplicates are found
+ * during insert. .. or do someother sort .. shell-sort perhaps.
+ */
+
+ idx = size;
+
+ while(idx > 0 && (c = CMP_TERM(kv[1],ks[idx-1])) < 0) { idx--; }
+
+ if (c == 0) {
+ /* last compare was equal,
+ * i.e. we have to release memory
+ * and overwrite that key/value
+ */
+ ks[idx-1] = kv[1];
+ vs[idx-1] = kv[2];
+ unused_size++;
+ } else {
+ Uint i = size;
+ while(i > idx) {
+ ks[i] = ks[i-1];
+ vs[i] = vs[i-1];
+ i--;
+ }
+ ks[idx] = kv[1];
+ vs[idx] = kv[2];
+ size++;
+ }
+ item = CDR(list_val(item));
+ }
+
+ if (unused_size) {
+ /* the key tuple is embedded in the heap
+ * write a bignum to clear it.
+ */
+ /* release values as normal since they are on the top of the heap */
+
+ ks[size] = make_pos_bignum_header(unused_size - 1);
+ HRelease(p, vs + size + unused_size, vs + size);
+ }
+
+ *thp = make_arityval(size);
+ mp->size = size;
+ return res;
+}
+
+#define swizzle32(D,S) \
+ do { \
+ (D) = ((S) & 0x0000000f) << 28 | ((S) & 0x000000f0) << 20 \
+ | ((S) & 0x00000f00) << 12 | ((S) & 0x0000f000) << 4 \
+ | ((S) & 0x000f0000) >> 4 | ((S) & 0x00f00000) >> 12 \
+ | ((S) & 0x0f000000) >> 20 | ((S) & 0xf0000000) >> 28; \
+ } while(0)
+
+#define maskval(V,L) (((V) >> ((7 - (L))*4)) & 0xf)
+#define cdepth(V1,V2) (hashmap_clz((V1) ^ (V2)) >> 2)
+
+static Eterm hashmap_from_validated_list(Process *p, Eterm list, Uint size) {
+ Eterm item = list;
+ Eterm *hp;
+ Eterm *kv, res;
+ Uint32 sw, hx;
+ Uint ix = 0;
+ hxnode_t *hxns;
+ ErtsHeapFactory factory;
+ DeclareTmpHeap(tmp,2,p);
+ ASSERT(size > 0);
+
+ hp = HAlloc(p, (2 * size));
+
+ /* create tmp hx values and leaf ptrs */
+ hxns = (hxnode_t *)erts_alloc(ERTS_ALC_T_TMP, size * sizeof(hxnode_t));
+
+ UseTmpHeap(2,p);
+ while(is_list(item)) {
+ res = CAR(list_val(item));
+ kv = tuple_val(res);
+ hx = hashmap_restore_hash(tmp,0,kv[1]);
+ swizzle32(sw,hx);
+ hxns[ix].hx = sw;
+ hxns[ix].val = CONS(hp, kv[1], kv[2]); hp += 2;
+ hxns[ix].skip = 1; /* will be reassigned in from_array */
+ hxns[ix].i = ix;
+ ix++;
+ item = CDR(list_val(item));
+ }
+ UnUseTmpHeap(2,p);
+
+ erts_factory_proc_init(&factory, p);
+ res = hashmap_from_unsorted_array(&factory, hxns, size, 0);
+ erts_factory_close(&factory);
+
+ erts_free(ERTS_ALC_T_TMP, (void *) hxns);
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(p);
+
+ if (hashmap_size(res) <= MAP_SMALL_MAP_LIMIT) {
+ DECLARE_WSTACK(wstack);
+ Eterm *kv, *ks, *vs;
+ flatmap_t *mp;
+ Eterm keys;
+ Uint n = hashmap_size(res);
+
+ /* build flat structure */
+ hp = HAlloc(p, 3 + 1 + (2 * n));
keys = make_tuple(hp);
- *hp++ = make_arityval(size);
+ *hp++ = make_arityval(n);
ks = hp;
- hp += size;
- mp = (map_t*)hp;
- res = make_map(mp);
- hp += MAP_HEADER_SIZE;
+ hp += n;
+ mp = (flatmap_t*)hp;
+ hp += MAP_HEADER_FLATMAP_SZ;
vs = hp;
- mp->thing_word = MAP_HEADER;
- mp->size = size; /* set later, might shrink*/
+ mp->thing_word = MAP_HEADER_FLATMAP;
+ mp->size = n;
mp->keys = keys;
- if (size == 0)
- BIF_RET(res);
+ hashmap_iterator_init(&wstack, res, 0);
- item = BIF_ARG_1;
+ while ((kv=hashmap_iterator_next(&wstack)) != NULL) {
+ *ks++ = CAR(kv);
+ *vs++ = CDR(kv);
+ }
- /* first entry */
- kv = tuple_val(CAR(list_val(item)));
- ks[0] = kv[1];
- vs[0] = kv[2];
- size = 1;
- item = CDR(list_val(item));
+ /* it cannot have multiple keys */
+ erts_validate_and_sort_flatmap(mp);
- /* insert sort key/value pairs */
- while(is_list(item)) {
+ DESTROY_WSTACK(wstack);
+ return make_flatmap(mp);
+ }
- kv = tuple_val(CAR(list_val(item)));
-
- /* compare ks backwards
- * idx represent word index to be written (hole position).
- * We cannot copy the elements when searching since we might
- * have an equal key. So we search for just the index first =(
- *
- * It is perhaps faster to move the values in the first pass.
- * Check for uniqueness during insert phase and then have a
- * second phace compacting the map if duplicates are found
- * during insert. .. or do someother sort .. shell-sort perhaps.
- */
+ return res;
+}
- idx = size;
+Eterm erts_hashmap_from_array(ErtsHeapFactory* factory, Eterm *leafs, Uint n,
+ int reject_dupkeys) {
+ Uint32 sw, hx;
+ Uint ix;
+ hxnode_t *hxns;
+ Eterm res;
+
+ /* create tmp hx values and leaf ptrs */
+ hxns = (hxnode_t *)erts_alloc(ERTS_ALC_T_TMP, n * sizeof(hxnode_t));
+
+ for (ix = 0; ix < n; ix++) {
+ hx = hashmap_make_hash(*leafs);
+ swizzle32(sw,hx);
+ hxns[ix].hx = sw;
+ hxns[ix].val = make_list(leafs);
+ hxns[ix].skip = 1;
+ hxns[ix].i = ix;
+ leafs += 2;
+ }
- while(idx > 0 && (c = CMP_TERM(kv[1],ks[idx-1])) < 0) { idx--; }
+ res = hashmap_from_unsorted_array(factory, hxns, n, reject_dupkeys);
- if (c == 0) {
- /* last compare was equal,
- * i.e. we have to release memory
- * and overwrite that key/value
- */
- ks[idx-1] = kv[1];
- vs[idx-1] = kv[2];
- unused_size++;
- } else {
- Uint i = size;
- while(i > idx) {
- ks[i] = ks[i-1];
- vs[i] = vs[i-1];
- i--;
+ erts_free(ERTS_ALC_T_TMP, (void *) hxns);
+
+ return res;
+}
+
+Eterm erts_map_from_ks_and_vs(ErtsHeapFactory *factory, Eterm *ks0, Eterm *vs0, Uint n)
+{
+ if (n < MAP_SMALL_MAP_LIMIT) {
+ Eterm *ks, *vs, *hp;
+ flatmap_t *mp;
+ Eterm keys;
+
+ hp = erts_produce_heap(factory, 3 + 1 + (2 * n), 0);
+ keys = make_tuple(hp);
+ *hp++ = make_arityval(n);
+ ks = hp;
+ hp += n;
+ mp = (flatmap_t*)hp;
+ hp += MAP_HEADER_FLATMAP_SZ;
+ vs = hp;
+
+ mp->thing_word = MAP_HEADER_FLATMAP;
+ mp->size = n;
+ mp->keys = keys;
+
+ sys_memcpy(ks, ks0, n * sizeof(Eterm));
+ sys_memcpy(vs, vs0, n * sizeof(Eterm));
+
+ erts_validate_and_sort_flatmap(mp);
+
+ return make_flatmap(mp);
+ } else {
+ return erts_hashmap_from_ks_and_vs(factory, ks0, vs0, n);
+ }
+ return THE_NON_VALUE;
+}
+
+
+Eterm erts_hashmap_from_ks_and_vs_extra(ErtsHeapFactory *factory,
+ Eterm *ks, Eterm *vs, Uint n,
+ Eterm key, Eterm value) {
+ Uint32 sw, hx;
+ Uint i,sz;
+ hxnode_t *hxns;
+ Eterm *hp, res;
+
+ sz = (key == THE_NON_VALUE) ? n : (n + 1);
+ ASSERT(sz > MAP_SMALL_MAP_LIMIT);
+ hp = erts_produce_heap(factory, 2 * sz, 0);
+
+ /* create tmp hx values and leaf ptrs */
+ hxns = (hxnode_t *)erts_alloc(ERTS_ALC_T_TMP, sz * sizeof(hxnode_t));
+
+ for(i = 0; i < n; i++) {
+ hx = hashmap_make_hash(ks[i]);
+ swizzle32(sw,hx);
+ hxns[i].hx = sw;
+ hxns[i].val = CONS(hp, ks[i], vs[i]); hp += 2;
+ hxns[i].skip = 1; /* will be reassigned in from_array */
+ hxns[i].i = i;
+ }
+
+ if (key != THE_NON_VALUE) {
+ hx = hashmap_make_hash(key);
+ swizzle32(sw,hx);
+ hxns[i].hx = sw;
+ hxns[i].val = CONS(hp, key, value); hp += 2;
+ hxns[i].skip = 1;
+ hxns[i].i = i;
+ }
+
+ res = hashmap_from_unsorted_array(factory, hxns, sz, 0);
+
+ erts_free(ERTS_ALC_T_TMP, (void *) hxns);
+
+ return res;
+}
+
+static Eterm hashmap_from_unsorted_array(ErtsHeapFactory* factory,
+ hxnode_t *hxns, Uint n,
+ int reject_dupkeys) {
+ Uint jx = 0, ix = 0, lx, cx;
+ Eterm res;
+
+ if (n == 0) {
+ Eterm *hp;
+ hp = erts_produce_heap(factory, 2, 0);
+ hp[0] = MAP_HEADER_HAMT_HEAD_BITMAP(0);
+ hp[1] = 0;
+
+ return make_hashmap(hp);
+ }
+
+ /* sort and compact array (remove non-unique entries) */
+ qsort(hxns, n, sizeof(hxnode_t), (int (*)(const void *, const void *)) hxnodecmp);
+
+ ix = 0, cx = 0;
+ while(ix < n - 1) {
+ if (hxns[ix].hx == hxns[ix+1].hx) {
+
+ /* find region of equal hash values */
+ jx = ix + 1;
+ while(jx < n && hxns[ix].hx == hxns[jx].hx) { jx++; }
+ /* find all correct keys from region
+ * (last in list but now hash sorted so we check highest id instead) */
+
+ /* resort with keys instead of hash value within region */
+
+ qsort(&hxns[ix], jx - ix, sizeof(hxnode_t),
+ (int (*)(const void *, const void *)) hxnodecmpkey);
+
+ while(ix < jx) {
+ lx = ix;
+ while(++ix < jx && EQ(CAR(list_val(hxns[ix].val)),
+ CAR(list_val(hxns[lx].val)))) {
+ if (reject_dupkeys)
+ return THE_NON_VALUE;
+
+ if (hxns[ix].i > hxns[lx].i) {
+ lx = ix;
+ }
}
- ks[idx] = kv[1];
- vs[idx] = kv[2];
- size++;
+ hxns[cx].hx = hxns[lx].hx;
+ hxns[cx].val = hxns[lx].val;
+ cx++;
}
- item = CDR(list_val(item));
+ ix = jx;
+ continue;
}
+ if (ix > cx) {
+ hxns[cx].hx = hxns[ix].hx;
+ hxns[cx].val = hxns[ix].val;
+ }
+ cx++;
+ ix++;
+ }
- if (unused_size) {
- /* the key tuple is embedded in the heap
- * write a bignum to clear it.
- */
- /* release values as normal since they are on the top of the heap */
+ if (ix < n) {
+ hxns[cx].hx = hxns[ix].hx;
+ hxns[cx].val = hxns[ix].val;
+ cx++;
+ }
- ks[size] = make_pos_bignum_header(unused_size - 1);
- HRelease(BIF_P, vs + size + unused_size, vs + size);
- }
+ if (cx > 1) {
+ /* recursive decompose array */
+ res = hashmap_from_sorted_unique_array(factory, hxns, cx, 0);
+ } else {
+ Eterm *hp;
- *thp = make_arityval(size);
- mp->size = size;
- BIF_RET(res);
+ /* we only have one item, either because n was 1 or
+ * because we hade multiples of the same key.
+ *
+ * hash value has been swizzled, need to drag it down to get the
+ * correct slot. */
+
+ hp = erts_produce_heap(factory, HAMT_HEAD_BITMAP_SZ(1), 0);
+ hp[0] = MAP_HEADER_HAMT_HEAD_BITMAP(1 << ((hxns[0].hx >> 0x1c) & 0xf));
+ hp[1] = 1;
+ hp[2] = hxns[0].val;
+ res = make_hashmap(hp);
}
-error:
+ return res;
+}
- BIF_ERROR(BIF_P, BADARG);
+static Eterm hashmap_from_sorted_unique_array(ErtsHeapFactory* factory,
+ hxnode_t *hxns, Uint n, int lvl) {
+ Eterm res = NIL;
+ Uint i,ix,jx,elems;
+ Uint32 sw, hx;
+ Eterm val;
+ hxnode_t *tmp;
+ DeclareTmpHeapNoproc(th,2);
+ UseTmpHeapNoproc(2);
+ ASSERT(lvl < 32);
+ ix = 0;
+ elems = 1;
+ while (ix < n - 1) {
+ if (hxns[ix].hx == hxns[ix+1].hx) {
+ jx = ix + 1;
+ while (jx < n && hxns[ix].hx == hxns[jx].hx) { jx++; }
+ tmp = (hxnode_t *)erts_alloc(ERTS_ALC_T_TMP, ((jx - ix)) * sizeof(hxnode_t));
+
+ for(i = 0; i < jx - ix; i++) {
+ val = hxns[i + ix].val;
+ hx = hashmap_restore_hash(th, lvl + 8, CAR(list_val(val)));
+ swizzle32(sw,hx);
+ tmp[i].hx = sw;
+ tmp[i].val = val;
+ tmp[i].i = i;
+ tmp[i].skip = 1;
+ }
+
+ qsort(tmp, jx - ix, sizeof(hxnode_t), (int (*)(const void *, const void *)) hxnodecmp);
+
+ hxns[ix].skip = jx - ix;
+ hxns[ix].val = hashmap_from_sorted_unique_array(factory, tmp, jx - ix, lvl + 8);
+ erts_free(ERTS_ALC_T_TMP, (void *) tmp);
+ ix = jx;
+ if (ix < n) { elems++; }
+ continue;
+ }
+ hxns[ix].skip = 1;
+ elems++;
+ ix++;
+ }
+
+ res = hashmap_from_chunked_array(factory, hxns, elems, n, !lvl);
+
+ ERTS_FACTORY_HOLE_CHECK(factory);
+
+ UnUseTmpHeapNoproc(2);
+ return res;
}
-/* maps:is_key/2
- */
+#define HALLOC_EXTRA 200
+static Eterm hashmap_from_chunked_array(ErtsHeapFactory *factory, hxnode_t *hxns, Uint n,
+ Uint size, int is_root) {
+ Uint ix, d, dn, dc, slot, elems;
+ Uint32 v, vp, vn, hdr;
+ Uint bp, sz;
+ DECLARE_ESTACK(stack);
+ Eterm res = NIL, *hp = NULL, *nhp;
-BIF_RETTYPE maps_is_key_2(BIF_ALIST_2) {
- if (is_map(BIF_ARG_2)) {
- Eterm *ks, key;
- map_t *mp;
- Uint n,i;
- mp = (map_t*)map_val(BIF_ARG_2);
- key = BIF_ARG_1;
- n = map_get_size(mp);
- ks = map_get_keys(mp);
+ /* if we get here with only one element then
+ * we have eight levels of collisions
+ */
- if (n == 0)
- BIF_RET(am_false);
+ if (n == 1) {
+ res = hxns[0].val;
+ v = hxns[0].hx;
+ for (d = 7; d > 0; d--) {
+ slot = maskval(v,d);
+ hp = erts_produce_heap(factory, HAMT_NODE_BITMAP_SZ(1), HALLOC_EXTRA);
+ hp[0] = MAP_HEADER_HAMT_NODE_BITMAP(1 << slot);
+ hp[1] = res;
+ res = make_hashmap(hp);
+ }
- if (is_immed(key)) {
- for( i = 0; i < n; i++) {
- if (ks[i] == key) {
- BIF_RET(am_true);
- }
+ slot = maskval(v,0);
+ hp = erts_produce_heap(factory, (is_root ? 3 : 2), 0);
+
+ if (is_root) {
+ hp[0] = MAP_HEADER_HAMT_HEAD_BITMAP(1 << slot);
+ hp[1] = size;
+ hp[2] = res;
+ } else {
+ hp[0] = MAP_HEADER_HAMT_NODE_BITMAP(1 << slot);
+ hp[1] = res;
+ }
+ return make_hashmap(hp);
+ }
+
+ /* push initial nodes on the stack,
+ * this is the starting depth */
+
+ ix = 0;
+ d = 0;
+ vp = hxns[ix].hx;
+ v = hxns[ix + hxns[ix].skip].hx;
+
+ ASSERT(vp > v);
+ slot = maskval(vp,d);
+
+ while(slot == maskval(v,d)) {
+ ESTACK_PUSH(stack, 1 << slot);
+ d++;
+ slot = maskval(vp,d);
+ }
+
+ res = hxns[ix].val;
+
+ if (hxns[ix].skip > 1) {
+ dc = 7;
+ /* build collision nodes */
+ while (dc > d) {
+ hp = erts_produce_heap(factory, HAMT_NODE_BITMAP_SZ(1), HALLOC_EXTRA);
+ hp[0] = MAP_HEADER_HAMT_NODE_BITMAP(1 << maskval(vp,dc));
+ hp[1] = res;
+ res = make_hashmap(hp);
+ dc--;
+ }
+ }
+
+ ESTACK_PUSH2(stack,res,1 << slot);
+
+ /* all of the other nodes .. */
+ elems = n - 2; /* remove first and last elements */
+ while(elems--) {
+ hdr = ESTACK_POP(stack);
+ ix = ix + hxns[ix].skip;
+
+ /* determine if node or subtree should be built by looking
+ * at the next value. */
+
+ vn = hxns[ix + hxns[ix].skip].hx;
+ dn = cdepth(v,vn);
+ ASSERT(v > vn);
+
+ res = hxns[ix].val;
+
+ if (hxns[ix].skip > 1) {
+ int wat = (d > dn) ? d : dn;
+ dc = 7;
+ /* build collision nodes */
+ while (dc > wat) {
+ hp = erts_produce_heap(factory, HAMT_NODE_BITMAP_SZ(1), HALLOC_EXTRA);
+ hp[0] = MAP_HEADER_HAMT_NODE_BITMAP(1 << maskval(v,dc));
+ hp[1] = res;
+ res = make_hashmap(hp);
+ dc--;
}
}
- for( i = 0; i < n; i++) {
- if (EQ(ks[i], key)) {
- BIF_RET(am_true);
+ /* next depth is higher (implies collision) */
+ if (d < dn) {
+ /* hdr is the popped one initially */
+ while(d < dn) {
+ slot = maskval(v, d);
+ bp = 1 << slot;
+ ESTACK_PUSH(stack, hdr | bp);
+ d++;
+ hdr = 0; /* clear hdr for all other collisions */
}
+
+ slot = maskval(v, d);
+ bp = 1 << slot;
+ /* no more collisions */
+ ESTACK_PUSH2(stack,res,bp);
+ } else if (d == dn) {
+ /* no collisions at all */
+ slot = maskval(v, d);
+ bp = 1 << slot;
+ ESTACK_PUSH2(stack,res,hdr | bp);
+ } else {
+ /* dn < n, we have a drop and we are done
+ * build nodes and subtree */
+ while (dn != d) {
+ slot = maskval(v, d);
+ bp = 1 << slot;
+ /* OR bitposition before sz calculation to handle
+ * redundant collisions */
+ hdr |= bp;
+ sz = hashmap_bitcount(hdr);
+ hp = erts_produce_heap(factory, HAMT_NODE_BITMAP_SZ(sz), HALLOC_EXTRA);
+ nhp = hp;
+ *hp++ = MAP_HEADER_HAMT_NODE_BITMAP(hdr);
+ *hp++ = res; sz--;
+ while (sz--) { *hp++ = ESTACK_POP(stack); }
+ ASSERT((hp - nhp) < 18);
+ res = make_hashmap(nhp);
+
+ /* we need to pop the next hdr and push if we don't need it */
+
+ hdr = ESTACK_POP(stack);
+ d--;
+ }
+ ESTACK_PUSH2(stack,res,hdr);
}
- BIF_RET(am_false);
+
+ vp = v;
+ v = vn;
+ d = dn;
+ ERTS_FACTORY_HOLE_CHECK(factory);
}
- BIF_ERROR(BIF_P, BADARG);
+
+ /* v and vp are reused from above */
+ dn = cdepth(vp,v);
+ ix = ix + hxns[ix].skip;
+ res = hxns[ix].val;
+
+ if (hxns[ix].skip > 1) {
+ dc = 7;
+ /* build collision nodes */
+ while (dc > dn) {
+ hp = erts_produce_heap(factory, HAMT_NODE_BITMAP_SZ(1), HALLOC_EXTRA);
+ hp[0] = MAP_HEADER_HAMT_NODE_BITMAP(1 << maskval(v,dc));
+ hp[1] = res;
+ res = make_hashmap(hp);
+ dc--;
+ }
+ }
+
+ hdr = ESTACK_POP(stack);
+ /* pop remaining subtree if any */
+ while (dn) {
+ slot = maskval(v, dn);
+ bp = 1 << slot;
+ /* OR bitposition before sz calculation to handle
+ * redundant collisions */
+ hdr |= bp;
+ sz = hashmap_bitcount(hdr);
+ hp = erts_produce_heap(factory, HAMT_NODE_BITMAP_SZ(sz), HALLOC_EXTRA);
+ nhp = hp;
+ *hp++ = MAP_HEADER_HAMT_NODE_BITMAP(hdr);
+ *hp++ = res; sz--;
+
+ while (sz--) { *hp++ = ESTACK_POP(stack); }
+ res = make_hashmap(nhp);
+ hdr = ESTACK_POP(stack);
+ dn--;
+ }
+
+ /* and finally the root .. */
+
+ slot = maskval(v, dn);
+ bp = 1 << slot;
+ hdr |= bp;
+ sz = hashmap_bitcount(hdr);
+ hp = erts_produce_heap(factory, sz + /* hdr + item */ (is_root ? 2 : 1), 0);
+ nhp = hp;
+
+ if (is_root) {
+ *hp++ = (hdr == 0xffff) ? MAP_HEADER_HAMT_HEAD_ARRAY : MAP_HEADER_HAMT_HEAD_BITMAP(hdr);
+ *hp++ = size;
+ } else {
+ *hp++ = MAP_HEADER_HAMT_NODE_BITMAP(hdr);
+ }
+
+ *hp++ = res; sz--;
+ while (sz--) { *hp++ = ESTACK_POP(stack); }
+
+ res = make_hashmap(nhp);
+
+ ASSERT(ESTACK_COUNT(stack) == 0);
+ DESTROY_ESTACK(stack);
+ ERTS_FACTORY_HOLE_CHECK(factory);
+ return res;
+}
+#undef HALLOC_EXTRA
+
+static int hxnodecmpkey(hxnode_t *a, hxnode_t *b) {
+ Sint c = CMP_TERM(CAR(list_val(a->val)), CAR(list_val(b->val)));
+#if ERTS_SIZEOF_ETERM <= SIZEOF_INT
+ return c;
+#else
+ return c > 0 ? 1 : (c < 0 ? -1 : 0);
+#endif
}
-/* maps:keys/1
- */
+static int hxnodecmp(hxnode_t *a, hxnode_t *b) {
+ if (a->hx < b->hx)
+ return 1;
+ else if (a->hx == b->hx)
+ return 0;
+ else
+ return -1;
+}
+
+/* maps:is_key/2 */
+
+BIF_RETTYPE maps_is_key_2(BIF_ALIST_2) {
+ if (is_map(BIF_ARG_2)) {
+ BIF_RET(erts_maps_get(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
+ }
+ BIF_P->fvalue = BIF_ARG_2;
+ BIF_ERROR(BIF_P, BADMAP);
+}
+
+/* maps:keys/1 */
BIF_RETTYPE maps_keys_1(BIF_ALIST_1) {
- if (is_map(BIF_ARG_1)) {
+ if (is_flatmap(BIF_ARG_1)) {
Eterm *hp, *ks, res = NIL;
- map_t *mp;
+ flatmap_t *mp;
Uint n;
- mp = (map_t*)map_val(BIF_ARG_1);
- n = map_get_size(mp);
+ mp = (flatmap_t*)flatmap_val(BIF_ARG_1);
+ n = flatmap_get_size(mp);
if (n == 0)
BIF_RET(res);
hp = HAlloc(BIF_P, (2 * n));
- ks = map_get_keys(mp);
+ ks = flatmap_get_keys(mp);
while(n--) {
res = CONS(hp, ks[n], res); hp += 2;
}
BIF_RET(res);
+ } else if (is_hashmap(BIF_ARG_1)) {
+ BIF_RET(hashmap_keys(BIF_P, BIF_ARG_1));
}
- BIF_ERROR(BIF_P, BADARG);
+ BIF_P->fvalue = BIF_ARG_1;
+ BIF_ERROR(BIF_P, BADMAP);
}
-/* maps:merge/2
- */
+
+/* maps:merge/2 */
+
+HIPE_WRAPPER_BIF_DISABLE_GC(maps_merge, 2)
BIF_RETTYPE maps_merge_2(BIF_ALIST_2) {
- if (is_map(BIF_ARG_1) && is_map(BIF_ARG_2)) {
- Eterm *hp,*thp;
- Eterm tup;
- Eterm *ks,*vs,*ks1,*vs1,*ks2,*vs2;
- map_t *mp1,*mp2,*mp_new;
- Uint n1,n2,i1,i2,need,unused_size=0;
- int c = 0;
-
- mp1 = (map_t*)map_val(BIF_ARG_1);
- mp2 = (map_t*)map_val(BIF_ARG_2);
- n1 = map_get_size(mp1);
- n2 = map_get_size(mp2);
-
- need = MAP_HEADER_SIZE + 1 + 2*(n1 + n2);
-
- hp = HAlloc(BIF_P, need);
- thp = hp;
- tup = make_tuple(thp);
- ks = hp + 1; hp += 1 + n1 + n2;
- mp_new = (map_t*)hp; hp += MAP_HEADER_SIZE;
- vs = hp; hp += n1 + n2;
-
- mp_new->thing_word = MAP_HEADER;
- mp_new->size = 0;
- mp_new->keys = tup;
-
- i1 = 0; i2 = 0;
- ks1 = map_get_keys(mp1);
- vs1 = map_get_values(mp1);
- ks2 = map_get_keys(mp2);
- vs2 = map_get_values(mp2);
-
- while(i1 < n1 && i2 < n2) {
- c = CMP_TERM(ks1[i1],ks2[i2]);
- if ( c == 0) {
- /* use righthand side arguments map value,
- * but advance both maps */
- *ks++ = ks2[i2];
- *vs++ = vs2[i2];
- i1++, i2++, unused_size++;
- } else if ( c < 0) {
- *ks++ = ks1[i1];
- *vs++ = vs1[i1];
- i1++;
- } else {
- *ks++ = ks2[i2];
- *vs++ = vs2[i2];
- i2++;
- }
+ if (is_flatmap(BIF_ARG_1)) {
+ if (is_flatmap(BIF_ARG_2)) {
+ BIF_RET(flatmap_merge(BIF_P, BIF_ARG_1, BIF_ARG_2));
+ } else if (is_hashmap(BIF_ARG_2)) {
+ /* Will always become a tree */
+ return map_merge_mixed(BIF_P, BIF_ARG_1, BIF_ARG_2, 0);
}
+ BIF_P->fvalue = BIF_ARG_2;
+ } else if (is_hashmap(BIF_ARG_1)) {
+ if (is_hashmap(BIF_ARG_2)) {
+ return hashmap_merge(BIF_P, BIF_ARG_1, BIF_ARG_2, 0, NULL);
+ } else if (is_flatmap(BIF_ARG_2)) {
+ /* Will always become a tree */
+ return map_merge_mixed(BIF_P, BIF_ARG_2, BIF_ARG_1, 1);
+ }
+ BIF_P->fvalue = BIF_ARG_2;
+ } else {
+ BIF_P->fvalue = BIF_ARG_1;
+ }
+ BIF_ERROR(BIF_P, BADMAP);
+}
+
+static Eterm flatmap_merge(Process *p, Eterm nodeA, Eterm nodeB) {
+ Eterm *hp,*thp;
+ Eterm tup;
+ Eterm *ks,*vs,*ks1,*vs1,*ks2,*vs2;
+ flatmap_t *mp1,*mp2,*mp_new;
+ Uint n,n1,n2,i1,i2,need,unused_size=0;
+ Sint c = 0;
+
+ mp1 = (flatmap_t*)flatmap_val(nodeA);
+ mp2 = (flatmap_t*)flatmap_val(nodeB);
+ n1 = flatmap_get_size(mp1);
+ n2 = flatmap_get_size(mp2);
- /* copy remaining */
- while (i1 < n1) {
+ need = MAP_HEADER_FLATMAP_SZ + 1 + 2 * (n1 + n2);
+
+ hp = HAlloc(p, need);
+ thp = hp;
+ tup = make_tuple(thp);
+ ks = hp + 1; hp += 1 + n1 + n2;
+ mp_new = (flatmap_t*)hp; hp += MAP_HEADER_FLATMAP_SZ;
+ vs = hp; hp += n1 + n2;
+
+ mp_new->thing_word = MAP_HEADER_FLATMAP;
+ mp_new->size = 0;
+ mp_new->keys = tup;
+
+ i1 = 0; i2 = 0;
+ ks1 = flatmap_get_keys(mp1);
+ vs1 = flatmap_get_values(mp1);
+ ks2 = flatmap_get_keys(mp2);
+ vs2 = flatmap_get_values(mp2);
+
+ while(i1 < n1 && i2 < n2) {
+ c = CMP_TERM(ks1[i1],ks2[i2]);
+ if (c == 0) {
+ /* use righthand side arguments map value,
+ * but advance both maps */
+ *ks++ = ks2[i2];
+ *vs++ = vs2[i2];
+ i1++, i2++, unused_size++;
+ } else if (c < 0) {
*ks++ = ks1[i1];
*vs++ = vs1[i1];
i1++;
- }
-
- while (i2 < n2) {
+ } else {
*ks++ = ks2[i2];
*vs++ = vs2[i2];
i2++;
}
+ }
- if (unused_size) {
- /* the key tuple is embedded in the heap, write a bignum to clear it.
- *
- * release values as normal since they are on the top of the heap
- * size = n1 + n1 - unused_size
- */
+ /* copy remaining */
+ while (i1 < n1) {
+ *ks++ = ks1[i1];
+ *vs++ = vs1[i1];
+ i1++;
+ }
+
+ while (i2 < n2) {
+ *ks++ = ks2[i2];
+ *vs++ = vs2[i2];
+ i2++;
+ }
+
+ if (unused_size) {
+ /* the key tuple is embedded in the heap, write a bignum to clear it.
+ *
+ * release values as normal since they are on the top of the heap
+ * size = n1 + n1 - unused_size
+ */
+
+ *ks = make_pos_bignum_header(unused_size - 1);
+ HRelease(p, vs + unused_size, vs);
+ }
+
+ n = n1 + n2 - unused_size;
+ *thp = make_arityval(n);
+ mp_new->size = n;
+
+ /* Reshape map to a hashmap if the map exceeds the limit */
- *ks = make_pos_bignum_header(unused_size - 1);
- HRelease(BIF_P, vs + unused_size, vs);
+ if (n > MAP_SMALL_MAP_LIMIT) {
+ Uint32 hx,sw;
+ Uint i;
+ Eterm res;
+ hxnode_t *hxns;
+ ErtsHeapFactory factory;
+
+ ks = flatmap_get_keys(mp_new);
+ vs = flatmap_get_values(mp_new);
+
+ hp = HAlloc(p, 2 * n);
+
+ hxns = (hxnode_t *)erts_alloc(ERTS_ALC_T_TMP,n * sizeof(hxnode_t));
+
+ for (i = 0; i < n; i++) {
+ hx = hashmap_make_hash(ks[i]);
+ swizzle32(sw,hx);
+ hxns[i].hx = sw;
+ hxns[i].val = CONS(hp, ks[i], vs[i]); hp += 2;
+ hxns[i].skip = 1;
+ hxns[i].i = i;
}
- mp_new->size = n1 + n2 - unused_size;
- *thp = make_arityval(n1 + n2 - unused_size);
+ erts_factory_proc_init(&factory, p);
+ res = hashmap_from_unsorted_array(&factory, hxns, n, 0);
+ erts_factory_close(&factory);
- BIF_RET(make_map(mp_new));
+ erts_free(ERTS_ALC_T_TMP, (void *) hxns);
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(p);
+
+ return res;
}
- BIF_ERROR(BIF_P, BADARG);
+
+ return make_flatmap(mp_new);
}
-/* maps:new/2
- */
-BIF_RETTYPE maps_new_0(BIF_ALIST_0) {
- Eterm* hp;
- Eterm tup;
- map_t *mp;
+static Eterm map_merge_mixed(Process *p, Eterm flat, Eterm tree, int swap_args) {
+ Eterm *ks, *vs, *hp, res;
+ flatmap_t *mp;
+ Uint n, i;
+ hxnode_t *hxns;
+ Uint32 sw, hx;
+ ErtsHeapFactory factory;
- hp = HAlloc(BIF_P, (MAP_HEADER_SIZE + 1));
- tup = make_tuple(hp);
- *hp++ = make_arityval(0);
+ /* convert flat to tree */
- mp = (map_t*)hp;
- mp->thing_word = MAP_HEADER;
- mp->size = 0;
- mp->keys = tup;
+ ASSERT(is_flatmap(flat));
+ ASSERT(is_hashmap(tree));
+
+ mp = (flatmap_t*)flatmap_val(flat);
+ n = flatmap_get_size(mp);
+
+ ks = flatmap_get_keys(mp);
+ vs = flatmap_get_values(mp);
+
+ hp = HAlloc(p, 2 * n);
+
+ hxns = (hxnode_t *)erts_alloc(ERTS_ALC_T_TMP, n * sizeof(hxnode_t));
- BIF_RET(make_map(mp));
+ for (i = 0; i < n; i++) {
+ hx = hashmap_make_hash(ks[i]);
+ swizzle32(sw,hx);
+ hxns[i].hx = sw;
+ hxns[i].val = CONS(hp, ks[i], vs[i]); hp += 2;
+ hxns[i].skip = 1;
+ hxns[i].i = i;
+ }
+
+ erts_factory_proc_init(&factory, p);
+ res = hashmap_from_unsorted_array(&factory, hxns, n, 0);
+ erts_factory_close(&factory);
+
+ erts_free(ERTS_ALC_T_TMP, (void *) hxns);
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(p);
+
+ return hashmap_merge(p, res, tree, swap_args, NULL);
}
-/* maps:put/3
- */
+#define PSTACK_TYPE struct HashmapMergePStackType
+struct HashmapMergePStackType {
+ Eterm nodeA, nodeB;
+ Eterm *srcA, *srcB;
+ Uint32 abm, bbm, rbm; /* node bitmaps */
+ int mix; /* &1: there are unique A stuff in node
+ * &2: there are unique B stuff in node */
+ int ix;
+ Eterm array[16]; /* temp node construction area */
+};
+
+typedef struct HashmapMergeContext_ {
+ Uint size; /* total key-value counter */
+ unsigned int lvl;
+ Eterm trap_bin;
+ ErtsPStack pstack;
+#ifdef DEBUG
+ Eterm dbg_map_A, dbg_map_B;
+#endif
+} HashmapMergeContext;
-Eterm erts_maps_put(Process *p, Eterm key, Eterm value, Eterm map) {
- Sint n,i;
- Sint c = 0;
- Eterm* hp, *shp;
- Eterm *ks,*vs, res, tup;
- map_t *mp = (map_t*)map_val(map);
+static int hashmap_merge_ctx_destructor(Binary* ctx_bin)
+{
+ HashmapMergeContext* ctx = (HashmapMergeContext*) ERTS_MAGIC_BIN_DATA(ctx_bin);
+ ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(ctx_bin) == hashmap_merge_ctx_destructor);
- n = map_get_size(mp);
+ PSTACK_DESTROY_SAVED(&ctx->pstack);
+ return 1;
+}
- if (n == 0) {
- hp = HAlloc(p, MAP_HEADER_SIZE + 1 + 2);
- tup = make_tuple(hp);
- *hp++ = make_arityval(1);
- *hp++ = key;
- res = make_map(hp);
- *hp++ = MAP_HEADER;
- *hp++ = 1;
- *hp++ = tup;
- *hp++ = value;
+BIF_RETTYPE maps_merge_trap_1(BIF_ALIST_1) {
+ Binary* ctx_bin = erts_magic_ref2bin(BIF_ARG_1);
- return res;
- }
+ ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(ctx_bin) == hashmap_merge_ctx_destructor);
- ks = map_get_keys(mp);
- vs = map_get_values(mp);
+ return hashmap_merge(BIF_P, NIL, NIL, 0,
+ (HashmapMergeContext*) ERTS_MAGIC_BIN_DATA(ctx_bin));
+}
- /* only allocate for values,
- * assume key-tuple will be intact
+#define HALLOC_EXTRA 200
+#define MAP_MERGE_LOOP_FACTOR 8
+
+static BIF_RETTYPE hashmap_merge(Process *p, Eterm map_A, Eterm map_B,
+ int swap_args, HashmapMergeContext* ctx) {
+#define PSTACK_TYPE struct HashmapMergePStackType
+ PSTACK_DECLARE(s, 4);
+ HashmapMergeContext local_ctx;
+ struct HashmapMergePStackType* sp;
+ Uint32 hx;
+ Eterm res = THE_NON_VALUE;
+ Eterm hdrA, hdrB;
+ Eterm *hp, *nhp;
+ Eterm trap_ret;
+ Sint initial_reds = (Sint) (ERTS_BIF_REDS_LEFT(p) * MAP_MERGE_LOOP_FACTOR);
+ Sint reds = initial_reds;
+ DeclareTmpHeap(th,2,p);
+ UseTmpHeap(2,p);
+
+ /*
+ * Strategy: Do depth-first traversal of both trees (at the same time)
+ * and merge each pair of nodes.
*/
- hp = HAlloc(p, MAP_HEADER_SIZE + n);
- shp = hp; /* save hp, used if optimistic update fails */
- res = make_map(hp);
- *hp++ = MAP_HEADER;
- *hp++ = n;
- *hp++ = mp->keys;
-
- if (is_immed(key)) {
- for( i = 0; i < n; i ++) {
- if (ks[i] == key) {
- *hp++ = value;
- vs++;
- c = 1;
- } else {
- *hp++ = *vs++;
+ PSTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK);
+
+ if (ctx == NULL) { /* first call */
+ hashmap_head_t* a = (hashmap_head_t*) hashmap_val(map_A);
+ hashmap_head_t* b = (hashmap_head_t*) hashmap_val(map_B);
+
+ sp = PSTACK_PUSH(s);
+ sp->srcA = swap_args ? &map_B : &map_A;
+ sp->srcB = swap_args ? &map_A : &map_B;
+ sp->mix = 0;
+ local_ctx.size = a->size + b->size;
+ local_ctx.lvl = 0;
+ #ifdef DEBUG
+ local_ctx.dbg_map_A = map_A;
+ local_ctx.dbg_map_B = map_B;
+ local_ctx.trap_bin = THE_NON_VALUE;
+ #endif
+ ctx = &local_ctx;
+ }
+ else {
+ PSTACK_RESTORE(s, &ctx->pstack);
+ sp = PSTACK_TOP(s);
+ goto resume_from_trap;
+ }
+
+recurse:
+
+ sp->nodeA = *sp->srcA;
+ sp->nodeB = *sp->srcB;
+
+ if (sp->nodeA == sp->nodeB) {
+ res = sp->nodeA;
+ ctx->size -= is_list(sp->nodeB) ? 1 : hashmap_subtree_size(sp->nodeB);
+ }
+ else {
+ if (is_list(sp->nodeA)) { /* A is LEAF */
+ Eterm keyA = CAR(list_val(sp->nodeA));
+
+ if (is_list(sp->nodeB)) { /* LEAF + LEAF */
+ Eterm keyB = CAR(list_val(sp->nodeB));
+
+ if (EQ(keyA, keyB)) {
+ --ctx->size;
+ res = sp->nodeB;
+ sp->mix = 2; /* We assume values differ.
+ + Don't spend time comparing big values.
+ - Might waste some heap space for internal
+ nodes that could otherwise be reused. */
+ goto merge_nodes;
+ }
+ }
+ hx = hashmap_restore_hash(th, ctx->lvl, keyA);
+ sp->abm = 1 << hashmap_index(hx);
+ /* keep srcA pointing at the leaf */
+ }
+ else { /* A is NODE */
+ sp->srcA = boxed_val(sp->nodeA);
+ hdrA = *sp->srcA++;
+ ASSERT(is_header(hdrA));
+ switch (hdrA & _HEADER_MAP_SUBTAG_MASK) {
+ case HAMT_SUBTAG_HEAD_ARRAY: {
+ sp->srcA++;
+ sp->abm = 0xffff;
+ break;
+ }
+ case HAMT_SUBTAG_HEAD_BITMAP: sp->srcA++;
+ case HAMT_SUBTAG_NODE_BITMAP: {
+ sp->abm = MAP_HEADER_VAL(hdrA);
+ break;
+ }
+ default:
+ erts_exit(ERTS_ABORT_EXIT, "bad header %ld\r\n", hdrA);
+ }
+ }
+
+ if (is_list(sp->nodeB)) { /* B is LEAF */
+ Eterm keyB = CAR(list_val(sp->nodeB));
+
+ hx = hashmap_restore_hash(th, ctx->lvl, keyB);
+ sp->bbm = 1 << hashmap_index(hx);
+ /* keep srcB pointing at the leaf */
+ }
+ else { /* B is NODE */
+ sp->srcB = boxed_val(sp->nodeB);
+ hdrB = *sp->srcB++;
+ ASSERT(is_header(hdrB));
+ switch (hdrB & _HEADER_MAP_SUBTAG_MASK) {
+ case HAMT_SUBTAG_HEAD_ARRAY: {
+ sp->srcB++;
+ sp->bbm = 0xffff;
+ break;
+ }
+ case HAMT_SUBTAG_HEAD_BITMAP: sp->srcB++;
+ case HAMT_SUBTAG_NODE_BITMAP: {
+ sp->bbm = MAP_HEADER_VAL(hdrB);
+ break;
+ }
+ default:
+ erts_exit(ERTS_ABORT_EXIT, "bad header %ld\r\n", hdrB);
+ }
+ }
+ }
+
+merge_nodes:
+
+ for (;;) {
+ if (is_value(res)) { /* We have a complete (sub-)tree or leaf */
+ int child_mix;
+ if (ctx->lvl == 0)
+ break;
+
+ /* Pop from stack and continue build parent node */
+ ctx->lvl--;
+ child_mix = sp->mix;
+ sp = PSTACK_POP(s);
+ sp->array[sp->ix++] = res;
+ sp->mix |= child_mix;
+ res = THE_NON_VALUE;
+ if (sp->rbm) {
+ sp->srcA++;
+ sp->srcB++;
}
+ } else { /* Start build a node */
+ sp->ix = 0;
+ sp->rbm = sp->abm | sp->bbm;
+ ASSERT(!(sp->rbm == 0 && ctx->lvl > 0));
}
- } else {
- for( i = 0; i < n; i ++) {
- if (EQ(ks[i], key)) {
- *hp++ = value;
- vs++;
- c = 1;
+
+ if (--reds <= 0) {
+ goto trap;
+ }
+resume_from_trap:
+
+ while (sp->rbm) {
+ Uint32 next = sp->rbm & (sp->rbm-1);
+ Uint32 bit = sp->rbm ^ next;
+ sp->rbm = next;
+ if (sp->abm & bit) {
+ if (sp->bbm & bit) {
+ /* Bit clash. Push and resolve by recursive merge */
+ Eterm* srcA = sp->srcA;
+ Eterm* srcB = sp->srcB;
+ ctx->lvl++;
+ sp = PSTACK_PUSH(s);
+ sp->srcA = srcA;
+ sp->srcB = srcB;
+ sp->mix = 0;
+ goto recurse;
+ } else {
+ sp->array[sp->ix++] = *sp->srcA++;
+ sp->mix |= 1;
+ }
} else {
- *hp++ = *vs++;
+ ASSERT(sp->bbm & bit);
+ sp->array[sp->ix++] = *sp->srcB++;
+ sp->mix |= 2;
}
}
+
+ switch (sp->mix) {
+ case 0: /* Nodes A and B contain the *EXACT* same sub-trees
+ => fall through and reuse nodeA */
+
+ case 1: /* Only unique A stuff => reuse nodeA */
+ res = sp->nodeA;
+ break;
+
+ case 2: /* Only unique B stuff => reuse nodeB */
+ res = sp->nodeB;
+ break;
+
+ case 3: /* We have a mix => must build new node */
+ ASSERT(sp->ix == hashmap_bitcount(sp->abm | sp->bbm));
+ if (ctx->lvl == 0) {
+ nhp = HAllocX(p, HAMT_HEAD_BITMAP_SZ(sp->ix), HALLOC_EXTRA);
+ hp = nhp;
+ *hp++ = (sp->ix == 16 ? MAP_HEADER_HAMT_HEAD_ARRAY
+ : MAP_HEADER_HAMT_HEAD_BITMAP(sp->abm | sp->bbm));
+ *hp++ = ctx->size;
+ } else {
+ nhp = HAllocX(p, HAMT_NODE_BITMAP_SZ(sp->ix), HALLOC_EXTRA);
+ hp = nhp;
+ *hp++ = MAP_HEADER_HAMT_NODE_BITMAP(sp->abm | sp->bbm);
+ }
+ sys_memcpy(hp, sp->array, sp->ix * sizeof(Eterm));
+ res = make_boxed(nhp);
+ break;
+ default:
+ erts_exit(ERTS_ABORT_EXIT, "strange mix %d\r\n", sp->mix);
+ }
}
- if (c)
- return res;
+ /* Done */
- /* need to make a new tuple,
- * use old hp since it needs to be recreated anyway.
- */
- tup = make_tuple(shp);
- *shp++ = make_arityval(n+1);
+#ifdef DEBUG
+ {
+ Eterm *head = hashmap_val(res);
+ Uint size = head[1];
+ Uint real_size = hashmap_subtree_size(res);
+ ASSERT(size == real_size);
+ }
+#endif
- hp = HAlloc(p, 3 + n + 1);
- res = make_map(hp);
- *hp++ = MAP_HEADER;
- *hp++ = n + 1;
- *hp++ = tup;
+ if (ctx != &local_ctx) {
+ ASSERT(ctx->trap_bin != THE_NON_VALUE);
+ ASSERT(p->flags & F_DISABLE_GC);
+ erts_set_gc_state(p, 1);
+ }
+ else {
+ ASSERT(ctx->trap_bin == THE_NON_VALUE);
+ ASSERT(!(p->flags & F_DISABLE_GC));
+ }
+ PSTACK_DESTROY(s);
+ UnUseTmpHeap(2,p);
+ BUMP_REDS(p, (initial_reds - reds) / MAP_MERGE_LOOP_FACTOR);
+ return res;
- ks = map_get_keys(mp);
- vs = map_get_values(mp);
+trap: /* Yield */
- ASSERT(n >= 0);
+ if (ctx == &local_ctx) {
+ Binary* ctx_b = erts_create_magic_binary(sizeof(HashmapMergeContext),
+ hashmap_merge_ctx_destructor);
+ ctx = ERTS_MAGIC_BIN_DATA(ctx_b);
+ sys_memcpy(ctx, &local_ctx, sizeof(HashmapMergeContext));
+ hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE);
+ ASSERT(ctx->trap_bin == THE_NON_VALUE);
+ ctx->trap_bin = erts_mk_magic_ref(&hp, &MSO(p), ctx_b);
- /* copy map in order */
- while (n && ((c = CMP_TERM(*ks, key)) < 0)) {
- *shp++ = *ks++;
- *hp++ = *vs++;
- n--;
+ erts_set_gc_state(p, 0);
}
+ else {
+ ASSERT(ctx->trap_bin != THE_NON_VALUE);
+ ASSERT(p->flags & F_DISABLE_GC);
+ }
+
+ PSTACK_SAVE(s, &ctx->pstack);
- *shp++ = key;
- *hp++ = value;
+ BUMP_ALL_REDS(p);
+ ERTS_BIF_PREP_TRAP1(trap_ret, &hashmap_merge_trap_export,
+ p, ctx->trap_bin);
+ UnUseTmpHeap(2,p);
+ return trap_ret;
+}
- ASSERT(n >= 0);
+static Uint hashmap_subtree_size(Eterm node) {
+ DECLARE_WSTACK(stack);
+ Uint size = 0;
- while(n--) {
- *shp++ = *ks++;
- *hp++ = *vs++;
+ hashmap_iterator_init(&stack, node, 0);
+ while (hashmap_iterator_next(&stack)) {
+ size++;
}
- /* we have one word remaining
- * this will work out fine once we get the size word
- * in the header.
- */
- *shp = make_pos_bignum_header(0);
- return res;
+ DESTROY_WSTACK(stack);
+ return size;
}
-BIF_RETTYPE maps_put_3(BIF_ALIST_3) {
- if (is_map(BIF_ARG_3)) {
- BIF_RET(erts_maps_put(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3));
+
+static int hash_cmp(Uint32 ha, Uint32 hb)
+{
+ int i;
+ for (i=0; i<8; i++) {
+ int cmp = (int)(ha & 0xF) - (int)(hb & 0xF);
+ if (cmp)
+ return cmp;
+ ha >>= 4;
+ hb >>= 4;
}
- BIF_ERROR(BIF_P, BADARG);
+ return 0;
}
-/* maps:remove/3
- */
+int hashmap_key_hash_cmp(Eterm* ap, Eterm* bp)
+{
+ unsigned int lvl = 0;
+ DeclareTmpHeapNoproc(th,2);
+ UseTmpHeapNoproc(2);
+
+ if (ap && bp) {
+ ASSERT(CMP_TERM(CAR(ap), CAR(bp)) != 0);
+ for (;;) {
+ Uint32 ha = hashmap_restore_hash(th, lvl, CAR(ap));
+ Uint32 hb = hashmap_restore_hash(th, lvl, CAR(bp));
+ int cmp = hash_cmp(ha, hb);
+ if (cmp) {
+ UnUseTmpHeapNoproc(2);
+ return cmp;
+ }
+ lvl += 8;
+ }
+ }
+ UnUseTmpHeapNoproc(2);
+ return ap ? -1 : 1;
+}
-int erts_maps_remove(Process *p, Eterm key, Eterm map, Eterm *res) {
- Sint n;
- Uint need;
- Eterm *hp_start;
- Eterm *thp, *mhp;
- Eterm *ks, *vs, tup;
- map_t *mp = (map_t*)map_val(map);
+/* maps:new/0 */
- n = map_get_size(mp);
+BIF_RETTYPE maps_new_0(BIF_ALIST_0) {
+ Eterm* hp;
+ Eterm tup;
+ flatmap_t *mp;
- if (n == 0) {
- *res = map;
- return 1;
- }
+ hp = HAlloc(BIF_P, (MAP_HEADER_FLATMAP_SZ + 1));
+ tup = make_tuple(hp);
+ *hp++ = make_arityval(0);
- ks = map_get_keys(mp);
- vs = map_get_values(mp);
+ mp = (flatmap_t*)hp;
+ mp->thing_word = MAP_HEADER_FLATMAP;
+ mp->size = 0;
+ mp->keys = tup;
- /* Assume key exists.
- * Release allocated if it didn't.
- * Allocate key tuple first.
- */
+ BIF_RET(make_flatmap(mp));
+}
- need = n + 1 - 1 + 3 + n - 1; /* tuple - 1 + map - 1 */
- hp_start = HAlloc(p, need);
- thp = hp_start;
- mhp = thp + n; /* offset with tuple heap size */
+/* maps:put/3 */
- tup = make_tuple(thp);
- *thp++ = make_arityval(n - 1);
-
- *res = make_map(mhp);
- *mhp++ = MAP_HEADER;
- *mhp++ = n - 1;
- *mhp++ = tup;
-
- if (is_immed(key)) {
- while (1) {
- if (*ks == key) {
- goto found_key;
- } else if (--n) {
- *mhp++ = *vs++;
- *thp++ = *ks++;
- } else
- break;
- }
- } else {
- while(1) {
- if (EQ(*ks, key)) {
- goto found_key;
- } else if (--n) {
- *mhp++ = *vs++;
- *thp++ = *ks++;
- } else
- break;
- }
+BIF_RETTYPE maps_put_3(BIF_ALIST_3) {
+ if (is_map(BIF_ARG_3)) {
+ BIF_RET(erts_maps_put(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3));
}
+ BIF_P->fvalue = BIF_ARG_3;
+ BIF_ERROR(BIF_P, BADMAP);
+}
- /* Not found, remove allocated memory
- * and return previous map.
- */
- HRelease(p, hp_start + need, hp_start);
+/* maps:take/2 */
- *res = map;
- return 1;
-
-found_key:
- /* Copy rest of keys and values */
- if (--n) {
- sys_memcpy(mhp, vs+1, n*sizeof(Eterm));
- sys_memcpy(thp, ks+1, n*sizeof(Eterm));
+BIF_RETTYPE maps_take_2(BIF_ALIST_2) {
+ if (is_map(BIF_ARG_2)) {
+ Eterm res, map, val;
+ if (erts_maps_take(BIF_P, BIF_ARG_1, BIF_ARG_2, &map, &val)) {
+ Eterm *hp = HAlloc(BIF_P, 3);
+ res = make_tuple(hp);
+ *hp++ = make_arityval(2);
+ *hp++ = val;
+ *hp++ = map;
+ BIF_RET(res);
+ }
+ BIF_RET(am_error);
}
- return 1;
+ BIF_P->fvalue = BIF_ARG_2;
+ BIF_ERROR(BIF_P, BADMAP);
}
+/* maps:remove/2 */
+
BIF_RETTYPE maps_remove_2(BIF_ALIST_2) {
if (is_map(BIF_ARG_2)) {
- Eterm res;
- if (erts_maps_remove(BIF_P, BIF_ARG_1, BIF_ARG_2, &res)) {
- BIF_RET(res);
- }
+ Eterm res;
+ (void) erts_maps_take(BIF_P, BIF_ARG_1, BIF_ARG_2, &res, NULL);
+ BIF_RET(res);
}
- BIF_ERROR(BIF_P, BADARG);
+ BIF_P->fvalue = BIF_ARG_2;
+ BIF_ERROR(BIF_P, BADMAP);
}
-/* maps:update/3
+/* erts_maps_take
+ * return 1 if key is found, otherwise 0
+ * If the key is not found res (output map) will be map (input map)
*/
+int erts_maps_take(Process *p, Eterm key, Eterm map,
+ Eterm *res, Eterm *value) {
+ Uint32 hx;
+ Eterm ret;
+ if (is_flatmap(map)) {
+ Sint n;
+ Uint need;
+ Eterm *hp_start;
+ Eterm *thp, *mhp;
+ Eterm *ks, *vs, tup;
+ flatmap_t *mp = (flatmap_t*)flatmap_val(map);
+
+ n = flatmap_get_size(mp);
+
+ if (n == 0) {
+ *res = map;
+ return 0;
+ }
+
+ ks = flatmap_get_keys(mp);
+ vs = flatmap_get_values(mp);
+
+ /* Assume key exists.
+ * Release allocated if it didn't.
+ * Allocate key tuple first.
+ */
+
+ need = n + 1 - 1 + 3 + n - 1; /* tuple - 1 + map - 1 */
+ hp_start = HAlloc(p, need);
+ thp = hp_start;
+ mhp = thp + n; /* offset with tuple heap size */
+
+ tup = make_tuple(thp);
+ *thp++ = make_arityval(n - 1);
+
+ *res = make_flatmap(mhp);
+ *mhp++ = MAP_HEADER_FLATMAP;
+ *mhp++ = n - 1;
+ *mhp++ = tup;
+
+ if (is_immed(key)) {
+ while (1) {
+ if (*ks == key) {
+ if (value) *value = *vs;
+ goto found_key;
+ } else if (--n) {
+ *mhp++ = *vs++;
+ *thp++ = *ks++;
+ } else
+ break;
+ }
+ } else {
+ while(1) {
+ if (EQ(*ks, key)) {
+ if (value) *value = *vs;
+ goto found_key;
+ } else if (--n) {
+ *mhp++ = *vs++;
+ *thp++ = *ks++;
+ } else
+ break;
+ }
+ }
+
+ /* Not found, remove allocated memory
+ * and return previous map.
+ */
+ HRelease(p, hp_start + need, hp_start);
+
+ *res = map;
+ return 0;
+
+found_key:
+ /* Copy rest of keys and values */
+ if (--n) {
+ sys_memcpy(mhp, vs+1, n*sizeof(Eterm));
+ sys_memcpy(thp, ks+1, n*sizeof(Eterm));
+ }
+ return 1;
+ }
+ ASSERT(is_hashmap(map));
+ hx = hashmap_make_hash(key);
+ ret = hashmap_delete(p, hx, key, map, value);
+ if (is_value(ret)) {
+ *res = ret;
+ return 1;
+ }
+ *res = map;
+ return 0;
+}
int erts_maps_update(Process *p, Eterm key, Eterm value, Eterm map, Eterm *res) {
+ Uint32 hx;
+ if (is_flatmap(map)) {
Sint n,i;
Eterm* hp,*shp;
Eterm *ks,*vs;
- map_t *mp = (map_t*)map_val(map);
+ flatmap_t *mp = (flatmap_t*)flatmap_val(map);
- if ((n = map_get_size(mp)) == 0) {
+ if ((n = flatmap_get_size(mp)) == 0) {
return 0;
}
- ks = map_get_keys(mp);
- vs = map_get_values(mp);
+ ks = flatmap_get_keys(mp);
+ vs = flatmap_get_values(mp);
/* only allocate for values,
* assume key-tuple will be intact
*/
- hp = HAlloc(p, MAP_HEADER_SIZE + n);
+ hp = HAlloc(p, MAP_HEADER_FLATMAP_SZ + n);
shp = hp;
- *hp++ = MAP_HEADER;
+ *hp++ = MAP_HEADER_FLATMAP;
*hp++ = n;
*hp++ = mp->keys;
@@ -739,7 +1766,7 @@ int erts_maps_update(Process *p, Eterm key, Eterm value, Eterm map, Eterm *res)
}
}
- HRelease(p, shp + MAP_HEADER_SIZE + n, shp);
+ HRelease(p, shp + MAP_HEADER_FLATMAP_SZ + n, shp);
return 0;
found_key:
@@ -747,56 +1774,956 @@ found_key:
vs++;
if (++i < n)
sys_memcpy(hp, vs, (n - i)*sizeof(Eterm));
- *res = make_map(shp);
+ *res = make_flatmap(shp);
return 1;
+ }
+
+ ASSERT(is_hashmap(map));
+ hx = hashmap_make_hash(key);
+ *res = erts_hashmap_insert(p, hx, key, value, map, 1);
+ if (is_value(*res))
+ return 1;
+
+ return 0;
+}
+
+Eterm erts_maps_put(Process *p, Eterm key, Eterm value, Eterm map) {
+ Uint32 hx;
+ Eterm res;
+ if (is_flatmap(map)) {
+ Sint n,i;
+ Sint c = 0;
+ Eterm* hp, *shp;
+ Eterm *ks, *vs, tup;
+ flatmap_t *mp = (flatmap_t*)flatmap_val(map);
+
+ n = flatmap_get_size(mp);
+
+ if (n == 0) {
+ hp = HAlloc(p, MAP_HEADER_FLATMAP_SZ + 1 + 2);
+ tup = make_tuple(hp);
+ *hp++ = make_arityval(1);
+ *hp++ = key;
+ res = make_flatmap(hp);
+ *hp++ = MAP_HEADER_FLATMAP;
+ *hp++ = 1;
+ *hp++ = tup;
+ *hp++ = value;
+
+ return res;
+ }
+
+ ks = flatmap_get_keys(mp);
+ vs = flatmap_get_values(mp);
+
+ /* only allocate for values,
+ * assume key-tuple will be intact
+ */
+
+ hp = HAlloc(p, MAP_HEADER_FLATMAP_SZ + n);
+ shp = hp; /* save hp, used if optimistic update fails */
+ res = make_flatmap(hp);
+ *hp++ = MAP_HEADER_FLATMAP;
+ *hp++ = n;
+ *hp++ = mp->keys;
+
+ if (is_immed(key)) {
+ for( i = 0; i < n; i ++) {
+ if (ks[i] == key) {
+ *hp++ = value;
+ vs++;
+ c = 1;
+ } else {
+ *hp++ = *vs++;
+ }
+ }
+ } else {
+ for( i = 0; i < n; i ++) {
+ if (EQ(ks[i], key)) {
+ *hp++ = value;
+ vs++;
+ c = 1;
+ } else {
+ *hp++ = *vs++;
+ }
+ }
+ }
+
+ if (c)
+ return res;
+
+ /* the map will grow */
+
+ if (n >= MAP_SMALL_MAP_LIMIT) {
+ ErtsHeapFactory factory;
+ HRelease(p, shp + MAP_HEADER_FLATMAP_SZ + n, shp);
+ ks = flatmap_get_keys(mp);
+ vs = flatmap_get_values(mp);
+
+ erts_factory_proc_init(&factory, p);
+ res = erts_hashmap_from_ks_and_vs_extra(&factory,ks,vs,n,key,value);
+ erts_factory_close(&factory);
+
+ return res;
+ }
+
+ /* still a small map. need to make a new tuple,
+ * use old hp since it needs to be recreated anyway. */
+
+ tup = make_tuple(shp);
+ *shp++ = make_arityval(n+1);
+
+ hp = HAlloc(p, 3 + n + 1);
+ res = make_flatmap(hp);
+ *hp++ = MAP_HEADER_FLATMAP;
+ *hp++ = n + 1;
+ *hp++ = tup;
+
+ ks = flatmap_get_keys(mp);
+ vs = flatmap_get_values(mp);
+
+ ASSERT(n >= 0);
+
+ /* copy map in order */
+ while (n && ((c = CMP_TERM(*ks, key)) < 0)) {
+ *shp++ = *ks++;
+ *hp++ = *vs++;
+ n--;
+ }
+
+ *shp++ = key;
+ *hp++ = value;
+
+ ASSERT(n >= 0);
+
+ while(n--) {
+ *shp++ = *ks++;
+ *hp++ = *vs++;
+ }
+ /* we have one word remaining
+ * this will work out fine once we get the size word
+ * in the header.
+ */
+ *shp = make_pos_bignum_header(0);
+ return res;
+ }
+ ASSERT(is_hashmap(map));
+
+ hx = hashmap_make_hash(key);
+ res = erts_hashmap_insert(p, hx, key, value, map, 0);
+ ASSERT(is_hashmap(res));
+
+ return res;
}
+/* maps:update/3 */
+
BIF_RETTYPE maps_update_3(BIF_ALIST_3) {
- if (is_map(BIF_ARG_3)) {
+ if (is_not_map(BIF_ARG_3)) {
+ BIF_P->fvalue = BIF_ARG_3;
+ BIF_ERROR(BIF_P, BADMAP);
+ } else {
Eterm res;
if (erts_maps_update(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, &res)) {
BIF_RET(res);
}
+ BIF_P->fvalue = BIF_ARG_1;
+ BIF_ERROR(BIF_P, BADKEY);
}
- BIF_ERROR(BIF_P, BADARG);
}
-/* maps:values/1
- */
+/* maps:values/1 */
BIF_RETTYPE maps_values_1(BIF_ALIST_1) {
- if (is_map(BIF_ARG_1)) {
+ if (is_flatmap(BIF_ARG_1)) {
Eterm *hp, *vs, res = NIL;
- map_t *mp;
+ flatmap_t *mp;
Uint n;
- mp = (map_t*)map_val(BIF_ARG_1);
- n = map_get_size(mp);
+ mp = (flatmap_t*)flatmap_val(BIF_ARG_1);
+ n = flatmap_get_size(mp);
if (n == 0)
BIF_RET(res);
hp = HAlloc(BIF_P, (2 * n));
- vs = map_get_values(mp);
+ vs = flatmap_get_values(mp);
while(n--) {
res = CONS(hp, vs[n], res); hp += 2;
}
BIF_RET(res);
+ } else if (is_hashmap(BIF_ARG_1)) {
+ BIF_RET(hashmap_values(BIF_P, BIF_ARG_1));
}
- BIF_ERROR(BIF_P, BADARG);
+ BIF_P->fvalue = BIF_ARG_1;
+ BIF_ERROR(BIF_P, BADMAP);
}
-int erts_validate_and_sort_map(map_t* mp)
+static Eterm hashmap_to_list(Process *p, Eterm node, Sint m) {
+ DECLARE_WSTACK(stack);
+ Eterm *hp, *kv;
+ Eterm tup, res = NIL;
+ Uint n = hashmap_size(node);
+
+ if (m >= 0) {
+ n = m < n ? m : n;
+ }
+
+ hp = HAlloc(p, n * (2 + 3));
+ hashmap_iterator_init(&stack, node, 0);
+ while (n--) {
+ kv = hashmap_iterator_next(&stack);
+ ASSERT(kv != NULL);
+ tup = TUPLE2(hp, CAR(kv), CDR(kv));
+ hp += 3;
+ res = CONS(hp, tup, res);
+ hp += 2;
+ }
+ DESTROY_WSTACK(stack);
+ return res;
+}
+
+void hashmap_iterator_init(ErtsWStack* s, Eterm node, int reverse) {
+ Eterm hdr = *hashmap_val(node);
+ Uint sz;
+
+ switch(hdr & _HEADER_MAP_SUBTAG_MASK) {
+ case HAMT_SUBTAG_HEAD_ARRAY:
+ sz = 16;
+ break;
+ case HAMT_SUBTAG_HEAD_BITMAP:
+ case HAMT_SUBTAG_NODE_BITMAP:
+ sz = hashmap_bitcount(MAP_HEADER_VAL(hdr));
+ break;
+ default:
+ erts_exit(ERTS_ABORT_EXIT, "bad header");
+ }
+
+ WSTACK_PUSH3((*s), (UWord)THE_NON_VALUE, /* end marker */
+ (UWord)(!reverse ? 0 : sz+1),
+ (UWord)node);
+}
+
+Eterm* hashmap_iterator_next(ErtsWStack* s) {
+ Eterm node, *ptr, hdr;
+ Uint32 sz;
+ Uint idx;
+
+ for (;;) {
+ ASSERT(!WSTACK_ISEMPTY((*s)));
+ node = (Eterm) WSTACK_POP((*s));
+ if (is_non_value(node)) {
+ return NULL;
+ }
+ idx = (Uint) WSTACK_POP((*s));
+ for (;;) {
+ ASSERT(is_boxed(node));
+ ptr = boxed_val(node);
+ hdr = *ptr;
+ ASSERT(is_header(hdr));
+ switch(hdr & _HEADER_MAP_SUBTAG_MASK) {
+ case HAMT_SUBTAG_HEAD_ARRAY:
+ ptr++;
+ sz = 16;
+ break;
+ case HAMT_SUBTAG_HEAD_BITMAP:
+ ptr++;
+ case HAMT_SUBTAG_NODE_BITMAP:
+ sz = hashmap_bitcount(MAP_HEADER_VAL(hdr));
+ ASSERT(sz < 17);
+ break;
+ default:
+ erts_exit(ERTS_ABORT_EXIT, "bad header");
+ }
+
+ idx++;
+
+ if (idx <= sz) {
+ WSTACK_PUSH2((*s), (UWord)idx, (UWord)node);
+
+ if (is_list(ptr[idx])) {
+ return list_val(ptr[idx]);
+ }
+ ASSERT(is_boxed(ptr[idx]));
+ node = ptr[idx];
+ idx = 0;
+ }
+ else
+ break; /* and pop parent node */
+ }
+ }
+}
+
+Eterm* hashmap_iterator_prev(ErtsWStack* s) {
+ Eterm node, *ptr, hdr;
+ Uint32 sz;
+ Uint idx;
+
+ for (;;) {
+ ASSERT(!WSTACK_ISEMPTY((*s)));
+ node = (Eterm) WSTACK_POP((*s));
+ if (is_non_value(node)) {
+ return NULL;
+ }
+ idx = (Uint) WSTACK_POP((*s));
+ for (;;) {
+ ASSERT(is_boxed(node));
+ ptr = boxed_val(node);
+ hdr = *ptr;
+ ASSERT(is_header(hdr));
+ switch(hdr & _HEADER_MAP_SUBTAG_MASK) {
+ case HAMT_SUBTAG_HEAD_ARRAY:
+ ptr++;
+ sz = 16;
+ break;
+ case HAMT_SUBTAG_HEAD_BITMAP:
+ ptr++;
+ case HAMT_SUBTAG_NODE_BITMAP:
+ sz = hashmap_bitcount(MAP_HEADER_VAL(hdr));
+ ASSERT(sz < 17);
+ break;
+ default:
+ erts_exit(ERTS_ERROR_EXIT, "bad header");
+ }
+
+ if (idx > sz)
+ idx = sz;
+ else
+ idx--;
+
+ if (idx >= 1) {
+ WSTACK_PUSH2((*s), (UWord)idx, (UWord)node);
+
+ if (is_list(ptr[idx])) {
+ return list_val(ptr[idx]);
+ }
+ ASSERT(is_boxed(ptr[idx]));
+ node = ptr[idx];
+ idx = 17;
+ }
+ else
+ break; /* and pop parent node */
+ }
+ }
+}
+
+const Eterm *
+erts_hashmap_get(Uint32 hx, Eterm key, Eterm node)
{
- Eterm *ks = map_get_keys(mp);
- Eterm *vs = map_get_values(mp);
- Uint sz = map_get_size(mp);
+ Eterm *ptr, hdr, *res;
+ Uint ix, lvl = 0;
+ Uint32 hval,bp;
+ DeclareTmpHeapNoproc(th,2);
+ UseTmpHeapNoproc(2);
+
+ ASSERT(is_boxed(node));
+ ptr = boxed_val(node);
+ hdr = *ptr;
+ ASSERT(is_header(hdr));
+ ASSERT(is_hashmap_header_head(hdr));
+ ptr++;
+
+ for (;;) {
+ hval = MAP_HEADER_VAL(hdr);
+ ix = hashmap_index(hx);
+ if (hval != 0xffff) {
+ bp = 1 << ix;
+ if (!(bp & hval)) {
+ /* not occupied */
+ res = NULL;
+ break;
+ }
+ ix = hashmap_bitcount(hval & (bp - 1));
+ }
+ node = ptr[ix+1];
+
+ if (is_list(node)) { /* LEAF NODE [K|V] */
+ 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(node);
+ hdr = *ptr;
+ ASSERT(is_header(hdr));
+ ASSERT(!is_hashmap_header_head(hdr));
+ }
+
+ UnUseTmpHeapNoproc(2);
+ return res;
+}
+
+Eterm erts_hashmap_insert(Process *p, Uint32 hx, Eterm key, Eterm value,
+ Eterm map, int is_update) {
+ Uint size, upsz;
+ Eterm *hp, res = THE_NON_VALUE;
+ DECLARE_ESTACK(stack);
+ if (erts_hashmap_insert_down(hx, key, map, &size, &upsz, &stack, is_update)) {
+ hp = HAlloc(p, size);
+ res = erts_hashmap_insert_up(hp, key, value, &upsz, &stack);
+ }
+
+ DESTROY_ESTACK(stack);
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(p);
+ ERTS_HOLE_CHECK(p);
+
+ return res;
+}
+
+
+int erts_hashmap_insert_down(Uint32 hx, Eterm key, Eterm node, Uint *sz,
+ Uint *update_size, ErtsEStack *sp, int is_update) {
+ Eterm *ptr;
+ Eterm hdr, ckey;
+ Uint32 ix, cix, bp, hval, chx;
+ Uint slot, lvl = 0, clvl;
+ Uint size = 0, n = 0;
+ DeclareTmpHeapNoproc(th,2);
+
+ *update_size = 1;
+
+ UseTmpHeapNoproc(2);
+ for (;;) {
+ switch(primary_tag(node)) {
+ case TAG_PRIMARY_LIST: /* LEAF NODE [K|V] */
+ ptr = list_val(node);
+ ckey = CAR(ptr);
+ if (EQ(ckey, key)) {
+ *update_size = 0;
+ goto unroll;
+ }
+ if (is_update) {
+ UnUseTmpHeapNoproc(2);
+ return 0;
+ }
+ goto insert_subnodes;
+ case TAG_PRIMARY_BOXED:
+ ptr = boxed_val(node);
+ hdr = *ptr;
+ ASSERT(is_header(hdr));
+
+ switch(hdr & _HEADER_MAP_SUBTAG_MASK) {
+ case HAMT_SUBTAG_HEAD_ARRAY:
+ ix = hashmap_index(hx);
+ hx = hashmap_shift_hash(th,hx,lvl,key);
+ size += HAMT_HEAD_ARRAY_SZ;
+ ESTACK_PUSH2(*sp, ix, node);
+ node = ptr[ix+2];
+ break;
+ case HAMT_SUBTAG_NODE_BITMAP:
+ hval = MAP_HEADER_VAL(hdr);
+ ix = hashmap_index(hx);
+ bp = 1 << ix;
+ if (hval == 0xffff) {
+ slot = ix;
+ n = 16;
+ } else {
+ slot = hashmap_bitcount(hval & (bp - 1));
+ n = hashmap_bitcount(hval);
+ }
+
+ ESTACK_PUSH4(*sp, n, bp, slot, node);
+
+ if (!(bp & hval)) { /* not occupied */
+ if (is_update) {
+ UnUseTmpHeapNoproc(2);
+ return 0;
+ }
+ size += HAMT_NODE_BITMAP_SZ(n+1);
+ goto unroll;
+ }
+
+ hx = hashmap_shift_hash(th,hx,lvl,key);
+ node = ptr[slot+1];
+ ASSERT(HAMT_NODE_BITMAP_SZ(n) <= 17);
+ size += HAMT_NODE_BITMAP_SZ(n);
+ break;
+
+ case HAMT_SUBTAG_HEAD_BITMAP:
+ hval = MAP_HEADER_VAL(hdr);
+ ix = hashmap_index(hx);
+ bp = 1 << ix;
+ slot = hashmap_bitcount(hval & (bp - 1));
+ n = hashmap_bitcount(hval);
+
+ ESTACK_PUSH4(*sp, n, bp, slot, node);
+
+ /* occupied */
+ if (bp & hval) {
+ hx = hashmap_shift_hash(th,hx,lvl,key);
+ node = ptr[slot+2];
+ ASSERT(HAMT_HEAD_BITMAP_SZ(n) <= 18);
+ size += HAMT_HEAD_BITMAP_SZ(n);
+ break;
+ }
+ /* not occupied */
+ if (is_update) {
+ UnUseTmpHeapNoproc(2);
+ return 0;
+ }
+ size += HAMT_HEAD_BITMAP_SZ(n+1);
+ goto unroll;
+ default:
+ erts_exit(ERTS_ERROR_EXIT, "bad header tag %ld\r\n", hdr & _HEADER_MAP_SUBTAG_MASK);
+ break;
+ }
+ break;
+ default:
+ erts_exit(ERTS_ERROR_EXIT, "bad primary tag %p\r\n", node);
+ break;
+ }
+ }
+insert_subnodes:
+ clvl = lvl;
+ chx = hashmap_restore_hash(th,clvl,ckey);
+ size += HAMT_NODE_BITMAP_SZ(2);
+ ix = hashmap_index(hx);
+ cix = hashmap_index(chx);
+
+ while (cix == ix) {
+ ESTACK_PUSH4(*sp, 0, 1 << ix, 0, MAP_HEADER_HAMT_NODE_BITMAP(0));
+ size += HAMT_NODE_BITMAP_SZ(1);
+ hx = hashmap_shift_hash(th,hx,lvl,key);
+ chx = hashmap_shift_hash(th,chx,clvl,ckey);
+ ix = hashmap_index(hx);
+ cix = hashmap_index(chx);
+ }
+ ESTACK_PUSH3(*sp, cix, ix, node);
+
+unroll:
+ *sz = size + /* res cons */ 2;
+ UnUseTmpHeapNoproc(2);
+ return 1;
+}
+
+Eterm erts_hashmap_insert_up(Eterm *hp, Eterm key, Eterm value,
+ Uint *update_size, ErtsEStack *sp) {
+ Eterm node, *ptr, hdr;
+ Eterm res;
+ Eterm *nhp = NULL;
+ Uint32 ix, cix, bp, hval;
+ Uint slot, n;
+ /* Needed for halfword */
+ DeclareTmpHeapNoproc(fake,1);
+ UseTmpHeapNoproc(1);
+
+ res = CONS(hp, key, value); hp += 2;
+
+ do {
+ node = ESTACK_POP(*sp);
+ switch(primary_tag(node)) {
+ case TAG_PRIMARY_LIST:
+ ix = (Uint32) ESTACK_POP(*sp);
+ cix = (Uint32) ESTACK_POP(*sp);
+
+ nhp = hp;
+ *hp++ = MAP_HEADER_HAMT_NODE_BITMAP((1 << ix) | (1 << cix));
+ if (ix < cix) {
+ *hp++ = res;
+ *hp++ = node;
+ } else {
+ *hp++ = node;
+ *hp++ = res;
+ }
+ res = make_hashmap(nhp);
+ break;
+ case TAG_PRIMARY_HEADER:
+ /* subnodes, fake it */
+ *fake = node;
+ node = make_boxed(fake);
+ case TAG_PRIMARY_BOXED:
+ ptr = boxed_val(node);
+ hdr = *ptr;
+ ASSERT(is_header(hdr));
+
+ switch(hdr & _HEADER_MAP_SUBTAG_MASK) {
+ case HAMT_SUBTAG_HEAD_ARRAY:
+ slot = (Uint) ESTACK_POP(*sp);
+ nhp = hp;
+ n = HAMT_HEAD_ARRAY_SZ - 2;
+ *hp++ = MAP_HEADER_HAMT_HEAD_ARRAY; ptr++;
+ *hp++ = (*ptr++) + *update_size;
+ while(n--) { *hp++ = *ptr++; }
+ nhp[slot+2] = res;
+ res = make_hashmap(nhp);
+ break;
+ case HAMT_SUBTAG_NODE_BITMAP:
+ slot = (Uint) ESTACK_POP(*sp);
+ bp = (Uint32) ESTACK_POP(*sp);
+ n = (Uint32) ESTACK_POP(*sp);
+ hval = MAP_HEADER_VAL(hdr);
+ nhp = hp;
+ *hp++ = MAP_HEADER_HAMT_NODE_BITMAP(hval | bp); ptr++;
+
+ n -= slot;
+ while(slot--) { *hp++ = *ptr++; }
+ *hp++ = res;
+ if (hval & bp) { ptr++; n--; }
+ while(n--) { *hp++ = *ptr++; }
+
+ res = make_hashmap(nhp);
+ break;
+ case HAMT_SUBTAG_HEAD_BITMAP:
+ slot = (Uint) ESTACK_POP(*sp);
+ bp = (Uint32) ESTACK_POP(*sp);
+ n = (Uint32) ESTACK_POP(*sp);
+ hval = MAP_HEADER_VAL(hdr);
+ nhp = hp;
+ *hp++ = MAP_HEADER_HAMT_HEAD_BITMAP(hval | bp); ptr++;
+ *hp++ = (*ptr++) + *update_size;
+
+ n -= slot;
+ while(slot--) { *hp++ = *ptr++; }
+ *hp++ = res;
+ if (hval & bp) { ptr++; n--; }
+ while(n--) { *hp++ = *ptr++; }
+
+ if ((hval | bp) == 0xffff) {
+ *nhp = MAP_HEADER_HAMT_HEAD_ARRAY;
+ }
+ res = make_hashmap(nhp);
+ break;
+ default:
+ erts_exit(ERTS_ERROR_EXIT, "bad header tag %x\r\n", hdr & _HEADER_MAP_SUBTAG_MASK);
+ break;
+ }
+ break;
+ default:
+ erts_exit(ERTS_ERROR_EXIT, "bad primary tag %x\r\n", primary_tag(node));
+ break;
+ }
+
+ } while(!ESTACK_ISEMPTY(*sp));
+
+ UnUseTmpHeapNoproc(1);
+ return res;
+}
+
+static Eterm hashmap_keys(Process* p, Eterm node) {
+ DECLARE_WSTACK(stack);
+ hashmap_head_t* root;
+ Eterm *hp, *kv;
+ Eterm res = NIL;
+
+ root = (hashmap_head_t*) boxed_val(node);
+ hp = HAlloc(p, root->size * 2);
+ hashmap_iterator_init(&stack, node, 0);
+ while ((kv=hashmap_iterator_next(&stack)) != NULL) {
+ res = CONS(hp, CAR(kv), res);
+ hp += 2;
+ }
+ DESTROY_WSTACK(stack);
+ return res;
+}
+
+static Eterm hashmap_values(Process* p, Eterm node) {
+ DECLARE_WSTACK(stack);
+ hashmap_head_t* root;
+ Eterm *hp, *kv;
+ Eterm res = NIL;
+
+ root = (hashmap_head_t*) boxed_val(node);
+ hp = HAlloc(p, root->size * 2);
+ hashmap_iterator_init(&stack, node, 0);
+ while ((kv=hashmap_iterator_next(&stack)) != NULL) {
+ res = CONS(hp, CDR(kv), res);
+ hp += 2;
+ }
+ DESTROY_WSTACK(stack);
+ return res;
+}
+
+static Eterm hashmap_delete(Process *p, Uint32 hx, Eterm key,
+ Eterm map, Eterm *value) {
+ Eterm *hp = NULL, *nhp = NULL, *hp_end = NULL;
+ Eterm *ptr;
+ Eterm hdr, res = map, node = map;
+ Uint32 ix, bp, hval;
+ Uint slot, lvl = 0;
+ Uint size = 0, n = 0;
+ DECLARE_ESTACK(stack);
+ DeclareTmpHeapNoproc(th,2);
+ UseTmpHeapNoproc(2);
+
+ for (;;) {
+ switch(primary_tag(node)) {
+ case TAG_PRIMARY_LIST:
+ if (EQ(CAR(list_val(node)), key)) {
+ if (value) {
+ *value = CDR(list_val(node));
+ }
+ goto unroll;
+ }
+ res = THE_NON_VALUE;
+ goto not_found;
+ case TAG_PRIMARY_BOXED:
+ ptr = boxed_val(node);
+ hdr = *ptr;
+ ASSERT(is_header(hdr));
+
+ switch(hdr & _HEADER_MAP_SUBTAG_MASK) {
+ case HAMT_SUBTAG_HEAD_ARRAY:
+ ix = hashmap_index(hx);
+ hx = hashmap_shift_hash(th,hx,lvl,key);
+ size += HAMT_HEAD_ARRAY_SZ;
+ ESTACK_PUSH2(stack, ix, node);
+ node = ptr[ix+2];
+ break;
+ case HAMT_SUBTAG_NODE_BITMAP:
+ hval = MAP_HEADER_VAL(hdr);
+ ix = hashmap_index(hx);
+ bp = 1 << ix;
+ if (hval == 0xffff) {
+ slot = ix;
+ n = 16;
+ } else if (bp & hval) {
+ slot = hashmap_bitcount(hval & (bp - 1));
+ n = hashmap_bitcount(hval);
+ } else {
+ /* not occupied */
+ res = THE_NON_VALUE;
+ goto not_found;
+ }
+
+ ESTACK_PUSH4(stack, n, bp, slot, node);
+
+ hx = hashmap_shift_hash(th,hx,lvl,key);
+ node = ptr[slot+1];
+ ASSERT(HAMT_NODE_BITMAP_SZ(n) <= 17);
+ size += HAMT_NODE_BITMAP_SZ(n);
+ break;
+
+ case HAMT_SUBTAG_HEAD_BITMAP:
+ hval = MAP_HEADER_VAL(hdr);
+ ix = hashmap_index(hx);
+ bp = 1 << ix;
+ slot = hashmap_bitcount(hval & (bp - 1));
+ n = hashmap_bitcount(hval);
+
+ ESTACK_PUSH4(stack, n, bp, slot, node);
+
+ /* occupied */
+ if (bp & hval) {
+ hx = hashmap_shift_hash(th,hx,lvl,key);
+ node = ptr[slot+2];
+ ASSERT(HAMT_HEAD_BITMAP_SZ(n) <= 18);
+ size += HAMT_HEAD_BITMAP_SZ(n);
+ break;
+ }
+ /* not occupied */
+ res = THE_NON_VALUE;
+ goto not_found;
+ default:
+ erts_exit(ERTS_ERROR_EXIT, "bad header tag %ld\r\n", hdr & _HEADER_MAP_SUBTAG_MASK);
+ break;
+ }
+ break;
+ default:
+ erts_exit(ERTS_ERROR_EXIT, "bad primary tag %p\r\n", node);
+ break;
+ }
+ }
+
+unroll:
+ /* the size is bounded and atleast one less than the previous size */
+ size -= 1;
+ n = hashmap_size(map) - 1;
+
+ if (n <= MAP_SMALL_MAP_LIMIT) {
+ DECLARE_WSTACK(wstack);
+ Eterm *kv, *ks, *vs;
+ flatmap_t *mp;
+ Eterm keys;
+
+ DESTROY_ESTACK(stack);
+
+ /* build flat structure */
+ hp = HAlloc(p, 3 + 1 + (2 * n));
+ keys = make_tuple(hp);
+ *hp++ = make_arityval(n);
+ ks = hp;
+ hp += n;
+ mp = (flatmap_t*)hp;
+ hp += MAP_HEADER_FLATMAP_SZ;
+ vs = hp;
+
+ mp->thing_word = MAP_HEADER_FLATMAP;
+ mp->size = n;
+ mp->keys = keys;
+
+ hashmap_iterator_init(&wstack, map, 0);
+
+ while ((kv=hashmap_iterator_next(&wstack)) != NULL) {
+ if (EQ(CAR(kv),key))
+ continue;
+ *ks++ = CAR(kv);
+ *vs++ = CDR(kv);
+ }
+
+ /* it cannot have multiple keys */
+ erts_validate_and_sort_flatmap(mp);
+
+ DESTROY_WSTACK(wstack);
+ UnUseTmpHeapNoproc(2);
+ return make_flatmap(mp);
+ }
+
+ hp = HAlloc(p, size);
+ hp_end = hp + size;
+ res = THE_NON_VALUE;
+
+ do {
+ node = ESTACK_POP(stack);
+
+ /* all nodes are things */
+ ptr = boxed_val(node);
+ hdr = *ptr;
+ ASSERT(is_header(hdr));
+
+ switch(hdr & _HEADER_MAP_SUBTAG_MASK) {
+ case HAMT_SUBTAG_HEAD_ARRAY:
+ ix = (Uint) ESTACK_POP(stack);
+ nhp = hp;
+ if (res == THE_NON_VALUE) {
+ n = 16;
+ n -= ix;
+ *hp++ = MAP_HEADER_HAMT_HEAD_BITMAP(0xffff ^ (1 << ix)); ptr++;
+ *hp++ = (*ptr++) - 1;
+ while(ix--) { *hp++ = *ptr++; }
+ ptr++; n--;
+ while(n--) { *hp++ = *ptr++; }
+ res = make_hashmap(nhp);
+ } else {
+ n = 16;
+ *hp++ = MAP_HEADER_HAMT_HEAD_ARRAY; ptr++;
+ *hp++ = (*ptr++) - 1;
+ while(n--) { *hp++ = *ptr++; }
+ nhp[ix+2] = res;
+ res = make_hashmap(nhp);
+ }
+ break;
+ case HAMT_SUBTAG_NODE_BITMAP:
+ slot = (Uint) ESTACK_POP(stack);
+ bp = (Uint32) ESTACK_POP(stack);
+ n = (Uint32) ESTACK_POP(stack);
+ nhp = hp;
+
+ /* bitmap change matrix
+ * res | none leaf bitmap
+ * ----------------------------
+ * n=1 | remove remove keep
+ * n=2 | other keep keep
+ * n>2 | shrink keep keep
+ *
+ * other: (remember, n is 2)
+ * shrink if the other bitmap value is a bitmap node
+ * remove if the other bitmap value is a leaf
+ *
+ * remove:
+ * this bitmap node is removed, res is moved up in tree (could be none)
+ * this is a special case of shrink
+ *
+ * keep:
+ * the current path index is still used down in the tree, need to keep it
+ * copy as usual with the updated res
+ *
+ * shrink:
+ * the current path index is no longer used down in the tree, remove it (shrink)
+ */
+ if (res == THE_NON_VALUE) {
+ if (n == 1) {
+ break;
+ } else if (n == 2) {
+ if (slot == 0) {
+ ix = 2; /* off by one 'cause hdr */
+ } else {
+ ix = 1; /* off by one 'cause hdr */
+ }
+ if (primary_tag(ptr[ix]) == TAG_PRIMARY_LIST) {
+ res = ptr[ix];
+ } else {
+ hval = MAP_HEADER_VAL(hdr);
+ *hp++ = MAP_HEADER_HAMT_NODE_BITMAP(hval ^ bp);
+ *hp++ = ptr[ix];
+ res = make_hashmap(nhp);
+ }
+ } else {
+ /* n > 2 */
+ hval = MAP_HEADER_VAL(hdr);
+ *hp++ = MAP_HEADER_HAMT_NODE_BITMAP(hval ^ bp); ptr++;
+ n -= slot;
+ while(slot--) { *hp++ = *ptr++; }
+ ptr++; n--;
+ while(n--) { *hp++ = *ptr++; }
+ res = make_hashmap(nhp);
+ }
+ } else if (primary_tag(res) == TAG_PRIMARY_LIST && n == 1) {
+ break;
+ } else {
+ /* res is bitmap or leaf && n > 1, keep */
+ n -= slot;
+ *hp++ = *ptr++;
+ while(slot--) { *hp++ = *ptr++; }
+ *hp++ = res;
+ ptr++; n--;
+ while(n--) { *hp++ = *ptr++; }
+ res = make_hashmap(nhp);
+ }
+ break;
+ case HAMT_SUBTAG_HEAD_BITMAP:
+ slot = (Uint) ESTACK_POP(stack);
+ bp = (Uint32) ESTACK_POP(stack);
+ n = (Uint32) ESTACK_POP(stack);
+ nhp = hp;
+
+ if (res != THE_NON_VALUE) {
+ *hp++ = *ptr++;
+ *hp++ = (*ptr++) - 1;
+ n -= slot;
+ while(slot--) { *hp++ = *ptr++; }
+ *hp++ = res;
+ ptr++; n--;
+ while(n--) { *hp++ = *ptr++; }
+ } else {
+ hval = MAP_HEADER_VAL(hdr);
+ *hp++ = MAP_HEADER_HAMT_HEAD_BITMAP(hval ^ bp); ptr++;
+ *hp++ = (*ptr++) - 1;
+ n -= slot;
+ while(slot--) { *hp++ = *ptr++; }
+ ptr++; n--;
+ while(n--) { *hp++ = *ptr++; }
+ }
+ res = make_hashmap(nhp);
+ break;
+ default:
+ erts_exit(ERTS_ERROR_EXIT, "bad header tag %x\r\n", hdr & _HEADER_MAP_SUBTAG_MASK);
+ break;
+ }
+ } while(!ESTACK_ISEMPTY(stack));
+ HRelease(p, hp_end, hp);
+not_found:
+ DESTROY_ESTACK(stack);
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(p);
+ ERTS_HOLE_CHECK(p);
+ UnUseTmpHeapNoproc(2);
+ return res;
+}
+
+
+int erts_validate_and_sort_flatmap(flatmap_t* mp)
+{
+ Eterm *ks = flatmap_get_keys(mp);
+ Eterm *vs = flatmap_get_values(mp);
+ Uint sz = flatmap_get_size(mp);
Uint ix,jx;
Eterm tmp;
- int c;
+ Sint c;
/* sort */
@@ -819,3 +2746,345 @@ int erts_validate_and_sort_map(map_t* mp)
}
return 1;
}
+
+#if 0 /* Can't get myself to remove this beautiful piece of code
+ for probabilistic overestimation of nr of nodes in a hashmap */
+
+/* Really rough estimate of sqrt(x)
+ * Guaranteed not to be less than sqrt(x)
+ */
+static int int_sqrt_ceiling(Uint x)
+{
+ int n;
+
+ if (x <= 2)
+ return x;
+
+ n = erts_fit_in_bits_uint(x-1);
+ if (n & 1) {
+ /* Calc: sqrt(2^n) = 2^(n/2) * sqrt(2) ~= 2^(n/2) * 3 / 2 */
+ return (1 << (n/2 - 1)) * 3;
+ }
+ else {
+ /* Calc: sqrt(2^n) = 2^(n/2) */
+ return 1 << (n / 2);
+ }
+}
+
+/* May not be enough if hashing is broken (not uniform)
+ * or if hell freezes over.
+ */
+Uint hashmap_overestimated_node_count(Uint k)
+{
+ /* k is nr of key-value pairs.
+ N(k) is expected nr of nodes in hamt.
+
+ Observation:
+ For uniformly distributed hash values, average of N varies between
+ 0.3*k and 0.4*k (with a beautiful sine curve)
+ and standard deviation of N is about sqrt(k)/3.
+
+ Assuming normal probability distribution, we overestimate nr of nodes
+ by 15 std.devs above the average, which gives a probability for overrun
+ less than 1.0e-49 (same magnitude as a git SHA1 collision).
+ */
+ return 2*k/5 + 1 + (15/3)*int_sqrt_ceiling(k);
+}
+#endif
+
+BIF_RETTYPE erts_debug_map_info_1(BIF_ALIST_1) {
+ if (is_hashmap(BIF_ARG_1)) {
+ BIF_RET(hashmap_info(BIF_P,BIF_ARG_1));
+ } else if (is_flatmap(BIF_ARG_1)) {
+ BIF_ERROR(BIF_P, BADARG);
+ } else {
+ BIF_P->fvalue = BIF_ARG_1;
+ BIF_ERROR(BIF_P, BADMAP);
+ }
+}
+
+/*
+ * erts_internal:map_to_tuple_keys/1
+ *
+ * Used in erts_debug:size/1
+ */
+
+BIF_RETTYPE erts_internal_map_to_tuple_keys_1(BIF_ALIST_1) {
+ if (is_flatmap(BIF_ARG_1)) {
+ flatmap_t *mp = (flatmap_t*)flatmap_val(BIF_ARG_1);
+ BIF_RET(mp->keys);
+ } else if (is_hashmap(BIF_ARG_1)) {
+ BIF_ERROR(BIF_P, BADARG);
+ } else {
+ BIF_P->fvalue = BIF_ARG_1;
+ BIF_ERROR(BIF_P, BADMAP);
+ }
+}
+
+/*
+ * erts_internal:term_type/1
+ *
+ * Used in erts_debug:size/1
+ */
+
+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);
+ }
+}
+
+/*
+ * erts_internal:map_hashmap_children/1
+ *
+ * Used in erts_debug:size/1
+ */
+
+BIF_RETTYPE erts_internal_map_hashmap_children_1(BIF_ALIST_1) {
+ if (is_map(BIF_ARG_1)) {
+ Eterm node = BIF_ARG_1;
+ Eterm *ptr, hdr, *hp, res = NIL;
+ Uint sz = 0;
+ ptr = boxed_val(node);
+ hdr = *ptr;
+ ASSERT(is_header(hdr));
+
+ switch(hdr & _HEADER_MAP_SUBTAG_MASK) {
+ case HAMT_SUBTAG_HEAD_FLATMAP:
+ BIF_ERROR(BIF_P, BADARG);
+ case HAMT_SUBTAG_HEAD_BITMAP:
+ ptr++;
+ case HAMT_SUBTAG_NODE_BITMAP:
+ ptr++;
+ sz = hashmap_bitcount(MAP_HEADER_VAL(hdr));
+ break;
+ case HAMT_SUBTAG_HEAD_ARRAY:
+ sz = 16;
+ ptr += 2;
+ break;
+ default:
+ erts_exit(ERTS_ERROR_EXIT, "bad header\r\n");
+ break;
+ }
+ ASSERT(sz < 17);
+ hp = HAlloc(BIF_P, 2*sz);
+ while(sz--) { res = CONS(hp, *ptr++, res); hp += 2; }
+ BIF_RET(res);
+ }
+ BIF_P->fvalue = BIF_ARG_1;
+ BIF_ERROR(BIF_P, BADMAP);
+}
+
+
+static Eterm hashmap_info(Process *p, Eterm node) {
+ Eterm *hp;
+ Eterm res = NIL, info = NIL;
+ Eterm *ptr, tup, hdr;
+ Uint sz;
+ DECL_AM(depth);
+ DECL_AM(leafs);
+ DECL_AM(bitmaps);
+ DECL_AM(arrays);
+ Uint nleaf=0, nbitmap=0, narray=0;
+ Uint bitmap_usage[16], leaf_usage[16];
+ Uint lvl = 0, clvl;
+ DECLARE_ESTACK(stack);
+
+ for (sz = 0; sz < 16; sz++) {
+ bitmap_usage[sz] = 0;
+ leaf_usage[sz] = 0;
+ }
+
+ ptr = boxed_val(node);
+ ESTACK_PUSH(stack, 0);
+ ESTACK_PUSH(stack, node);
+ do {
+ node = ESTACK_POP(stack);
+ clvl = ESTACK_POP(stack);
+ if (lvl < clvl)
+ lvl = clvl;
+ switch(primary_tag(node)) {
+ case TAG_PRIMARY_LIST:
+ nleaf++;
+ leaf_usage[clvl] += 1;
+ break;
+ case TAG_PRIMARY_BOXED:
+ ptr = boxed_val(node);
+ hdr = *ptr;
+ ASSERT(is_header(hdr));
+ switch(hdr & _HEADER_MAP_SUBTAG_MASK) {
+ case HAMT_SUBTAG_NODE_BITMAP:
+ nbitmap++;
+ sz = hashmap_bitcount(MAP_HEADER_VAL(hdr));
+ ASSERT(sz < 17);
+ bitmap_usage[sz-1] += 1;
+ while(sz--) {
+ ESTACK_PUSH(stack, clvl + 1);
+ ESTACK_PUSH(stack, ptr[sz+1]);
+ }
+ break;
+ case HAMT_SUBTAG_HEAD_BITMAP:
+ nbitmap++;
+ sz = hashmap_bitcount(MAP_HEADER_VAL(hdr));
+ bitmap_usage[sz-1] += 1;
+ while(sz--) {
+ ESTACK_PUSH(stack, clvl + 1);
+ ESTACK_PUSH(stack, ptr[sz+2]);
+ }
+ break;
+ case HAMT_SUBTAG_HEAD_ARRAY:
+ narray++;
+ sz = 16;
+ while(sz--) {
+ ESTACK_PUSH(stack, clvl + 1);
+ ESTACK_PUSH(stack, ptr[sz+2]);
+ }
+ break;
+ default:
+ erts_exit(ERTS_ERROR_EXIT, "bad header\r\n");
+ break;
+ }
+ }
+ } while(!ESTACK_ISEMPTY(stack));
+
+
+ /* size */
+ sz = 0;
+ hashmap_bld_tuple_uint(NULL,&sz,16,leaf_usage);
+ hashmap_bld_tuple_uint(NULL,&sz,16,bitmap_usage);
+
+ /* alloc */
+ hp = HAlloc(p, 2+3 + 3*(2+4) + sz);
+
+ info = hashmap_bld_tuple_uint(&hp,NULL,16,leaf_usage);
+ tup = TUPLE3(hp, AM_leafs, make_small(nleaf),info); hp += 4;
+ res = CONS(hp, tup, res); hp += 2;
+
+ info = hashmap_bld_tuple_uint(&hp,NULL,16,bitmap_usage);
+ tup = TUPLE3(hp, AM_bitmaps, make_small(nbitmap), info); hp += 4;
+ res = CONS(hp, tup, res); hp += 2;
+
+ tup = TUPLE3(hp, AM_arrays, make_small(narray),NIL); hp += 4;
+ res = CONS(hp, tup, res); hp += 2;
+
+ tup = TUPLE2(hp, AM_depth, make_small(lvl)); hp += 3;
+ res = CONS(hp, tup, res); hp += 2;
+
+ DESTROY_ESTACK(stack);
+ ERTS_HOLE_CHECK(p);
+ return res;
+}
+
+static Eterm hashmap_bld_tuple_uint(Uint **hpp, Uint *szp, Uint n, Uint nums[]) {
+ Eterm res = THE_NON_VALUE;
+ Eterm *ts = (Eterm *)erts_alloc(ERTS_ALC_T_TMP, n * sizeof(Eterm));
+ Uint i;
+
+ for (i = 0; i < n; i++) {
+ ts[i] = erts_bld_uint(hpp, szp, nums[i]);
+ }
+ res = erts_bld_tuplev(hpp, szp, n, ts);
+ erts_free(ERTS_ALC_T_TMP, (void *) ts);
+ return res;
+}
+
+
+/* implementation of builtin emulations */
+
+#if !ERTS_AT_LEAST_GCC_VSN__(3, 4, 0)
+/* Count leading zeros emulation */
+Uint32 hashmap_clz(Uint32 x) {
+ Uint32 y;
+ int n = 32;
+ y = x >>16; if (y != 0) {n = n -16; x = y;}
+ y = x >> 8; if (y != 0) {n = n - 8; x = y;}
+ y = x >> 4; if (y != 0) {n = n - 4; x = y;}
+ y = x >> 2; if (y != 0) {n = n - 2; x = y;}
+ y = x >> 1; if (y != 0) return n - 2;
+ return n - x;
+}
+
+const Uint32 SK5 = 0x55555555, SK3 = 0x33333333;
+const Uint32 SKF0 = 0xF0F0F0F, SKFF = 0xFF00FF;
+
+/* CTPOP emulation */
+Uint32 hashmap_bitcount(Uint32 x) {
+ x -= ((x >> 1 ) & SK5);
+ x = (x & SK3 ) + ((x >> 2 ) & SK3 );
+ x = (x & SKF0) + ((x >> 4 ) & SKF0);
+ x += x >> 8;
+ return (x + (x >> 16)) & 0x3F;
+}
+#endif
diff --git a/erts/emulator/beam/erl_map.h b/erts/emulator/beam/erl_map.h
index cfacb2ec28..c3ccf80b85 100644
--- a/erts/emulator/beam/erl_map.h
+++ b/erts/emulator/beam/erl_map.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2014. All Rights Reserved.
+ * Copyright Ericsson AB 2014-2017. 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.
+ * 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%
*/
@@ -22,13 +23,23 @@
#define __ERL_MAP_H__
#include "sys.h"
+
+/* instrinsic wrappers */
+#if ERTS_AT_LEAST_GCC_VSN__(3, 4, 0)
+#define hashmap_clz(x) ((Uint32) __builtin_clz((unsigned int)(x)))
+#define hashmap_bitcount(x) ((Uint32) __builtin_popcount((unsigned int) (x)))
+#else
+Uint32 hashmap_clz(Uint32 x);
+Uint32 hashmap_bitcount(Uint32 x);
+#endif
+
/* MAP */
-typedef struct map_s {
+typedef struct flatmap_s {
Eterm thing_word;
Uint size;
Eterm keys; /* tuple */
-} map_t;
+} flatmap_t;
/* map node
*
* -----------
@@ -42,31 +53,147 @@ typedef struct map_s {
* -----------
*/
+/* the head-node is a bitmap or array with an untagged size */
+
+
+#define hashmap_size(x) (((hashmap_head_t*) hashmap_val(x))->size)
+#define hashmap_make_hash(Key) make_internal_hash(Key, 0)
+
+#define hashmap_restore_hash(Heap,Lvl,Key) \
+ (((Lvl) < 8) ? hashmap_make_hash(Key) >> (4*(Lvl)) : hashmap_make_hash(CONS(Heap, make_small((Lvl)>>3), (Key))) >> (4*((Lvl) & 7)))
+#define hashmap_shift_hash(Heap,Hx,Lvl,Key) \
+ (((++(Lvl)) & 7) ? (Hx) >> 4 : hashmap_make_hash(CONS(Heap, make_small((Lvl)>>3), Key)))
/* erl_term.h stuff */
-#define make_map(x) make_boxed((Eterm*)(x))
-#define make_map_rel(x, BASE) make_boxed_rel((Eterm*)(x),(BASE))
-#define is_map(x) (is_boxed((x)) && is_map_header(*boxed_val((x))))
-#define is_map_rel(RTERM,BASE) is_map(rterm2wterm(RTERM,BASE))
-#define is_not_map(x) (!is_map((x)))
-#define is_map_header(x) (((x) & (_TAG_HEADER_MASK)) == _TAG_HEADER_MAP)
-#define header_is_map(x) ((((x) & (_HEADER_SUBTAG_MASK)) == MAP_SUBTAG))
-#define map_val(x) (_unchecked_boxed_val((x)))
-#define map_val_rel(RTERM, BASE) map_val(rterm2wterm(RTERM, BASE))
-
-#define map_get_values(x) (((Eterm *)(x)) + 3)
-#define map_get_keys(x) (((Eterm *)tuple_val(((map_t *)(x))->keys)) + 1)
-#define map_get_size(x) (((map_t*)(x))->size)
-
-#define MAP_HEADER _make_header(1,_TAG_HEADER_MAP)
-#define MAP_HEADER_SIZE (sizeof(map_t) / sizeof(Eterm))
-
-Eterm erts_maps_put(Process *p, Eterm key, Eterm value, Eterm map);
-int erts_maps_update(Process *p, Eterm key, Eterm value, Eterm map, Eterm *res);
-int erts_maps_find(Eterm key, Eterm map, Eterm *value);
-int erts_maps_get(Eterm key, Eterm map, Eterm *value);
-int erts_maps_remove(Process *p, Eterm key, Eterm map, Eterm *res);
-int erts_validate_and_sort_map(map_t* map);
+#define flatmap_get_values(x) (((Eterm *)(x)) + sizeof(flatmap_t)/sizeof(Eterm))
+#define flatmap_get_keys(x) (((Eterm *)tuple_val(((flatmap_t *)(x))->keys)) + 1)
+#define flatmap_get_size(x) (((flatmap_t*)(x))->size)
+
+#ifdef DEBUG
+#define MAP_SMALL_MAP_LIMIT (3)
+#else
+#define MAP_SMALL_MAP_LIMIT (32)
#endif
+struct ErtsWStack_;
+struct ErtsEStack_;
+
+Eterm erts_maps_put(Process *p, Eterm key, Eterm value, Eterm map);
+int erts_maps_update(Process *p, Eterm key, Eterm value, Eterm map, Eterm *res);
+int erts_maps_remove(Process *p, Eterm key, Eterm map, Eterm *res);
+int erts_maps_take(Process *p, Eterm key, Eterm map, Eterm *res, Eterm *value);
+
+Eterm erts_hashmap_insert(Process *p, Uint32 hx, Eterm key, Eterm value,
+ Eterm node, int is_update);
+int erts_hashmap_insert_down(Uint32 hx, Eterm key, Eterm node, Uint *sz,
+ Uint *upsz, struct ErtsEStack_ *sp, int is_update);
+Eterm erts_hashmap_insert_up(Eterm *hp, Eterm key, Eterm value,
+ Uint *upsz, struct ErtsEStack_ *sp);
+
+int erts_validate_and_sort_flatmap(flatmap_t* map);
+void hashmap_iterator_init(struct ErtsWStack_* s, Eterm node, int reverse);
+Eterm* hashmap_iterator_next(struct ErtsWStack_* s);
+Eterm* hashmap_iterator_prev(struct ErtsWStack_* s);
+int hashmap_key_hash_cmp(Eterm* ap, Eterm* bp);
+Eterm erts_hashmap_from_array(ErtsHeapFactory*, Eterm *leafs, Uint n, int reject_dupkeys);
+
+#define erts_hashmap_from_ks_and_vs(F, KS, VS, N) \
+ erts_hashmap_from_ks_and_vs_extra((F), (KS), (VS), (N), THE_NON_VALUE, THE_NON_VALUE);
+
+Eterm erts_map_from_ks_and_vs(ErtsHeapFactory *factory, Eterm *ks, Eterm *vs, Uint n);
+Eterm erts_hashmap_from_ks_and_vs_extra(ErtsHeapFactory *factory,
+ Eterm *ks, Eterm *vs, Uint n,
+ Eterm k, Eterm v);
+
+const Eterm *erts_maps_get(Eterm key, Eterm map);
+
+const Eterm *erts_hashmap_get(Uint32 hx, Eterm key, Eterm map);
+
+/* hamt nodes v2.0
+ *
+ * node :: leaf | array | bitmap
+ * head
+ */
+typedef struct hashmap_head_s {
+ Eterm thing_word;
+ Uint size;
+ Eterm items[1];
+} hashmap_head_t;
+
+/* thing_word tagscheme
+ * Need two bits for map subtags
+ *
+ * Original HEADER representation:
+ *
+ * aaaaaaaaaaaaaaaa aaaaaaaaaatttt00 arity:26, tag:4
+ *
+ * For maps we have:
+ *
+ * vvvvvvvvvvvvvvvv aaaaaaaamm111100 val:16, arity:8, mtype:2
+ *
+ * unsure about trailing zeros
+ *
+ * map-tag:
+ * 00 - flat map tag (non-hamt) -> val:16 = #items
+ * 01 - map-node bitmap tag -> val:16 = bitmap
+ * 10 - map-head (array-node) -> val:16 = 0xffff
+ * 11 - map-head (bitmap-node) -> val:16 = bitmap
+ */
+
+/* erl_map.h stuff */
+
+#define is_hashmap_header_head(x) ((MAP_HEADER_TYPE(x) & (0x2)))
+
+#define MAKE_MAP_HEADER(Type,Arity,Val) \
+ (_make_header(((((Uint16)(Val)) << MAP_HEADER_ARITY_SZ) | (Arity)) << MAP_HEADER_TAG_SZ | (Type) , _TAG_HEADER_MAP))
+
+#define MAP_HEADER_FLATMAP \
+ MAKE_MAP_HEADER(MAP_HEADER_TAG_FLATMAP_HEAD,0x1,0x0)
+
+#define MAP_HEADER_HAMT_HEAD_ARRAY \
+ MAKE_MAP_HEADER(MAP_HEADER_TAG_HAMT_HEAD_ARRAY,0x1,0xffff)
+
+#define MAP_HEADER_HAMT_HEAD_BITMAP(Bmp) \
+ MAKE_MAP_HEADER(MAP_HEADER_TAG_HAMT_HEAD_BITMAP,0x1,Bmp)
+
+#define MAP_HEADER_HAMT_NODE_BITMAP(Bmp) \
+ MAKE_MAP_HEADER(MAP_HEADER_TAG_HAMT_NODE_BITMAP,0x0,Bmp)
+
+#define MAP_HEADER_FLATMAP_SZ (sizeof(flatmap_t) / sizeof(Eterm))
+
+#define HAMT_NODE_ARRAY_SZ (17)
+#define HAMT_HEAD_ARRAY_SZ (18)
+#define HAMT_NODE_BITMAP_SZ(n) (1 + n)
+#define HAMT_HEAD_BITMAP_SZ(n) (2 + n)
+
+/* 2 bits maps tag + 4 bits subtag + 2 ignore bits */
+#define _HEADER_MAP_SUBTAG_MASK (0xfc)
+/* 1 bit map tag + 1 ignore bit + 4 bits subtag + 2 ignore bits */
+#define _HEADER_MAP_HASHMAP_HEAD_MASK (0xbc)
+
+#define HAMT_SUBTAG_NODE_BITMAP ((MAP_HEADER_TAG_HAMT_NODE_BITMAP << _HEADER_ARITY_OFFS) | MAP_SUBTAG)
+#define HAMT_SUBTAG_HEAD_ARRAY ((MAP_HEADER_TAG_HAMT_HEAD_ARRAY << _HEADER_ARITY_OFFS) | MAP_SUBTAG)
+#define HAMT_SUBTAG_HEAD_BITMAP ((MAP_HEADER_TAG_HAMT_HEAD_BITMAP << _HEADER_ARITY_OFFS) | MAP_SUBTAG)
+#define HAMT_SUBTAG_HEAD_FLATMAP ((MAP_HEADER_TAG_FLATMAP_HEAD << _HEADER_ARITY_OFFS) | MAP_SUBTAG)
+
+#define hashmap_index(hash) (((Uint32)hash) & 0xf)
+
+/* hashmap heap size:
+ [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_WORDS_PER_KEY 3
+#define HASHMAP_WORDS_PER_NODE 2
+#ifdef DEBUG
+# define HASHMAP_ESTIMATED_TOT_NODE_SIZE(KEYS) \
+ (HASHMAP_WORDS_PER_NODE * (KEYS) * 3/10) /* slightly under estimated */
+#else
+# define HASHMAP_ESTIMATED_TOT_NODE_SIZE(KEYS) \
+ (HASHMAP_WORDS_PER_NODE * (KEYS) * 4/10) /* slightly over estimated */
+#endif
+#define HASHMAP_ESTIMATED_HEAP_SIZE(KEYS) \
+ ((KEYS)*HASHMAP_WORDS_PER_KEY + HASHMAP_ESTIMATED_TOT_NODE_SIZE(KEYS))
+#endif
diff --git a/erts/emulator/beam/erl_math.c b/erts/emulator/beam/erl_math.c
index 16d4fdc09c..1f270eb55f 100644
--- a/erts/emulator/beam/erl_math.c
+++ b/erts/emulator/beam/erl_math.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1997-2009. All Rights Reserved.
+ * Copyright Ericsson AB 1997-2016. 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.
+ * 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%
*/
@@ -207,6 +208,24 @@ BIF_RETTYPE math_log_1(BIF_ALIST_1)
return math_call_1(BIF_P, log, BIF_ARG_1);
}
+#ifdef HAVE_LOG2
+static double
+log2_wrapper(double x)
+{
+ return log2(x);
+}
+#else
+static double
+log2_wrapper(double x)
+{
+ return log(x) / 0.6931471805599453; /* log(2.0); */
+}
+#endif
+
+BIF_RETTYPE math_log2_1(BIF_ALIST_1)
+{
+ return math_call_1(BIF_P, log2_wrapper, BIF_ARG_1);
+}
BIF_RETTYPE math_log10_1(BIF_ALIST_1)
{
@@ -228,6 +247,17 @@ BIF_RETTYPE math_pow_2(BIF_ALIST_2)
return math_call_2(BIF_P, pow, BIF_ARG_1, BIF_ARG_2);
}
+BIF_RETTYPE math_ceil_1(BIF_ALIST_1)
+{
+ return math_call_1(BIF_P, ceil, BIF_ARG_1);
+}
+BIF_RETTYPE math_floor_1(BIF_ALIST_1)
+{
+ return math_call_1(BIF_P, floor, BIF_ARG_1);
+}
-
+BIF_RETTYPE math_fmod_2(BIF_ALIST_2)
+{
+ return math_call_2(BIF_P, fmod, BIF_ARG_1, BIF_ARG_2);
+}
diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c
index 0eb8117980..b30c4a49d7 100644
--- a/erts/emulator/beam/erl_message.c
+++ b/erts/emulator/beam/erl_message.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1997-2012. All Rights Reserved.
+ * Copyright Ericsson AB 1997-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -31,9 +32,10 @@
#include "erl_process.h"
#include "erl_binary.h"
#include "dtrace-wrapper.h"
+#include "beam_bp.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)
@@ -43,27 +45,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) */
@@ -73,7 +68,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;
}
@@ -93,9 +89,6 @@ erts_resize_message_buffer(ErlHeapFragment *bp, Uint size,
#endif
ErlHeapFragment* nbp;
- /* ToDo: Make use of 'used_size' to avoid realloc
- when shrinking just a few words */
-
#ifdef DEBUG
{
Uint off_sz = size < bp->used_size ? size : bp->used_size;
@@ -110,8 +103,10 @@ erts_resize_message_buffer(ErlHeapFragment *bp, Uint size,
}
#endif
- if (size == bp->used_size)
+ if (size >= (bp->used_size - bp->used_size / 16)) {
+ bp->used_size = size;
return bp;
+ }
#ifdef HARD_DEBUG
dbg_brefs = erts_alloc(ERTS_ALC_T_UNDEF, sizeof(Eterm *)*brefs_size);
@@ -172,15 +167,17 @@ erts_cleanup_offheap(ErlOffHeap *offheap)
for (u.hdr = offheap->first; u.hdr; u.hdr = u.hdr->next) {
switch (thing_subtag(u.hdr->thing_word)) {
case REFC_BINARY_SUBTAG:
- if (erts_refc_dectest(&u.pb->val->refc, 0) == 0) {
- erts_bin_free(u.pb->val);
- }
+ erts_bin_release(u.pb->val);
break;
case FUN_SUBTAG:
- if (erts_refc_dectest(&u.fun->fe->refc, 0) == 0) {
+ if (erts_smp_refc_dectest(&u.fun->fe->refc, 0) == 0) {
erts_erase_fun_entry(u.fun->fe);
}
break;
+ case REF_SUBTAG:
+ ASSERT(is_magic_ref_thing(u.hdr));
+ erts_bin_release((Binary *)u.mref->mb);
+ break;
default:
ASSERT(is_external_header(u.hdr->thing_word));
erts_deref_node_entry(u.ext->node);
@@ -198,113 +195,71 @@ free_message_buffer(ErlHeapFragment* bp)
erts_cleanup_offheap(&bp->off_heap);
ERTS_HEAP_FREE(ERTS_ALC_T_HEAP_FRAG, (void *) bp,
- ERTS_HEAP_FRAG_SIZE(bp->size));
+ ERTS_HEAP_FRAG_SIZE(bp->alloc_size));
bp = next_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);
}
- *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 (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);
+ }
+ 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;
- Eterm *hp_end = NULL;
- ErlOffHeap *ohp;
- 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)
- hp = erts_alloc_message_heap(sz, bpp, &ohp, pp, plcksp);
- else {
- *bpp = new_message_buffer(sz);
- hp = (*bpp)->mem;
- ohp = &(*bpp)->off_heap;
- }
- hp_end = hp + sz;
- msg = erts_decode_dist_ext(&hp, ohp, dist_extp);
- if (is_non_value(msg))
- goto decode_error;
- if (is_not_nil(*tokenp)) {
- ErlHeapFragment *heap_frag = erts_dist_ext_trailer(dist_extp);
- *tokenp = copy_struct(*tokenp, tok_sz, &hp, ohp);
- erts_cleanup_offheap(&heap_frag->off_heap);
- }
- erts_free_dist_ext_copy(dist_extp);
- if (hp_end != hp) {
- if (!(*bpp)) {
- HRelease(pp, hp_end, hp);
- }
- else {
- Uint final_size = hp - &(*bpp)->mem[0];
- Eterm brefs[2] = {msg, *tokenp};
- ASSERT(sz - (hp_end - hp) == final_size);
- *bpp = erts_resize_message_buffer(*bpp, final_size, &brefs[0], 2);
- msg = brefs[0];
- *tokenp = brefs[1];
- }
+ 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);
}
- 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);
- if (*bpp) {
- free_message_buffer(*bpp);
- *bpp = NULL;
- }
- else if (hp) {
- HRelease(pp, hp_end, hp);
- }
- return THE_NON_VALUE;
- }
+ nmp->hfrag.used_size = sz;
+ nmp->hfrag.alloc_size = sz;
+
+ return nmp;
+}
void
erts_queue_dist_message(Process *rcvr,
- ErtsProcLocks *rcvr_locks,
+ ErtsProcLocks rcvr_locks,
ErtsDistExternal *dist_ext,
- Eterm token)
+ Eterm token,
+ Eterm from)
{
- ErlMessage* mp;
+ ErtsMessage* mp;
#ifdef USE_VM_PROBES
Sint tok_label = 0;
Sint tok_lastcnt = 0;
@@ -314,17 +269,29 @@ erts_queue_dist_message(Process *rcvr,
erts_aint_t state;
#endif
- ERTS_SMP_LC_ASSERT(*rcvr_locks == erts_proc_lc_my_proc_locks(rcvr));
+ ERTS_SMP_LC_ASSERT(rcvr_locks == erts_proc_lc_my_proc_locks(rcvr));
+
+ mp = erts_alloc_message(0, NULL);
+ mp->data.dist_ext = dist_ext;
- mp = message_alloc();
+ 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)) {
+ if (!(rcvr_locks & ERTS_PROC_LOCK_MSGQ)) {
if (erts_smp_proc_trylock(rcvr, ERTS_PROC_LOCK_MSGQ) == EBUSY) {
ErtsProcLocks need_locks = ERTS_PROC_LOCK_MSGQ;
- if (*rcvr_locks & ERTS_PROC_LOCK_STATUS) {
- erts_smp_proc_unlock(rcvr, ERTS_PROC_LOCK_STATUS);
- need_locks |= ERTS_PROC_LOCK_STATUS;
+ ErtsProcLocks unlocks =
+ rcvr_locks & ERTS_PROC_LOCKS_HIGHER_THAN(ERTS_PROC_LOCK_MSGQ);
+ if (unlocks) {
+ erts_smp_proc_unlock(rcvr, unlocks);
+ need_locks |= unlocks;
}
erts_smp_proc_lock(rcvr, need_locks);
}
@@ -332,71 +299,52 @@ erts_queue_dist_message(Process *rcvr,
state = erts_smp_atomic32_read_acqb(&rcvr->state);
if (state & (ERTS_PSFLG_PENDING_EXIT|ERTS_PSFLG_EXITING)) {
- if (!(*rcvr_locks & ERTS_PROC_LOCK_MSGQ))
+ 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)) {
+ if (from == am_Empty)
+ from = dist_ext->dep->sysname;
+
/* Ahh... need to decode it in order to trace it... */
- ErlHeapFragment *mbuf;
- Eterm msg;
- if (!(*rcvr_locks & ERTS_PROC_LOCK_MSGQ))
+ 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))
-#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);
- }
-#endif
- erts_queue_message(rcvr, rcvr_locks, mbuf, msg, token
+ 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
- , NIL
+ 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, mp, msg, from);
+ }
}
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));
@@ -409,70 +357,73 @@ 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))
+ LINK_MESSAGE(rcvr, mp, &mp->next, 1);
+
+ if (!(rcvr_locks & ERTS_PROC_LOCK_MSGQ))
erts_smp_proc_unlock(rcvr, ERTS_PROC_LOCK_MSGQ);
- erts_proc_notify_new_message(rcvr);
+ erts_proc_notify_new_message(rcvr,
+#ifdef ERTS_SMP
+ rcvr_locks
+#else
+ 0
+#endif
+ );
}
}
-/* Add a message last in message queue */
+/* Add messages last in message queue */
static Sint
-queue_message(Process *c_p,
- Process* receiver,
- ErtsProcLocks *receiver_locks,
- erts_aint32_t *receiver_state,
- ErlHeapFragment* bp,
- Eterm message,
- Eterm seq_trace_token
-#ifdef USE_VM_PROBES
- , Eterm dt_utag
-#endif
- )
+queue_messages(Process* receiver,
+ erts_aint32_t *receiver_state,
+ ErtsProcLocks receiver_locks,
+ ErtsMessage* first,
+ ErtsMessage** last,
+ Uint len,
+ Eterm from)
{
+ ErtsTracingEvent* te;
Sint res;
- ErlMessage* mp;
int locked_msgq = 0;
- erts_aint_t state;
-
-#ifndef ERTS_SMP
- ASSERT(bp != NULL || receiver->mbuf == NULL);
-#endif
-
- ERTS_SMP_LC_ASSERT(*receiver_locks == erts_proc_lc_my_proc_locks(receiver));
+ erts_aint32_t state;
- mp = message_alloc();
-
- if (receiver_state)
- state = *receiver_state;
- else
- state = erts_smp_atomic32_read_acqb(&receiver->state);
+ ASSERT(is_value(ERL_MESSAGE_TERM(first)));
+ ASSERT(ERL_MESSAGE_TOKEN(first) == am_undefined ||
+ ERL_MESSAGE_TOKEN(first) == NIL ||
+ is_tuple(ERL_MESSAGE_TOKEN(first)));
#ifdef ERTS_SMP
+#ifdef ERTS_ENABLE_LOCK_CHECK
+ ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(receiver) < ERTS_PROC_LOCK_MSGQ ||
+ receiver_locks == erts_proc_lc_my_proc_locks(receiver));
+#endif
- if (state & (ERTS_PSFLG_EXITING|ERTS_PSFLG_PENDING_EXIT))
- goto exiting;
-
- if (!(*receiver_locks & ERTS_PROC_LOCK_MSGQ)) {
+ 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_locks & ERTS_PROC_LOCK_STATUS) {
- erts_smp_proc_unlock(receiver, ERTS_PROC_LOCK_STATUS);
- need_locks |= ERTS_PROC_LOCK_STATUS;
+ ErtsProcLocks need_locks;
+
+ 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;
+
+ need_locks = receiver_locks & ERTS_PROC_LOCKS_HIGHER_THAN(ERTS_PROC_LOCK_MSGQ);
+ if (need_locks) {
+ erts_smp_proc_unlock(receiver, need_locks);
}
+ need_locks |= ERTS_PROC_LOCK_MSGQ;
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:
@@ -480,25 +431,13 @@ 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(first);
return 0;
}
- ERL_MESSAGE_TERM(mp) = message;
- ERL_MESSAGE_TOKEN(mp) = seq_trace_token;
-#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;
- if (*receiver_locks & ERTS_PROC_LOCK_MAIN) {
+#ifdef ERTS_SMP
+ if (receiver_locks & ERTS_PROC_LOCK_MAIN) {
/*
* We move 'in queue' to 'private queue' and place
* message at the end of 'private queue' in order
@@ -507,313 +446,120 @@ 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);
+ LINK_MESSAGE_PRIVQ(receiver, first, last, len);
}
else
#endif
{
- LINK_MESSAGE(receiver, mp);
+ LINK_MESSAGE(receiver, first, last, len);
}
+ if (IS_TRACED_FL(receiver, F_TRACE_RECEIVE)
+ && (te = &erts_receive_tracing[erts_active_bp_ix()],
+ te->on)) {
+
+ ErtsMessage *msg = first;
+
#ifdef USE_VM_PROBES
- if (DTRACE_ENABLED(message_queued)) {
- DTRACE_CHARBUF(receiver_name, DTRACE_TERM_BUF_SIZE);
- Sint tok_label = 0;
- Sint tok_lastcnt = 0;
- Sint tok_serial = 0;
-
- dtrace_proc_str(receiver, receiver_name);
- if (seq_trace_token != NIL && is_tuple(seq_trace_token)) {
- tok_label = signed_val(SEQ_TRACE_T_LABEL(seq_trace_token));
- tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(seq_trace_token));
- tok_serial = signed_val(SEQ_TRACE_T_SERIAL(seq_trace_token));
+ if (DTRACE_ENABLED(message_queued)) {
+ DTRACE_CHARBUF(receiver_name, DTRACE_TERM_BUF_SIZE);
+ Sint tok_label = 0;
+ Sint tok_lastcnt = 0;
+ Sint tok_serial = 0;
+ Eterm seq_trace_token = ERL_MESSAGE_TOKEN(msg);
+
+ dtrace_proc_str(receiver, receiver_name);
+ if (seq_trace_token != NIL && is_tuple(seq_trace_token)) {
+ tok_label = signed_val(SEQ_TRACE_T_LABEL(seq_trace_token));
+ tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(seq_trace_token));
+ tok_serial = signed_val(SEQ_TRACE_T_SERIAL(seq_trace_token));
+ }
+ DTRACE6(message_queued,
+ receiver_name, size_object(ERL_MESSAGE_TERM(msg)),
+ receiver->msg.len,
+ tok_label, tok_lastcnt, tok_serial);
}
- DTRACE6(message_queued,
- receiver_name, size_object(message), receiver->msg.len,
- tok_label, tok_lastcnt, tok_serial);
- }
#endif
+ while (msg) {
+ trace_receive(receiver, from, ERL_MESSAGE_TERM(msg), te);
+ msg = msg->next;
+ }
- if (IS_TRACED_FL(receiver, F_TRACE_RECEIVE))
- trace_receive(receiver, message);
-
- if (locked_msgq)
+ }
+ if (locked_msgq) {
erts_smp_proc_unlock(receiver, ERTS_PROC_LOCK_MSGQ);
+ }
- erts_proc_notify_new_message(receiver);
-
-#ifndef ERTS_SMP
- ERTS_HOLE_CHECK(receiver);
+#ifdef ERTS_SMP
+ erts_proc_notify_new_message(receiver, receiver_locks);
+#else
+ erts_proc_notify_new_message(receiver, 0);
#endif
return res;
}
-void
-erts_queue_message(Process* receiver,
- ErtsProcLocks *receiver_locks,
- ErlHeapFragment* bp,
- Eterm message,
- Eterm seq_trace_token
-#ifdef USE_VM_PROBES
- , Eterm dt_utag
-#endif
- )
+static Sint
+queue_message(Process* receiver,
+ erts_aint32_t *receiver_state,
+ ErtsProcLocks receiver_locks,
+ ErtsMessage* mp, Eterm msg, Eterm from)
{
- queue_message(NULL,
- receiver,
- receiver_locks,
- NULL,
- bp,
- message,
- seq_trace_token
-#ifdef USE_VM_PROBES
- , dt_utag
-#endif
- );
+ ERL_MESSAGE_TERM(mp) = msg;
+ return queue_messages(receiver, receiver_state, receiver_locks,
+ mp, &mp->next, 1, from);
}
-void
-erts_link_mbuf_to_proc(struct process *proc, ErlHeapFragment *bp)
+Sint
+erts_queue_message(Process* receiver, ErtsProcLocks receiver_locks,
+ ErtsMessage* mp, Eterm msg, Eterm from)
{
- Eterm* htop = HEAP_TOP(proc);
+ return queue_message(receiver, NULL, receiver_locks, mp, msg, from);
+}
- 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);
- }
+
+Sint
+erts_queue_messages(Process* receiver, ErtsProcLocks receiver_locks,
+ ErtsMessage* first, ErtsMessage** last, Uint len,
+ Eterm from)
+{
+ return queue_messages(receiver, NULL, receiver_locks,
+ first, last, len, from);
}
-/*
- * 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)));
@@ -822,14 +568,11 @@ erts_msg_attached_data_size_aux(ErlMessage *msg)
sz = erts_decode_dist_ext_size(msg->data.dist_ext);
if (sz < 0) {
- /* Bad external; remove it */
- if (is_not_nil(ERL_MESSAGE_TOKEN(msg))) {
- ErlHeapFragment *heap_frag;
- heap_frag = erts_dist_ext_trailer(msg->data.dist_ext);
- erts_cleanup_offheap(&heap_frag->off_heap);
- }
- erts_free_dist_ext_copy(msg->data.dist_ext);
- msg->data.dist_ext = NULL;
+ /* Bad external
+ * We leave the message intact in this case as it's not worth the trouble
+ * to make all callers remove it from queue. It will be detected again
+ * and removed from message queue later anyway.
+ */
return 0;
}
@@ -842,29 +585,89 @@ erts_msg_attached_data_size_aux(ErlMessage *msg)
return sz;
}
-void
-erts_move_msg_attached_data_to_heap(Eterm **hpp, ErlOffHeap *ohp, 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(hpp, ohp, 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,
- hpp,
- ohp);
- 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 ((*psp) & ERTS_PSFLGS_VOLATILE_HEAP)
+ goto in_message_fragment;
+ else if (
+#if defined(ERTS_SMP)
+ *plp & ERTS_PROC_LOCK_MAIN
+#else
+ pp
+#endif
+ ) {
+#ifdef ERTS_SMP
+ try_on_heap:
+#endif
+ if (((*psp) & ERTS_PSFLGS_VOLATILE_HEAP)
+ || (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(hpp,
- ohp,
- 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 (pp && 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;
}
/*
@@ -879,7 +682,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
@@ -888,80 +692,94 @@ 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;
+#else
+ erts_literal_area_t litarea;
+ INITIALIZE_LITERAL_PURGE_AREA(litarea);
#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
+ /* 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,
+ 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;
}
-#endif
-
- bp = new_message_buffer(msize + seq_trace_size
#ifdef USE_VM_PROBES
- + dt_utag_size
+ 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
- );
- hp = bp->mem;
- 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
+ INITIALIZE_SHCOPY(info);
+ msize = copy_shared_calculate(message, &info);
+#else
+ msize = size_object_litopt(message, &litarea);
+#endif
+ mp = erts_alloc_message_heap_state(receiver,
+ &receiver_state,
+ receiver_locks,
+ (msize
#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);
-#ifdef DTRACE_TAG_HARDDEBUG
- erts_fprintf(stderr,
- "Dtrace -> (%T) Spreading tag (%T) with "
- "message %T!\r\n",sender->common.id, utag, message);
+ + dt_utag_size
#endif
- }
+ + seq_trace_size),
+ &hp,
+ &ohp);
+
+#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_litopt(message, msize, &hp, ohp, &litarea);
#endif
- BM_MESSAGE_COPIED(msize);
- BM_SWAP_TIMER(copy,send);
+ 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) {
+ if (is_immed(DT_UTAG(sender)))
+ utag = DT_UTAG(sender);
+ else
+ utag = copy_struct(DT_UTAG(sender), dt_utag_size, &hp, ohp);
+ }
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));
@@ -970,140 +788,55 @@ 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 {
+#ifdef SHCOPY_SEND
+ INITIALIZE_SHCOPY(info);
+ msize = copy_shared_calculate(message, &info);
+#else
+ msize = size_object_litopt(message, &litarea);
#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;
+ mp = erts_alloc_message_heap_state(receiver,
+ &receiver_state,
+ receiver_locks,
+ msize,
+ &hp,
+ &ohp);
+#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_litopt(message, msize, &hp, ohp, &litarea);
#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_SWAP_TIMER(send,system);
- } else {
-#ifdef ERTS_SMP
- 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);
+#ifdef USE_VM_PROBES
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
-#ifdef USE_VM_PROBES
- , NIL
#endif
- );
- BM_SWAP_TIMER(send,system);
-#else
- ErlMessage* mp = message_alloc();
- Eterm *hp;
- BM_SWAP_TIMER(send,size);
- msize = size_object(message);
- BM_SWAP_TIMER(size,send);
-
- if (receiver->stop - receiver->htop <= msize) {
- BM_SWAP_TIMER(send,system);
- erts_garbage_collect(receiver, msize, receiver->arg_reg, receiver->arity);
- BM_SWAP_TIMER(system,send);
- }
- hp = receiver->htop;
- receiver->htop = hp + msize;
- BM_SWAP_TIMER(send,copy);
- message = copy_struct(message, msize, &hp, &receiver->off_heap);
- BM_MESSAGE_COPIED(msize);
- BM_SWAP_TIMER(copy,send);
- DTRACE6(message_send, sender_name, receiver_name,
- (uint32_t)msize, tok_label, tok_lastcnt, tok_serial);
- ERL_MESSAGE_TERM(mp) = message;
- ERL_MESSAGE_TOKEN(mp) = NIL;
+ }
+
+ ERL_MESSAGE_TOKEN(mp) = token;
#ifdef USE_VM_PROBES
- ERL_MESSAGE_DT_UTAG(mp) = NIL;
+ ERL_MESSAGE_DT_UTAG(mp) = utag;
#endif
- mp->next = NULL;
- mp->data.attached = NULL;
- LINK_MESSAGE(receiver, mp);
- res = receiver->msg.len;
- erts_proc_notify_new_message(receiver);
+ res = queue_message(receiver,
+ &receiver_state,
+ *receiver_locks,
+ mp, message,
+ sender->common.id);
- if (IS_TRACED_FL(receiver, F_TRACE_RECEIVE)) {
- trace_receive(receiver, message);
- }
- BM_SWAP_TIMER(send,system);
-#endif /* #ifndef ERTS_SMP */
- }
- return res;
+ return res;
}
+
/*
* This function delivers an EXIT message to a process
* which is trapping EXITs.
@@ -1121,53 +854,1012 @@ 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
-#ifdef USE_VM_PROBES
- , NIL
-#endif
- );
+ temptoken = copy_struct(token, sz_token, &hp, ohp);
+ ERL_MESSAGE_TOKEN(mp) = temptoken;
+ erts_queue_message(to, *to_locksp, mp, save, am_system);
} 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, am_system);
+ }
+}
+
+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
- , NIL
+ && 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;
+ c_p->flags &= ~F_OFF_HEAP_MSGQ;
+ erts_smp_atomic32_read_bor_nob(&c_p->state,
+ ERTS_PSFLG_ON_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_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;
+
+ 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;
+
+ ASSERT(*mpp == bad_mp);
+
+ erts_msgq_update_internal_pointers(&rp->msg, mpp, &bad_mp->next);
+
+ 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;
+ erts_msgq_replace_msg_ref(&rp->msg, tmp, mpp);
+ 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,
+ Process* p)
+{
+ erts_factory_proc_prealloc_init(factory, p, HEAP_LIMIT(p) - HEAP_TOP(p));
+}
+
+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 = 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_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 = proc ? erts_smp_atomic32_read_nob(&proc->state) : 0;
+
+ 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)
+{
+ ErlHeapFragment* bp;
+ if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG) {
+ bp = &msgp->hfrag;
+ factory->heap_frags = NULL;
+ }
+ else {
+ 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,
+ ErlOffHeap* off_heap)
+{
+ factory->mode = FACTORY_STATIC;
+ factory->hp_start = hp;
+ factory->hp = hp;
+ factory->hp_end = hp + size;
+ factory->off_heap = off_heap;
+ factory->off_heap_saved.first = factory->off_heap->first;
+ 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)
+{
+ factory->mode = FACTORY_CLOSED;
+}
+
+static void reserve_heap(ErtsHeapFactory*, Uint need, Uint xtra);
+
+Eterm* erts_produce_heap(ErtsHeapFactory* factory, Uint need, Uint xtra)
+{
+ Eterm* res;
+
+ ASSERT((unsigned int)factory->mode > (unsigned int)FACTORY_CLOSED);
+ if (factory->hp + need > factory->hp_end) {
+ reserve_heap(factory, need, xtra);
+ }
+ res = factory->hp;
+ factory->hp += need;
+ return res;
+}
+
+Eterm* erts_reserve_heap(ErtsHeapFactory* factory, Uint need)
+{
+ ASSERT((unsigned int)factory->mode > (unsigned int)FACTORY_CLOSED);
+ if (factory->hp + need > factory->hp_end) {
+ reserve_heap(factory, need, 200);
+ }
+ return factory->hp;
+}
+
+static void reserve_heap(ErtsHeapFactory* factory, Uint need, Uint xtra)
+{
+ ErlHeapFragment* bp;
+
+ switch (factory->mode) {
+ case FACTORY_HALLOC:
+ HRelease(factory->p, factory->hp_end, factory->hp);
+ factory->hp = HAllocX(factory->p, need, xtra);
+ factory->hp_end = factory->hp + need;
+ return;
+
+ 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);
+ ASSERT(factory->hp <= factory->hp_end);
+ ASSERT(factory->hp_end == bp->mem + bp->alloc_size);
+
+ bp->used_size = factory->hp - bp->mem;
+ }
+ bp = (ErlHeapFragment*) ERTS_HEAP_ALLOC(factory->alloc_type,
+ ERTS_HEAP_FRAG_SIZE(need+xtra));
+ bp->next = factory->heap_frags;
+ factory->heap_frags = bp;
+ bp->alloc_size = need + xtra;
+ bp->used_size = need;
+ bp->off_heap.first = NULL;
+ bp->off_heap.overhead = 0;
+
+ factory->hp = bp->mem;
+ factory->hp_end = bp->mem + bp->alloc_size;
+ return;
+
+ case FACTORY_STATIC:
+ case FACTORY_CLOSED:
+ default:
+ ASSERT(!"Invalid factory mode");
+ }
+}
+
+void erts_factory_close(ErtsHeapFactory* factory)
+{
+ ErlHeapFragment* bp;
+
+ switch (factory->mode) {
+ case FACTORY_HALLOC:
+ HRelease(factory->p, factory->hp_end, factory->hp);
+ break;
+
+ 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);
+ ASSERT(factory->hp <= factory->hp_end);
+ ASSERT(factory->hp_end == bp->mem + bp->alloc_size);
+
+ 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:
+ ASSERT(!"Invalid factory mode");
+ }
+ factory->mode = FACTORY_CLOSED;
+}
+
+void erts_factory_trim_and_close(ErtsHeapFactory* factory,
+ Eterm *brefs, Uint brefs_size)
+{
+ ErlHeapFragment *bp;
+
+ switch (factory->mode) {
+ case FACTORY_MESSAGE: {
+ ErtsMessage *mp = factory->message;
+ if (mp->data.attached == ERTS_MSG_COMBINED_HFRAG) {
+ if (!factory->heap_frags) {
+ 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);
+ 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 (off_heap...) */
+ default:
+ break;
+ }
+ erts_factory_close(factory);
+}
+
+void erts_factory_undo(ErtsHeapFactory* factory)
+{
+ ErlHeapFragment* bp;
+ struct erl_off_heap_header *hdr, **hdr_nextp;
+
+ switch (factory->mode) {
+ case FACTORY_HALLOC:
+ case FACTORY_STATIC:
+ /* Cleanup off-heap
+ */
+ hdr_nextp = NULL;
+ for (hdr = factory->off_heap->first;
+ hdr != factory->off_heap_saved.first;
+ hdr = hdr->next) {
+
+ hdr_nextp = &hdr->next;
+ }
+
+ if (hdr_nextp != NULL) {
+ *hdr_nextp = NULL;
+ erts_cleanup_offheap(factory->off_heap);
+ factory->off_heap->first = factory->off_heap_saved.first;
+ factory->off_heap->overhead = factory->off_heap_saved.overhead;
+ }
+
+ if (factory->mode == FACTORY_HALLOC) {
+ /* Free heap frags
+ */
+ bp = factory->p->mbuf;
+ if (bp != factory->heap_frags_saved) {
+ do {
+ ErlHeapFragment *next_bp = bp->next;
+ ASSERT(bp->off_heap.first == NULL);
+ ERTS_HEAP_FREE(ERTS_ALC_T_HEAP_FRAG, (void *) bp,
+ ERTS_HEAP_FRAG_SIZE(bp->alloc_size));
+ bp = next_bp;
+ } while (bp != factory->heap_frags_saved);
+
+ factory->p->mbuf = bp;
+ }
+
+ /* Rollback heap top
+ */
+
+ 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)
+ 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));
+ }
+ }
+ }
+ 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;
+ while (bp != NULL) {
+ ErlHeapFragment* next_bp = bp->next;
+
+ ASSERT(bp->off_heap.first == NULL);
+ ERTS_HEAP_FREE(factory->alloc_type, (void *) bp,
+ ERTS_HEAP_FRAG_SIZE(bp->alloc_size));
+ bp = next_bp;
+ }
+ break;
+
+ case FACTORY_CLOSED: break;
+ default:
+ ASSERT(!"Invalid factory mode");
+ }
+ factory->mode = FACTORY_CLOSED;
+#ifdef DEBUG
+ factory->p = NULL;
+ factory->hp = NULL;
+ factory->heap_frags = NULL;
+#endif
+}
+
+Uint
+erts_mbuf_size(Process *p)
+{
+ Uint sz = 0;
+ ErlHeapFragment* bp;
+ ErtsMessage* mp;
+
+ for (bp = p->mbuf; bp; bp = bp->next)
+ sz += bp->used_size;
+
+ for (mp = p->msg_frag; mp; mp = mp->next)
+ for (bp = erts_message_to_heap_frag(mp); bp; bp = bp->next)
+ sz += bp->used_size;
+
+ return sz;
+}
diff --git a/erts/emulator/beam/erl_message.h b/erts/emulator/beam/erl_message.h
index 0f3bb8d281..42ed14e69c 100644
--- a/erts/emulator/beam/erl_message.h
+++ b/erts/emulator/beam/erl_message.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1997-2012. All Rights Reserved.
+ * Copyright Ericsson AB 1997-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -23,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.
@@ -31,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;
};
@@ -51,9 +51,58 @@ typedef struct erl_off_heap {
(OHP)->first = NULL; \
(OHP)->overhead = 0; \
} while (0)
+
+typedef struct {
+ enum {
+ FACTORY_CLOSED = 0,
+ FACTORY_HALLOC,
+ FACTORY_MESSAGE,
+ FACTORY_HEAP_FRAGS,
+ 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;
+} ErtsHeapFactory;
+
+void erts_factory_proc_init(ErtsHeapFactory*, Process*);
+void erts_factory_proc_prealloc_init(ErtsHeapFactory*, Process*, Sint size);
+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);
+Eterm* erts_reserve_heap(ErtsHeapFactory*, Uint need);
+void erts_factory_close(ErtsHeapFactory*);
+void erts_factory_trim_and_close(ErtsHeapFactory*,Eterm *brefs, Uint brefs_size);
+void erts_factory_undo(ErtsHeapFactory*);
+
+#ifdef CHECK_FOR_HOLES
+# define ERTS_FACTORY_HOLE_CHECK(f) do { \
+ /*if ((f)->p) erts_check_for_holes((f)->p);*/ \
+ } while (0)
+#else
+# define ERTS_FACTORY_HOLE_CHECK(p)
+#endif
+
#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.
@@ -63,38 +112,58 @@ typedef struct erl_heap_fragment ErlHeapFragment;
struct erl_heap_fragment {
ErlHeapFragment* next; /* Next heap fragment */
ErlOffHeap off_heap; /* Offset heap data. */
- unsigned alloc_size; /* Size in (half)words of mem */
- unsigned used_size; /* With terms to be moved to heap by GC */
+ Uint alloc_size; /* Size in (half)words of mem */
+ Uint used_size; /* With terms to be moved to heap by GC */
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 */
/*
@@ -102,65 +171,81 @@ 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;
+typedef struct erl_trace_message_queue__ {
+ struct erl_trace_message_queue__ *next; /* point to the next receiver */
+ Eterm receiver;
+ ErtsMessage* first;
+ ErtsMessage** last; /* point to the last next pointer */
+ Sint len; /* queue length */
+} ErlTraceMessageQueue;
+
#endif
/* Get "current" message */
#define PEEK_MESSAGE(p) (*(p)->msg.save)
+#ifdef USE_VM_PROBES
+#define LINK_MESSAGE_DTAG(mp, dt) ERL_MESSAGE_DT_UTAG(mp) = dt
+#else
+#define LINK_MESSAGE_DTAG(mp, dt)
+#endif
-/* Add message last in private message queue */
-#define LINK_MESSAGE_PRIVQ(p, mp) do { \
- *(p)->msg.last = (mp); \
- (p)->msg.last = &(mp)->next; \
- (p)->msg.len++; \
-} while(0)
-
+#define LINK_MESSAGE_IMPL(p, first_msg, last_msg, num_msgs, where) do { \
+ *(p)->where.last = (first_msg); \
+ (p)->where.last = (last_msg); \
+ (p)->where.len += (num_msgs); \
+ } while(0)
#ifdef ERTS_SMP
-/* Move in message queue to end of private message queue */
-#define ERTS_SMP_MSGQ_MV_INQ2PRIVQ(P) \
-do { \
- if ((P)->msg_inq.first) { \
- *(P)->msg.last = (P)->msg_inq.first; \
- (P)->msg.last = (P)->msg_inq.last; \
- (P)->msg.len += (P)->msg_inq.len; \
- (P)->msg_inq.first = NULL; \
- (P)->msg_inq.last = &(P)->msg_inq.first; \
- (P)->msg_inq.len = 0; \
- } \
-} while (0)
-
-/* Add message last in message queue */
-#define LINK_MESSAGE(p, mp) do { \
- *(p)->msg_inq.last = (mp); \
- (p)->msg_inq.last = &(mp)->next; \
- (p)->msg_inq.len++; \
-} while(0)
+/* Add message last in private message queue */
+#define LINK_MESSAGE_PRIVQ(p, first_msg, last_msg, len) \
+ do { \
+ LINK_MESSAGE_IMPL(p, first_msg, last_msg, len, msg); \
+ } while (0)
+
+/* Add message last_msg in message queue */
+#define LINK_MESSAGE(p, first_msg, last_msg, len) \
+ LINK_MESSAGE_IMPL(p, first_msg, last_msg, len, msg_inq)
+
+#define ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p) \
+ do { \
+ if (p->msg_inq.first) { \
+ *p->msg.last = p->msg_inq.first; \
+ p->msg.last = p->msg_inq.last; \
+ p->msg.len += p->msg_inq.len; \
+ p->msg_inq.first = NULL; \
+ p->msg_inq.last = &p->msg_inq.first; \
+ p->msg_inq.len = 0; \
+ } \
+ } while (0)
#else
-#define ERTS_SMP_MSGQ_MV_INQ2PRIVQ(P)
+#define ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p)
-/* Add message last in message queue */
-#define LINK_MESSAGE(p, mp) LINK_MESSAGE_PRIVQ((p), (mp))
+/* Add message last_msg in message queue */
+#define LINK_MESSAGE(p, first_msg, last_msg, len) \
+ do { \
+ LINK_MESSAGE_IMPL(p, first_msg, last_msg, len, msg); \
+ } while(0)
#endif
/* 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) \
@@ -176,102 +261,207 @@ 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)); \
- if ((ST) - (HT) >= need__) { \
- Uint *htop__ = (HT); \
- erts_move_msg_attached_data_to_heap(&htop__, &MSO((P)), (M));\
- ASSERT(htop__ - (HT) <= need__); \
- (HT) = htop__; \
- } \
- else { \
- { SWPO ; } \
- (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)
+
+#ifdef USE_VM_PROBES
+#define ERL_MESSAGE_DT_UTAG_INIT(MP) ERL_MESSAGE_DT_UTAG(MP) = NIL
+#else
+#define ERL_MESSAGE_DT_UTAG_INIT(MP) do{ } while (0)
+#endif
+
+#define ERTS_INIT_MESSAGE(MP) \
+ do { \
+ (MP)->next = NULL; \
+ ERL_MESSAGE_TERM(MP) = THE_NON_VALUE; \
+ ERL_MESSAGE_TOKEN(MP) = NIL; \
+ ERL_MESSAGE_DT_UTAG_INIT(MP); \
+ MP->data.attached = NULL; \
+ } 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);
-void erts_queue_message(Process*, ErtsProcLocks*, ErlHeapFragment*, Eterm, Eterm
-#ifdef USE_VM_PROBES
- , Eterm dt_utag
-#endif
-);
+void erts_queue_dist_message(Process*, ErtsProcLocks, ErtsDistExternal *, Eterm, Eterm);
+Sint erts_queue_message(Process*, ErtsProcLocks,ErtsMessage*, Eterm, Eterm);
+Sint erts_queue_messages(Process*, ErtsProcLocks,
+ ErtsMessage*, ErtsMessage**, Uint, Eterm);
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(ErtsMessage *msg);
-Uint erts_msg_attached_data_size_aux(ErlMessage *msg);
-void erts_move_msg_attached_data_to_heap(Eterm **, ErlOffHeap *, ErlMessage *);
+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);
-Eterm erts_msg_distext2heap(Process *, ErtsProcLocks *, ErlHeapFragment **,
- Eterm *, ErtsDistExternal *);
+int erts_decode_dist_message(Process *, ErtsProcLocks, ErtsMessage *, int);
-void erts_cleanup_offheap(ErlOffHeap *offheap);
+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);
-ERTS_GLB_INLINE Uint erts_msg_used_frag_sz(const ErlMessage *msg);
-ERTS_GLB_INLINE Uint erts_msg_attached_data_size(ErlMessage *msg);
+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(ErtsMessage *msg);
+ERTS_GLB_INLINE void erts_msgq_update_internal_pointers(ErlMessageQueue *msgq,
+ ErtsMessage **newpp,
+ ErtsMessage **oldpp);
+ERTS_GLB_INLINE void erts_msgq_replace_msg_ref(ErlMessageQueue *msgq,
+ ErtsMessage *newp,
+ ErtsMessage **oldpp);
+
+#define ERTS_MSG_COMBINED_HFRAG ((void *) 0x1)
+
+#define erts_message_to_heap_frag(MP) \
+ (((MP)->data.attached == ERTS_MSG_COMBINED_HFRAG) ? \
+ &(MP)->hfrag : (MP)->data.heap_frag)
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
-ERTS_GLB_INLINE Uint erts_msg_used_frag_sz(const ErlMessage *msg)
+
+ERTS_GLB_FORCE_INLINE ErtsMessage *erts_alloc_message(Uint sz, Eterm **hpp)
+{
+ ErtsMessage *mp;
+
+ if (sz == 0) {
+ mp = erts_alloc_message_ref();
+ ERTS_INIT_MESSAGE(mp);
+ if (hpp)
+ *hpp = NULL;
+ return mp;
+ }
+
+ mp = erts_alloc(ERTS_ALC_T_MSG,
+ sizeof(ErtsMessage) + (sz - 1)*sizeof(Eterm));
+
+ ERTS_INIT_MESSAGE(mp);
+ 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)
{
- const ErlHeapFragment *bp;
Uint sz = 0;
- for (bp = msg->data.heap_frag; bp!=NULL; bp=bp->next) {
+ for ( ; bp!=NULL; bp=bp->next) {
sz += bp->used_size;
}
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_msg_used_frag_sz(msg);
+ if (is_value(ERL_MESSAGE_TERM(msg))) {
+ ErlHeapFragment *bp;
+ bp = erts_message_to_heap_frag(msg);
+ return erts_used_frag_sz(bp);
+ }
else if (msg->data.dist_ext->heap_size < 0)
return erts_msg_attached_data_size_aux(msg);
else {
@@ -284,6 +474,40 @@ ERTS_GLB_INLINE Uint erts_msg_attached_data_size(ErlMessage *msg)
return sz;
}
}
+
+ERTS_GLB_INLINE void
+erts_msgq_update_internal_pointers(ErlMessageQueue *msgq,
+ ErtsMessage **newpp,
+ ErtsMessage **oldpp)
+{
+ if (msgq->save == oldpp)
+ msgq->save = newpp;
+ if (msgq->last == oldpp)
+ msgq->last = newpp;
+ if (msgq->saved_last == oldpp)
+ msgq->saved_last = newpp;
+}
+
+ERTS_GLB_INLINE void
+erts_msgq_replace_msg_ref(ErlMessageQueue *msgq, ErtsMessage *newp, ErtsMessage **oldpp)
+{
+ ErtsMessage *oldp = *oldpp;
+ newp->next = oldp->next;
+ erts_msgq_update_internal_pointers(msgq, &newp->next, &oldp->next);
+ *oldpp = newp;
+}
+
+#endif
+
+Uint erts_mbuf_size(Process *p);
+#if defined(DEBUG) || 0
+# define ERTS_CHK_MBUF_SZ(P) \
+ do { \
+ Uint actual_mbuf_sz__ = erts_mbuf_size((P)); \
+ ERTS_ASSERT((P)->mbuf_sz >= actual_mbuf_sz__); \
+ } while (0)
+#else
+# define ERTS_CHK_MBUF_SZ(P) ((void) 1)
#endif
#endif
diff --git a/erts/emulator/beam/erl_monitors.c b/erts/emulator/beam/erl_monitors.c
index 244a2b26db..3994800ba7 100644
--- a/erts/emulator/beam/erl_monitors.c
+++ b/erts/emulator/beam/erl_monitors.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2004-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2004-2017. 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.
+ * 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%
*/
@@ -23,7 +24,7 @@
* key in the monitor case and the pid of the linked process as key in the
* link case. Lookups the order of the references is somewhat special. Local
* references are strictly smaller than remote references and are sorted
- * by inlined comparision functionality. Remote references are handled by the
+ * by inlined comparison functionality. Remote references are handled by the
* usual cmp function.
* Each Monitor is tagged with different tags depending on which end of the
* monitor it is.
@@ -44,6 +45,7 @@
#include "bif.h"
#include "big.h"
#include "erl_monitors.h"
+#include "erl_bif_unique.h"
#define STACK_NEED 50
#define MAX_MONITORS 0xFFFFFFFFUL
@@ -78,7 +80,24 @@ static ERTS_INLINE int cmp_mon_ref(Eterm ref1, Eterm ref2)
b2 = boxed_val(ref2);
if (is_ref_thing_header(*b1)) {
if (is_ref_thing_header(*b2)) {
- return memcmp(b1+1,b2+1,ERTS_REF_WORDS*sizeof(Uint));
+ Uint32 *num1, *num2;
+ if (is_ordinary_ref_thing(b1)) {
+ ErtsORefThing *rtp = (ErtsORefThing *) b1;
+ num1 = rtp->num;
+ }
+ else {
+ ErtsMRefThing *mrtp = (ErtsMRefThing *) b1;
+ num1 = mrtp->mb->refn;
+ }
+ if (is_ordinary_ref_thing(b2)) {
+ ErtsORefThing *rtp = (ErtsORefThing *) b2;
+ num2 = rtp->num;
+ }
+ else {
+ ErtsMRefThing *mrtp = (ErtsMRefThing *) b2;
+ num2 = mrtp->mb->refn;
+ }
+ return erts_internal_ref_number_cmp(num1, num2);
}
return -1;
}
@@ -90,33 +109,34 @@ static ERTS_INLINE int cmp_mon_ref(Eterm ref1, Eterm ref2)
#define CP_LINK_VAL(To, Hp, From) \
do { \
- if (IS_CONST(From)) \
+ if (is_immed(From)) \
(To) = (From); \
else { \
Uint i__; \
Uint len__; \
ASSERT((Hp)); \
- ASSERT(is_internal_ref((From)) || is_external((From))); \
+ ASSERT(is_internal_ordinary_ref((From)) \
+ || is_external((From))); \
(To) = make_boxed((Hp)); \
len__ = thing_arityval(*boxed_val((From))) + 1; \
for(i__ = 0; i__ < len__; i__++) \
(*((Hp)++)) = boxed_val((From))[i__]; \
if (is_external((To))) { \
external_thing_ptr((To))->next = NULL; \
- erts_refc_inc(&(external_thing_ptr((To))->node->refc), 2);\
+ erts_smp_refc_inc(&(external_thing_ptr((To))->node->refc), 2);\
} \
} \
} while (0)
-static ErtsMonitor *create_monitor(Uint type, Eterm ref, Eterm pid, Eterm name)
+static ErtsMonitor *create_monitor(Uint type, Eterm ref, UWord entity, Eterm name)
{
Uint mon_size = ERTS_MONITOR_SIZE;
ErtsMonitor *n;
Eterm *hp;
mon_size += NC_HEAP_SIZE(ref);
- if (!IS_CONST(pid)) {
- mon_size += NC_HEAP_SIZE(pid);
+ if (type != MON_NIF_TARGET && is_not_immed(entity)) {
+ mon_size += NC_HEAP_SIZE(entity);
}
if (mon_size <= ERTS_MONITOR_SH_SIZE) {
@@ -134,8 +154,11 @@ static ErtsMonitor *create_monitor(Uint type, Eterm ref, Eterm pid, Eterm name)
n->type = (Uint16) type;
n->balance = 0; /* Always the same initial value */
n->name = name; /* atom() or [] */
- CP_LINK_VAL(n->ref, hp, ref); /*XXX Unneccesary check, never immediate*/
- CP_LINK_VAL(n->pid, hp, pid);
+ CP_LINK_VAL(n->ref, hp, ref); /*XXX Unnecessary check, never immediate*/
+ if (type == MON_NIF_TARGET)
+ n->u.resource = (ErtsResource*)entity;
+ else
+ CP_LINK_VAL(n->u.pid, hp, (Eterm)entity);
return n;
}
@@ -146,7 +169,7 @@ static ErtsLink *create_link(Uint type, Eterm pid)
ErtsLink *n;
Eterm *hp;
- if (!IS_CONST(pid)) {
+ if (is_not_immed(pid)) {
lnk_size += NC_HEAP_SIZE(pid);
}
@@ -205,16 +228,16 @@ void erts_destroy_monitor(ErtsMonitor *mon)
Uint mon_size = ERTS_MONITOR_SIZE;
ErlNode *node;
- ASSERT(!IS_CONST(mon->ref));
+ ASSERT(is_not_immed(mon->ref));
mon_size += NC_HEAP_SIZE(mon->ref);
if (is_external(mon->ref)) {
node = external_thing_ptr(mon->ref)->node;
erts_deref_node_entry(node);
}
- if (!IS_CONST(mon->pid)) {
- mon_size += NC_HEAP_SIZE(mon->pid);
- if (is_external(mon->pid)) {
- node = external_thing_ptr(mon->pid)->node;
+ if (mon->type != MON_NIF_TARGET && is_not_immed(mon->u.pid)) {
+ mon_size += NC_HEAP_SIZE(mon->u.pid);
+ if (is_external(mon->u.pid)) {
+ node = external_thing_ptr(mon->u.pid)->node;
erts_deref_node_entry(node);
}
}
@@ -233,7 +256,7 @@ void erts_destroy_link(ErtsLink *lnk)
ASSERT(lnk->type == LINK_NODE || ERTS_LINK_ROOT(lnk) == NULL);
- if (!IS_CONST(lnk->pid)) {
+ if (is_not_immed(lnk->pid)) {
lnk_size += NC_HEAP_SIZE(lnk->pid);
if (is_external(lnk->pid)) {
node = external_thing_ptr(lnk->pid)->node;
@@ -328,7 +351,7 @@ static void insertion_rotation(int dstack[], int dpos,
}
}
-void erts_add_monitor(ErtsMonitor **root, Uint type, Eterm ref, Eterm pid,
+void erts_add_monitor(ErtsMonitor **root, Uint type, Eterm ref, UWord entity,
Eterm name)
{
void *tstack[STACK_NEED];
@@ -338,12 +361,14 @@ void erts_add_monitor(ErtsMonitor **root, Uint type, Eterm ref, Eterm pid,
int state = 0;
ErtsMonitor **this = root;
Sint c;
+
+ ASSERT(is_internal_ordinary_ref(ref) || is_external_ref(ref));
dstack[0] = DIR_END;
for (;;) {
if (!*this) { /* Found our place */
state = 1;
- *this = create_monitor(type,ref,pid,name);
+ *this = create_monitor(type,ref,entity,name);
break;
} else if ((c = CMP_MON_REF(ref,(*this)->ref)) < 0) {
/* go left */
@@ -355,7 +380,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;
}
}
@@ -913,8 +938,12 @@ static void erts_dump_monitors(ErtsMonitor *root, int indent)
if (root == NULL)
return;
erts_dump_monitors(root->right,indent+2);
- erts_printf("%*s[%b16d:%b16u:%T:%T:%T]\n", indent, "", root->balance,
- root->type, root->ref, root->pid, root->name);
+ erts_printf("%*s[%b16d:%b16u:%T:%T", indent, "", root->balance,
+ root->type, root->ref, root->name);
+ if (root->type == MON_NIF_TARGET)
+ erts_printf(":%p]\n", root->u.resource);
+ else
+ erts_printf(":%T]\n", root->u.pid);
erts_dump_monitors(root->left,indent+2);
}
@@ -1029,7 +1058,7 @@ void erts_one_link_size(ErtsLink *lnk, void *vpu)
{
Uint *pu = vpu;
*pu += ERTS_LINK_SIZE*sizeof(Uint);
- if(!IS_CONST(lnk->pid))
+ if(is_not_immed(lnk->pid))
*pu += NC_HEAP_SIZE(lnk->pid)*sizeof(Uint);
if (lnk->type != LINK_NODE && ERTS_LINK_ROOT(lnk) != NULL) {
erts_doforall_links(ERTS_LINK_ROOT(lnk),&erts_one_link_size,vpu);
@@ -1039,8 +1068,8 @@ void erts_one_mon_size(ErtsMonitor *mon, void *vpu)
{
Uint *pu = vpu;
*pu += ERTS_MONITOR_SIZE*sizeof(Uint);
- if(!IS_CONST(mon->pid))
- *pu += NC_HEAP_SIZE(mon->pid)*sizeof(Uint);
- if(!IS_CONST(mon->ref))
+ if(mon->type != MON_NIF_TARGET && is_not_immed(mon->u.pid))
+ *pu += NC_HEAP_SIZE(mon->u.pid)*sizeof(Uint);
+ if(is_not_immed(mon->ref))
*pu += NC_HEAP_SIZE(mon->ref)*sizeof(Uint);
}
diff --git a/erts/emulator/beam/erl_monitors.h b/erts/emulator/beam/erl_monitors.h
index fb11dbbd22..1cacecd7e9 100644
--- a/erts/emulator/beam/erl_monitors.h
+++ b/erts/emulator/beam/erl_monitors.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2004-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2004-2017. 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.
+ * 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%
*/
@@ -81,7 +82,9 @@
/* Type tags for monitors */
#define MON_ORIGIN 1
-#define MON_TARGET 3
+#define MON_TARGET 2
+#define MON_NIF_TARGET 3
+#define MON_TIME_OFFSET 4
/* Type tags for links */
#define LINK_PID 1 /* ...Or port */
@@ -89,7 +92,7 @@
/* Size of a monitor without heap, in words (fixalloc) */
#define ERTS_MONITOR_SIZE ((sizeof(ErtsMonitor) - sizeof(Uint))/sizeof(Uint))
-#define ERTS_MONITOR_SH_SIZE (ERTS_MONITOR_SIZE + REF_THING_SIZE)
+#define ERTS_MONITOR_SH_SIZE (ERTS_MONITOR_SIZE + ERTS_REF_THING_SIZE)
#define ERTS_LINK_SIZE ((sizeof(ErtsLink) - sizeof(Uint))/sizeof(Uint))
#define ERTS_LINK_SH_SIZE ERTS_LINK_SIZE /* Size of fix-alloced links */
@@ -103,11 +106,15 @@ typedef struct erts_monitor_or_link {
typedef struct erts_monitor {
struct erts_monitor *left, *right;
Sint16 balance;
- Uint16 type; /* MON_ORIGIN | MON_TARGET */
+ Uint16 type; /* MON_ORIGIN | MON_TARGET | MON_NIF_TARGET | MON_TIME_OFFSET */
Eterm ref;
- Eterm pid; /* In case of distributed named monitor, this is the
- nodename atom in MON_ORIGIN process, otherwise a pid or
- , in case of a MON_TARGET, a port */
+ union {
+ Eterm pid; /* In case of distributed named monitor, this is the
+ * nodename atom in MON_ORIGIN process, otherwise a pid or,
+ * in case of a MON_TARGET, a port
+ */
+ struct ErtsResource_* resource; /* MON_NIF_TARGET */
+ }u;
Eterm name; /* When monitoring a named process: atom() else [] */
Uint heap[1]; /* Larger in reality */
} ErtsMonitor;
@@ -142,7 +149,7 @@ Uint erts_tot_link_lh_size(void);
/* Prototypes */
void erts_destroy_monitor(ErtsMonitor *mon);
-void erts_add_monitor(ErtsMonitor **root, Uint type, Eterm ref, Eterm pid,
+void erts_add_monitor(ErtsMonitor **root, Uint type, Eterm ref, UWord entity,
Eterm name);
ErtsMonitor *erts_remove_monitor(ErtsMonitor **root, Eterm ref);
ErtsMonitor *erts_lookup_monitor(ErtsMonitor *root, Eterm ref);
diff --git a/erts/emulator/beam/erl_msacc.c b/erts/emulator/beam/erl_msacc.c
new file mode 100644
index 0000000000..6c477be615
--- /dev/null
+++ b/erts/emulator/beam/erl_msacc.c
@@ -0,0 +1,490 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2014-2017. 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"
+#include "erl_bif_table.h"
+
+#if ERTS_ENABLE_MSACC
+
+static Eterm erts_msacc_gather_stats(ErtsMsAcc *msacc, ErtsHeapFactory *factory);
+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
+#ifndef ERTS_MSACC_ALWAYS_ON
+int ERTS_WRITE_UNLIKELY(erts_msacc_enabled);
+#endif
+
+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
+
+#if ERTS_MSACC_STATE_COUNT < MAP_SMALL_MAP_LIMIT
+#define DEFAULT_MSACC_MSG_SIZE (3 + 1 + ERTS_MSACC_STATE_COUNT * 2 + 3 + ERTS_REF_THING_SIZE)
+#else
+#define DEFAULT_MSACC_MSG_SIZE (3 + ERTS_MSACC_STATE_COUNT * 3 + 3 + ERTS_REF_THING_SIZE)
+#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", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
+#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) +
+ sizeof(ErtsMsAccPerfCntr) * ERTS_MSACC_STATE_COUNT);
+
+ 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", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
+ 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
+}
+
+#ifdef ERTS_MSACC_EXTENDED_STATES
+
+void erts_msacc_set_bif_state(ErtsMsAcc *__erts_msacc_cache, Eterm mod, void *fn) {
+
+#ifdef ERTS_MSACC_EXTENDED_BIFS
+#define BIF_LIST(Mod,Func,Arity,BifFuncAddr,FuncAddr,Num) \
+ if (fn == &BifFuncAddr) { \
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATIC_STATE_COUNT + Num); \
+ } else
+#include "erl_bif_list.h"
+#undef BIF_LIST
+ { /* The last else in the macro expansion,
+ this happens for internal bifs, i.e. traps etc */
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_BIF);
+ }
+#else
+ if (mod == 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);
+ }
+#endif
+}
+
+#endif
+
+/*
+ * Creates a structure looking like this
+ * #{ type => scheduler, id => 1, counters => #{ State1 => Counter1 ... StateN => CounterN}}
+ */
+static
+Eterm erts_msacc_gather_stats(ErtsMsAcc *msacc, ErtsHeapFactory *factory) {
+ Uint sz = 0;
+ Eterm *hp, cvs[ERTS_MSACC_STATE_COUNT];
+ Eterm key, state_map;
+ int i;
+ flatmap_t *map;
+
+ hp = erts_produce_heap(factory, 4, 0);
+ key = TUPLE3(hp,am_counters,am_id,am_type);
+
+ for (i = 0; i < ERTS_MSACC_STATE_COUNT; i++) {
+ cvs[i] = erts_bld_sint64(NULL, &sz,(Sint64)msacc->counters[i].pc);
+#ifdef ERTS_MSACC_STATE_COUNTERS
+ erts_bld_uint64(NULL,&sz,msacc->counters[i].sc);
+ sz += 3;
+#endif
+ }
+
+ hp = erts_produce_heap(factory, sz, 0);
+
+ for (i = 0; i < ERTS_MSACC_STATE_COUNT; i++) {
+ cvs[i] = erts_bld_sint64(&hp,NULL,(Sint64)msacc->counters[i].pc);
+#ifdef ERTS_MSACC_STATE_COUNTERS
+ Eterm counter__ = erts_bld_uint64(&hp,NULL,msacc->counters[i].sc);
+ cvs[i] = TUPLE2(hp,cvs[i],counter__);
+ hp += 3;
+#endif
+ }
+
+ state_map = erts_map_from_ks_and_vs(factory, erts_msacc_state_atoms, cvs,
+ ERTS_MSACC_STATE_COUNT);
+
+ hp = erts_produce_heap(factory, MAP_HEADER_FLATMAP_SZ + 3, 0);
+ 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));
+
+ return make_flatmap(map);
+}
+
+typedef struct {
+ int action;
+ Process *proc;
+ Eterm ref;
+ Eterm ref_heap[ERTS_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 *hp;
+ Eterm ref_copy = NIL, msg;
+ ErtsProcLocks rp_locks = (esdp && msaccrp->req_sched == esdp->no
+ ? ERTS_PROC_LOCK_MAIN : 0);
+ ErtsHeapFactory factory;
+
+ if (msaccrp->action == ERTS_MSACC_GATHER) {
+
+ msgp = erts_factory_message_create(&factory, rp, &rp_locks, DEFAULT_MSACC_MSG_SIZE);
+
+ if (msacc->unmanaged) erts_mtx_lock(&msacc->mtx);
+
+ hp = erts_produce_heap(&factory, ERTS_REF_THING_SIZE + 3 /* tuple */, 0);
+ ref_copy = STORE_NC(&hp, &msgp->hfrag.off_heap, msaccrp->ref);
+ msg = erts_msacc_gather_stats(msacc, &factory);
+ msg = TUPLE2(hp, ref_copy, msg);
+
+ if (msacc->unmanaged) erts_mtx_unlock(&msacc->mtx);
+
+ erts_factory_close(&factory);
+ } else {
+ ErlOffHeap *ohp = NULL;
+ msgp = erts_alloc_message_heap(rp, &rp_locks, ERTS_REF_THING_SIZE, &hp, &ohp);
+ msg = STORE_NC(&hp, &msgp->hfrag.off_heap, msaccrp->ref);
+ }
+
+ erts_queue_message(rp, rp_locks, msgp, msg, am_system);
+
+ 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->counters[i].pc = 0;
+#ifdef ERTS_MSACC_STATE_COUNTERS
+ msacc->counters[i].sc = 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_sched_data(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]->counters[unmanaged[i]->state].pc +=
+ 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->counters[msacc->state].pc += 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..d64ef8c8b9
--- /dev/null
+++ b/erts/emulator/beam/erl_msacc.h
@@ -0,0 +1,434 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2014-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%
+ */
+
+#ifndef ERL_MSACC_H__
+#define ERL_MSACC_H__
+
+/* Can be enabled/disabled via configure */
+#if defined(ERTS_ENABLE_MSACC) && 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 */
+
+/* Uncomment this to keep individual stats for all
+ of the bifs when extended states is enabled */
+/* #define ERTS_MSACC_EXTENDED_BIFS 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 defined(ERTS_MSACC_STATE_STRINGS) && defined(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_STATIC_STATE_COUNT 15
+
+#ifdef ERTS_MSACC_EXTENDED_BIFS
+#define ERTS_MSACC_STATE_COUNT (ERTS_MSACC_STATIC_STATE_COUNT + BIF_SIZE)
+#else
+#define ERTS_MSACC_STATE_COUNT ERTS_MSACC_STATIC_STATE_COUNT
+#endif
+
+#ifdef 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"
+#ifdef ERTS_MSACC_EXTENDED_BIFS
+#define BIF_LIST(Mod,Func,Arity,BifFuncAddr,FuncAddr,Num) \
+ ,"bif_" #Mod "_" #Func "_" #Arity
+#include "erl_bif_list.h"
+#undef BIF_LIST
+#endif
+};
+#endif
+
+#endif
+
+typedef struct erl_msacc_t_ ErtsMsAcc;
+typedef struct erl_msacc_p_cnt_t_ {
+ ErtsSysPerfCounter pc;
+#ifdef ERTS_MSACC_STATE_COUNTERS
+ Uint64 sc;
+#endif
+} ErtsMsAccPerfCntr;
+
+struct erl_msacc_t_ {
+
+ /* 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;
+
+ /* the the values below are protected by mtx iff unmanaged = 1 */
+ ErtsSysPerfCounter perf_counter;
+ Uint state;
+ ErtsMsAccPerfCntr counters[];
+
+};
+
+#ifdef ERTS_ENABLE_MSACC
+
+#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_GLB_INLINE
+void erts_msacc_set_state_um__(ErtsMsAcc *msacc,Uint state,int increment);
+ERTS_GLB_INLINE
+void erts_msacc_set_state_m__(ErtsMsAcc *msacc,Uint state,int increment);
+
+ERTS_GLB_INLINE
+Uint erts_msacc_get_state_um__(ErtsMsAcc *msacc);
+ERTS_GLB_INLINE
+Uint erts_msacc_get_state_m__(ErtsMsAcc *msacc);
+
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_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_GLB_INLINE
+Uint erts_msacc_get_state_m__(ErtsMsAcc *msacc) {
+ return msacc->state;
+}
+
+ERTS_GLB_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_GLB_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->counters[msacc->state].pc += diff;
+#ifdef ERTS_MSACC_STATE_COUNTERS
+ msacc->counters[new_state].sc += 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)
+#define ERTS_MSACC_SET_BIF_STATE_CACHED_X(Mod,Addr)
+
+#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)
+#define ERTS_MSACC_PUSH_AND_SET_STATE_CACHED_M_X(state)
+#define ERTS_MSACC_SET_BIF_STATE_CACHED_X(Mod,Addr)
+
+#else
+
+void erts_msacc_set_bif_state(ErtsMsAcc *msacc, Eterm mod, void *addr);
+
+#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)
+#define ERTS_MSACC_SET_BIF_STATE_CACHED_X(Mod,Addr) \
+ if (ERTS_MSACC_IS_ENABLED_CACHED_X()) \
+ erts_msacc_set_bif_state(__erts_msacc_cache, Mod, Addr)
+
+#endif /* !ERTS_MSACC_EXTENDED_STATES */
+
+#endif /* ERL_MSACC_H__ */
diff --git a/erts/emulator/beam/erl_mtrace.c b/erts/emulator/beam/erl_mtrace.c
index c8bb126687..f2a660f085 100644
--- a/erts/emulator/beam/erl_mtrace.c
+++ b/erts/emulator/beam/erl_mtrace.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2003-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2003-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -571,7 +572,7 @@ void erts_mtrace_pre_init(void)
void erts_mtrace_init(char *receiver, char *nodename)
{
- char hostname[MAXHOSTNAMELEN];
+ char hostname[MAXHOSTNAMELEN + 1];
char pid[21]; /* enough for a 64 bit number */
socket_desc = ERTS_SOCK_INVALID_SOCKET;
@@ -582,8 +583,10 @@ void erts_mtrace_init(char *receiver, char *nodename)
byte ip_addr[4];
Uint16 port;
- erts_mtx_init(&mtrace_buf_mutex, "mtrace_buf");
- erts_mtx_init(&mtrace_op_mutex, "mtrace_op");
+ erts_mtx_init(&mtrace_buf_mutex, "mtrace_buf", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
+ erts_mtx_init(&mtrace_op_mutex, "mtrace_op", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
socket_desc = erts_sock_open();
if (socket_desc == ERTS_SOCK_INVALID_SOCKET) {
@@ -612,9 +615,10 @@ void erts_mtrace_init(char *receiver, char *nodename)
}
tracep = trace_buffer;
endp = trace_buffer + TRACE_BUF_SZ;
- if (erts_sock_gethostname(hostname, MAXHOSTNAMELEN) != 0)
+ /* gethostname requires that the len is max(hostname) + 1 */
+ if (erts_sock_gethostname(hostname, MAXHOSTNAMELEN + 1) != 0)
hostname[0] = '\0';
- hostname[MAXHOSTNAMELEN-1] = '\0';
+ hostname[MAXHOSTNAMELEN] = '\0';
sys_get_pid(pid, sizeof(pid));
write_trace_header(nodename ? nodename : "", pid, hostname);
erts_mtrace_update_heap_size();
@@ -627,7 +631,7 @@ erts_mtrace_install_wrapper_functions(void)
if (erts_mtrace_enabled) {
int i;
/* Install trace functions */
- ASSERT(sizeof(erts_allctrs) == sizeof(real_allctrs));
+ ERTS_CT_ASSERT(sizeof(erts_allctrs) == sizeof(real_allctrs));
sys_memcpy((void *) real_allctrs,
(void *) erts_allctrs,
diff --git a/erts/emulator/beam/erl_mtrace.h b/erts/emulator/beam/erl_mtrace.h
index 204543ddb0..776c70a819 100644
--- a/erts/emulator/beam/erl_mtrace.h
+++ b/erts/emulator/beam/erl_mtrace.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2003-2009. All Rights Reserved.
+ * Copyright Ericsson AB 2003-2016. 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.
+ * 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%
*/
diff --git a/erts/emulator/beam/erl_nfunc_sched.c b/erts/emulator/beam/erl_nfunc_sched.c
new file mode 100644
index 0000000000..1bebc1eda4
--- /dev/null
+++ b/erts/emulator/beam/erl_nfunc_sched.c
@@ -0,0 +1,180 @@
+/*
+ * %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%
+ */
+
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#define ERTS_WANT_NFUNC_SCHED_INTERNALS__
+
+#include "global.h"
+#include "erl_process.h"
+#include "bif.h"
+#include "erl_nfunc_sched.h"
+#include "erl_trace.h"
+
+NifExport *
+erts_new_proc_nif_export(Process *c_p, int argc)
+{
+ size_t size;
+ int i;
+ NifExport *nep, *old_nep;
+
+ size = sizeof(NifExport) + (argc-1)*sizeof(Eterm);
+ nep = erts_alloc(ERTS_ALC_T_NIF_TRAP_EXPORT, size);
+
+ for (i = 0; i < ERTS_NUM_CODE_IX; i++)
+ nep->exp.addressv[i] = &nep->exp.beam[0];
+
+ nep->argc = -1; /* unused marker */
+ nep->argv_size = argc;
+ nep->trace = NULL;
+ old_nep = ERTS_PROC_SET_NIF_TRAP_EXPORT(c_p, nep);
+ if (old_nep) {
+ ASSERT(!nep->trace);
+ erts_free(ERTS_ALC_T_NIF_TRAP_EXPORT, old_nep);
+ }
+ return nep;
+}
+
+void
+erts_destroy_nif_export(Process *p)
+{
+ NifExport *nep = ERTS_PROC_SET_NIF_TRAP_EXPORT(p, NULL);
+ if (nep) {
+ if (nep->m)
+ erts_nif_export_cleanup_nif_mod(nep);
+ erts_free(ERTS_ALC_T_NIF_TRAP_EXPORT, nep);
+ }
+}
+
+void
+erts_nif_export_save_trace(Process *c_p, NifExport *nep, int applying,
+ Export* ep, BeamInstr *cp, Uint32 flags,
+ Uint32 flags_meta, BeamInstr* I,
+ ErtsTracer meta_tracer)
+{
+ NifExportTrace *netp;
+ ASSERT(nep && nep->argc >= 0);
+ ASSERT(!nep->trace);
+ netp = erts_alloc(ERTS_ALC_T_NIF_EXP_TRACE,
+ sizeof(NifExportTrace));
+ netp->applying = applying;
+ netp->ep = ep;
+ netp->cp = cp;
+ netp->flags = flags;
+ netp->flags_meta = flags_meta;
+ netp->I = I;
+ netp->meta_tracer = NIL;
+ erts_tracer_update(&netp->meta_tracer, meta_tracer);
+ nep->trace = netp;
+}
+
+void
+erts_nif_export_restore_trace(Process *c_p, Eterm result, NifExport *nep)
+{
+ NifExportTrace *netp = nep->trace;
+ nep->trace = NULL;
+ erts_bif_trace_epilogue(c_p, result, netp->applying, netp->ep,
+ netp->cp, netp->flags, netp->flags_meta,
+ netp->I, netp->meta_tracer);
+ erts_tracer_update(&netp->meta_tracer, NIL);
+ erts_free(ERTS_ALC_T_NIF_EXP_TRACE, netp);
+}
+
+NifExport *
+erts_nif_export_schedule(Process *c_p, Process *dirty_shadow_proc,
+ ErtsCodeMFA *mfa, BeamInstr *pc,
+ BeamInstr instr,
+ void *dfunc, void *ifunc,
+ Eterm mod, Eterm func,
+ int argc, const Eterm *argv)
+{
+ Process *used_proc;
+ ErtsSchedulerData *esdp;
+ Eterm* reg;
+ NifExport* nep;
+ int i;
+
+ ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p)
+ & ERTS_PROC_LOCK_MAIN);
+
+ if (dirty_shadow_proc) {
+ esdp = erts_get_scheduler_data();
+ ASSERT(esdp && ERTS_SCHEDULER_IS_DIRTY(esdp));
+
+ used_proc = dirty_shadow_proc;
+ }
+ else {
+ esdp = erts_proc_sched_data(c_p);
+ ASSERT(esdp && !ERTS_SCHEDULER_IS_DIRTY(esdp));
+
+ used_proc = c_p;
+ ERTS_VBUMP_ALL_REDS(c_p);
+ }
+
+ reg = esdp->x_reg_array;
+
+ if (mfa)
+ nep = erts_get_proc_nif_export(c_p, (int) mfa->arity);
+ else {
+ /* If no mfa, this is not the first schedule... */
+ nep = ERTS_PROC_GET_NIF_TRAP_EXPORT(c_p);
+ ASSERT(nep && nep->argc >= 0);
+ }
+
+ if (nep->argc < 0) {
+ /*
+ * First schedule; save things that might
+ * need to be restored...
+ */
+ for (i = 0; i < (int) mfa->arity; i++)
+ nep->argv[i] = reg[i];
+ nep->pc = pc;
+ nep->cp = c_p->cp;
+ nep->mfa = mfa;
+ nep->current = c_p->current;
+ ASSERT(argc >= 0);
+ nep->argc = (int) mfa->arity;
+ nep->m = NULL;
+
+ ASSERT(!erts_check_nif_export_in_area(c_p,
+ (char *) nep,
+ (sizeof(NifExport)
+ + (sizeof(Eterm)
+ *(nep->argc-1)))));
+ }
+ /* Copy new arguments into register array if necessary... */
+ if (reg != argv) {
+ for (i = 0; i < argc; i++)
+ reg[i] = argv[i];
+ }
+ ASSERT(is_atom(mod) && is_atom(func));
+ nep->exp.info.mfa.module = mod;
+ nep->exp.info.mfa.function = func;
+ nep->exp.info.mfa.arity = (Uint) argc;
+ nep->exp.beam[0] = (BeamInstr) instr; /* call_nif || apply_bif */
+ nep->exp.beam[1] = (BeamInstr) dfunc;
+ nep->func = ifunc;
+ used_proc->arity = argc;
+ used_proc->freason = TRAP;
+ used_proc->i = (BeamInstr*) nep->exp.addressv[0];
+ return nep;
+}
diff --git a/erts/emulator/beam/erl_nfunc_sched.h b/erts/emulator/beam/erl_nfunc_sched.h
new file mode 100644
index 0000000000..55a3a6dbf6
--- /dev/null
+++ b/erts/emulator/beam/erl_nfunc_sched.h
@@ -0,0 +1,332 @@
+/*
+ * %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%
+ */
+
+#ifndef ERL_NFUNC_SCHED_H__
+#define ERL_NFUNC_SCHED_H__
+
+#include "erl_process.h"
+#include "bif.h"
+#include "error.h"
+
+typedef struct {
+ int applying;
+ Export* ep;
+ BeamInstr *cp;
+ Uint32 flags;
+ Uint32 flags_meta;
+ BeamInstr* I;
+ ErtsTracer meta_tracer;
+} NifExportTrace;
+
+/*
+ * NIF exports need a few more items than the Export struct provides,
+ * including the erl_module_nif* and a NIF function pointer, so the
+ * NifExport below adds those. The Export member must be first in the
+ * struct. A number of values are stored for error handling purposes
+ * only.
+ *
+ * 'argc' is >= 0 when NifExport is in use, and < 0 when not.
+ */
+
+typedef struct {
+ Export exp;
+ struct erl_module_nif* m; /* NIF module, or NULL if BIF */
+ void *func; /* Indirect NIF or BIF to execute (may be unused) */
+ ErtsCodeMFA *current;/* Current as set when originally called */
+ NifExportTrace *trace;
+ /* --- The following is only used on error --- */
+ BeamInstr *pc; /* Program counter */
+ BeamInstr *cp; /* Continuation pointer */
+ ErtsCodeMFA *mfa; /* MFA of original call */
+ int argc; /* Number of arguments in original call */
+ int argv_size; /* Allocated size of argv */
+ Eterm argv[1]; /* Saved arguments from the original call */
+} NifExport;
+
+NifExport *erts_new_proc_nif_export(Process *c_p, int argc);
+void erts_nif_export_save_trace(Process *c_p, NifExport *nep, int applying,
+ Export* ep, BeamInstr *cp, Uint32 flags,
+ Uint32 flags_meta, BeamInstr* I,
+ ErtsTracer meta_tracer);
+void erts_nif_export_restore_trace(Process *c_p, Eterm result, NifExport *nep);
+void erts_destroy_nif_export(Process *p);
+NifExport *erts_nif_export_schedule(Process *c_p, Process *dirty_shadow_proc,
+ ErtsCodeMFA *mfa, BeamInstr *pc,
+ BeamInstr instr,
+ void *dfunc, void *ifunc,
+ Eterm mod, Eterm func,
+ int argc, const Eterm *argv);
+void erts_nif_export_cleanup_nif_mod(NifExport *ep); /* erl_nif.c */
+ERTS_GLB_INLINE NifExport *erts_get_proc_nif_export(Process *c_p, int extra);
+ERTS_GLB_INLINE int erts_setup_nif_export_rootset(Process* proc, Eterm** objv,
+ Uint* nobj);
+ERTS_GLB_INLINE int erts_check_nif_export_in_area(Process *p,
+ char *start, Uint size);
+ERTS_GLB_INLINE void erts_nif_export_restore(Process *c_p, NifExport *ep,
+ Eterm result);
+ERTS_GLB_INLINE void erts_nif_export_restore_error(Process* c_p, BeamInstr **pc,
+ Eterm *reg, ErtsCodeMFA **nif_mfa);
+ERTS_GLB_INLINE int erts_nif_export_check_save_trace(Process *c_p, Eterm result,
+ int applying, Export* ep,
+ BeamInstr *cp, Uint32 flags,
+ Uint32 flags_meta, BeamInstr* I,
+ ErtsTracer meta_tracer);
+ERTS_GLB_INLINE Process *erts_proc_shadow2real(Process *c_p);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_INLINE NifExport *
+erts_get_proc_nif_export(Process *c_p, int argc)
+{
+ NifExport *nep = ERTS_PROC_GET_NIF_TRAP_EXPORT(c_p);
+ if (!nep || (nep->argc < 0 && nep->argv_size < argc))
+ return erts_new_proc_nif_export(c_p, argc);
+ return nep;
+}
+
+/*
+ * If a process has saved arguments, they need to be part of the GC
+ * rootset. The function below is called from setup_rootset() in
+ * erl_gc.c. Any exception term saved in the NifExport is also made
+ * part of the GC rootset here; it always resides in rootset[0].
+ */
+ERTS_GLB_INLINE int
+erts_setup_nif_export_rootset(Process* proc, Eterm** objv, Uint* nobj)
+{
+ NifExport* ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc);
+
+ if (!ep || ep->argc <= 0)
+ return 0;
+
+ *objv = ep->argv;
+ *nobj = ep->argc;
+ return 1;
+}
+
+/*
+ * Check if nif export points into code area...
+ */
+ERTS_GLB_INLINE int
+erts_check_nif_export_in_area(Process *p, char *start, Uint size)
+{
+ NifExport *nep = ERTS_PROC_GET_NIF_TRAP_EXPORT(p);
+ if (!nep || nep->argc < 0)
+ return 0;
+ if (ErtsInArea(nep->pc, start, size))
+ return 1;
+ if (ErtsInArea(nep->cp, start, size))
+ return 1;
+ if (ErtsInArea(nep->mfa, start, size))
+ return 1;
+ if (ErtsInArea(nep->current, start, size))
+ return 1;
+ return 0;
+}
+
+ERTS_GLB_INLINE void
+erts_nif_export_restore(Process *c_p, NifExport *ep, Eterm result)
+{
+ ASSERT(!ERTS_SCHEDULER_IS_DIRTY(erts_get_scheduler_data()));
+ ERTS_SMP_LC_ASSERT(!(c_p->static_flags
+ & ERTS_STC_FLG_SHADOW_PROC));
+ ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p)
+ & ERTS_PROC_LOCK_MAIN);
+
+ c_p->current = ep->current;
+ ep->argc = -1; /* Unused nif-export marker... */
+ if (ep->trace)
+ erts_nif_export_restore_trace(c_p, result, ep);
+}
+
+ERTS_GLB_INLINE void
+erts_nif_export_restore_error(Process* c_p, BeamInstr **pc,
+ Eterm *reg, ErtsCodeMFA **nif_mfa)
+{
+ NifExport *nep = (NifExport *) ERTS_PROC_GET_NIF_TRAP_EXPORT(c_p);
+ int ix;
+
+ ASSERT(nep);
+ *pc = nep->pc;
+ c_p->cp = nep->cp;
+ *nif_mfa = nep->mfa;
+ for (ix = 0; ix < nep->argc; ix++)
+ reg[ix] = nep->argv[ix];
+ erts_nif_export_restore(c_p, nep, THE_NON_VALUE);
+}
+
+ERTS_GLB_INLINE int
+erts_nif_export_check_save_trace(Process *c_p, Eterm result,
+ int applying, Export* ep,
+ BeamInstr *cp, Uint32 flags,
+ Uint32 flags_meta, BeamInstr* I,
+ ErtsTracer meta_tracer)
+{
+ if (is_non_value(result) && c_p->freason == TRAP) {
+ NifExport *nep = ERTS_PROC_GET_NIF_TRAP_EXPORT(c_p);
+ if (nep && nep->argc >= 0) {
+ erts_nif_export_save_trace(c_p, nep, applying, ep,
+ cp, flags, flags_meta,
+ I, meta_tracer);
+ return 1;
+ }
+ }
+ return 0;
+}
+
+ERTS_GLB_INLINE Process *
+erts_proc_shadow2real(Process *c_p)
+{
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (c_p->static_flags & ERTS_STC_FLG_SHADOW_PROC) {
+ Process *real_c_p = c_p->next;
+ ASSERT(ERTS_SCHEDULER_IS_DIRTY(erts_get_scheduler_data()));
+ ASSERT(real_c_p->common.id == c_p->common.id);
+ return real_c_p;
+ }
+ ASSERT(!ERTS_SCHEDULER_IS_DIRTY(erts_get_scheduler_data()));
+#endif
+ return c_p;
+}
+
+#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
+
+#endif /* ERL_NFUNC_SCHED_H__ */
+
+#if defined(ERTS_WANT_NFUNC_SCHED_INTERNALS__) && !defined(ERTS_NFUNC_SCHED_INTERNALS__)
+#define ERTS_NFUNC_SCHED_INTERNALS__
+
+#define ERTS_I_BEAM_OP_TO_NIF_EXPORT(I) \
+ (ASSERT(BeamOp(op_apply_bif) == (BeamInstr *) (*(I)) \
+ || BeamOp(op_call_nif) == (BeamInstr *) (*(I))), \
+ ((NifExport *) (((char *) (I)) - offsetof(NifExport, exp.beam[0]))))
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+
+#include "erl_message.h"
+#include <stddef.h>
+
+ERTS_GLB_INLINE void erts_flush_dirty_shadow_proc(Process *sproc);
+ERTS_GLB_INLINE void erts_cache_dirty_shadow_proc(Process *sproc);
+ERTS_GLB_INLINE Process *erts_make_dirty_shadow_proc(ErtsSchedulerData *esdp,
+ Process *c_p);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_INLINE void
+erts_flush_dirty_shadow_proc(Process *sproc)
+{
+ Process *c_p = sproc->next;
+
+ ASSERT(sproc->common.id == c_p->common.id);
+ ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p)
+ & ERTS_PROC_LOCK_MAIN);
+
+ ASSERT(c_p->stop == sproc->stop);
+ ASSERT(c_p->hend == sproc->hend);
+ ASSERT(c_p->heap == sproc->heap);
+ ASSERT(c_p->abandoned_heap == sproc->abandoned_heap);
+ ASSERT(c_p->heap_sz == sproc->heap_sz);
+ ASSERT(c_p->high_water == sproc->high_water);
+ ASSERT(c_p->old_heap == sproc->old_heap);
+ ASSERT(c_p->old_htop == sproc->old_htop);
+ ASSERT(c_p->old_hend == sproc->old_hend);
+
+ ASSERT(c_p->htop <= sproc->htop && sproc->htop <= c_p->stop);
+
+ c_p->htop = sproc->htop;
+
+ if (!c_p->mbuf)
+ c_p->mbuf = sproc->mbuf;
+ else if (sproc->mbuf) {
+ ErlHeapFragment *bp;
+ for (bp = sproc->mbuf; bp->next; bp = bp->next)
+ ASSERT(!bp->off_heap.first);
+ bp->next = c_p->mbuf;
+ c_p->mbuf = sproc->mbuf;
+ }
+
+ c_p->mbuf_sz += sproc->mbuf_sz;
+
+ if (!c_p->off_heap.first)
+ c_p->off_heap.first = sproc->off_heap.first;
+ else if (sproc->off_heap.first) {
+ struct erl_off_heap_header *ohhp;
+ for (ohhp = sproc->off_heap.first; ohhp->next; ohhp = ohhp->next)
+ ;
+ ohhp->next = c_p->off_heap.first;
+ c_p->off_heap.first = sproc->off_heap.first;
+ }
+
+ c_p->off_heap.overhead += sproc->off_heap.overhead;
+}
+
+ERTS_GLB_INLINE void
+erts_cache_dirty_shadow_proc(Process *sproc)
+{
+ Process *c_p = sproc->next;
+ ASSERT(c_p);
+ ASSERT(sproc->common.id == c_p->common.id);
+ ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p)
+ & ERTS_PROC_LOCK_MAIN);
+
+ sproc->htop = c_p->htop;
+ sproc->stop = c_p->stop;
+ sproc->hend = c_p->hend;
+ sproc->heap = c_p->heap;
+ sproc->abandoned_heap = c_p->abandoned_heap;
+ sproc->heap_sz = c_p->heap_sz;
+ sproc->high_water = c_p->high_water;
+ sproc->old_hend = c_p->old_hend;
+ sproc->old_htop = c_p->old_htop;
+ sproc->old_heap = c_p->old_heap;
+ sproc->mbuf = NULL;
+ sproc->mbuf_sz = 0;
+ ERTS_INIT_OFF_HEAP(&sproc->off_heap);
+}
+
+ERTS_GLB_INLINE Process *
+erts_make_dirty_shadow_proc(ErtsSchedulerData *esdp, Process *c_p)
+{
+ Process *sproc;
+
+ ASSERT(ERTS_SCHEDULER_IS_DIRTY(esdp));
+
+ sproc = esdp->dirty_shadow_process;
+ ASSERT(sproc);
+ ASSERT(sproc->static_flags & ERTS_STC_FLG_SHADOW_PROC);
+ ASSERT(erts_smp_atomic32_read_nob(&sproc->state)
+ == (ERTS_PSFLG_ACTIVE
+ | ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_PROXY));
+
+ sproc->next = c_p;
+ sproc->common.id = c_p->common.id;
+
+ erts_cache_dirty_shadow_proc(sproc);
+
+ return sproc;
+}
+
+#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
+
+#endif /* ERTS_DIRTY_SCHEDULERS */
+
+#endif /* defined(ERTS_WANT_NFUNC_SCHED_INTERNALS__) && !defined(ERTS_NFUNC_SCHED_INTERNALS__) */
+
diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c
index ff551ea3af..ac4ecd77e5 100644
--- a/erts/emulator/beam/erl_nif.c
+++ b/erts/emulator/beam/erl_nif.c
@@ -1,24 +1,42 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2009-2014. All Rights Reserved.
+ * Copyright Ericsson AB 2009-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
/* Erlang Native InterFace
*/
+/*
+ * Environment contains a pointer to currently executing process.
+ * In the dirty case this pointer do however not point to the
+ * actual process structure of the executing process, but instead
+ * a "shadow process structure". This in order to be able to handle
+ * heap allocation without the need to acquire the main lock on
+ * the process.
+ *
+ * The dirty process is allowed to allocate on the heap without
+ * the main lock, i.e., incrementing htop, but is not allowed to
+ * modify mbuf, offheap, etc without the main lock. The dirty
+ * process moves mbuf list and offheap list of the shadow process
+ * structure into the real structure when the dirty nif call
+ * completes.
+ */
+
+
#ifdef HAVE_CONFIG_H
# include "config.h"
#endif
@@ -36,6 +54,12 @@
#include "erl_thr_progress.h"
#include "dtrace-wrapper.h"
#include "erl_process.h"
+#include "erl_bif_unique.h"
+#include "erl_utils.h"
+#include "erl_io_queue.h"
+#undef ERTS_WANT_NFUNC_SCHED_INTERNALS__
+#define ERTS_WANT_NFUNC_SCHED_INTERNALS__
+#include "erl_nfunc_sched.h"
#if defined(USE_DYNAMIC_TRACE) && (defined(USE_DTRACE) || defined(USE_SYSTEMTAP))
#define HAVE_USE_DTRACE 1
#endif
@@ -43,7 +67,6 @@
#include <limits.h>
#include <stddef.h> /* offsetof */
-
/* Information about a loaded nif library.
* Each successful call to erlang:load_nif will allocate an instance of
* erl_module_nif. Two calls opening the same library will thus have the same
@@ -52,14 +75,19 @@
struct erl_module_nif {
void* priv_data;
void* handle; /* "dlopen" */
- struct enif_entry_t* entry;
+ struct enif_entry_t entry;
erts_refc_t rt_cnt; /* number of resource types */
erts_refc_t rt_dtor_cnt; /* number of resource types with destructors */
Module* mod; /* Can be NULL if orphan with dtor-resources left */
+
+ ErlNifFunc _funcs_copy_[1]; /* only used for old libs */
};
+typedef ERL_NIF_TERM (*NativeFunPtr)(ErlNifEnv*, int, const ERL_NIF_TERM[]);
+
#ifdef DEBUG
# define READONLY_CHECK
+# define ERTS_DBG_NIF_NOT_SCHED_MARKER ((void *) (UWord) 1)
#endif
#ifdef READONLY_CHECK
# define ADD_READONLY_CHECK(ENV,PTR,SIZE) add_readonly_check(ENV,PTR,SIZE)
@@ -68,6 +96,14 @@ static void add_readonly_check(ErlNifEnv*, unsigned char* ptr, unsigned sz);
# define ADD_READONLY_CHECK(ENV,PTR,SIZE) ((void)0)
#endif
+#ifdef ERTS_NIF_ASSERT_IN_ENV
+# define ASSERT_IN_ENV(ENV, TERM, NR, TYPE) dbg_assert_in_env(ENV, TERM, NR, TYPE, __func__)
+static void dbg_assert_in_env(ErlNifEnv*, Eterm term, int nr, const char* type, const char* func);
+# include "erl_gc.h"
+#else
+# define ASSERT_IN_ENV(ENV, TERM, NR, TYPE)
+#endif
+
#ifdef DEBUG
static int is_offheap(const ErlOffHeap* off_heap);
#endif
@@ -77,9 +113,48 @@ void dtrace_nifenv_str(ErlNifEnv *, char *);
#endif
#define MIN_HEAP_FRAG_SZ 200
-static Eterm* alloc_heap_heavy(ErlNifEnv* env, unsigned need, Eterm* hp);
+static Eterm* alloc_heap_heavy(ErlNifEnv* env, size_t need, Eterm* hp);
+
+static ERTS_INLINE int
+is_scheduler(void)
+{
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
+ if (!esdp)
+ return 0;
+ if (ERTS_SCHEDULER_IS_DIRTY(esdp))
+ return -1;
+ return 1;
+}
+
+static ERTS_INLINE void
+execution_state(ErlNifEnv *env, Process **c_pp, int *schedp)
+{
+ if (schedp)
+ *schedp = is_scheduler();
+ if (c_pp) {
+ if (!env || env->proc->common.id == ERTS_INVALID_PID)
+ *c_pp = NULL;
+ else {
+ Process *c_p = env->proc;
+
+ if (!(c_p->static_flags & ERTS_STC_FLG_SHADOW_PROC)) {
+ ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p)
+ & ERTS_PROC_LOCK_MAIN);
+ }
+ else {
+ c_p = env->proc->next;
+ ASSERT(is_scheduler() < 0);
+ ASSERT(c_p && env->proc->common.id == c_p->common.id);
+ }
+
+ *c_pp = c_p;
+
+ ASSERT(!(c_p->static_flags & ERTS_STC_FLG_SHADOW_PROC));
+ }
+ }
+}
-static ERTS_INLINE Eterm* alloc_heap(ErlNifEnv* env, unsigned need)
+static ERTS_INLINE Eterm* alloc_heap(ErlNifEnv* env, size_t need)
{
Eterm* hp = env->hp;
env->hp += need;
@@ -89,15 +164,18 @@ static ERTS_INLINE Eterm* alloc_heap(ErlNifEnv* env, unsigned need)
return alloc_heap_heavy(env, need, hp);
}
-static Eterm* alloc_heap_heavy(ErlNifEnv* env, unsigned need, Eterm* hp)
-{
+static Eterm* alloc_heap_heavy(ErlNifEnv* env, size_t need, Eterm* hp)
+{
env->hp = hp;
- if (env->heap_frag == NULL) {
+ if (env->heap_frag == NULL) {
ASSERT(HEAP_LIMIT(env->proc) == env->hp_end);
- HEAP_TOP(env->proc) = env->hp;
+ ASSERT(env->hp + need > env->hp_end);
+ HEAP_TOP(env->proc) = env->hp;
}
else {
- env->heap_frag->used_size = hp - env->heap_frag->mem;
+ Uint usz = env->hp - env->heap_frag->mem;
+ env->proc->mbuf_sz += usz - env->heap_frag->used_size;
+ env->heap_frag->used_size = usz;
ASSERT(env->heap_frag->used_size <= env->heap_frag->alloc_size);
}
hp = erts_heap_alloc(env->proc, need, MIN_HEAP_FRAG_SZ);
@@ -109,7 +187,7 @@ static Eterm* alloc_heap_heavy(ErlNifEnv* env, unsigned need, Eterm* hp)
}
#if SIZEOF_LONG != ERTS_SIZEOF_ETERM
-static ERTS_INLINE void ensure_heap(ErlNifEnv* env, unsigned may_need)
+static ERTS_INLINE void ensure_heap(ErlNifEnv* env, size_t may_need)
{
if (env->hp + may_need > env->hp_end) {
alloc_heap_heavy(env, may_need, env->hp);
@@ -118,7 +196,8 @@ static ERTS_INLINE void ensure_heap(ErlNifEnv* env, unsigned may_need)
}
#endif
-void erts_pre_nif(ErlNifEnv* env, Process* p, struct erl_module_nif* mod_nif)
+void erts_pre_nif(ErlNifEnv* env, Process* p, struct erl_module_nif* mod_nif,
+ Process* tracee)
{
env->mod_nif = mod_nif;
env->proc = p;
@@ -127,19 +206,37 @@ void erts_pre_nif(ErlNifEnv* env, Process* p, struct erl_module_nif* mod_nif)
env->heap_frag = NULL;
env->fpe_was_unmasked = erts_block_fpe();
env->tmp_obj_list = NULL;
-}
+ env->exception_thrown = 0;
+ env->tracee = tracee;
-static void pre_nif_noproc(ErlNifEnv* env, struct erl_module_nif* mod_nif)
-{
- env->mod_nif = mod_nif;
- env->proc = NULL;
- env->hp = NULL;
- env->hp_end = NULL;
- env->heap_frag = NULL;
- env->fpe_was_unmasked = erts_block_fpe();
- env->tmp_obj_list = NULL;
+ ASSERT(p->common.id != ERTS_INVALID_PID);
+
+#ifdef ERTS_NIF_ASSERT_IN_ENV
+ env->dbg_disable_assert_in_env = 0;
+#endif
+#if defined(DEBUG) && defined(ERTS_DIRTY_SCHEDULERS)
+ {
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
+ ASSERT(esdp);
+
+ if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
+ erts_aint32_t state = erts_smp_atomic32_read_nob(&p->state);
+
+ ASSERT(p->scheduler_data == esdp);
+ ASSERT((state & (ERTS_PSFLG_RUNNING
+ | ERTS_PSFLG_RUNNING_SYS))
+ && !(state & (ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS)));
+ }
+ }
+#endif
}
+static void full_cache_env(ErlNifEnv *env);
+static void cache_env(ErlNifEnv* env);
+static void full_flush_env(ErlNifEnv *env);
+static void flush_env(ErlNifEnv* env);
+
/* Temporary object header, auto-deallocated when NIF returns
* or when independent environment is cleared.
*/
@@ -162,27 +259,161 @@ static ERTS_INLINE void free_tmp_objs(ErlNifEnv* env)
void erts_post_nif(ErlNifEnv* env)
{
erts_unblock_fpe(env->fpe_was_unmasked);
- if (env->heap_frag == NULL) {
- ASSERT(env->hp_end == HEAP_LIMIT(env->proc));
- ASSERT(env->hp >= HEAP_TOP(env->proc));
- ASSERT(env->hp <= HEAP_LIMIT(env->proc));
- HEAP_TOP(env->proc) = env->hp;
+ full_flush_env(env);
+ free_tmp_objs(env);
+ env->exiting = ERTS_PROC_IS_EXITING(env->proc);
+}
+
+
+/*
+ * Initialize a NifExport struct. Create it if needed and store it in the
+ * proc. The direct_fp function is what will be invoked by op_call_nif, and
+ * the indirect_fp function, if not NULL, is what the direct_fp function
+ * will call. If the allocated NifExport isn't enough to hold all of argv,
+ * allocate a larger one. Save 'current' and registers if first time this
+ * call is scheduled.
+ */
+
+static ERTS_INLINE ERL_NIF_TERM
+schedule(ErlNifEnv* env, NativeFunPtr direct_fp, NativeFunPtr indirect_fp,
+ Eterm mod, Eterm func_name, int argc, const ERL_NIF_TERM argv[])
+{
+ NifExport *ep;
+ Process *c_p, *dirty_shadow_proc;
+
+ execution_state(env, &c_p, NULL);
+ if (c_p == env->proc)
+ dirty_shadow_proc = NULL;
+ else
+ dirty_shadow_proc = env->proc;
+
+ ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(c_p));
+
+ ep = erts_nif_export_schedule(c_p, dirty_shadow_proc,
+ c_p->current,
+ c_p->cp,
+ (BeamInstr) em_call_nif,
+ direct_fp, indirect_fp,
+ mod, func_name,
+ argc, (const Eterm *) argv);
+ if (!ep->m) {
+ /* First time this call is scheduled... */
+ erts_refc_inc(&env->mod_nif->rt_dtor_cnt, 1);
+ ep->m = env->mod_nif;
}
- else {
- ASSERT(env->hp_end != HEAP_LIMIT(env->proc));
- ASSERT(env->hp_end - env->hp <= env->heap_frag->alloc_size);
- env->heap_frag->used_size = env->hp - env->heap_frag->mem;
- ASSERT(env->heap_frag->used_size <= env->heap_frag->alloc_size);
+ return (ERL_NIF_TERM) THE_NON_VALUE;
+}
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+
+static ERL_NIF_TERM dirty_nif_finalizer(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM dirty_nif_exception(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+
+int
+erts_call_dirty_nif(ErtsSchedulerData *esdp, Process *c_p, BeamInstr *I, Eterm *reg)
+{
+ int exiting;
+ ERL_NIF_TERM *argv = (ERL_NIF_TERM *) reg;
+ NifExport *nep = ERTS_I_BEAM_OP_TO_NIF_EXPORT(I);
+ ErtsCodeMFA *codemfa = erts_code_to_codemfa(I);
+ NativeFunPtr dirty_nif = (NativeFunPtr) I[1];
+ ErlNifEnv env;
+ ERL_NIF_TERM result;
+#ifdef DEBUG
+ erts_aint32_t state = erts_smp_atomic32_read_nob(&c_p->state);
+
+ ASSERT(nep == ERTS_PROC_GET_NIF_TRAP_EXPORT(c_p));
+
+ ASSERT(!c_p->scheduler_data);
+ ASSERT((state & ERTS_PSFLG_DIRTY_RUNNING)
+ && !(state & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS)));
+ ASSERT(esdp);
+
+ nep->func = ERTS_DBG_NIF_NOT_SCHED_MARKER;
+#endif
+
+ erts_pre_nif(&env, c_p, nep->m, NULL);
+
+ env.proc = erts_make_dirty_shadow_proc(esdp, c_p);
+
+ env.proc->freason = EXC_NULL;
+ env.proc->fvalue = NIL;
+ env.proc->ftrace = NIL;
+ env.proc->i = c_p->i;
+
+ ASSERT(ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(c_p)));
+
+ erts_smp_atomic32_read_band_mb(&c_p->state, ~(ERTS_PSFLG_DIRTY_CPU_PROC
+ | ERTS_PSFLG_DIRTY_IO_PROC));
+
+ erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
+
+ result = (*dirty_nif)(&env, codemfa->arity, argv); /* Call dirty NIF */
+
+ erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
+
+ ASSERT(env.proc->static_flags & ERTS_STC_FLG_SHADOW_PROC);
+ ASSERT(env.proc->next == c_p);
+
+ exiting = ERTS_PROC_IS_EXITING(c_p);
+
+ if (!exiting) {
+ if (env.exception_thrown) {
+ schedule_exception:
+ schedule(&env, dirty_nif_exception, NULL,
+ am_erts_internal, am_dirty_nif_exception,
+ 1, &env.proc->fvalue);
+ }
+ else if (is_value(result)) {
+ schedule(&env, dirty_nif_finalizer, NULL,
+ am_erts_internal, am_dirty_nif_finalizer,
+ 1, &result);
+ }
+ else if (env.proc->freason != TRAP) { /* user returned garbage... */
+ ERTS_DECL_AM(badreturn);
+ (void) enif_raise_exception(&env, AM_badreturn);
+ goto schedule_exception;
+ }
+ else {
+ /* Rescheduled by dirty NIF call... */
+ ASSERT(nep->func != ERTS_DBG_NIF_NOT_SCHED_MARKER);
+ }
+ c_p->i = env.proc->i;
+ c_p->arity = env.proc->arity;
}
- free_tmp_objs(env);
+
+#ifdef DEBUG
+ if (nep->func == ERTS_DBG_NIF_NOT_SCHED_MARKER)
+ nep->func = NULL;
+#endif
+
+ erts_unblock_fpe(env.fpe_was_unmasked);
+ full_flush_env(&env);
+ free_tmp_objs(&env);
+
+ return exiting;
}
-static void post_nif_noproc(ErlNifEnv* env)
+#endif
+
+static void full_flush_env(ErlNifEnv* env)
{
- erts_unblock_fpe(env->fpe_was_unmasked);
- free_tmp_objs(env);
+ flush_env(env);
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (env->proc->static_flags & ERTS_STC_FLG_SHADOW_PROC)
+ /* Dirty nif call using shadow process struct */
+ erts_flush_dirty_shadow_proc(env->proc);
+#endif
}
+static void full_cache_env(ErlNifEnv* env)
+{
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (env->proc->static_flags & ERTS_STC_FLG_SHADOW_PROC)
+ erts_cache_dirty_shadow_proc(env->proc);
+#endif
+ cache_env(env);
+}
/* Flush out our cached heap pointers to allow an ordinary HAlloc
*/
@@ -195,9 +426,12 @@ static void flush_env(ErlNifEnv* env)
HEAP_TOP(env->proc) = env->hp;
}
else {
+ Uint usz;
ASSERT(env->hp_end != HEAP_LIMIT(env->proc));
ASSERT(env->hp_end - env->hp <= env->heap_frag->alloc_size);
- env->heap_frag->used_size = env->hp - env->heap_frag->mem;
+ usz = env->hp - env->heap_frag->mem;
+ env->proc->mbuf_sz += usz - env->heap_frag->used_size;
+ env->heap_frag->used_size = usz;
ASSERT(env->heap_frag->used_size <= env->heap_frag->alloc_size);
}
}
@@ -206,6 +440,7 @@ static void flush_env(ErlNifEnv* env)
*/
static void cache_env(ErlNifEnv* env)
{
+ env->heap_frag = MBUF(env->proc);
if (env->heap_frag == NULL) {
ASSERT(env->hp_end == HEAP_LIMIT(env->proc));
ASSERT(env->hp <= HEAP_TOP(env->proc));
@@ -213,10 +448,6 @@ static void cache_env(ErlNifEnv* env)
env->hp = HEAP_TOP(env->proc);
}
else {
- ASSERT(env->hp_end != HEAP_LIMIT(env->proc));
- ASSERT(env->hp_end - env->hp <= env->heap_frag->alloc_size);
- env->heap_frag = MBUF(env->proc);
- ASSERT(env->heap_frag != NULL);
env->hp = env->heap_frag->mem + env->heap_frag->used_size;
env->hp_end = env->heap_frag->mem + env->heap_frag->alloc_size;
}
@@ -247,18 +478,20 @@ struct enif_msg_environment_t
Process phony_proc;
};
-ErlNifEnv* enif_alloc_env(void)
+static ERTS_INLINE void
+setup_nif_env(struct enif_msg_environment_t* msg_env,
+ struct erl_module_nif* mod,
+ Process* tracee)
{
- struct enif_msg_environment_t* msg_env =
- erts_alloc_fnf(ERTS_ALC_T_NIF, sizeof(struct enif_msg_environment_t));
Eterm* phony_heap = (Eterm*) msg_env; /* dummy non-NULL ptr */
-
- msg_env->env.hp = phony_heap;
+
+ msg_env->env.hp = phony_heap;
msg_env->env.hp_end = phony_heap;
msg_env->env.heap_frag = NULL;
- msg_env->env.mod_nif = NULL;
+ msg_env->env.mod_nif = mod;
msg_env->env.tmp_obj_list = NULL;
msg_env->env.proc = &msg_env->phony_proc;
+ msg_env->env.exception_thrown = 0;
memset(&msg_env->phony_proc, 0, sizeof(Process));
HEAP_START(&msg_env->phony_proc) = phony_heap;
HEAP_TOP(&msg_env->phony_proc) = phony_heap;
@@ -266,10 +499,22 @@ ErlNifEnv* enif_alloc_env(void)
HEAP_END(&msg_env->phony_proc) = phony_heap;
MBUF(&msg_env->phony_proc) = NULL;
msg_env->phony_proc.common.id = ERTS_INVALID_PID;
+ msg_env->env.tracee = tracee;
+
#ifdef FORCE_HEAP_FRAGS
msg_env->phony_proc.space_verified = 0;
msg_env->phony_proc.space_verified_from = NULL;
#endif
+#ifdef ERTS_NIF_ASSERT_IN_ENV
+ msg_env->env.dbg_disable_assert_in_env = 0;
+#endif
+}
+
+ErlNifEnv* enif_alloc_env(void)
+{
+ struct enif_msg_environment_t* msg_env =
+ erts_alloc_fnf(ERTS_ALC_T_NIF, sizeof(struct enif_msg_environment_t));
+ setup_nif_env(msg_env, NULL, NULL);
return &msg_env->env;
}
void enif_free_env(ErlNifEnv* env)
@@ -278,6 +523,20 @@ void enif_free_env(ErlNifEnv* env)
erts_free(ERTS_ALC_T_NIF, env);
}
+static ERTS_INLINE void pre_nif_noproc(struct enif_msg_environment_t* msg_env,
+ struct erl_module_nif* mod,
+ Process* tracee)
+{
+ setup_nif_env(msg_env, mod, tracee);
+ msg_env->env.fpe_was_unmasked = erts_block_fpe();
+}
+
+static ERTS_INLINE void post_nif_noproc(struct enif_msg_environment_t* msg_env)
+{
+ erts_unblock_fpe(msg_env->env.fpe_was_unmasked);
+ enif_clear_env(&msg_env->env);
+}
+
static ERTS_INLINE void clear_offheap(ErlOffHeap* oh)
{
oh->first = NULL;
@@ -304,79 +563,393 @@ void enif_clear_env(ErlNifEnv* env)
ASSERT(!is_offheap(&MSO(p)));
free_tmp_objs(env);
}
+
+#ifdef ERTS_SMP
+#ifdef DEBUG
+static int enif_send_delay = 0;
+#define ERTS_FORCE_ENIF_SEND_DELAY() (enif_send_delay++ % 2 == 0)
+#else
+#ifdef ERTS_PROC_LOCK_OWN_IMPL
+#define ERTS_FORCE_ENIF_SEND_DELAY() 0
+#else
+/*
+ * We always schedule messages if we do not use our own
+ * process lock implementation, as if we try to do a trylock on
+ * a lock that might already be locked by the same thread.
+ * And what happens then with different mutex implementations
+ * is not always guaranteed.
+ */
+#define ERTS_FORCE_ENIF_SEND_DELAY() 1
+#endif
+#endif
+
+int erts_flush_trace_messages(Process *c_p, ErtsProcLocks c_p_locks)
+{
+ ErlTraceMessageQueue *msgq, **last_msgq;
+ int reds = 0;
+
+ /* Only one thread at a time is allowed to flush trace messages,
+ so we require the main lock to be held when doing the flush */
+ ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(c_p);
+
+ erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_TRACE);
+
+ msgq = c_p->trace_msg_q;
+
+ if (!msgq)
+ goto error;
+
+ do {
+ Process* rp;
+ ErtsProcLocks rp_locks;
+ ErtsMessage *first, **last;
+ Uint len;
+
+ first = msgq->first;
+ last = msgq->last;
+ len = msgq->len;
+ msgq->first = NULL;
+ msgq->last = &msgq->first;
+ msgq->len = 0;
+ erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_TRACE);
+
+ ASSERT(len != 0);
+
+ rp = erts_proc_lookup(msgq->receiver);
+ if (rp) {
+ rp_locks = 0;
+ if (rp->common.id == c_p->common.id)
+ rp_locks = c_p_locks;
+ erts_queue_messages(rp, rp_locks, first, last, len, c_p->common.id);
+ if (rp->common.id == c_p->common.id)
+ rp_locks &= ~c_p_locks;
+ if (rp_locks)
+ erts_smp_proc_unlock(rp, rp_locks);
+ reds += len;
+ } else {
+ erts_cleanup_messages(first);
+ }
+ reds += 1;
+ erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_TRACE);
+ msgq = msgq->next;
+ } while (msgq);
+
+ last_msgq = &c_p->trace_msg_q;
+
+ while (*last_msgq) {
+ msgq = *last_msgq;
+ if (msgq->len == 0) {
+ *last_msgq = msgq->next;
+ erts_free(ERTS_ALC_T_TRACE_MSG_QUEUE, msgq);
+ } else {
+ last_msgq = &msgq->next;
+ }
+ }
+
+error:
+ erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_TRACE);
+
+ return reds;
+}
+
+#endif
+
int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid,
ErlNifEnv* msg_env, ERL_NIF_TERM msg)
{
struct enif_msg_environment_t* menv = (struct enif_msg_environment_t*)msg_env;
ErtsProcLocks rp_locks = 0;
+#ifdef ERTS_SMP
+ ErtsProcLocks lc_locks = 0;
+#endif
Process* rp;
Process* c_p;
- ErlHeapFragment* frags;
+ ErtsMessage *mp;
Eterm receiver = to_pid->pid;
- int flush_me = 0;
- int scheduler = erts_get_scheduler_id() != 0;
+ int scheduler;
- if (env != NULL) {
- c_p = env->proc;
- if (receiver == c_p->common.id) {
- rp_locks = ERTS_PROC_LOCK_MAIN;
- flush_me = 1;
- }
+ execution_state(env, &c_p, &scheduler);
+
+#ifndef ERTS_SMP
+ if (!scheduler) {
+ erts_exit(ERTS_ABORT_EXIT,
+ "enif_send: called from non-scheduler thread on non-SMP VM");
+ return 0;
+ }
+#endif
+
+ if (scheduler > 0) { /* Normal scheduler */
+ rp = erts_proc_lookup(receiver);
+ if (!rp)
+ return 0;
}
else {
-#ifdef ERTS_SMP
- c_p = NULL;
-#else
- erl_exit(ERTS_ABORT_EXIT,"enif_send: env==NULL on non-SMP VM");
-#endif
- }
-
- rp = (scheduler
- ? erts_proc_lookup(receiver)
- : erts_pid2proc_opt(c_p, ERTS_PROC_LOCK_MAIN,
- receiver, rp_locks, ERTS_P2P_FLG_SMP_INC_REFC));
- if (rp == NULL) {
- ASSERT(env == NULL || receiver != c_p->common.id);
- return 0;
+ if (c_p) {
+ ASSERT(scheduler < 0); /* Dirty scheduler */
+ if (ERTS_PROC_IS_EXITING(c_p))
+ return 0;
+
+ if (env->proc->static_flags & ERTS_STC_FLG_SHADOW_PROC) {
+ erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
+ }
+ }
+
+ rp = erts_pid2proc_opt(c_p, ERTS_PROC_LOCK_MAIN,
+ receiver, rp_locks,
+ ERTS_P2P_FLG_INC_REFC);
+ if (!rp) {
+ if (c_p && (env->proc->static_flags & ERTS_STC_FLG_SHADOW_PROC))
+ erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
+ return 0;
+ }
}
- flush_env(msg_env);
- frags = menv->env.heap_frag;
- 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. */
- ASSERT(!is_offheap(&frags->off_heap));
- frags->off_heap = MSO(&menv->phony_proc);
- clear_offheap(&MSO(&menv->phony_proc));
- menv->env.heap_frag = NULL;
- MBUF(&menv->phony_proc) = NULL;
+
+ if (c_p == rp)
+ rp_locks = ERTS_PROC_LOCK_MAIN;
+
+ if (menv) {
+ flush_env(msg_env);
+ mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = menv->env.heap_frag;
+ ASSERT(mp->data.heap_frag == MBUF(&menv->phony_proc));
+ if (mp->data.heap_frag != NULL) {
+ /* Move all offheap's from phony proc to the first fragment.
+ Quick and dirty... */
+ ASSERT(!is_offheap(&mp->data.heap_frag->off_heap));
+ mp->data.heap_frag->off_heap = MSO(&menv->phony_proc);
+ clear_offheap(&MSO(&menv->phony_proc));
+ menv->env.heap_frag = NULL;
+ MBUF(&menv->phony_proc) = NULL;
+ }
+ } else {
+ erts_literal_area_t litarea;
+ ErlOffHeap *ohp;
+ Eterm *hp;
+ Uint sz;
+ INITIALIZE_LITERAL_PURGE_AREA(litarea);
+ sz = size_object_litopt(msg, &litarea);
+ if (c_p && !env->tracee) {
+ full_flush_env(env);
+ mp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp);
+ full_cache_env(env);
+ }
+ else {
+ erts_aint_t state = erts_smp_atomic32_read_nob(&rp->state);
+ if (state & ERTS_PSFLG_OFF_HEAP_MSGQ) {
+ mp = erts_alloc_message(sz, &hp);
+ ohp = sz == 0 ? NULL : &mp->hfrag.off_heap;
+ }
+ else {
+ ErlHeapFragment *bp = new_message_buffer(sz);
+ mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = bp;
+ hp = bp->mem;
+ ohp = &bp->off_heap;
+ }
+ }
+ msg = copy_struct_litopt(msg, sz, &hp, ohp, &litarea);
}
- ASSERT(!is_offheap(&MSO(&menv->phony_proc)));
- if (flush_me) {
- flush_env(env); /* Needed for ERTS_HOLE_CHECK */
+ ERL_MESSAGE_TERM(mp) = msg;
+
+ if (!env || !env->tracee) {
+
+ if (c_p && IS_TRACED_FL(c_p, F_TRACE_SEND)) {
+ full_flush_env(env);
+ trace_send(c_p, receiver, msg);
+ full_cache_env(env);
+ }
}
- erts_queue_message(rp, &rp_locks, frags, msg, am_undefined
-#ifdef USE_VM_PROBES
- , NIL
+#ifdef ERTS_SMP
+ else {
+ /* This clause is taken when the nif is called in the context
+ of a traced process. We do not know which locks we have
+ so we have to do a try lock and if that fails we enqueue
+ the message in a special trace message output queue of the
+ tracee */
+ ErlTraceMessageQueue *msgq;
+ Process *t_p = env->tracee;
+
+
+ erts_smp_proc_lock(t_p, ERTS_PROC_LOCK_TRACE);
+
+ msgq = t_p->trace_msg_q;
+
+ while (msgq != NULL) {
+ if (msgq->receiver == receiver) {
+ break;
+ }
+ msgq = msgq->next;
+ }
+
+#ifdef ERTS_ENABLE_LOCK_CHECK
+ lc_locks = erts_proc_lc_my_proc_locks(rp);
+ rp_locks |= lc_locks;
#endif
- );
+ if (ERTS_FORCE_ENIF_SEND_DELAY() || msgq ||
+ rp_locks & ERTS_PROC_LOCK_MSGQ ||
+ erts_smp_proc_trylock(rp, ERTS_PROC_LOCK_MSGQ) == EBUSY) {
+
+ if (!msgq) {
+ msgq = erts_alloc(ERTS_ALC_T_TRACE_MSG_QUEUE,
+ sizeof(ErlTraceMessageQueue));
+ msgq->receiver = receiver;
+ msgq->first = mp;
+ msgq->last = &mp->next;
+ msgq->len = 1;
+
+ /* Insert in linked list */
+ msgq->next = t_p->trace_msg_q;
+ t_p->trace_msg_q = msgq;
+
+ erts_smp_proc_unlock(t_p, ERTS_PROC_LOCK_TRACE);
+
+ erts_schedule_flush_trace_messages(t_p, 0);
+ } else {
+ msgq->len++;
+ *msgq->last = mp;
+ msgq->last = &mp->next;
+ erts_smp_proc_unlock(t_p, ERTS_PROC_LOCK_TRACE);
+ }
+ goto done;
+ } else {
+ erts_smp_proc_unlock(t_p, ERTS_PROC_LOCK_TRACE);
+ rp_locks &= ~ERTS_PROC_LOCK_TRACE;
+ rp_locks |= ERTS_PROC_LOCK_MSGQ;
+ }
+ }
+#endif /* ERTS_SMP */
+
+ erts_queue_message(rp, rp_locks, mp, msg,
+ c_p ? c_p->common.id : am_undefined);
+
+#ifdef ERTS_SMP
+done:
if (c_p == rp)
rp_locks &= ~ERTS_PROC_LOCK_MAIN;
- if (rp_locks)
- erts_smp_proc_unlock(rp, rp_locks);
- if (!scheduler)
- erts_smp_proc_dec_refc(rp);
- if (flush_me) {
- cache_env(env);
- }
+ if (rp_locks & ~lc_locks)
+ erts_smp_proc_unlock(rp, rp_locks & ~lc_locks);
+ if (c_p && (env->proc->static_flags & ERTS_STC_FLG_SHADOW_PROC))
+ erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
+#endif
+ if (scheduler <= 0)
+ erts_proc_dec_refc(rp);
+
return 1;
}
+int
+enif_port_command(ErlNifEnv *env, const ErlNifPort* to_port,
+ ErlNifEnv *msg_env, ERL_NIF_TERM msg)
+{
+ int iflags = (erts_port_synchronous_ops
+ ? ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP
+ : ERTS_PORT_SFLGS_INVALID_LOOKUP);
+ int scheduler;
+ Process *c_p;
+ Port *prt;
+ int res;
+
+ if (!env)
+ erts_exit(ERTS_ABORT_EXIT, "enif_port_command: env == NULL");
+
+ execution_state(env, &c_p, &scheduler);
+
+ if (!c_p)
+ c_p = env->proc;
+
+ if (scheduler > 0)
+ prt = erts_port_lookup(to_port->port_id, iflags);
+ else {
+#ifdef ERTS_SMP
+ if (ERTS_PROC_IS_EXITING(c_p))
+ return 0;
+ prt = erts_thr_port_lookup(to_port->port_id, iflags);
+#else
+ erts_exit(ERTS_ABORT_EXIT,
+ "enif_port_command: called from non-scheduler "
+ "thread on non-SMP VM");
+#endif
+ }
+
+ if (!prt)
+ res = 0;
+ else
+ res = erts_port_output_async(prt, c_p->common.id, msg);
+
+ if (scheduler <= 0)
+ erts_port_dec_refc(prt);
+
+ return res;
+}
+
+/*
+ * env must be the caller's environment in a scheduler or NULL in a
+ * non-scheduler thread.
+ * name must be an atom - anything else will just waste time.
+ */
+static Eterm call_whereis(ErlNifEnv *env, Eterm name)
+{
+ Process *c_p;
+ Eterm res;
+ int scheduler;
+
+ execution_state(env, &c_p, &scheduler);
+ ASSERT((c_p && scheduler) || (!c_p && !scheduler));
+
+ if (scheduler < 0) {
+ /* dirty scheduler */
+ if (ERTS_PROC_IS_EXITING(c_p))
+ return 0;
+
+ if (env->proc->static_flags & ERTS_STC_FLG_SHADOW_PROC)
+ c_p = NULL; /* as we don't have main lock */
+ }
+
+
+ if (c_p) {
+ /* main lock may be released below and c_p->htop updated by others */
+ flush_env(env);
+ }
+ res = erts_whereis_name_to_id(c_p, name);
+ if (c_p)
+ cache_env(env);
+
+ return res;
+}
+
+int enif_whereis_pid(ErlNifEnv *env, ERL_NIF_TERM name, ErlNifPid *pid)
+{
+ Eterm res;
+
+ if (is_not_atom(name))
+ return 0;
+
+ res = call_whereis(env, name);
+ /* enif_get_local_ functions check the type */
+ return enif_get_local_pid(env, res, pid);
+}
+
+int enif_whereis_port(ErlNifEnv *env, ERL_NIF_TERM name, ErlNifPort *port)
+{
+ Eterm res;
+
+ if (is_not_atom(name))
+ return 0;
+
+ res = call_whereis(env, name);
+ /* enif_get_local_ functions check the type */
+ return enif_get_local_port(env, res, port);
+}
+
ERL_NIF_TERM enif_make_copy(ErlNifEnv* dst_env, ERL_NIF_TERM src_term)
{
Uint sz;
Eterm* hp;
+ /*
+ * No preserved sharing allowed as long as literals are also preserved.
+ * Process independent environment can not be reached by purge.
+ */
sz = size_object(src_term);
hp = alloc_heap(dst_env, sz);
return copy_struct(src_term, sz, &hp, &MSO(dst_env->proc));
@@ -392,12 +965,28 @@ static int is_offheap(const ErlOffHeap* oh)
ErlNifPid* enif_self(ErlNifEnv* caller_env, ErlNifPid* pid)
{
+ if (caller_env->proc->common.id == ERTS_INVALID_PID)
+ return NULL;
pid->pid = caller_env->proc->common.id;
return pid;
}
+
int enif_get_local_pid(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifPid* pid)
{
- return is_internal_pid(term) ? (pid->pid=term, 1) : 0;
+ if (is_internal_pid(term)) {
+ pid->pid=term;
+ return 1;
+ }
+ return 0;
+}
+
+int enif_get_local_port(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifPort* port)
+{
+ if (is_internal_port(term)) {
+ port->port_id=term;
+ return 1;
+ }
+ return 0;
}
int enif_is_atom(ErlNifEnv* env, ERL_NIF_TERM term)
@@ -447,7 +1036,7 @@ int enif_is_list(ErlNifEnv* env, ERL_NIF_TERM term)
int enif_is_exception(ErlNifEnv* env, ERL_NIF_TERM term)
{
- return term == THE_NON_VALUE;
+ return env->exception_thrown && term == THE_NON_VALUE;
}
int enif_is_number(ErlNifEnv* env, ERL_NIF_TERM term)
@@ -472,6 +1061,16 @@ int enif_inspect_binary(ErlNifEnv* env, Eterm bin_term, ErlNifBinary* bin)
struct enif_tmp_obj_t* tmp;
byte* raw_ptr;
}u;
+
+ if (is_binary(bin_term)) {
+ ProcBin *pb = (ProcBin*) binary_val(bin_term);
+ if (pb->thing_word == HEADER_SUB_BIN) {
+ ErlSubBin* sb = (ErlSubBin*) pb;
+ pb = (ProcBin*) binary_val(sb->orig);
+ }
+ if (pb->thing_word == HEADER_PROC_BIN && pb->flags)
+ erts_emasculate_writable_binary(pb);
+ }
u.tmp = NULL;
bin->data = erts_get_aligned_binary_bytes_extra(bin_term, &u.raw_ptr, allocator,
sizeof(struct enif_tmp_obj_t));
@@ -487,7 +1086,7 @@ int enif_inspect_binary(ErlNifEnv* env, Eterm bin_term, ErlNifBinary* bin)
bin->bin_term = bin_term;
bin->size = binary_size(bin_term);
bin->ref_bin = NULL;
- ADD_READONLY_CHECK(env, bin->data, bin->size);
+ ADD_READONLY_CHECK(env, bin->data, bin->size);
return 1;
}
@@ -539,9 +1138,6 @@ int enif_alloc_binary(size_t size, ErlNifBinary* bin)
if (refbin == NULL) {
return 0; /* The NIF must take action */
}
- refbin->flags = BIN_FLAG_DRV; /* BUGBUG: Flag? */
- erts_refc_init(&refbin->refc, 1);
- refbin->orig_size = (SWord) size;
bin->size = size;
bin->data = (unsigned char*) refbin->orig_bytes;
@@ -561,7 +1157,6 @@ int enif_realloc_binary(ErlNifBinary* bin, size_t size)
if (!newbin) {
return 0;
}
- newbin->orig_size = size;
bin->ref_bin = newbin;
bin->data = (unsigned char*) newbin->orig_bytes;
bin->size = size;
@@ -581,9 +1176,7 @@ void enif_release_binary(ErlNifBinary* bin)
if (bin->ref_bin != NULL) {
Binary* refbin = bin->ref_bin;
ASSERT(bin->bin_term == THE_NON_VALUE);
- if (erts_refc_dectest(&refbin->refc, 0) == 0) {
- erts_bin_free(refbin);
- }
+ erts_bin_release(refbin);
}
#ifdef DEBUG
bin->data = NULL;
@@ -601,6 +1194,68 @@ unsigned char* enif_make_new_binary(ErlNifEnv* env, size_t size,
return binary_bytes(*termp);
}
+int enif_term_to_binary(ErlNifEnv *dst_env, ERL_NIF_TERM term,
+ ErlNifBinary *bin)
+{
+ Sint size;
+ byte *bp;
+ Binary* refbin;
+
+ size = erts_encode_ext_size(term);
+ if (!enif_alloc_binary(size, bin))
+ return 0;
+
+ refbin = bin->ref_bin;
+
+ bp = bin->data;
+
+ erts_encode_ext(term, &bp);
+
+ bin->size = bp - bin->data;
+ refbin->orig_size = bin->size;
+
+ ASSERT(bin->data + bin->size == bp);
+
+ return 1;
+}
+
+size_t enif_binary_to_term(ErlNifEnv *dst_env,
+ const unsigned char* data,
+ size_t data_sz,
+ ERL_NIF_TERM *term,
+ ErlNifBinaryToTerm opts)
+{
+ Sint size;
+ ErtsHeapFactory factory;
+ byte *bp = (byte*) data;
+
+ ERTS_CT_ASSERT(ERL_NIF_BIN2TERM_SAFE == ERTS_DIST_EXT_BTT_SAFE);
+
+ if (opts & ~ERL_NIF_BIN2TERM_SAFE) {
+ return 0;
+ }
+ if ((size = erts_decode_ext_size(bp, data_sz)) < 0)
+ return 0;
+
+ if (size > 0) {
+ flush_env(dst_env);
+ erts_factory_proc_prealloc_init(&factory, dst_env->proc, size);
+ } else {
+ erts_factory_dummy_init(&factory);
+ }
+
+ *term = erts_decode_ext(&factory, &bp, (Uint32)opts);
+
+ if (is_non_value(*term)) {
+ return 0;
+ }
+ erts_factory_close(&factory);
+ cache_env(dst_env);
+
+ ASSERT(bp > data);
+ return bp - data;
+}
+
int enif_is_identical(Eterm lhs, Eterm rhs)
{
return EQ(lhs,rhs);
@@ -619,6 +1274,22 @@ int enif_compare(Eterm lhs, Eterm rhs)
return result;
}
+ErlNifUInt64 enif_hash(ErlNifHash type, Eterm term, ErlNifUInt64 salt)
+{
+ switch (type) {
+ case ERL_NIF_INTERNAL_HASH:
+ return make_internal_hash(term, (Uint32) salt);
+ case ERL_NIF_PHASH2:
+ /* It appears that make_hash2 doesn't always react to seasoning
+ * as well as it should. Therefore, let's make it ignore the salt
+ * value and declare salted uses of phash2 as unsupported.
+ */
+ return make_hash2(term) & ((1 << 27) - 1);
+ default:
+ return 0;
+ }
+}
+
int enif_get_tuple(ErlNifEnv* env, Eterm tpl, int* arity, const Eterm** array)
{
Eterm* ptr;
@@ -685,7 +1356,7 @@ Eterm enif_make_binary(ErlNifEnv* env, ErlNifBinary* bin)
OH_OVERHEAD(&(MSO(env->proc)), pb->size / sizeof(Eterm));
bin_term = make_binary(pb);
- if (erts_refc_read(&bptr->refc, 1) == 1) {
+ if (erts_refc_read(&bptr->intern.refc, 1) == 1) {
/* Total ownership transfer */
bin->ref_bin = NULL;
bin->bin_term = bin_term;
@@ -707,7 +1378,7 @@ Eterm enif_make_sub_binary(ErlNifEnv* env, ERL_NIF_TERM bin_term,
Eterm orig;
Uint offset, bit_offset, bit_size;
#ifdef DEBUG
- unsigned src_size;
+ size_t src_size;
ASSERT(is_binary(bin_term));
src_size = binary_size(bin_term);
@@ -730,7 +1401,21 @@ Eterm enif_make_sub_binary(ErlNifEnv* env, ERL_NIF_TERM bin_term,
Eterm enif_make_badarg(ErlNifEnv* env)
{
- BIF_ERROR(env->proc, BADARG);
+ return enif_raise_exception(env, am_badarg);
+}
+
+Eterm enif_raise_exception(ErlNifEnv* env, ERL_NIF_TERM reason)
+{
+ env->exception_thrown = 1;
+ env->proc->fvalue = reason;
+ BIF_ERROR(env->proc, EXC_ERROR);
+}
+
+int enif_has_pending_exception(ErlNifEnv* env, ERL_NIF_TERM* reason)
+{
+ if (env->exception_thrown && reason != NULL)
+ *reason = env->proc->fvalue;
+ return env->exception_thrown;
}
int enif_get_atom(ErlNifEnv* env, Eterm atom, char* buf, unsigned len,
@@ -875,8 +1560,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;
}
@@ -952,8 +1642,12 @@ ERL_NIF_TERM enif_make_uint64(ErlNifEnv* env, ErlNifUInt64 i)
ERL_NIF_TERM enif_make_double(ErlNifEnv* env, double d)
{
- Eterm* hp = alloc_heap(env,FLOAT_SIZE_OBJECT);
+ Eterm* hp;
FloatDef f;
+
+ if (!erts_isfinite(d))
+ return enif_make_badarg(env);
+ hp = alloc_heap(env,FLOAT_SIZE_OBJECT);
f.fd = d;
PUT_DOUBLE(f, hp);
return make_float(hp);
@@ -966,6 +1660,8 @@ ERL_NIF_TERM enif_make_atom(ErlNifEnv* env, const char* name)
ERL_NIF_TERM enif_make_atom_len(ErlNifEnv* env, const char* name, size_t len)
{
+ if (len > MAX_ATOM_CHARACTERS)
+ return enif_make_badarg(env);
return erts_atom_put((byte*)name, len, ERTS_ATOM_ENC_LATIN1, 1);
}
@@ -979,11 +1675,16 @@ int enif_make_existing_atom_len(ErlNifEnv* env, const char* name, size_t len,
ERL_NIF_TERM* atom, ErlNifCharEncoding encoding)
{
ASSERT(encoding == ERL_NIF_LATIN1);
+ if (len > MAX_ATOM_CHARACTERS)
+ return 0;
return erts_atom_get(name, len, atom, ERTS_ATOM_ENC_LATIN1);
}
ERL_NIF_TERM enif_make_tuple(ErlNifEnv* env, unsigned cnt, ...)
{
+#ifdef ERTS_NIF_ASSERT_IN_ENV
+ int nr = 0;
+#endif
Eterm* hp = alloc_heap(env,cnt+1);
Eterm ret = make_tuple(hp);
va_list ap;
@@ -991,7 +1692,9 @@ ERL_NIF_TERM enif_make_tuple(ErlNifEnv* env, unsigned cnt, ...)
*hp++ = make_arityval(cnt);
va_start(ap,cnt);
while (cnt--) {
- *hp++ = va_arg(ap,Eterm);
+ Eterm elem = va_arg(ap,Eterm);
+ ASSERT_IN_ENV(env, elem, ++nr, "tuple");
+ *hp++ = elem;
}
va_end(ap);
return ret;
@@ -999,12 +1702,16 @@ ERL_NIF_TERM enif_make_tuple(ErlNifEnv* env, unsigned cnt, ...)
ERL_NIF_TERM enif_make_tuple_from_array(ErlNifEnv* env, const ERL_NIF_TERM arr[], unsigned cnt)
{
+#ifdef ERTS_NIF_ASSERT_IN_ENV
+ int nr = 0;
+#endif
Eterm* hp = alloc_heap(env,cnt+1);
Eterm ret = make_tuple(hp);
const Eterm* src = arr;
*hp++ = make_arityval(cnt);
while (cnt--) {
+ ASSERT_IN_ENV(env, *src, ++nr, "tuple");
*hp++ = *src++;
}
return ret;
@@ -1015,6 +1722,8 @@ ERL_NIF_TERM enif_make_list_cell(ErlNifEnv* env, Eterm car, Eterm cdr)
Eterm* hp = alloc_heap(env,2);
Eterm ret = make_list(hp);
+ ASSERT_IN_ENV(env, car, 0, "head of list cell");
+ ASSERT_IN_ENV(env, cdr, 0, "tail of list cell");
CAR(hp) = car;
CDR(hp) = cdr;
return ret;
@@ -1026,6 +1735,9 @@ ERL_NIF_TERM enif_make_list(ErlNifEnv* env, unsigned cnt, ...)
return NIL;
}
else {
+#ifdef ERTS_NIF_ASSERT_IN_ENV
+ int nr = 0;
+#endif
Eterm* hp = alloc_heap(env,cnt*2);
Eterm ret = make_list(hp);
Eterm* last = &ret;
@@ -1033,8 +1745,10 @@ ERL_NIF_TERM enif_make_list(ErlNifEnv* env, unsigned cnt, ...)
va_start(ap,cnt);
while (cnt--) {
+ Eterm term = va_arg(ap,Eterm);
*last = make_list(hp);
- *hp = va_arg(ap,Eterm);
+ ASSERT_IN_ENV(env, term, ++nr, "list");
+ *hp = term;
last = ++hp;
++hp;
}
@@ -1046,14 +1760,19 @@ ERL_NIF_TERM enif_make_list(ErlNifEnv* env, unsigned cnt, ...)
ERL_NIF_TERM enif_make_list_from_array(ErlNifEnv* env, const ERL_NIF_TERM arr[], unsigned cnt)
{
+#ifdef ERTS_NIF_ASSERT_IN_ENV
+ int nr = 0;
+#endif
Eterm* hp = alloc_heap(env,cnt*2);
Eterm ret = make_list(hp);
Eterm* last = &ret;
const Eterm* src = arr;
while (cnt--) {
+ Eterm term = *src++;
*last = make_list(hp);
- *hp = *src++;
+ ASSERT_IN_ENV(env, term, ++nr, "list");
+ *hp = term;
last = ++hp;
++hp;
}
@@ -1077,7 +1796,7 @@ ERL_NIF_TERM enif_make_string_len(ErlNifEnv* env, const char* string,
ERL_NIF_TERM enif_make_ref(ErlNifEnv* env)
{
- Eterm* hp = alloc_heap(env, REF_THING_SIZE);
+ Eterm* hp = alloc_heap(env, ERTS_REF_THING_SIZE);
return erts_make_ref_in_buffer(hp);
}
@@ -1086,13 +1805,9 @@ void enif_system_info(ErlNifSysInfo *sip, size_t si_size)
driver_system_info(sip, si_size);
}
-int enif_make_reverse_list(ErlNifEnv* env, ERL_NIF_TERM term, ERL_NIF_TERM *list) {
- Eterm *listptr, ret = NIL, *hp;
-
- if (is_nil(term)) {
- *list = term;
- return 1;
- }
+int enif_make_reverse_list(ErlNifEnv* env, ERL_NIF_TERM term, ERL_NIF_TERM *list)
+{
+ Eterm *listptr, ret, *hp;
ret = NIL;
@@ -1109,6 +1824,120 @@ int enif_make_reverse_list(ErlNifEnv* env, ERL_NIF_TERM term, ERL_NIF_TERM *list
return 1;
}
+int enif_is_current_process_alive(ErlNifEnv* env)
+{
+ Process *c_p;
+ int scheduler;
+
+ execution_state(env, &c_p, &scheduler);
+
+ if (!c_p)
+ erts_exit(ERTS_ABORT_EXIT,
+ "enif_is_current_process_alive: "
+ "Invalid environment");
+
+ if (!scheduler)
+ erts_exit(ERTS_ABORT_EXIT, "enif_is_current_process_alive: "
+ "called from non-scheduler thread");
+
+ return !ERTS_PROC_IS_EXITING(c_p);
+}
+
+int enif_is_process_alive(ErlNifEnv* env, ErlNifPid *proc)
+{
+ int scheduler;
+
+ execution_state(env, NULL, &scheduler);
+
+ if (scheduler > 0)
+ return !!erts_proc_lookup(proc->pid);
+ else {
+#ifdef ERTS_SMP
+ Process* rp = erts_pid2proc_opt(NULL, 0, proc->pid, 0,
+ ERTS_P2P_FLG_INC_REFC);
+ if (rp)
+ erts_proc_dec_refc(rp);
+ return !!rp;
+#else
+ erts_exit(ERTS_ABORT_EXIT, "enif_is_process_alive: "
+ "called from non-scheduler thread "
+ "in non-smp emulator");
+ return 0;
+#endif
+ }
+}
+
+int enif_is_port_alive(ErlNifEnv *env, ErlNifPort *port)
+{
+ int scheduler;
+ Uint32 iflags = (erts_port_synchronous_ops
+ ? ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP
+ : ERTS_PORT_SFLGS_INVALID_LOOKUP);
+
+ execution_state(env, NULL, &scheduler);
+
+ if (scheduler > 0)
+ return !!erts_port_lookup(port->port_id, iflags);
+ else {
+#ifdef ERTS_SMP
+ Port *prt = erts_thr_port_lookup(port->port_id, iflags);
+ if (prt)
+ erts_port_dec_refc(prt);
+ return !!prt;
+#else
+ erts_exit(ERTS_ABORT_EXIT, "enif_is_port_alive: "
+ "called from non-scheduler thread "
+ "in non-smp emulator");
+ return 0;
+#endif
+ }
+}
+
+ERL_NIF_TERM
+enif_now_time(ErlNifEnv *env)
+{
+ Uint mega, sec, micro;
+ Eterm *hp;
+ get_now(&mega, &sec, &micro);
+ hp = alloc_heap(env, 4);
+ return TUPLE3(hp, make_small(mega), make_small(sec), make_small(micro));
+}
+
+ERL_NIF_TERM
+enif_cpu_time(ErlNifEnv *env)
+{
+#ifdef HAVE_ERTS_NOW_CPU
+ Uint mega, sec, micro;
+ Eterm *hp;
+ erts_get_now_cpu(&mega, &sec, &micro);
+ hp = alloc_heap(env, 4);
+ return TUPLE3(hp, make_small(mega), make_small(sec), make_small(micro));
+#else
+ return enif_make_badarg(env);
+#endif
+}
+
+ERL_NIF_TERM
+enif_make_unique_integer(ErlNifEnv *env, ErlNifUniqueInteger properties)
+{
+ int monotonic = properties & ERL_NIF_UNIQUE_MONOTONIC;
+ int positive = properties & ERL_NIF_UNIQUE_POSITIVE;
+ Eterm *hp;
+ Uint hsz;
+
+ if (monotonic) {
+ Sint64 raw_unique = erts_raw_get_unique_monotonic_integer();
+ hsz = erts_raw_unique_monotonic_integer_heap_size(raw_unique, positive);
+ hp = alloc_heap(env, hsz);
+ return erts_raw_make_unique_monotonic_integer_value(&hp, raw_unique, positive);
+ } else {
+ Uint64 raw_unique[ERTS_UNIQUE_INT_RAW_VALUES];
+ erts_raw_get_unique_integer(raw_unique);
+ hsz = erts_raw_unique_integer_heap_size(raw_unique, positive);
+ hp = alloc_heap(env, hsz);
+ return erts_raw_make_unique_integer(&hp, raw_unique, positive);
+ }
+}
ErlNifMutex* enif_mutex_create(char *name) { return erl_drv_mutex_create(name); }
void enif_mutex_destroy(ErlNifMutex *mtx) { erl_drv_mutex_destroy(mtx); }
@@ -1142,6 +1971,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, ...)
{
@@ -1153,38 +2003,23 @@ int enif_fprintf(void* filep, const char* format, ...)
return ret;
}
+int enif_snprintf(char *buffer, size_t size, const char* format, ...)
+{
+ int ret;
+ va_list arglist;
+ va_start(arglist, format);
+ ret = erts_vsnprintf(buffer, size, format, arglist);
+ va_end(arglist);
+ return ret;
+}
+
/***********************************************************
** Memory managed (GC'ed) "resource" objects **
***********************************************************/
-
-struct enif_resource_type_t
-{
- struct enif_resource_type_t* next; /* list of all resource types */
- struct enif_resource_type_t* prev;
- struct erl_module_nif* owner; /* that created this type and thus implements the destructor*/
- ErlNifResourceDtor* dtor; /* user destructor function */
- erts_refc_t refc; /* num of resources of this type (HOTSPOT warning)
- +1 for active erl_module_nif */
- Eterm module;
- Eterm name;
-};
-
/* dummy node in circular list */
struct enif_resource_type_t resource_type_list;
-typedef struct enif_resource_t
-{
- struct enif_resource_type_t* type;
-#ifdef DEBUG
- erts_refc_t nif_refc;
-#endif
- char data[1];
-}ErlNifResource;
-
-#define SIZEOF_ErlNifResource(SIZE) (offsetof(ErlNifResource,data) + (SIZE))
-#define DATA_TO_RESOURCE(PTR) ((ErlNifResource*)((char*)(PTR) - offsetof(ErlNifResource,data)))
-
static ErlNifResourceType* find_resource_type(Eterm module, Eterm name)
{
ErlNifResourceType* type;
@@ -1209,11 +2044,11 @@ static void close_lib(struct erl_module_nif* lib)
ASSERT(lib->handle != NULL);
ASSERT(erts_refc_read(&lib->rt_dtor_cnt,0) == 0);
- if (lib->entry != NULL && lib->entry->unload != NULL) {
- ErlNifEnv env;
- pre_nif_noproc(&env, lib);
- lib->entry->unload(&env, lib->priv_data);
- post_nif_noproc(&env);
+ if (lib->entry.unload != NULL) {
+ struct enif_msg_environment_t msg_env;
+ pre_nif_noproc(&msg_env, lib, NULL);
+ lib->entry.unload(&msg_env.env, lib->priv_data);
+ post_nif_noproc(&msg_env);
}
if (!erts_is_static_nif(lib->handle))
erts_sys_ddll_close(lib->handle);
@@ -1246,24 +2081,23 @@ struct opened_resource_type
ErlNifResourceFlags op;
ErlNifResourceType* type;
- ErlNifResourceDtor* new_dtor;
+ ErlNifResourceTypeInit new_callbacks;
};
static struct opened_resource_type* opened_rt_list = NULL;
-ErlNifResourceType*
-enif_open_resource_type(ErlNifEnv* env,
- const char* module_str,
- const char* name_str,
- ErlNifResourceDtor* dtor,
- ErlNifResourceFlags flags,
- ErlNifResourceFlags* tried)
+static
+ErlNifResourceType* open_resource_type(ErlNifEnv* env,
+ const char* name_str,
+ const ErlNifResourceTypeInit* init,
+ ErlNifResourceFlags flags,
+ ErlNifResourceFlags* tried,
+ size_t sizeof_init)
{
ErlNifResourceType* type = NULL;
ErlNifResourceFlags op = flags;
Eterm module_am, name_am;
ASSERT(erts_smp_thr_progress_is_blocking());
- ASSERT(module_str == NULL); /* for now... */
module_am = make_atom(env->mod_nif->mod->module);
name_am = enif_make_atom(env, name_str);
@@ -1297,7 +2131,9 @@ enif_open_resource_type(ErlNifEnv* env,
sizeof(struct opened_resource_type));
ort->op = op;
ort->type = type;
- ort->new_dtor = dtor;
+ sys_memzero(&ort->new_callbacks, sizeof(ErlNifResourceTypeInit));
+ ASSERT(sizeof_init > 0 && sizeof_init <= sizeof(ErlNifResourceTypeInit));
+ sys_memcpy(&ort->new_callbacks, init, sizeof_init);
ort->next = opened_rt_list;
opened_rt_list = ort;
}
@@ -1307,6 +2143,31 @@ enif_open_resource_type(ErlNifEnv* env,
return type;
}
+ErlNifResourceType*
+enif_open_resource_type(ErlNifEnv* env,
+ const char* module_str,
+ const char* name_str,
+ ErlNifResourceDtor* dtor,
+ ErlNifResourceFlags flags,
+ ErlNifResourceFlags* tried)
+{
+ ErlNifResourceTypeInit init = {dtor, NULL};
+ ASSERT(module_str == NULL); /* for now... */
+ return open_resource_type(env, name_str, &init, flags, tried,
+ sizeof(init));
+}
+
+ErlNifResourceType*
+enif_open_resource_type_x(ErlNifEnv* env,
+ const char* name_str,
+ const ErlNifResourceTypeInit* init,
+ ErlNifResourceFlags flags,
+ ErlNifResourceFlags* tried)
+{
+ return open_resource_type(env, name_str, init, flags, tried,
+ env->mod_nif->entry.sizeof_ErlNifResourceTypeInit);
+}
+
static void commit_opened_resource_types(struct erl_module_nif* lib)
{
while (opened_rt_list) {
@@ -1325,7 +2186,9 @@ static void commit_opened_resource_types(struct erl_module_nif* lib)
}
type->owner = lib;
- type->dtor = ort->new_dtor;
+ type->dtor = ort->new_callbacks.dtor;
+ type->stop = ort->new_callbacks.stop;
+ type->down = ort->new_callbacks.down;
if (type->dtor != NULL) {
erts_refc_inc(&lib->rt_dtor_cnt, 1);
@@ -1351,18 +2214,151 @@ static void rollback_opened_resource_types(void)
}
}
+struct destroy_monitor_ctx
+{
+ ErtsResource* resource;
+ int exiting_procs;
+ int scheduler;
+};
+
+static void destroy_one_monitor(ErtsMonitor* mon, void* context)
+{
+ struct destroy_monitor_ctx* ctx = (struct destroy_monitor_ctx*) context;
+ Process* rp;
+ ErtsMonitor *rmon = NULL;
+ int is_exiting;
+
+ ASSERT(mon->type == MON_ORIGIN);
+ ASSERT(is_internal_pid(mon->u.pid));
+ ASSERT(is_internal_ref(mon->ref));
+
+ if (ctx->scheduler > 0) { /* Normal scheduler */
+ rp = erts_proc_lookup(mon->u.pid);
+ }
+ else {
+#ifdef ERTS_SMP
+ rp = erts_proc_lookup_inc_refc(mon->u.pid);
+#else
+ ASSERT(!"nif monitor destruction in non-scheduler thread");
+ rp = NULL;
+#endif
+ }
+
+ if (!rp) {
+ is_exiting = 1;
+ }
+ if (rp) {
+ erts_smp_proc_lock(rp, ERTS_PROC_LOCK_LINK);
+ if (ERTS_PROC_IS_EXITING(rp)) {
+ is_exiting = 1;
+ } else {
+ rmon = erts_remove_monitor(&ERTS_P_MONITORS(rp), mon->ref);
+ ASSERT(rmon);
+ is_exiting = 0;
+ }
+ erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
+#ifdef ERTS_SMP
+ if (ctx->scheduler <= 0)
+ erts_proc_dec_refc(rp);
+#endif
+ }
+ if (is_exiting) {
+ ctx->resource->monitors->pending_failed_fire++;
+ }
+
+ /* ToDo: Delay destruction after monitor_locks */
+ if (rmon) {
+ ASSERT(rmon->type == MON_NIF_TARGET);
+ ASSERT(rmon->u.resource == ctx->resource);
+ erts_destroy_monitor(rmon);
+ }
+ erts_destroy_monitor(mon);
+}
-static void nif_resource_dtor(Binary* bin)
+static void destroy_all_monitors(ErtsMonitor* monitors, ErtsResource* resource)
{
- ErlNifResource* resource = (ErlNifResource*) ERTS_MAGIC_BIN_DATA(bin);
+ struct destroy_monitor_ctx ctx;
+
+ execution_state(NULL, NULL, &ctx.scheduler);
+
+ ctx.resource = resource;
+ erts_sweep_monitors(monitors, &destroy_one_monitor, &ctx);
+}
+
+
+#ifdef ERTS_SMP
+# define NIF_RESOURCE_DTOR &nif_resource_dtor
+#else
+# define NIF_RESOURCE_DTOR &nosmp_nif_resource_dtor_prologue
+
+/*
+ * NO-SMP: Always run resource destructor on scheduler thread
+ * as we may have to remove process monitors.
+ */
+static int nif_resource_dtor(Binary*);
+
+static void nosmp_nif_resource_dtor_scheduled(void* vbin)
+{
+ erts_bin_free((Binary*)vbin);
+}
+
+static int nosmp_nif_resource_dtor_prologue(Binary* bin)
+{
+ if (is_scheduler()) {
+ return nif_resource_dtor(bin);
+ }
+ else {
+ erts_schedule_misc_aux_work(1, nosmp_nif_resource_dtor_scheduled, bin);
+ return 0; /* do not free */
+ }
+}
+
+#endif /* !ERTS_SMP */
+
+static int nif_resource_dtor(Binary* bin)
+{
+ ErtsResource* resource = (ErtsResource*) ERTS_MAGIC_BIN_UNALIGNED_DATA(bin);
ErlNifResourceType* type = resource->type;
- ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(bin) == &nif_resource_dtor);
+ ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(bin) == NIF_RESOURCE_DTOR);
+
+ if (resource->monitors) {
+ ErtsResourceMonitors* rm = resource->monitors;
+
+ ASSERT(type->down);
+ erts_smp_mtx_lock(&rm->lock);
+ ASSERT(erts_refc_read(&bin->intern.refc, 0) == 0);
+ if (rm->root) {
+ ASSERT(!rm->is_dying);
+ destroy_all_monitors(rm->root, resource);
+ rm->root = NULL;
+ }
+ if (rm->pending_failed_fire) {
+ /*
+ * Resource death struggle prolonged to serve exiting process(es).
+ * Destructor will be called again when last exiting process
+ * tries to fire its MON_NIF_TARGET monitor (and fails).
+ *
+ * This resource is doomed. It has no "real" references and
+ * should get not get called upon to do anything except the
+ * final destructor call.
+ *
+ * We keep refc at 0 and use a separate counter for exiting
+ * processes to avoid resource getting revived by "dec_term".
+ */
+ ASSERT(!rm->is_dying);
+ rm->is_dying = 1;
+ erts_smp_mtx_unlock(&rm->lock);
+ return 0;
+ }
+ erts_smp_mtx_unlock(&rm->lock);
+ erts_smp_mtx_destroy(&rm->lock);
+ }
if (type->dtor != NULL) {
- ErlNifEnv env;
- pre_nif_noproc(&env, type->owner);
- type->dtor(&env,resource->data);
- post_nif_noproc(&env);
+ struct enif_msg_environment_t msg_env;
+ pre_nif_noproc(&msg_env, type->owner, NULL);
+ type->dtor(&msg_env.env, resource->data);
+ post_nif_noproc(&msg_env);
}
if (erts_refc_dectest(&type->refc, 0) == 0) {
ASSERT(type->next == NULL);
@@ -1371,83 +2367,203 @@ static void nif_resource_dtor(Binary* bin)
steal_resource_type(type);
erts_free(ERTS_ALC_T_NIF, type);
}
+ return 1;
+}
+
+void erts_resource_stop(ErtsResource* resource, ErlNifEvent e,
+ int is_direct_call)
+{
+ struct enif_msg_environment_t msg_env;
+ ASSERT(resource->type->stop);
+ pre_nif_noproc(&msg_env, resource->type->owner, NULL);
+ resource->type->stop(&msg_env.env, resource->data, e, is_direct_call);
+ post_nif_noproc(&msg_env);
+}
+
+void erts_fire_nif_monitor(ErtsResource* resource, Eterm pid, Eterm ref)
+{
+ ErtsMonitor* rmon;
+ ErtsBinary* bin = ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(resource);
+ struct enif_msg_environment_t msg_env;
+ ErlNifPid nif_pid;
+ ErlNifMonitor nif_monitor;
+ ErtsResourceMonitors* rmp = resource->monitors;
+
+ ASSERT(rmp);
+ ASSERT(resource->type->down);
+
+ erts_smp_mtx_lock(&rmp->lock);
+ rmon = erts_remove_monitor(&rmp->root, ref);
+ if (!rmon) {
+ int free_me = (--rmp->pending_failed_fire == 0) && rmp->is_dying;
+ ASSERT(rmp->pending_failed_fire >= 0);
+ erts_smp_mtx_unlock(&rmp->lock);
+
+ if (free_me) {
+ ASSERT(erts_refc_read(&bin->binary.intern.refc, 0) == 0);
+ erts_bin_free(&bin->binary);
+ }
+ return;
+ }
+ ASSERT(!rmp->is_dying);
+ if (erts_refc_inc_unless(&bin->binary.intern.refc, 0, 0) == 0) {
+ /*
+ * Racing resource destruction.
+ * To avoid a more complex refc-dance with destructing thread
+ * we avoid calling 'down' and just silently remove the monitor.
+ * This can happen even for non smp as destructor calls may be scheduled.
+ */
+ erts_smp_mtx_unlock(&rmp->lock);
+ }
+ else {
+ erts_smp_mtx_unlock(&rmp->lock);
+
+ ASSERT(rmon->u.pid == pid);
+ erts_ref_to_driver_monitor(ref, &nif_monitor);
+ nif_pid.pid = pid;
+ pre_nif_noproc(&msg_env, resource->type->owner, NULL);
+ resource->type->down(&msg_env.env, resource->data, &nif_pid, &nif_monitor);
+ post_nif_noproc(&msg_env);
+
+ erts_bin_release(&bin->binary);
+ }
+ erts_destroy_monitor(rmon);
}
-void* enif_alloc_resource(ErlNifResourceType* type, size_t size)
+void* enif_alloc_resource(ErlNifResourceType* type, size_t data_sz)
{
- Binary* bin = erts_create_magic_binary(SIZEOF_ErlNifResource(size), &nif_resource_dtor);
- ErlNifResource* resource = ERTS_MAGIC_BIN_DATA(bin);
+ size_t magic_sz = offsetof(ErtsResource,data);
+ Binary* bin;
+ ErtsResource* resource;
+ size_t monitors_offs;
+
+ if (type->down) {
+ /* Put ErtsResourceMonitors after user data and properly aligned */
+ monitors_offs = ((data_sz + ERTS_ALLOC_ALIGN_BYTES - 1)
+ & ~((size_t)ERTS_ALLOC_ALIGN_BYTES - 1));
+ magic_sz += monitors_offs + sizeof(ErtsResourceMonitors);
+ }
+ else {
+ ERTS_UNDEF(monitors_offs, 0);
+ magic_sz += data_sz;
+ }
+ bin = erts_create_magic_binary_x(magic_sz, NIF_RESOURCE_DTOR,
+ ERTS_ALC_T_BINARY,
+ 1); /* unaligned */
+ resource = ERTS_MAGIC_BIN_UNALIGNED_DATA(bin);
ASSERT(type->owner && type->next && type->prev); /* not allowed in load/upgrade */
resource->type = type;
- erts_refc_inc(&bin->refc, 1);
+ erts_refc_inc(&bin->intern.refc, 1);
#ifdef DEBUG
erts_refc_init(&resource->nif_refc, 1);
#endif
erts_refc_inc(&resource->type->refc, 2);
+ if (type->down) {
+ resource->monitors = (ErtsResourceMonitors*) (resource->data + monitors_offs);
+ erts_smp_mtx_init(&resource->monitors->lock, "resource_monitors", NIL,
+ ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
+ resource->monitors->root = NULL;
+ resource->monitors->pending_failed_fire = 0;
+ resource->monitors->is_dying = 0;
+ resource->monitors->user_data_sz = data_sz;
+ }
+ else {
+ resource->monitors = NULL;
+ }
return resource->data;
}
void enif_release_resource(void* obj)
{
- ErlNifResource* resource = DATA_TO_RESOURCE(obj);
- ErtsBinary* bin = ERTS_MAGIC_BIN_FROM_DATA(resource);
+ ErtsResource* resource = DATA_TO_RESOURCE(obj);
+ ErtsBinary* bin = ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(resource);
- ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(bin) == &nif_resource_dtor);
+ ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(bin) == NIF_RESOURCE_DTOR);
+ ASSERT(!(resource->monitors && resource->monitors->is_dying));
#ifdef DEBUG
erts_refc_dec(&resource->nif_refc, 0);
#endif
- if (erts_refc_dectest(&bin->binary.refc, 0) == 0) {
- erts_bin_free(&bin->binary);
- }
+ erts_bin_release(&bin->binary);
}
void enif_keep_resource(void* obj)
{
- ErlNifResource* resource = DATA_TO_RESOURCE(obj);
- ErtsBinary* bin = ERTS_MAGIC_BIN_FROM_DATA(resource);
+ ErtsResource* resource = DATA_TO_RESOURCE(obj);
+ ErtsBinary* bin = ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(resource);
- ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(bin) == &nif_resource_dtor);
+ ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(bin) == NIF_RESOURCE_DTOR);
+ ASSERT(!(resource->monitors && resource->monitors->is_dying));
#ifdef DEBUG
erts_refc_inc(&resource->nif_refc, 1);
#endif
- erts_refc_inc(&bin->binary.refc, 2);
+ erts_refc_inc(&bin->binary.intern.refc, 2);
+}
+
+Eterm erts_bld_resource_ref(Eterm** hpp, ErlOffHeap* oh, ErtsResource* resource)
+{
+ ErtsBinary* bin = ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(resource);
+ ASSERT(!(resource->monitors && resource->monitors->is_dying));
+ return erts_mk_magic_ref(hpp, oh, &bin->binary);
}
ERL_NIF_TERM enif_make_resource(ErlNifEnv* env, void* obj)
{
- ErlNifResource* resource = DATA_TO_RESOURCE(obj);
- ErtsBinary* bin = ERTS_MAGIC_BIN_FROM_DATA(resource);
- Eterm* hp = alloc_heap(env,PROC_BIN_SIZE);
- return erts_mk_magic_binary_term(&hp, &MSO(env->proc), &bin->binary);
+ ErtsResource* resource = DATA_TO_RESOURCE(obj);
+ ErtsBinary* bin = ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(resource);
+ Eterm* hp = alloc_heap(env, ERTS_MAGIC_REF_THING_SIZE);
+ ASSERT(!(resource->monitors && resource->monitors->is_dying));
+ return erts_mk_magic_ref(&hp, &MSO(env->proc), &bin->binary);
}
ERL_NIF_TERM enif_make_resource_binary(ErlNifEnv* env, void* obj,
const void* data, size_t size)
{
- Eterm bin = enif_make_resource(env, obj);
- ProcBin* pb = (ProcBin*) binary_val(bin);
- pb->bytes = (byte*) data;
+ ErtsResource* resource = DATA_TO_RESOURCE(obj);
+ ErtsBinary* bin = ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(resource);
+ ErlOffHeap *ohp = &MSO(env->proc);
+ Eterm* hp = alloc_heap(env,PROC_BIN_SIZE);
+ ProcBin* pb = (ProcBin *) hp;
+
+ pb->thing_word = HEADER_PROC_BIN;
pb->size = size;
- return bin;
+ pb->next = ohp->first;
+ ohp->first = (struct erl_off_heap_header*) pb;
+ pb->val = &bin->binary;
+ pb->bytes = (byte*) data;
+ pb->flags = 0;
+
+ OH_OVERHEAD(ohp, size / sizeof(Eterm));
+ erts_refc_inc(&bin->binary.intern.refc, 1);
+
+ return make_binary(hp);
}
int enif_get_resource(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifResourceType* type,
void** objp)
{
- ProcBin* pb;
Binary* mbin;
- ErlNifResource* resource;
- if (!ERTS_TERM_IS_MAGIC_BINARY(term)) {
- return 0;
+ ErtsResource* resource;
+ if (is_internal_magic_ref(term))
+ mbin = erts_magic_ref2bin(term);
+ else {
+ Eterm *hp;
+ if (!is_binary(term))
+ return 0;
+ hp = binary_val(term);
+ if (thing_subtag(*hp) != REFC_BINARY_SUBTAG)
+ return 0;
+ /*
+ if (((ProcBin *) hp)->size != 0) {
+ return 0; / * Or should we allow "resource binaries" as handles? * /
+ }
+ */
+ mbin = ((ProcBin *) hp)->val;
+ if (!(mbin->intern.flags & BIN_FLAG_MAGIC))
+ return 0;
}
- pb = (ProcBin*) binary_val(term);
- /*if (pb->size != 0) {
- return 0; / * Or should we allow "resource binaries" as handles? * /
- }*/
- mbin = pb->val;
- resource = (ErlNifResource*) ERTS_MAGIC_BIN_DATA(mbin);
- if (ERTS_MAGIC_BIN_DESTRUCTOR(mbin) != &nif_resource_dtor
+ resource = (ErtsResource*) ERTS_MAGIC_BIN_UNALIGNED_DATA(mbin);
+ if (ERTS_MAGIC_BIN_DESTRUCTOR(mbin) != NIF_RESOURCE_DTOR
|| resource->type != type) {
return 0;
}
@@ -1457,9 +2573,14 @@ int enif_get_resource(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifResourceType* typ
size_t enif_sizeof_resource(void* obj)
{
- ErlNifResource* resource = DATA_TO_RESOURCE(obj);
- Binary* bin = &ERTS_MAGIC_BIN_FROM_DATA(resource)->binary;
- return ERTS_MAGIC_BIN_DATA_SIZE(bin) - offsetof(ErlNifResource,data);
+ ErtsResource* resource = DATA_TO_RESOURCE(obj);
+ if (resource->monitors) {
+ return resource->monitors->user_data_sz;
+ }
+ else {
+ Binary* bin = &ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(resource)->binary;
+ return ERTS_MAGIC_BIN_UNALIGNED_DATA_SIZE(bin) - offsetof(ErtsResource,data);
+ }
}
@@ -1501,184 +2622,291 @@ void* enif_dlsym(void* handle, const char* symbol,
int enif_consume_timeslice(ErlNifEnv* env, int percent)
{
+ Process *proc;
Sint reds;
+ execution_state(env, &proc, NULL);
+
ASSERT(is_proc_bound(env) && percent >= 1 && percent <= 100);
if (percent < 1) percent = 1;
else if (percent > 100) percent = 100;
reds = ((CONTEXT_REDS+99) / 100) * percent;
ASSERT(reds > 0 && reds <= CONTEXT_REDS);
- BUMP_REDS(env->proc, reds);
- return ERTS_BIF_REDS_LEFT(env->proc) == 0;
+ BUMP_REDS(proc, reds);
+ return ERTS_BIF_REDS_LEFT(proc) == 0;
+}
+
+static ERTS_INLINE void
+nif_export_cleanup_nif_mod(NifExport *ep)
+{
+ if (erts_refc_dectest(&ep->m->rt_dtor_cnt, 0) == 0 && ep->m->mod == NULL)
+ close_lib(ep->m);
+ ep->m = NULL;
+}
+
+void
+erts_nif_export_cleanup_nif_mod(NifExport *ep)
+{
+ nif_export_cleanup_nif_mod(ep);
}
+static ERTS_INLINE void
+nif_export_restore(Process *c_p, NifExport *ep, Eterm res)
+{
+ erts_nif_export_restore(c_p, ep, res);
+ ASSERT(ep->m);
+ nif_export_cleanup_nif_mod(ep);
+}
+
+
#ifdef ERTS_DIRTY_SCHEDULERS
-/* NIFs exports need one more item than the Export struct provides, the
- * erl_module_nif*, so the DirtyNifExport below adds that. The Export
- * member must be first in the struct.
+/*
+ * Finalize a dirty NIF call. This function is scheduled to cause the VM to
+ * switch the process off a dirty scheduler thread and back onto a regular
+ * scheduler thread, and then return the result from the dirty NIF. It also
+ * restores the original NIF MFA when necessary based on the value of
+ * ep->func set by execute_dirty_nif via init_nif_sched_data -- non-NULL
+ * means restore, NULL means do not restore.
*/
-typedef struct {
- Export exp;
- struct erl_module_nif* m;
-} DirtyNifExport;
+static ERL_NIF_TERM
+dirty_nif_finalizer(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ Process* proc;
+ NifExport* ep;
+
+ execution_state(env, &proc, NULL);
+
+ ASSERT(argc == 1);
+ ASSERT(!ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(proc)));
+ ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc);
+ ASSERT(ep);
+ nif_export_restore(proc, ep, argv[0]);
+ return argv[0];
+}
-static void
-alloc_proc_psd(Process* proc, DirtyNifExport **ep)
+/* Finalize a dirty NIF call that raised an exception. Otherwise same as
+ * the dirty_nif_finalizer() function.
+ */
+static ERL_NIF_TERM
+dirty_nif_exception(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
- int i;
- if (!*ep) {
- *ep = erts_alloc(ERTS_ALC_T_PSD, sizeof(DirtyNifExport));
- sys_memset((void*) *ep, 0, sizeof(DirtyNifExport));
- for (i=0; i<ERTS_NUM_CODE_IX; i++) {
- (*ep)->exp.addressv[i] = &(*ep)->exp.code[3];
- }
- (*ep)->exp.code[3] = (BeamInstr) em_call_nif;
- }
- (void) ERTS_PROC_SET_DIRTY_SCHED_TRAP_EXPORT(proc, ERTS_PROC_LOCK_MAIN, &(*ep)->exp);
+ ERL_NIF_TERM ret;
+ Process* proc;
+ NifExport* ep;
+ Eterm exception;
+
+ execution_state(env, &proc, NULL);
+
+ ASSERT(argc == 1);
+ ASSERT(!ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(proc)));
+ ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc);
+ ASSERT(ep);
+ exception = argv[0]; /* argv overwritten by restore below... */
+ nif_export_cleanup_nif_mod(ep);
+ ret = enif_raise_exception(env, exception);
+
+ /* Restore orig info for error and clear nif export in handle_error() */
+ proc->freason |= EXF_RESTORE_NIF;
+ return ret;
+}
+
+/*
+ * Dirty NIF scheduling wrapper function. Schedule a dirty NIF to execute.
+ * The dirty scheduler thread type (CPU or I/O) is indicated in flags
+ * parameter.
+ */
+static ERTS_INLINE ERL_NIF_TERM
+schedule_dirty_nif(ErlNifEnv* env, int flags, NativeFunPtr fp,
+ Eterm func_name, int argc, const ERL_NIF_TERM argv[])
+{
+ Process* proc;
+
+ ASSERT(is_atom(func_name));
+ ASSERT(fp);
+
+ ASSERT(flags==ERL_NIF_DIRTY_JOB_IO_BOUND || flags==ERL_NIF_DIRTY_JOB_CPU_BOUND);
+
+ execution_state(env, &proc, NULL);
+
+ (void) erts_smp_atomic32_read_bset_nob(&proc->state,
+ (ERTS_PSFLG_DIRTY_CPU_PROC
+ | ERTS_PSFLG_DIRTY_IO_PROC),
+ (flags == ERL_NIF_DIRTY_JOB_CPU_BOUND
+ ? ERTS_PSFLG_DIRTY_CPU_PROC
+ : ERTS_PSFLG_DIRTY_IO_PROC));
+
+ return schedule(env, fp, NULL, proc->current->module, func_name, argc, argv);
+}
+
+static ERTS_INLINE ERL_NIF_TERM
+static_schedule_dirty_nif(ErlNifEnv* env, erts_aint32_t dirty_psflg,
+ int argc, const ERL_NIF_TERM argv[])
+{
+ Process *proc;
+ NifExport *ep;
+ Eterm mod, func;
+ NativeFunPtr fp;
+
+ execution_state(env, &proc, NULL);
+
+ /*
+ * Called in order to schedule statically determined
+ * dirty NIF calls...
+ *
+ * Note that 'current' does not point into a NifExport
+ * structure; only a structure with similar
+ * parts (located in code).
+ */
+
+ ep = ErtsContainerStruct(proc->current, NifExport, exp.info.mfa);
+ mod = proc->current->module;
+ func = proc->current->function;
+ fp = (NativeFunPtr) ep->func;
+
+ ASSERT(is_atom(mod) && is_atom(func));
+ ASSERT(fp);
+
+ (void) erts_smp_atomic32_read_bset_nob(&proc->state,
+ (ERTS_PSFLG_DIRTY_CPU_PROC
+ | ERTS_PSFLG_DIRTY_IO_PROC),
+ dirty_psflg);
+
+ return schedule(env, fp, NULL, mod, func, argc, argv);
}
static ERL_NIF_TERM
-execute_dirty_nif_finalizer(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+static_schedule_dirty_io_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
- Eterm* reg = ERTS_PROC_GET_SCHDATA(env->proc)->x_reg_array;
- ERL_NIF_TERM result, dirty_result = (ERL_NIF_TERM) reg[0];
- typedef ERL_NIF_TERM (*FinalizerFP)(ErlNifEnv*, ERL_NIF_TERM);
- FinalizerFP fp;
-#if HAVE_INT64 && SIZEOF_LONG != 8
- ASSERT(sizeof(fp) <= sizeof(ErlNifUInt64));
- enif_get_uint64(env, reg[1], (ErlNifUInt64 *) &fp);
-#else
- ASSERT(sizeof(fp) <= sizeof(unsigned long));
- enif_get_ulong(env, reg[1], (unsigned long *) &fp);
-#endif
- result = (*fp)(env, dirty_result);
- if (erts_refc_dectest(&env->mod_nif->rt_dtor_cnt, 0) == 0
- && env->mod_nif->mod == NULL)
- close_lib(env->mod_nif);
- return result;
+ return static_schedule_dirty_nif(env, ERTS_PSFLG_DIRTY_IO_PROC, argc, argv);
+}
+
+static ERL_NIF_TERM
+static_schedule_dirty_cpu_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ return static_schedule_dirty_nif(env, ERTS_PSFLG_DIRTY_CPU_PROC, argc, argv);
}
#endif /* ERTS_DIRTY_SCHEDULERS */
-#ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT
+/*
+ * NIF execution wrapper used by enif_schedule_nif() for regular NIFs. It
+ * calls the actual NIF, restores original NIF MFA if necessary, and
+ * then returns the NIF result.
+ */
+static ERL_NIF_TERM
+execute_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ Process* proc;
+ NativeFunPtr fp;
+ NifExport* ep;
+ ERL_NIF_TERM result;
-ERL_NIF_TERM
-enif_schedule_dirty_nif(ErlNifEnv* env, int flags,
- ERL_NIF_TERM (*fp)(ErlNifEnv*, int, const ERL_NIF_TERM[]),
- int argc, const ERL_NIF_TERM argv[])
-{
-#ifdef USE_THREADS
- erts_aint32_t state, n, a;
- Process* proc = env->proc;
- Eterm* reg = ERTS_PROC_GET_SCHDATA(proc)->x_reg_array;
- DirtyNifExport* ep = NULL;
- int i;
+ execution_state(env, &proc, NULL);
- int chkflgs = (flags & (ERL_NIF_DIRTY_JOB_IO_BOUND|ERL_NIF_DIRTY_JOB_CPU_BOUND));
- if (chkflgs != ERL_NIF_DIRTY_JOB_IO_BOUND && chkflgs != ERL_NIF_DIRTY_JOB_CPU_BOUND)
- return enif_make_badarg(env);
+ ep = ErtsContainerStruct(proc->current, NifExport, exp.info.mfa);
+ fp = ep->func;
+ ASSERT(ep);
+ ASSERT(!env->exception_thrown);
- 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 (chkflgs == ERL_NIF_DIRTY_JOB_CPU_BOUND)
- n |= ERTS_PSFLG_DIRTY_CPU_PROC;
- else
- n |= ERTS_PSFLG_DIRTY_IO_PROC;
- a = erts_smp_atomic32_cmpxchg_mb(&proc->state, n, state);
- if (a == state)
- break;
- }
- if (!(ep = (DirtyNifExport*) ERTS_PROC_GET_DIRTY_SCHED_TRAP_EXPORT(proc)))
- alloc_proc_psd(proc, &ep);
- ERTS_VBUMP_ALL_REDS(proc);
- ep->exp.code[2] = argc;
- for (i = 0; i < argc; i++) {
- reg[i] = (Eterm) argv[i];
- }
- proc->i = (BeamInstr*) ep->exp.addressv[0];
- ep->exp.code[4] = (BeamInstr) fp;
- ep->m = env->mod_nif;
- proc->freason = TRAP;
+ fp = (NativeFunPtr) ep->func;
- erts_refc_inc(&env->mod_nif->rt_dtor_cnt, 1);
+#ifdef DEBUG
+ ep->func = ERTS_DBG_NIF_NOT_SCHED_MARKER;
+#endif
- return THE_NON_VALUE;
-#else
- return (*fp)(env, argc, argv);
+ result = (*fp)(env, argc, argv);
+
+ ASSERT(ep == ERTS_PROC_GET_NIF_TRAP_EXPORT(proc));
+
+ if (is_value(result) || proc->freason != TRAP) {
+ /* Done (not rescheduled)... */
+ ASSERT(ep->func == ERTS_DBG_NIF_NOT_SCHED_MARKER);
+ if (!env->exception_thrown)
+ nif_export_restore(proc, ep, result);
+ else {
+ nif_export_cleanup_nif_mod(ep);
+ /*
+ * Restore orig info for error and clear nif
+ * export in handle_error()
+ */
+ proc->freason |= EXF_RESTORE_NIF;
+ }
+ }
+
+#ifdef DEBUG
+ if (ep->func == ERTS_DBG_NIF_NOT_SCHED_MARKER)
+ ep->func = NULL;
#endif
+
+ return result;
}
ERL_NIF_TERM
-enif_schedule_dirty_nif_finalizer(ErlNifEnv* env, ERL_NIF_TERM result,
- ERL_NIF_TERM (*fp)(ErlNifEnv*, ERL_NIF_TERM))
-{
-#ifdef USE_THREADS
- Process* proc = env->proc;
- Eterm* reg = ERTS_PROC_GET_SCHDATA(proc)->x_reg_array;
- DirtyNifExport* ep;
-
- 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 (!(ep = (DirtyNifExport*) ERTS_PROC_GET_DIRTY_SCHED_TRAP_EXPORT(proc)))
- alloc_proc_psd(proc, &ep);
- ERTS_VBUMP_ALL_REDS(proc);
- ep->exp.code[2] = 2;
- reg[0] = (Eterm) result;
-#if HAVE_INT64 && SIZEOF_LONG != 8
- ASSERT(sizeof(fp) <= sizeof(ErlNifUInt64));
- reg[1] = (Eterm) enif_make_uint64(env, (ErlNifUInt64) fp);
-#else
- ASSERT(sizeof(fp) <= sizeof(unsigned long));
- reg[1] = (Eterm) enif_make_ulong(env, (unsigned long) fp);
-#endif
- proc->i = (BeamInstr*) ep->exp.addressv[0];
- ep->exp.code[4] = (BeamInstr) execute_dirty_nif_finalizer;
- proc->freason = TRAP;
+enif_schedule_nif(ErlNifEnv* env, const char* fun_name, int flags,
+ ERL_NIF_TERM (*fp)(ErlNifEnv*, int, const ERL_NIF_TERM[]),
+ int argc, const ERL_NIF_TERM argv[])
+{
+ Process* proc;
+ ERL_NIF_TERM fun_name_atom, result;
+ int scheduler;
- return THE_NON_VALUE;
+ if (argc > MAX_ARG)
+ return enif_make_badarg(env);
+ fun_name_atom = enif_make_atom(env, fun_name);
+ if (enif_is_exception(env, fun_name_atom))
+ return fun_name_atom;
+
+ execution_state(env, &proc, &scheduler);
+ if (scheduler <= 0) {
+ if (scheduler == 0)
+ enif_make_badarg(env);
+ erts_smp_proc_lock(proc, ERTS_PROC_LOCK_MAIN);
+ }
+
+ if (flags == 0)
+ result = schedule(env, execute_nif, fp, proc->current->module,
+ fun_name_atom, argc, argv);
+ else if (!(flags & ~(ERL_NIF_DIRTY_JOB_IO_BOUND|ERL_NIF_DIRTY_JOB_CPU_BOUND))) {
+#ifdef ERTS_DIRTY_SCHEDULERS
+ result = schedule_dirty_nif(env, flags, fp, fun_name_atom, argc, argv);
#else
- return (*fp)(env, result);
+ result = enif_raise_exception(env, am_notsup);
#endif
-}
+ }
+ else
+ result = enif_make_badarg(env);
+
+ if (scheduler < 0)
+ erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_MAIN);
-/* A simple finalizer that just returns its result argument */
-ERL_NIF_TERM
-enif_dirty_nif_finalizer(ErlNifEnv* env, ERL_NIF_TERM result)
-{
return result;
}
int
-enif_is_on_dirty_scheduler(ErlNifEnv* env)
+enif_thread_type(void)
{
- return ERTS_SCHEDULER_IS_DIRTY(env->proc->scheduler_data);
-}
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
-int
-enif_have_dirty_schedulers()
-{
-#ifdef USE_THREADS
- return 1;
-#else
- return 0;
+ if (!esdp)
+ return ERL_NIF_THR_UNDEFINED;
+
+ switch (esdp->type) {
+ case ERTS_SCHED_NORMAL:
+ return ERL_NIF_THR_NORMAL_SCHEDULER;
+#ifdef ERTS_DIRTY_SCHEDULERS
+ case ERTS_SCHED_DIRTY_CPU:
+ return ERL_NIF_THR_DIRTY_CPU_SCHEDULER;
+ case ERTS_SCHED_DIRTY_IO:
+ return ERL_NIF_THR_DIRTY_IO_SCHEDULER;
#endif
+ default:
+ ERTS_INTERNAL_ERROR("Invalid scheduler type");
+ return -1;
+ }
}
-#endif /* ERL_NIF_DIRTY_SCHEDULER_SUPPORT */
-
/* Maps */
int enif_is_map(ErlNifEnv* env, ERL_NIF_TERM term)
@@ -1688,29 +2916,33 @@ int enif_is_map(ErlNifEnv* env, ERL_NIF_TERM term)
int enif_get_map_size(ErlNifEnv* env, ERL_NIF_TERM term, size_t *size)
{
- if (is_map(term)) {
- map_t *mp;
- mp = (map_t*)map_val(term);
- *size = map_get_size(mp);
+ if (is_flatmap(term)) {
+ flatmap_t *mp;
+ mp = (flatmap_t*)flatmap_val(term);
+ *size = flatmap_get_size(mp);
return 1;
}
+ else if (is_hashmap(term)) {
+ *size = hashmap_size(term);
+ return 1;
+ }
return 0;
}
ERL_NIF_TERM enif_make_new_map(ErlNifEnv* env)
{
- Eterm* hp = alloc_heap(env,MAP_HEADER_SIZE+1);
+ Eterm* hp = alloc_heap(env,MAP_HEADER_FLATMAP_SZ+1);
Eterm tup;
- map_t *mp;
+ flatmap_t *mp;
tup = make_tuple(hp);
*hp++ = make_arityval(0);
- mp = (map_t*)hp;
- mp->thing_word = MAP_HEADER;
+ mp = (flatmap_t*)hp;
+ mp->thing_word = MAP_HEADER_FLATMAP;
mp->size = 0;
mp->keys = tup;
- return make_map(mp);
+ return make_flatmap(mp);
}
int enif_make_map_put(ErlNifEnv* env,
@@ -1719,9 +2951,13 @@ int enif_make_map_put(ErlNifEnv* env,
Eterm value,
Eterm *map_out)
{
- if (is_not_map(map_in)) {
+ if (!is_map(map_in)) {
return 0;
}
+ ASSERT_IN_ENV(env, map_in, 0, "old map");
+ ASSERT_IN_ENV(env, key, 0, "key");
+ ASSERT_IN_ENV(env, value, 0, "value");
+
flush_env(env);
*map_out = erts_maps_put(env->proc, key, value, map_in);
cache_env(env);
@@ -1733,10 +2969,16 @@ int enif_get_map_value(ErlNifEnv* env,
Eterm key,
Eterm *value)
{
- if (is_not_map(map)) {
+ const Eterm *ret;
+ if (!is_map(map)) {
return 0;
}
- return erts_maps_get(key, map, value);
+ ret = erts_maps_get(key, map);
+ if (ret) {
+ *value = *ret;
+ return 1;
+ }
+ return 0;
}
int enif_make_map_update(ErlNifEnv* env,
@@ -1746,10 +2988,14 @@ int enif_make_map_update(ErlNifEnv* env,
Eterm *map_out)
{
int res;
- if (is_not_map(map_in)) {
+ if (!is_map(map_in)) {
return 0;
}
+ ASSERT_IN_ENV(env, map_in, 0, "old map");
+ ASSERT_IN_ENV(env, key, 0, "key");
+ ASSERT_IN_ENV(env, value, 0, "value");
+
flush_env(env);
res = erts_maps_update(env->proc, key, value, map_in, map_out);
cache_env(env);
@@ -1761,14 +3007,13 @@ int enif_make_map_remove(ErlNifEnv* env,
Eterm key,
Eterm *map_out)
{
- int res;
- if (is_not_map(map_in)) {
+ if (!is_map(map_in)) {
return 0;
}
flush_env(env);
- res = erts_maps_remove(env->proc, key, map_in, map_out);
+ (void) erts_maps_take(env->proc, key, map_in, map_out, NULL);
cache_env(env);
- return res;
+ return 1;
}
int enif_map_iterator_create(ErlNifEnv *env,
@@ -1776,13 +3021,13 @@ int enif_map_iterator_create(ErlNifEnv *env,
ErlNifMapIterator *iter,
ErlNifMapIteratorEntry entry)
{
- if (is_map(map)) {
- map_t *mp = (map_t*)map_val(map);
+ if (is_flatmap(map)) {
+ flatmap_t *mp = (flatmap_t*)flatmap_val(map);
size_t offset;
switch (entry) {
- case ERL_NIF_MAP_ITERATOR_HEAD: offset = 0; break;
- case ERL_NIF_MAP_ITERATOR_TAIL: offset = map_get_size(mp) - 1; break;
+ case ERL_NIF_MAP_ITERATOR_FIRST: offset = 0; break;
+ case ERL_NIF_MAP_ITERATOR_LAST: offset = flatmap_get_size(mp) - 1; break;
default: goto error;
}
@@ -1791,14 +3036,37 @@ int enif_map_iterator_create(ErlNifEnv *env,
*/
iter->map = map;
- iter->ks = ((Eterm *)map_get_keys(mp)) + offset;
- iter->vs = ((Eterm *)map_get_values(mp)) + offset;
- iter->t_limit = map_get_size(mp) + 1;
+ iter->u.flat.ks = ((Eterm *)flatmap_get_keys(mp)) + offset;
+ iter->u.flat.vs = ((Eterm *)flatmap_get_values(mp)) + offset;
+ iter->size = flatmap_get_size(mp);
iter->idx = offset + 1;
return 1;
}
-
+ else if (is_hashmap(map)) {
+ iter->map = map;
+ iter->size = hashmap_size(map);
+ iter->u.hash.wstack = erts_alloc(ERTS_ALC_T_NIF, sizeof(ErtsDynamicWStack));
+ WSTACK_INIT(iter->u.hash.wstack, ERTS_ALC_T_NIF);
+
+ switch (entry) {
+ case ERL_NIF_MAP_ITERATOR_FIRST:
+ iter->idx = 1;
+ hashmap_iterator_init(&iter->u.hash.wstack->ws, map, 0);
+ iter->u.hash.kv = hashmap_iterator_next(&iter->u.hash.wstack->ws);
+ break;
+ case ERL_NIF_MAP_ITERATOR_LAST:
+ iter->idx = hashmap_size(map);
+ hashmap_iterator_init(&iter->u.hash.wstack->ws, map, 1);
+ iter->u.hash.kv = hashmap_iterator_prev(&iter->u.hash.wstack->ws);
+ break;
+ default:
+ goto error;
+ }
+ ASSERT(!!iter->u.hash.kv == (iter->idx >= 1 &&
+ iter->idx <= iter->size));
+ return 1;
+ }
error:
#ifdef DEBUG
iter->map = THE_NON_VALUE;
@@ -1808,48 +3076,97 @@ error:
void enif_map_iterator_destroy(ErlNifEnv *env, ErlNifMapIterator *iter)
{
- /* not used */
+ if (is_hashmap(iter->map)) {
+ WSTACK_DESTROY(iter->u.hash.wstack->ws);
+ erts_free(ERTS_ALC_T_NIF, iter->u.hash.wstack);
+ }
+ else
+ ASSERT(is_flatmap(iter->map));
+
#ifdef DEBUG
iter->map = THE_NON_VALUE;
#endif
-
}
int enif_map_iterator_is_tail(ErlNifEnv *env, ErlNifMapIterator *iter)
{
- ASSERT(iter && is_map(iter->map));
- ASSERT(iter->idx >= 0 && (iter->idx <= map_get_size(map_val(iter->map)) + 1));
- return (iter->t_limit == 1 || iter->idx == iter->t_limit);
+ ASSERT(iter);
+ if (is_flatmap(iter->map)) {
+ ASSERT(iter->idx >= 0);
+ ASSERT(iter->idx <= flatmap_get_size(flatmap_val(iter->map)) + 1);
+ return (iter->size == 0 || iter->idx > iter->size);
+ }
+ else {
+ ASSERT(is_hashmap(iter->map));
+ return iter->idx > iter->size;
+ }
}
int enif_map_iterator_is_head(ErlNifEnv *env, ErlNifMapIterator *iter)
{
- ASSERT(iter && is_map(iter->map));
- ASSERT(iter->idx >= 0 && (iter->idx <= map_get_size(map_val(iter->map)) + 1));
- return (iter->t_limit == 1 || iter->idx == 0);
+ ASSERT(iter);
+ if (is_flatmap(iter->map)) {
+ ASSERT(iter->idx >= 0);
+ ASSERT(iter->idx <= flatmap_get_size(flatmap_val(iter->map)) + 1);
+ return (iter->size == 0 || iter->idx == 0);
+ }
+ else {
+ ASSERT(is_hashmap(iter->map));
+ return iter->idx == 0;
+ }
}
int enif_map_iterator_next(ErlNifEnv *env, ErlNifMapIterator *iter)
{
- ASSERT(iter && is_map(iter->map));
- if (iter->idx < iter->t_limit) {
- iter->idx++;
- iter->ks++;
- iter->vs++;
+ ASSERT(iter);
+ if (is_flatmap(iter->map)) {
+ if (iter->idx <= iter->size) {
+ iter->idx++;
+ iter->u.flat.ks++;
+ iter->u.flat.vs++;
+ }
+ return (iter->idx <= iter->size);
+ }
+ else {
+ ASSERT(is_hashmap(iter->map));
+
+ if (iter->idx <= hashmap_size(iter->map)) {
+ if (iter->idx < 1) {
+ hashmap_iterator_init(&iter->u.hash.wstack->ws, iter->map, 0);
+ }
+ iter->u.hash.kv = hashmap_iterator_next(&iter->u.hash.wstack->ws);
+ iter->idx++;
+ ASSERT(!!iter->u.hash.kv == (iter->idx <= iter->size));
+ }
+ return iter->idx <= iter->size;
}
- return (iter->idx != iter->t_limit);
}
int enif_map_iterator_prev(ErlNifEnv *env, ErlNifMapIterator *iter)
{
- ASSERT(iter && is_map(iter->map));
- if (iter->idx > 0) {
- iter->idx--;
- iter->ks--;
- iter->vs--;
+ ASSERT(iter);
+ if (is_flatmap(iter->map)) {
+ if (iter->idx > 0) {
+ iter->idx--;
+ iter->u.flat.ks--;
+ iter->u.flat.vs--;
+ }
+ return iter->idx > 0;
+ }
+ else {
+ ASSERT(is_hashmap(iter->map));
+
+ if (iter->idx > 0) {
+ if (iter->idx > iter->size) {
+ hashmap_iterator_init(&iter->u.hash.wstack->ws, iter->map, 1);
+ }
+ iter->u.hash.kv = hashmap_iterator_prev(&iter->u.hash.wstack->ws);
+ iter->idx--;
+ ASSERT(!!iter->u.hash.kv == (iter->idx > 0));
+ }
+ return iter->idx > 0;
}
- return (iter->idx > 0);
}
int enif_map_iterator_get_pair(ErlNifEnv *env,
@@ -1857,35 +3174,552 @@ int enif_map_iterator_get_pair(ErlNifEnv *env,
Eterm *key,
Eterm *value)
{
- ASSERT(iter && is_map(iter->map));
- if (iter->idx > 0 && iter->idx < iter->t_limit) {
- ASSERT(iter->ks >= map_get_keys(map_val(iter->map)) &&
- iter->ks < (map_get_keys(map_val(iter->map)) + map_get_size(map_val(iter->map))));
- ASSERT(iter->vs >= map_get_values(map_val(iter->map)) &&
- iter->vs < (map_get_values(map_val(iter->map)) + map_get_size(map_val(iter->map))));
- *key = *(iter->ks);
- *value = *(iter->vs);
- return 1;
+ ASSERT(iter);
+ if (is_flatmap(iter->map)) {
+ if (iter->idx > 0 && iter->idx <= iter->size) {
+ ASSERT(iter->u.flat.ks >= flatmap_get_keys(flatmap_val(iter->map)) &&
+ iter->u.flat.ks < (flatmap_get_keys(flatmap_val(iter->map)) + flatmap_get_size(flatmap_val(iter->map))));
+ ASSERT(iter->u.flat.vs >= flatmap_get_values(flatmap_val(iter->map)) &&
+ iter->u.flat.vs < (flatmap_get_values(flatmap_val(iter->map)) + flatmap_get_size(flatmap_val(iter->map))));
+ *key = *(iter->u.flat.ks);
+ *value = *(iter->u.flat.vs);
+ return 1;
+ }
+ }
+ else {
+ ASSERT(is_hashmap(iter->map));
+ if (iter->idx > 0 && iter->idx <= iter->size) {
+ *key = CAR(iter->u.hash.kv);
+ *value = CDR(iter->u.hash.kv);
+ return 1;
+ }
+ }
+ return 0;
+}
+
+int enif_monitor_process(ErlNifEnv* env, void* obj, const ErlNifPid* target_pid,
+ ErlNifMonitor* monitor)
+{
+ int scheduler;
+ ErtsResource* rsrc = DATA_TO_RESOURCE(obj);
+ Process *rp;
+ Eterm tmp[ERTS_REF_THING_SIZE];
+ Eterm ref;
+ int retval;
+
+ ASSERT(ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(rsrc)->magic_binary.destructor
+ == NIF_RESOURCE_DTOR);
+ ASSERT(!(rsrc->monitors && rsrc->monitors->is_dying));
+ ASSERT(!rsrc->monitors == !rsrc->type->down);
+
+
+ if (!rsrc->monitors) {
+ ASSERT(!rsrc->type->down);
+ return -1;
+ }
+ ASSERT(rsrc->type->down);
+
+ execution_state(env, NULL, &scheduler);
+
+#ifdef ERTS_SMP
+ if (scheduler > 0) /* Normal scheduler */
+ rp = erts_proc_lookup_raw(target_pid->pid);
+ else
+ rp = erts_proc_lookup_raw_inc_refc(target_pid->pid);
+#else
+ if (scheduler <= 0) {
+ erts_exit(ERTS_ABORT_EXIT, "enif_monitor_process: called from "
+ "non-scheduler thread on non-SMP VM");
+ }
+ rp = erts_proc_lookup(target_pid->pid);
+#endif
+
+ if (!rp)
+ return 1;
+
+ ref = erts_make_ref_in_buffer(tmp);
+
+ erts_smp_mtx_lock(&rsrc->monitors->lock);
+ erts_smp_proc_lock(rp, ERTS_PROC_LOCK_LINK);
+ if (ERTS_PSFLG_FREE & erts_smp_atomic32_read_nob(&rp->state)) {
+ retval = 1;
}
+ else {
+ erts_add_monitor(&rsrc->monitors->root, MON_ORIGIN, ref, rp->common.id, NIL);
+ erts_add_monitor(&ERTS_P_MONITORS(rp), MON_NIF_TARGET, ref, (UWord)rsrc, NIL);
+ retval = 0;
+ }
+ erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
+ erts_smp_mtx_unlock(&rsrc->monitors->lock);
+
+#ifdef ERTS_SMP
+ if (scheduler <= 0)
+ erts_proc_dec_refc(rp);
+#endif
+ if (monitor)
+ erts_ref_to_driver_monitor(ref,monitor);
+
+ return retval;
+}
+
+int enif_demonitor_process(ErlNifEnv* env, void* obj, const ErlNifMonitor* monitor)
+{
+ int scheduler;
+ ErtsResource* rsrc = DATA_TO_RESOURCE(obj);
+#ifdef DEBUG
+ ErtsBinary* bin = ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(rsrc);
+#endif
+ Process *rp;
+ ErtsMonitor *mon;
+ ErtsMonitor *rmon = NULL;
+ Eterm ref_heap[ERTS_REF_THING_SIZE];
+ Eterm ref;
+ int is_exiting;
+
+ ASSERT(bin->magic_binary.destructor == NIF_RESOURCE_DTOR);
+ ASSERT(!(rsrc->monitors && rsrc->monitors->is_dying));
+
+ execution_state(env, NULL, &scheduler);
+
+ ref = erts_driver_monitor_to_ref(ref_heap, monitor);
+
+ erts_smp_mtx_lock(&rsrc->monitors->lock);
+ mon = erts_remove_monitor(&rsrc->monitors->root, ref);
+
+ if (mon == NULL) {
+ erts_smp_mtx_unlock(&rsrc->monitors->lock);
+ return 1;
+ }
+
+ ASSERT(mon->type == MON_ORIGIN);
+ ASSERT(is_internal_pid(mon->u.pid));
+
+#ifdef ERTS_SMP
+ if (scheduler > 0) /* Normal scheduler */
+ rp = erts_proc_lookup(mon->u.pid);
+ else
+ rp = erts_proc_lookup_inc_refc(mon->u.pid);
+#else
+ if (scheduler <= 0) {
+ erts_exit(ERTS_ABORT_EXIT, "enif_demonitor_process: called from "
+ "non-scheduler thread on non-SMP VM");
+ }
+ rp = erts_proc_lookup(mon->u.pid);
+#endif
+
+ if (!rp) {
+ is_exiting = 1;
+ }
+ else {
+ erts_smp_proc_lock(rp, ERTS_PROC_LOCK_LINK);
+ if (ERTS_PROC_IS_EXITING(rp)) {
+ is_exiting = 1;
+ } else {
+ rmon = erts_remove_monitor(&ERTS_P_MONITORS(rp), ref);
+ ASSERT(rmon);
+ is_exiting = 0;
+ }
+ erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
+
+#ifdef ERTS_SMP
+ if (scheduler <= 0)
+ erts_proc_dec_refc(rp);
+#endif
+ }
+ if (is_exiting) {
+ rsrc->monitors->pending_failed_fire++;
+ }
+ erts_smp_mtx_unlock(&rsrc->monitors->lock);
+
+ if (rmon) {
+ ASSERT(rmon->type == MON_NIF_TARGET);
+ ASSERT(rmon->u.resource == rsrc);
+ erts_destroy_monitor(rmon);
+ }
+ erts_destroy_monitor(mon);
+
return 0;
}
+int enif_compare_monitors(const ErlNifMonitor *monitor1,
+ const ErlNifMonitor *monitor2)
+{
+ return sys_memcmp((void *) monitor1, (void *) monitor2,
+ ERTS_REF_THING_SIZE*sizeof(Eterm));
+}
+
+ErlNifIOQueue *enif_ioq_create(ErlNifIOQueueOpts opts)
+{
+ ErlNifIOQueue *q;
+
+ if (opts != ERL_NIF_IOQ_NORMAL)
+ return NULL;
+
+ q = enif_alloc(sizeof(ErlNifIOQueue));
+ if (!q) return NULL;
+ erts_ioq_init(q, ERTS_ALC_T_NIF, 0);
+
+ return q;
+}
+
+void enif_ioq_destroy(ErlNifIOQueue *q)
+{
+ erts_ioq_clear(q);
+ enif_free(q);
+}
+
+/* If the iovec was preallocated (Stack or otherwise) it needs to be marked as
+ * such to perform a proper free. */
+#define ERL_NIF_IOVEC_FLAGS_PREALLOC (1 << 0)
+
+void enif_free_iovec(ErlNifIOVec *iov)
+{
+ int i;
+ /* Decrement the refc of all the binaries */
+ for (i = 0; i < iov->iovcnt; i++) {
+ Binary *bptr = ((Binary**)iov->ref_bins)[i];
+ /* bptr can be null if enq_binary was used */
+ if (bptr && erts_refc_dectest(&bptr->intern.refc, 0) == 0) {
+ erts_bin_free(bptr);
+ }
+ }
+
+ if (!(iov->flags & ERL_NIF_IOVEC_FLAGS_PREALLOC)) {
+ enif_free(iov);
+ }
+}
+
+typedef struct {
+ UWord sublist_length;
+ Eterm sublist_start;
+ Eterm sublist_end;
+
+ UWord offheap_size;
+ UWord onheap_size;
+
+ UWord iovec_len;
+} iovec_slice_t;
+
+static int examine_iovec_term(Eterm list, UWord max_length, iovec_slice_t *result) {
+ Eterm lookahead;
+
+ result->sublist_start = list;
+ result->sublist_length = 0;
+ result->offheap_size = 0;
+ result->onheap_size = 0;
+ result->iovec_len = 0;
+
+ lookahead = result->sublist_start;
+
+ while (is_list(lookahead)) {
+ Eterm *binary_header, binary;
+ Eterm *cell;
+ UWord size;
+
+ cell = list_val(lookahead);
+ binary = CAR(cell);
+
+ if (!is_binary(binary)) {
+ return 0;
+ }
+
+ size = binary_size(binary);
+ binary_header = binary_val(binary);
+
+ /* If we're a sub-binary we'll need to check our underlying binary to
+ * determine whether we're on-heap or not. */
+ if(thing_subtag(*binary_header) == SUB_BINARY_SUBTAG) {
+ ErlSubBin *sb = (ErlSubBin*)binary_header;
+
+ /* Reject bitstrings */
+ if((sb->bitoffs + sb->bitsize) > 0) {
+ return 0;
+ }
+
+ ASSERT(size <= binary_size(sb->orig));
+ binary_header = binary_val(sb->orig);
+ }
+
+ if(thing_subtag(*binary_header) == HEAP_BINARY_SUBTAG) {
+ ASSERT(size <= ERL_ONHEAP_BIN_LIMIT);
+
+ result->iovec_len += 1;
+ result->onheap_size += size;
+ } else {
+ ASSERT(thing_subtag(*binary_header) == REFC_BINARY_SUBTAG);
+
+ result->iovec_len += 1 + size / MAX_SYSIOVEC_IOVLEN;
+ result->offheap_size += size;
+ }
+
+ result->sublist_length += 1;
+ lookahead = CDR(cell);
+
+ if(result->sublist_length >= max_length) {
+ break;
+ }
+ }
+
+ if (!is_nil(lookahead) && !is_list(lookahead)) {
+ return 0;
+ }
+
+ result->sublist_end = lookahead;
+
+ return 1;
+}
+
+static void inspect_raw_binary_data(Eterm binary, ErlNifBinary *result) {
+ Eterm *parent_header;
+ Eterm parent_binary;
+
+ int bit_offset, bit_size;
+ Uint byte_offset;
+
+ ASSERT(is_binary(binary));
+
+ ERTS_GET_REAL_BIN(binary, parent_binary, byte_offset, bit_offset, bit_size);
+
+ parent_header = binary_val(parent_binary);
+
+ result->size = binary_size(binary);
+ result->bin_term = binary;
+
+ if (thing_subtag(*parent_header) == REFC_BINARY_SUBTAG) {
+ ProcBin *pb = (ProcBin*)parent_header;
+
+ ASSERT(pb->val != NULL);
+ ASSERT(byte_offset < pb->size);
+ ASSERT(&pb->bytes[byte_offset] >= (byte*)(pb->val)->orig_bytes);
+
+ result->data = (unsigned char*)&pb->bytes[byte_offset];
+ result->ref_bin = (void*)pb->val;
+ } else {
+ ErlHeapBin *hb = (ErlHeapBin*)parent_header;
+
+ ASSERT(thing_subtag(*parent_header) == HEAP_BINARY_SUBTAG);
+
+ result->data = &((unsigned char*)&hb->data)[byte_offset];
+ result->ref_bin = NULL;
+ }
+}
+
+static int fill_iovec_with_slice(ErlNifEnv *env,
+ iovec_slice_t *slice,
+ ErlNifIOVec *iovec) {
+ UWord onheap_offset, iovec_idx;
+ ErlNifBinary onheap_data;
+ Eterm sublist_iterator;
+
+ /* Set up a common refc binary for all on-heap binaries. */
+ if (slice->onheap_size > 0) {
+ if (!enif_alloc_binary(slice->onheap_size, &onheap_data)) {
+ return 0;
+ }
+ }
+
+ sublist_iterator = slice->sublist_start;
+ onheap_offset = 0;
+ iovec_idx = 0;
+
+ while (sublist_iterator != slice->sublist_end) {
+ ErlNifBinary raw_data;
+ Eterm *cell;
+
+ cell = list_val(sublist_iterator);
+ inspect_raw_binary_data(CAR(cell), &raw_data);
+
+ /* If this isn't a refc binary, copy its contents to the onheap buffer
+ * and reference that instead. */
+ if (raw_data.ref_bin == NULL) {
+ ASSERT(onheap_offset < onheap_data.size);
+ ASSERT(slice->onheap_size > 0);
+
+ sys_memcpy(&onheap_data.data[onheap_offset],
+ raw_data.data, raw_data.size);
+
+ raw_data.data = &onheap_data.data[onheap_offset];
+ raw_data.ref_bin = onheap_data.ref_bin;
+ }
+
+ ASSERT(raw_data.ref_bin != NULL);
+
+ while (raw_data.size > 0) {
+ UWord chunk_len = MIN(raw_data.size, MAX_SYSIOVEC_IOVLEN);
+
+ ASSERT(iovec_idx < iovec->iovcnt);
+
+ iovec->iov[iovec_idx].iov_base = raw_data.data;
+ iovec->iov[iovec_idx].iov_len = chunk_len;
+
+ iovec->ref_bins[iovec_idx] = raw_data.ref_bin;
+
+ raw_data.data += chunk_len;
+ raw_data.size -= chunk_len;
+
+ iovec_idx += 1;
+ }
+
+ sublist_iterator = CDR(cell);
+ }
+
+ ASSERT(iovec_idx == iovec->iovcnt);
+
+ if (env == NULL) {
+ int i;
+ for (i = 0; i < iovec->iovcnt; i++) {
+ Binary *refc_binary = (Binary*)(iovec->ref_bins[i]);
+ erts_refc_inc(&refc_binary->intern.refc, 1);
+ }
+
+ if (slice->onheap_size > 0) {
+ /* Transfer ownership to the iovec; we've taken references to it in
+ * the above loop. */
+ enif_release_binary(&onheap_data);
+ }
+ } else {
+ if (slice->onheap_size > 0) {
+ /* Attach the binary to our environment and let the GC take care of
+ * it after returning. */
+ enif_make_binary(env, &onheap_data);
+ }
+ }
+
+ return 1;
+}
+
+static int create_iovec_from_slice(ErlNifEnv *env,
+ iovec_slice_t *slice,
+ ErlNifIOVec **result) {
+ ErlNifIOVec *iovec = *result;
+
+ if (iovec && slice->iovec_len < ERL_NIF_IOVEC_SIZE) {
+ iovec->iov = iovec->small_iov;
+ iovec->ref_bins = iovec->small_ref_bin;
+ iovec->flags = ERL_NIF_IOVEC_FLAGS_PREALLOC;
+ } else {
+ UWord iov_offset, binv_offset, alloc_size;
+ char *alloc_base;
+
+ iov_offset = ERTS_ALC_DATA_ALIGN_SIZE(sizeof(ErlNifIOVec));
+ binv_offset = iov_offset;
+ binv_offset += ERTS_ALC_DATA_ALIGN_SIZE(slice->iovec_len * sizeof(SysIOVec));
+ alloc_size = binv_offset;
+ alloc_size += slice->iovec_len * sizeof(Binary*);
+
+ /* If we have an environment we'll attach the allocated data to it. The
+ * GC will take care of releasing it later on. */
+ if (env != NULL) {
+ ErlNifBinary gc_bin;
+
+ if (!enif_alloc_binary(alloc_size, &gc_bin)) {
+ return 0;
+ }
+
+ alloc_base = (char*)gc_bin.data;
+ enif_make_binary(env, &gc_bin);
+ } else {
+ alloc_base = enif_alloc(alloc_size);
+ }
+
+ iovec = (ErlNifIOVec*)alloc_base;
+ iovec->iov = (SysIOVec*)(alloc_base + iov_offset);
+ iovec->ref_bins = (void**)(alloc_base + binv_offset);
+ iovec->flags = 0;
+ }
+
+ iovec->size = slice->offheap_size + slice->onheap_size;
+ iovec->iovcnt = slice->iovec_len;
+
+ if(!fill_iovec_with_slice(env, slice, iovec)) {
+ if (env == NULL && !(iovec->flags & ERL_NIF_IOVEC_FLAGS_PREALLOC)) {
+ enif_free(iovec);
+ }
+
+ return 0;
+ }
+
+ *result = iovec;
+
+ return 1;
+}
+
+int enif_inspect_iovec(ErlNifEnv *env, size_t max_elements,
+ ERL_NIF_TERM list, ERL_NIF_TERM *tail,
+ ErlNifIOVec **iov) {
+ iovec_slice_t slice;
+
+ if(!examine_iovec_term(list, max_elements, &slice)) {
+ return 0;
+ } else if(!create_iovec_from_slice(env, &slice, iov)) {
+ return 0;
+ }
+
+ (*tail) = slice.sublist_end;
+
+ return 1;
+}
+
+/* */
+int enif_ioq_enqv(ErlNifIOQueue *q, ErlNifIOVec *iov, size_t skip)
+{
+ if(skip <= iov->size) {
+ return !erts_ioq_enqv(q, (ErtsIOVec*)iov, skip);
+ }
+
+ return 0;
+}
+
+int enif_ioq_enq_binary(ErlNifIOQueue *q, ErlNifBinary *bin, size_t skip)
+{
+ ErlNifIOVec vec = {1, bin->size, NULL, NULL, ERL_NIF_IOVEC_FLAGS_PREALLOC };
+ Binary *ref_bin = (Binary*)bin->ref_bin;
+ int res;
+ vec.iov = vec.small_iov;
+ vec.ref_bins = vec.small_ref_bin;
+ vec.iov[0].iov_base = bin->data;
+ vec.iov[0].iov_len = bin->size;
+ ((Binary**)(vec.ref_bins))[0] = ref_bin;
+
+ res = enif_ioq_enqv(q, &vec, skip);
+ enif_release_binary(bin);
+ return res;
+}
+
+size_t enif_ioq_size(ErlNifIOQueue *q)
+{
+ return erts_ioq_size(q);
+}
+
+int enif_ioq_deq(ErlNifIOQueue *q, size_t elems, size_t *size)
+{
+ if (erts_ioq_deq(q, elems) == -1)
+ return 0;
+ if (size)
+ *size = erts_ioq_size(q);
+ return 1;
+}
+
+SysIOVec *enif_ioq_peek(ErlNifIOQueue *q, int *iovlen)
+{
+ return erts_ioq_peekq(q, iovlen);
+}
+
/***************************************************************************
** load_nif/2 **
***************************************************************************/
-static BeamInstr** get_func_pp(BeamInstr* mod_code, Eterm f_atom, unsigned arity)
+static ErtsCodeInfo** 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];
- 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];
+ ErtsCodeInfo* ci = mod_code->functions[j];
+ ASSERT(ci->op == (BeamInstr) BeamOp(op_i_func_info_IaaI));
+ if (f_atom == ci->mfa.function
+ && arity == ci->mfa.arity) {
+ return mod_code->functions+j;
}
}
return NULL;
@@ -1935,16 +3769,16 @@ Eterm erts_nif_taints(Process* p)
return list;
}
-void erts_print_nif_taints(int to, void* to_arg)
+void erts_print_nif_taints(fmtfn_t to, void* to_arg)
{
struct tainted_module_t* t;
const char* delim = "";
for (t=first_tainted_module ; t!=NULL; t=t->next) {
const Atom* atom = atom_tab(atom_val(t->module_atom));
- erts_print(to,to_arg,"%s%.*s", delim, atom->len, atom->name);
+ erts_cbprintf(to,to_arg,"%s%.*s", delim, atom->len, atom->name);
delim = ",";
}
- erts_print(to,to_arg,"\n");
+ erts_cbprintf(to,to_arg,"\n");
}
@@ -1977,10 +3811,62 @@ static Eterm load_nif_error(Process* p, const char* atom, const char* format, ..
return ret;
}
+#define AT_LEAST_VERSION(E,MAJ,MIN) \
+ (((E)->major * 0x100 + (E)->minor) >= ((MAJ) * 0x100 + (MIN)))
+
+/*
+ * Allocate erl_module_nif and make a _modern_ copy of the lib entry.
+ */
+static struct erl_module_nif* create_lib(const ErlNifEntry* src)
+{
+ struct erl_module_nif* lib;
+ ErlNifEntry* dst;
+ Uint bytes = offsetof(struct erl_module_nif, _funcs_copy_);
+
+ if (!AT_LEAST_VERSION(src, 2, 7))
+ bytes += src->num_of_funcs * sizeof(ErlNifFunc);
+
+ lib = erts_alloc(ERTS_ALC_T_NIF, bytes);
+ dst = &lib->entry;
+
+ sys_memcpy(dst, src, offsetof(ErlNifEntry, vm_variant));
+
+ if (AT_LEAST_VERSION(src, 2, 1)) {
+ dst->vm_variant = src->vm_variant;
+ } else {
+ dst->vm_variant = "beam.vanilla";
+ }
+ if (AT_LEAST_VERSION(src, 2, 7)) {
+ dst->options = src->options;
+ } else {
+ /*
+ * Make a modern copy of the ErlNifFunc array
+ */
+ struct ErlNifFunc_V1 {
+ const char* name;
+ unsigned arity;
+ ERL_NIF_TERM (*fptr)(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+ }*src_funcs = (struct ErlNifFunc_V1*) src->funcs;
+ int i;
+ for (i = 0; i < src->num_of_funcs; ++i) {
+ sys_memcpy(&lib->_funcs_copy_[i], &src_funcs[i], sizeof(*src_funcs));
+ lib->_funcs_copy_[i].flags = 0;
+ }
+ dst->funcs = lib->_funcs_copy_;
+ dst->options = 0;
+ }
+ if (AT_LEAST_VERSION(src, 2, 12)) {
+ dst->sizeof_ErlNifResourceTypeInit = src->sizeof_ErlNifResourceTypeInit;
+ } else {
+ dst->sizeof_ErlNifResourceTypeInit = 0;
+ }
+ return lib;
+};
+
+
BIF_RETTYPE load_nif_2(BIF_ALIST_2)
{
static const char bad_lib[] = "bad_lib";
- static const char reload[] = "reload";
static const char upgrade[] = "upgrade";
char* lib_name = NULL;
void* handle = NULL;
@@ -1988,16 +3874,23 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2)
ErlNifEntry* entry = NULL;
ErlNifEnv env;
int i, err, encoding;
- Module* mod;
+ Module* module_p;
Eterm mod_atom;
const Atom* mod_atomp;
Eterm f_atom;
- BeamInstr* caller;
+ ErtsCodeMFA* caller;
ErtsSysDdllError errdesc = ERTS_SYS_DDLL_ERROR_INIT;
Eterm ret = am_ok;
int veto;
struct erl_module_nif* lib = NULL;
- int reload_warning = 0;
+ struct erl_module_instance* this_mi;
+ struct erl_module_instance* prev_mi;
+
+ if (BIF_P->flags & F_HIPE_MODE) {
+ ret = load_nif_error(BIF_P, "notsup", "Calling load_nif from HiPE compiled "
+ "modules not supported");
+ BIF_RET(ret);
+ }
encoding = erts_get_native_filename_encoding();
if (encoding == ERL_FILENAME_WIN_WCHAR) {
@@ -2024,29 +3917,43 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2)
/* Find calling module */
ASSERT(BIF_P->current != NULL);
- ASSERT(BIF_P->current[0] == am_erlang
- && BIF_P->current[1] == am_load_nif
- && BIF_P->current[2] == 2);
+ ASSERT(BIF_P->current->module == am_erlang
+ && BIF_P->current->function == am_load_nif
+ && BIF_P->current->arity == 2);
caller = find_function_from_pc(BIF_P->cp);
ASSERT(caller != NULL);
- mod_atom = caller[0];
+ mod_atom = caller->module;
ASSERT(is_atom(mod_atom));
- mod=erts_get_module(mod_atom, erts_active_code_ix());
- ASSERT(mod != NULL);
+ module_p = erts_get_module(mod_atom, erts_active_code_ix());
+ ASSERT(module_p != NULL);
mod_atomp = atom_tab(atom_val(mod_atom));
init_func = erts_static_nif_get_nif_init((char*)mod_atomp->name, mod_atomp->len);
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));
-
+ this_mi = &module_p->curr;
+ prev_mi = &module_p->old;
+ if (in_area(caller, module_p->old.code_hdr, module_p->old.code_length)) {
ret = load_nif_error(BIF_P, "old_code", "Calling load_nif from old "
"module '%T' not allowed", mod_atom);
- }
+ goto error;
+ } else if (module_p->on_load) {
+ ASSERT(module_p->on_load->code_hdr->on_load_function_ptr);
+ if (module_p->curr.code_hdr) {
+ prev_mi = &module_p->curr;
+ } else {
+ prev_mi = &module_p->old;
+ }
+ this_mi = module_p->on_load;
+ }
+
+ if (this_mi->nif != NULL) {
+ ret = load_nif_error(BIF_P,"reload","NIF library already loaded"
+ " (reload disallowed since OTP 20).");
+ }
else if (init_func == NULL &&
- (err=erts_sys_ddll_open(lib_name, &handle, &errdesc)) != ERL_DE_NO_ERROR) {
+ (err=erts_sys_ddll_open(lib_name, &handle, &errdesc)) != ERL_DE_NO_ERROR) {
const char slogan[] = "Failed to load NIF library";
if (strstr(errdesc.str, lib_name) != NULL) {
ret = load_nif_error(BIF_P, "load_failed", "%s: '%s'", slogan, errdesc.str);
@@ -2074,7 +3981,7 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2)
ret = load_nif_error(BIF_P, bad_lib, "Library version (%d.%d) not compatible (with %d.%d).",
entry->major, entry->minor, ERL_NIF_MAJOR_VERSION, ERL_NIF_MINOR_VERSION);
}
- else if (entry->minor >= 1
+ else if (AT_LEAST_VERSION(entry, 2, 1)
&& sys_strcmp(entry->vm_variant, ERL_NIF_VM_VARIANT) != 0) {
ret = load_nif_error(BIF_P, bad_lib, "Library (%s) not compiled for "
"this vm variant (%s).",
@@ -2085,23 +3992,50 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2)
" match calling module '%T'", entry->name, mod_atom);
}
else {
- /*erts_fprintf(stderr, "Found module %T\r\n", mod_atom);*/
-
- for (i=0; i < entry->num_of_funcs && ret==am_ok; i++) {
- BeamInstr** code_pp;
- ErlNifFunc* f = &entry->funcs[i];
+ lib = create_lib(entry);
+ entry = &lib->entry; /* Use a guaranteed modern lib entry from now on */
+
+ lib->handle = handle;
+ erts_refc_init(&lib->rt_cnt, 0);
+ erts_refc_init(&lib->rt_dtor_cnt, 0);
+ ASSERT(opened_rt_list == NULL);
+ lib->mod = module_p;
+
+ for (i=0; i < entry->num_of_funcs && ret==am_ok; i++) {
+ ErtsCodeInfo** ci_pp;
+ ErlNifFunc* f = &entry->funcs[i];
+
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) {
+ || (ci_pp = get_func_pp(this_mi->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);
- }
- else if (code_pp[1] - code_pp[0] < (5+3)) {
+ }
+ else if (f->flags) {
+ /*
+ * If the flags field is non-zero and this emulator was
+ * built with dirty scheduler support, check that the flags
+ * value is legal. But if this emulator was built without
+ * dirty scheduler support, treat a non-zero flags field as
+ * a load error.
+ */
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (f->flags != ERL_NIF_DIRTY_JOB_IO_BOUND && f->flags != ERL_NIF_DIRTY_JOB_CPU_BOUND)
+ ret = load_nif_error(BIF_P, bad_lib, "Illegal flags field value %d for NIF %T:%s/%u",
+ f->flags, mod_atom, f->name, f->arity);
+#else
+ ret = load_nif_error(BIF_P, bad_lib, "NIF %T:%s/%u requires a runtime with dirty scheduler support.",
+ mod_atom, f->name, f->arity);
+#endif
+ }
+ else if (erts_codeinfo_to_code(ci_pp[1]) - erts_codeinfo_to_code(ci_pp[0])
+ < BEAM_NIF_MIN_FUNC_SZ)
+ {
ret = load_nif_error(BIF_P,bad_lib,"No explicit call to load_nif"
- " in module (%T:%s/%u to small)",
- mod_atom, entry->funcs[i].name, entry->funcs[i].arity);
+ " in module (%T:%s/%u too small)",
+ mod_atom, f->name, f->arity);
}
/*erts_fprintf(stderr, "Found NIF %T:%s/%u\r\n",
- mod_atom, entry->funcs[i].name, entry->funcs[i].arity);*/
+ mod_atom, f->name, f->arity);*/
}
}
@@ -2109,112 +4043,72 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2)
goto error;
}
- /* Call load, reload or upgrade:
+ /* Call load or upgrade:
*/
-
- lib = erts_alloc(ERTS_ALC_T_NIF, sizeof(struct erl_module_nif));
- lib->handle = handle;
- lib->entry = entry;
- erts_refc_init(&lib->rt_cnt, 0);
- erts_refc_init(&lib->rt_dtor_cnt, 0);
- ASSERT(opened_rt_list == NULL);
- lib->mod = mod;
env.mod_nif = lib;
- if (mod->curr.nif != NULL) { /*************** Reload ******************/
- /*
- * Repeated load_nif calls from same Erlang module instance ("reload")
- * is deprecated and was only ment as a development feature not to
- * be used in production systems. (See warning below)
- */
- int k;
- lib->priv_data = mod->curr.nif->priv_data;
- ASSERT(mod->curr.nif->entry != NULL);
- if (entry->reload == NULL) {
- ret = load_nif_error(BIF_P,reload,"Reload not supported by this NIF library.");
- goto error;
- }
- /* Check that no NIF is removed */
- for (k=0; k < mod->curr.nif->entry->num_of_funcs; k++) {
- ErlNifFunc* old_func = &mod->curr.nif->entry->funcs[k];
- for (i=0; i < entry->num_of_funcs; i++) {
- if (old_func->arity == entry->funcs[i].arity
- && sys_strcmp(old_func->name, entry->funcs[i].name) == 0) {
- break;
- }
- }
- if (i == entry->num_of_funcs) {
- ret = load_nif_error(BIF_P,reload,"Reloaded library missing "
- "function %T:%s/%u\r\n", mod_atom,
- old_func->name, old_func->arity);
- goto error;
- }
- }
- erts_pre_nif(&env, BIF_P, lib);
- veto = entry->reload(&env, &lib->priv_data, BIF_ARG_2);
- erts_post_nif(&env);
- if (veto) {
- ret = load_nif_error(BIF_P, reload, "Library reload-call unsuccessful.");
- }
- else {
- commit_opened_resource_types(lib);
- mod->curr.nif->entry = NULL; /* to prevent 'unload' callback */
- erts_unload_nif(mod->curr.nif);
- reload_warning = 1;
- }
+ lib->priv_data = NULL;
+ if (prev_mi->nif != NULL) { /**************** Upgrade ***************/
+ void* prev_old_data = prev_mi->nif->priv_data;
+ if (entry->upgrade == NULL) {
+ ret = load_nif_error(BIF_P, upgrade, "Upgrade not supported by this NIF library.");
+ goto error;
+ }
+ erts_pre_nif(&env, BIF_P, lib, NULL);
+ veto = entry->upgrade(&env, &lib->priv_data, &prev_mi->nif->priv_data, BIF_ARG_2);
+ erts_post_nif(&env);
+ if (veto) {
+ prev_mi->nif->priv_data = prev_old_data;
+ ret = load_nif_error(BIF_P, upgrade, "Library upgrade-call unsuccessful (%d).", veto);
+ }
}
- else {
- lib->priv_data = NULL;
- if (mod->old.nif != NULL) { /**************** Upgrade ***************/
- void* prev_old_data = mod->old.nif->priv_data;
- if (entry->upgrade == NULL) {
- ret = load_nif_error(BIF_P, upgrade, "Upgrade not supported by this NIF library.");
- goto error;
- }
- erts_pre_nif(&env, BIF_P, lib);
- veto = entry->upgrade(&env, &lib->priv_data, &mod->old.nif->priv_data, BIF_ARG_2);
- erts_post_nif(&env);
- if (veto) {
- mod->old.nif->priv_data = prev_old_data;
- ret = load_nif_error(BIF_P, upgrade, "Library upgrade-call unsuccessful.");
- }
- else
- commit_opened_resource_types(lib);
- }
- else if (entry->load != NULL) { /********* Initial load ***********/
- erts_pre_nif(&env, BIF_P, lib);
- veto = entry->load(&env, &lib->priv_data, BIF_ARG_2);
- erts_post_nif(&env);
- if (veto) {
- ret = load_nif_error(BIF_P, "load", "Library load-call unsuccessful.");
- }
- else
- commit_opened_resource_types(lib);
- }
+ else if (entry->load != NULL) { /********* Initial load ***********/
+ erts_pre_nif(&env, BIF_P, lib, NULL);
+ veto = entry->load(&env, &lib->priv_data, BIF_ARG_2);
+ erts_post_nif(&env);
+ if (veto) {
+ ret = load_nif_error(BIF_P, "load", "Library load-call unsuccessful (%d).", veto);
+ }
}
if (ret == am_ok) {
+ commit_opened_resource_types(lib);
+
/*
** Everything ok, patch the beam code with op_call_nif
*/
- mod->curr.nif = lib;
+
+ this_mi->nif = lib;
for (i=0; i < entry->num_of_funcs; i++)
{
- BeamInstr* code_ptr;
- erts_atom_get(entry->funcs[i].name, sys_strlen(entry->funcs[i].name), &f_atom, ERTS_ATOM_ENC_LATIN1);
- code_ptr = *get_func_pp(mod->curr.code, f_atom, entry->funcs[i].arity);
-
- if (code_ptr[1] == 0) {
- code_ptr[5+0] = (BeamInstr) BeamOp(op_call_nif);
+ ErlNifFunc* f = &entry->funcs[i];
+ ErtsCodeInfo* ci;
+ BeamInstr *code_ptr;
+
+ erts_atom_get(f->name, sys_strlen(f->name), &f_atom, ERTS_ATOM_ENC_LATIN1);
+ ci = *get_func_pp(this_mi->code_hdr, f_atom, f->arity);
+ code_ptr = erts_codeinfo_to_code(ci);
+
+ if (ci->u.gen_bp == NULL) {
+ code_ptr[0] = (BeamInstr) BeamOp(op_call_nif);
}
else { /* Function traced, patch the original instruction word */
- GenericBp* g = (GenericBp *) code_ptr[1];
- ASSERT(code_ptr[5+0] ==
+ GenericBp* g = ci->u.gen_bp;
+ ASSERT(code_ptr[0] ==
(BeamInstr) BeamOp(op_i_generic_breakpoint));
- g->orig_instr = (BeamInstr) BeamOp(op_call_nif);
- }
- code_ptr[5+1] = (BeamInstr) entry->funcs[i].fptr;
- code_ptr[5+2] = (BeamInstr) lib;
+ g->orig_instr = (BeamInstr) BeamOp(op_call_nif);
+ }
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (f->flags) {
+ code_ptr[3] = (BeamInstr) f->fptr;
+ code_ptr[1] = (f->flags == ERL_NIF_DIRTY_JOB_IO_BOUND) ?
+ (BeamInstr) static_schedule_dirty_io_nif :
+ (BeamInstr) static_schedule_dirty_cpu_nif;
+ }
+ else
+#endif
+ code_ptr[1] = (BeamInstr) f->fptr;
+ code_ptr[2] = (BeamInstr) lib;
}
}
else {
@@ -2235,14 +4129,6 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2)
erts_release_code_write_permission();
erts_free(ERTS_ALC_T_TMP, lib_name);
- if (reload_warning) {
- erts_dsprintf_buf_t* dsbufp = erts_create_logger_dsbuf();
- erts_dsprintf(dsbufp,
- "Repeated calls to erlang:load_nif from module '%T'.\n\n"
- "The NIF reload mechanism is deprecated and must not "
- "be used in production systems.\n", mod_atom);
- erts_send_warning_to_logger(BIF_P->group_leader, dsbufp);
- }
BIF_RET(ret);
}
@@ -2255,6 +4141,9 @@ erts_unload_nif(struct erl_module_nif* lib)
ASSERT(erts_smp_thr_progress_is_blocking());
ASSERT(lib != NULL);
ASSERT(lib->mod != NULL);
+
+ erts_tracer_nif_clear();
+
for (rt = resource_type_list.next;
rt != &resource_type_list;
rt = next) {
@@ -2289,12 +4178,93 @@ erts_unload_nif(struct erl_module_nif* lib)
void erl_nif_init()
{
+ ERTS_CT_ASSERT((offsetof(ErtsResource,data) % 8)
+ == ERTS_MAGIC_BIN_BYTES_TO_ALIGN);
+
resource_type_list.next = &resource_type_list;
resource_type_list.prev = &resource_type_list;
resource_type_list.dtor = NULL;
resource_type_list.owner = NULL;
resource_type_list.module = THE_NON_VALUE;
resource_type_list.name = THE_NON_VALUE;
+
+}
+
+int erts_nif_get_funcs(struct erl_module_nif* mod,
+ ErlNifFunc **funcs)
+{
+ *funcs = mod->entry.funcs;
+ return mod->entry.num_of_funcs;
+}
+
+Eterm erts_nif_call_function(Process *p, Process *tracee,
+ struct erl_module_nif* mod,
+ ErlNifFunc *fun, int argc, Eterm *argv)
+{
+ Eterm nif_result;
+#ifdef DEBUG
+ /* Verify that function is part of this module */
+ int i;
+ for (i = 0; i < mod->entry.num_of_funcs; i++)
+ if (fun == &(mod->entry.funcs[i]))
+ break;
+ ASSERT(i < mod->entry.num_of_funcs);
+ if (p)
+ ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(p) & ERTS_PROC_LOCK_MAIN
+ || erts_smp_thr_progress_is_blocking());
+#endif
+ if (p) {
+ /* This is almost a normal nif call like in beam_emu,
+ except that any heap consumed by the nif will be
+ released without checking if anything in it is live.
+ This is because we cannot do a GC here as we don't know
+ the number of live registers that have to be preserved.
+ This means that any heap part of the returned term may
+ not be used outside this function. */
+ struct enif_environment_t env;
+ ErlHeapFragment *orig_hf = MBUF(p);
+ ErlOffHeap orig_oh = MSO(p);
+ Eterm *orig_htop = HEAP_TOP(p);
+ ASSERT(is_internal_pid(p->common.id));
+ MBUF(p) = NULL;
+ clear_offheap(&MSO(p));
+
+ erts_pre_nif(&env, p, mod, tracee);
+#ifdef ERTS_NIF_ASSERT_IN_ENV
+ env.dbg_disable_assert_in_env = 1;
+#endif
+ nif_result = (*fun->fptr)(&env, argc, argv);
+ if (env.exception_thrown)
+ nif_result = THE_NON_VALUE;
+ erts_post_nif(&env);
+
+ /* Free any offheap and heap fragments created in nif */
+ if (MSO(p).first) {
+ erts_cleanup_offheap(&MSO(p));
+ clear_offheap(&MSO(p));
+ }
+ if (MBUF(p))
+ free_message_buffer(MBUF(p));
+
+ /* restore original heap fragment list */
+ MBUF(p) = orig_hf;
+ MSO(p) = orig_oh;
+ HEAP_TOP(p) = orig_htop;
+ } else {
+ /* Nif call was done without a process context,
+ so we create a phony one. */
+ struct enif_msg_environment_t msg_env;
+ pre_nif_noproc(&msg_env, mod, tracee);
+#ifdef ERTS_NIF_ASSERT_IN_ENV
+ msg_env.env.dbg_disable_assert_in_env = 1;
+#endif
+ nif_result = (*fun->fptr)(&msg_env.env, argc, argv);
+ if (msg_env.env.exception_thrown)
+ nif_result = THE_NON_VALUE;
+ post_nif_noproc(&msg_env);
+ }
+
+ return nif_result;
}
#ifdef USE_VM_PROBES
@@ -2352,6 +4322,55 @@ static unsigned calc_checksum(unsigned char* ptr, unsigned size)
#endif /* READONLY_CHECK */
+#ifdef ERTS_NIF_ASSERT_IN_ENV
+static void dbg_assert_in_env(ErlNifEnv* env, Eterm term,
+ int nr, const char* type, const char* func)
+{
+ Uint saved_used_size;
+ Eterm* real_htop;
+
+ if (is_immed(term)
+ || (is_non_value(term) && env->exception_thrown)
+ || erts_is_literal(term, ptr_val(term)))
+ return;
+
+ if (env->dbg_disable_assert_in_env) {
+ /*
+ * Trace nifs may cheat as built terms are discarded after return.
+ * ToDo: Check if 'term' is part of argv[].
+ */
+ return;
+ }
+
+ if (env->heap_frag) {
+ ASSERT(env->heap_frag == MBUF(env->proc));
+ ASSERT(env->hp >= env->heap_frag->mem);
+ ASSERT(env->hp <= env->heap_frag->mem + env->heap_frag->alloc_size);
+ saved_used_size = env->heap_frag->used_size;
+ env->heap_frag->used_size = env->hp - env->heap_frag->mem;
+ real_htop = NULL;
+ }
+ else {
+ real_htop = env->hp;
+ }
+ if (!erts_dbg_within_proc(ptr_val(term), env->proc, real_htop)) {
+ fprintf(stderr, "\r\nFAILED ASSERTION in %s:\r\n", func);
+ if (nr) {
+ fprintf(stderr, "Term #%d of the %s is not from same ErlNifEnv.",
+ nr, type);
+ }
+ else {
+ fprintf(stderr, "The %s is not from the same ErlNifEnv.", type);
+ }
+ fprintf(stderr, "\r\nABORTING\r\n");
+ abort();
+ }
+ if (env->heap_frag) {
+ env->heap_frag->used_size = saved_used_size;
+ }
+}
+#endif
+
#ifdef HAVE_USE_DTRACE
#define MESSAGE_BUFSIZ 1024
diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h
index 5b93c2398e..d195721054 100644
--- a/erts/emulator/beam/erl_nif.h
+++ b/erts/emulator/beam/erl_nif.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2009-2014. All Rights Reserved.
+ * Copyright Ericsson AB 2009-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -27,7 +28,6 @@
# include "config.h"
#endif
-#include "erl_native_features_config.h"
#include "erl_drv_nif.h"
/* Version history:
@@ -42,9 +42,18 @@
** 2.5: R17 Maps API additions
** 2.6: R17 with maps
** R17 dirty schedulers
+** 2.7: 17.3 add enif_schedule_nif
+** remove enif_schedule_dirty_nif, enif_schedule_dirty_nif_finalizer, enif_dirty_nif_finalizer
+** 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
+** 2.11: 19.0 enif_snprintf
+** 2.12: 20.0 add enif_queue
*/
#define ERL_NIF_MAJOR_VERSION 2
-#define ERL_NIF_MINOR_VERSION 6
+#define ERL_NIF_MINOR_VERSION 12
/*
* The emulator will refuse to load a nif-lib with a major version
@@ -60,73 +69,43 @@
#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;
-typedef struct
+typedef struct enif_func_t
{
const char* name;
unsigned arity;
ERL_NIF_TERM (*fptr)(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+ unsigned flags;
}ErlNifFunc;
+
typedef struct enif_entry_t
{
int major;
@@ -138,9 +117,16 @@ typedef struct enif_entry_t
int (*reload) (ErlNifEnv*, void** priv_data, ERL_NIF_TERM load_info);
int (*upgrade)(ErlNifEnv*, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info);
void (*unload) (ErlNifEnv*, void* priv_data);
+
+ /* Added in 2.1 */
const char* vm_variant;
-}ErlNifEntry;
+ /* Added in 2.7 */
+ unsigned options; /* Unused. Can be set to 0 or 1 (dirty sched config) */
+
+ /* Added in 2.12 */
+ size_t sizeof_ErlNifResourceTypeInit;
+}ErlNifEntry;
typedef struct
@@ -153,8 +139,18 @@ typedef struct
void* ref_bin;
}ErlNifBinary;
-typedef struct enif_resource_type_t ErlNifResourceType;
-typedef void ErlNifResourceDtor(ErlNifEnv*, void*);
+#if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_))
+typedef void* ErlNifEvent; /* FIXME: Use 'HANDLE' somehow without breaking existing source */
+#else
+typedef int ErlNifEvent;
+#endif
+
+/* Return bits from enif_select: */
+#define ERL_NIF_SELECT_STOP_CALLED (1 << 0)
+#define ERL_NIF_SELECT_STOP_SCHEDULED (1 << 1)
+#define ERL_NIF_SELECT_INVALID_EVENT (1 << 2)
+#define ERL_NIF_SELECT_FAILED (1 << 3)
+
typedef enum
{
ERL_NIF_RT_CREATE = 1,
@@ -169,7 +165,25 @@ typedef enum
typedef struct
{
ERL_NIF_TERM pid; /* internal, may change */
-}ErlNifPid;
+} ErlNifPid;
+
+typedef struct
+{
+ ERL_NIF_TERM port_id; /* internal, may change */
+}ErlNifPort;
+
+typedef ErlDrvMonitor ErlNifMonitor;
+
+typedef struct enif_resource_type_t ErlNifResourceType;
+typedef void ErlNifResourceDtor(ErlNifEnv*, void*);
+typedef void ErlNifResourceStop(ErlNifEnv*, void*, ErlNifEvent, int is_direct_call);
+typedef void ErlNifResourceDown(ErlNifEnv*, void*, ErlNifPid*, ErlNifMonitor*);
+
+typedef struct {
+ ErlNifResourceDtor* dtor;
+ ErlNifResourceStop* stop; /* at ERL_NIF_SELECT_STOP event */
+ ErlNifResourceDown* down; /* enif_monitor_process */
+} ErlNifResourceTypeInit;
typedef ErlDrvSysInfo ErlNifSysInfo;
@@ -181,33 +195,91 @@ typedef int ErlNifTSDKey;
typedef ErlDrvThreadOpts ErlNifThreadOpts;
-#ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT
typedef enum
{
- ERL_NIF_DIRTY_JOB_CPU_BOUND = ERL_DRV_DIRTY_JOB_CPU_BOUND,
- ERL_NIF_DIRTY_JOB_IO_BOUND = ERL_DRV_DIRTY_JOB_IO_BOUND
+ ERL_NIF_DIRTY_JOB_CPU_BOUND = ERL_DIRTY_JOB_CPU_BOUND,
+ ERL_NIF_DIRTY_JOB_IO_BOUND = ERL_DIRTY_JOB_IO_BOUND
}ErlNifDirtyTaskFlags;
-#endif
typedef struct /* All fields all internal and may change */
{
ERL_NIF_TERM map;
- ERL_NIF_UINT t_limit;
+ ERL_NIF_UINT size;
ERL_NIF_UINT idx;
- ERL_NIF_TERM *ks;
- ERL_NIF_TERM *vs;
+ union {
+ struct {
+ ERL_NIF_TERM *ks;
+ ERL_NIF_TERM *vs;
+ }flat;
+ struct {
+ struct ErtsDynamicWStack_* wstack;
+ ERL_NIF_TERM* kv;
+ }hash;
+ }u;
void* __spare__[2]; /* for future additions to be ABI compatible (same struct size) */
} ErlNifMapIterator;
typedef enum {
- ERL_NIF_MAP_ITERATOR_HEAD = 1,
- ERL_NIF_MAP_ITERATOR_TAIL = 2
+ ERL_NIF_MAP_ITERATOR_FIRST = 1,
+ ERL_NIF_MAP_ITERATOR_LAST = 2,
+
+ /* deprecated synonyms (undocumented in 17 and 18-rc) */
+ ERL_NIF_MAP_ITERATOR_HEAD = ERL_NIF_MAP_ITERATOR_FIRST,
+ ERL_NIF_MAP_ITERATOR_TAIL = ERL_NIF_MAP_ITERATOR_LAST
} ErlNifMapIteratorEntry;
+typedef enum {
+ ERL_NIF_UNIQUE_POSITIVE = (1 << 0),
+ ERL_NIF_UNIQUE_MONOTONIC = (1 << 1)
+} ErlNifUniqueInteger;
+
+typedef enum {
+ ERL_NIF_BIN2TERM_SAFE = 0x20000000
+} ErlNifBinaryToTerm;
+
+typedef enum {
+ ERL_NIF_INTERNAL_HASH = 1,
+ ERL_NIF_PHASH2 = 2
+} ErlNifHash;
+
+#define ERL_NIF_IOVEC_SIZE 16
+
+typedef struct erl_nif_io_vec {
+ int iovcnt; /* length of vectors */
+ size_t size; /* total size in bytes */
+ SysIOVec *iov;
+
+ /* internals (avert your eyes) */
+ void **ref_bins; /* Binary[] */
+ int flags;
+
+ /* Used when stack allocating the io vec */
+ SysIOVec small_iov[ERL_NIF_IOVEC_SIZE];
+ void *small_ref_bin[ERL_NIF_IOVEC_SIZE];
+} ErlNifIOVec;
+
+typedef struct erts_io_queue ErlNifIOQueue;
+
+typedef enum {
+ ERL_NIF_IOQ_NORMAL = 1
+} ErlNifIOQueueOpts;
+
+/*
+ * Return values from enif_thread_type(). Negative values
+ * reserved for specific types of non-scheduler threads.
+ * Positive values reserved for scheduler thread types.
+ */
+
+#define ERL_NIF_THR_UNDEFINED 0
+#define ERL_NIF_THR_NORMAL_SCHEDULER 1
+#define ERL_NIF_THR_DIRTY_CPU_SCHEDULER 2
+#define ERL_NIF_THR_DIRTY_IO_SCHEDULER 3
+
#if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_))
# 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
@@ -227,22 +299,27 @@ 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 __cplusplus
}
@@ -268,7 +345,9 @@ ERL_NIF_INIT_DECL(NAME) \
sizeof(FUNCS) / sizeof(*FUNCS), \
FUNCS, \
LOAD, RELOAD, UPGRADE, UNLOAD, \
- ERL_NIF_VM_VARIANT \
+ ERL_NIF_VM_VARIANT, \
+ 1, \
+ sizeof(ErlNifResourceTypeInit) \
}; \
ERL_NIF_INIT_BODY; \
return &entry; \
diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h
index d7c554e60b..9e573307d8 100644
--- a/erts/emulator/beam/erl_nif_api_funcs.h
+++ b/erts/emulator/beam/erl_nif_api_funcs.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2009-2014. All Rights Reserved.
+ * Copyright Ericsson AB 2009-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -22,7 +23,7 @@
#endif
/*
-** WARNING: add new ERL_NIF_API_FUNC_DECL entries at the bottom of the list
+** WARNING: Add new ERL_NIF_API_FUNC_DECL entries at the bottom of the list
** to keep compatibility on Windows!!!
**
** And don't forget to increase ERL_NIF_MINOR_VERSION in erl_nif.h
@@ -141,14 +142,6 @@ ERL_NIF_API_FUNC_DECL(int,enif_is_number,(ErlNifEnv*, ERL_NIF_TERM term));
ERL_NIF_API_FUNC_DECL(void*,enif_dlopen,(const char* lib, void (*err_handler)(void*,const char*), void* err_arg));
ERL_NIF_API_FUNC_DECL(void*,enif_dlsym,(void* handle, const char* symbol, void (*err_handler)(void*,const char*), void* err_arg));
ERL_NIF_API_FUNC_DECL(int,enif_consume_timeslice,(ErlNifEnv*, int percent));
-#ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT
-ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_schedule_dirty_nif,(ErlNifEnv*,int,ERL_NIF_TERM (*)(ErlNifEnv*,int,const ERL_NIF_TERM[]),int,const ERL_NIF_TERM[]));
-ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_schedule_dirty_nif_finalizer,(ErlNifEnv*,ERL_NIF_TERM,ERL_NIF_TERM (*)(ErlNifEnv*,ERL_NIF_TERM)));
-ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_dirty_nif_finalizer,(ErlNifEnv*,ERL_NIF_TERM));
-ERL_NIF_API_FUNC_DECL(int,enif_is_on_dirty_scheduler,(ErlNifEnv*));
-ERL_NIF_API_FUNC_DECL(int,enif_have_dirty_schedulers,(void));
-#endif
-
ERL_NIF_API_FUNC_DECL(int, enif_is_map, (ErlNifEnv* env, ERL_NIF_TERM term));
ERL_NIF_API_FUNC_DECL(int, enif_get_map_size, (ErlNifEnv* env, ERL_NIF_TERM term, size_t *size));
ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM, enif_make_new_map, (ErlNifEnv* env));
@@ -163,12 +156,53 @@ ERL_NIF_API_FUNC_DECL(int, enif_map_iterator_is_tail, (ErlNifEnv *env, ErlNifMap
ERL_NIF_API_FUNC_DECL(int, enif_map_iterator_next, (ErlNifEnv *env, ErlNifMapIterator *iter));
ERL_NIF_API_FUNC_DECL(int, enif_map_iterator_prev, (ErlNifEnv *env, ErlNifMapIterator *iter));
ERL_NIF_API_FUNC_DECL(int, enif_map_iterator_get_pair, (ErlNifEnv *env, ErlNifMapIterator *iter, ERL_NIF_TERM *key, ERL_NIF_TERM *value));
+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));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM, enif_now_time, (ErlNifEnv *env));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM, enif_cpu_time, (ErlNifEnv *env));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM, enif_make_unique_integer, (ErlNifEnv *env, ErlNifUniqueInteger properties));
+ERL_NIF_API_FUNC_DECL(int, enif_is_current_process_alive, (ErlNifEnv *env));
+ERL_NIF_API_FUNC_DECL(int, enif_is_process_alive, (ErlNifEnv *env, ErlNifPid *pid));
+ERL_NIF_API_FUNC_DECL(int, enif_is_port_alive, (ErlNifEnv *env, ErlNifPort *port_id));
+ERL_NIF_API_FUNC_DECL(int, enif_get_local_port, (ErlNifEnv* env, ERL_NIF_TERM, ErlNifPort* port_id));
+ERL_NIF_API_FUNC_DECL(int, enif_term_to_binary, (ErlNifEnv *env, ERL_NIF_TERM term, ErlNifBinary *bin));
+ERL_NIF_API_FUNC_DECL(size_t, enif_binary_to_term, (ErlNifEnv *env, const unsigned char* data, size_t sz, ERL_NIF_TERM *term, unsigned int opts));
+ERL_NIF_API_FUNC_DECL(int, enif_port_command, (ErlNifEnv *env, const ErlNifPort* to_port, ErlNifEnv *msg_env, ERL_NIF_TERM msg));
+ERL_NIF_API_FUNC_DECL(int,enif_thread_type,(void));
+ERL_NIF_API_FUNC_DECL(int,enif_snprintf,(char * buffer, size_t size, const char *format, ...));
+ERL_NIF_API_FUNC_DECL(int,enif_select,(ErlNifEnv* env, ErlNifEvent e, enum ErlNifSelectFlags flags, void* obj, const ErlNifPid* pid, ERL_NIF_TERM ref));
+ERL_NIF_API_FUNC_DECL(ErlNifResourceType*,enif_open_resource_type_x,(ErlNifEnv*, const char* name_str, const ErlNifResourceTypeInit*, ErlNifResourceFlags flags, ErlNifResourceFlags* tried));
+ERL_NIF_API_FUNC_DECL(int, enif_monitor_process,(ErlNifEnv*,void* obj,const ErlNifPid*,ErlNifMonitor *monitor));
+ERL_NIF_API_FUNC_DECL(int, enif_demonitor_process,(ErlNifEnv*,void* obj,const ErlNifMonitor *monitor));
+ERL_NIF_API_FUNC_DECL(int, enif_compare_monitors,(const ErlNifMonitor*,const ErlNifMonitor*));
+ERL_NIF_API_FUNC_DECL(ErlNifUInt64,enif_hash,(ErlNifHash type, ERL_NIF_TERM term, ErlNifUInt64 salt));
+ERL_NIF_API_FUNC_DECL(int, enif_whereis_pid, (ErlNifEnv *env, ERL_NIF_TERM name, ErlNifPid *pid));
+ERL_NIF_API_FUNC_DECL(int, enif_whereis_port, (ErlNifEnv *env, ERL_NIF_TERM name, ErlNifPort *port));
+
+ERL_NIF_API_FUNC_DECL(ErlNifIOQueue *,enif_ioq_create,(ErlNifIOQueueOpts opts));
+ERL_NIF_API_FUNC_DECL(void,enif_ioq_destroy,(ErlNifIOQueue *q));
+
+ERL_NIF_API_FUNC_DECL(int,enif_ioq_enq_binary,(ErlNifIOQueue *q, ErlNifBinary *bin, size_t skip));
+ERL_NIF_API_FUNC_DECL(int,enif_ioq_enqv,(ErlNifIOQueue *q, ErlNifIOVec *iov, size_t skip));
+
+ERL_NIF_API_FUNC_DECL(size_t,enif_ioq_size,(ErlNifIOQueue *q));
+ERL_NIF_API_FUNC_DECL(int,enif_ioq_deq,(ErlNifIOQueue *q, size_t count, size_t *size));
+
+ERL_NIF_API_FUNC_DECL(SysIOVec*,enif_ioq_peek,(ErlNifIOQueue *q, int *iovlen));
+
+ERL_NIF_API_FUNC_DECL(int,enif_inspect_iovec,(ErlNifEnv *env, size_t max_length, ERL_NIF_TERM iovec_term, ERL_NIF_TERM *tail, ErlNifIOVec **iovec));
+ERL_NIF_API_FUNC_DECL(void,enif_free_iovec,(ErlNifIOVec *iov));
/*
-** Add new entries here to keep compatibility on Windows!!!
+** ADD NEW ENTRIES HERE (before this comment) !!!
*/
-#endif
+#endif /* ERL_NIF_API_FUNC_DECL */
/*
** Please keep the ERL_NIF_API_FUNC_MACRO list below in the same order
@@ -282,21 +316,12 @@ ERL_NIF_API_FUNC_DECL(int, enif_map_iterator_get_pair, (ErlNifEnv *env, ErlNifMa
# define enif_make_int64 ERL_NIF_API_FUNC_MACRO(enif_make_int64)
# define enif_make_uint64 ERL_NIF_API_FUNC_MACRO(enif_make_uint64)
#endif
-
# define enif_is_exception ERL_NIF_API_FUNC_MACRO(enif_is_exception)
# define enif_make_reverse_list ERL_NIF_API_FUNC_MACRO(enif_make_reverse_list)
# define enif_is_number ERL_NIF_API_FUNC_MACRO(enif_is_number)
# define enif_dlopen ERL_NIF_API_FUNC_MACRO(enif_dlopen)
# define enif_dlsym ERL_NIF_API_FUNC_MACRO(enif_dlsym)
# define enif_consume_timeslice ERL_NIF_API_FUNC_MACRO(enif_consume_timeslice)
-#ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT
-# define enif_schedule_dirty_nif ERL_NIF_API_FUNC_MACRO(enif_schedule_dirty_nif)
-# define enif_schedule_dirty_nif_finalizer ERL_NIF_API_FUNC_MACRO(enif_schedule_dirty_nif_finalizer)
-# define enif_dirty_nif_finalizer ERL_NIF_API_FUNC_MACRO(enif_dirty_nif_finalizer)
-# define enif_is_on_dirty_scheduler ERL_NIF_API_FUNC_MACRO(enif_is_on_dirty_scheduler)
-# define enif_have_dirty_schedulers ERL_NIF_API_FUNC_MACRO(enif_have_dirty_schedulers)
-#endif
-
# define enif_is_map ERL_NIF_API_FUNC_MACRO(enif_is_map)
# define enif_get_map_size ERL_NIF_API_FUNC_MACRO(enif_get_map_size)
# define enif_make_new_map ERL_NIF_API_FUNC_MACRO(enif_make_new_map)
@@ -311,11 +336,54 @@ ERL_NIF_API_FUNC_DECL(int, enif_map_iterator_get_pair, (ErlNifEnv *env, ErlNifMa
# define enif_map_iterator_next ERL_NIF_API_FUNC_MACRO(enif_map_iterator_next)
# define enif_map_iterator_prev ERL_NIF_API_FUNC_MACRO(enif_map_iterator_prev)
# define enif_map_iterator_get_pair ERL_NIF_API_FUNC_MACRO(enif_map_iterator_get_pair)
+# 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)
+# define enif_now_time ERL_NIF_API_FUNC_MACRO(enif_now_time)
+# define enif_cpu_time ERL_NIF_API_FUNC_MACRO(enif_cpu_time)
+# define enif_make_unique_integer ERL_NIF_API_FUNC_MACRO(enif_make_unique_integer)
+# define enif_is_current_process_alive ERL_NIF_API_FUNC_MACRO(enif_is_current_process_alive)
+# define enif_is_process_alive ERL_NIF_API_FUNC_MACRO(enif_is_process_alive)
+# define enif_is_port_alive ERL_NIF_API_FUNC_MACRO(enif_is_port_alive)
+# define enif_get_local_port ERL_NIF_API_FUNC_MACRO(enif_get_local_port)
+# define enif_term_to_binary ERL_NIF_API_FUNC_MACRO(enif_term_to_binary)
+# define enif_binary_to_term ERL_NIF_API_FUNC_MACRO(enif_binary_to_term)
+# define enif_port_command ERL_NIF_API_FUNC_MACRO(enif_port_command)
+# define enif_thread_type ERL_NIF_API_FUNC_MACRO(enif_thread_type)
+# define enif_snprintf ERL_NIF_API_FUNC_MACRO(enif_snprintf)
+# define enif_select ERL_NIF_API_FUNC_MACRO(enif_select)
+# define enif_open_resource_type_x ERL_NIF_API_FUNC_MACRO(enif_open_resource_type_x)
+# define enif_monitor_process ERL_NIF_API_FUNC_MACRO(enif_monitor_process)
+# define enif_demonitor_process ERL_NIF_API_FUNC_MACRO(enif_demonitor_process)
+# define enif_compare_monitors ERL_NIF_API_FUNC_MACRO(enif_compare_monitors)
+# define enif_hash ERL_NIF_API_FUNC_MACRO(enif_hash)
+# define enif_whereis_pid ERL_NIF_API_FUNC_MACRO(enif_whereis_pid)
+# define enif_whereis_port ERL_NIF_API_FUNC_MACRO(enif_whereis_port)
+# define enif_ioq_create ERL_NIF_API_FUNC_MACRO(enif_ioq_create)
+# define enif_ioq_destroy ERL_NIF_API_FUNC_MACRO(enif_ioq_destroy)
+# define enif_ioq_enq ERL_NIF_API_FUNC_MACRO(enif_ioq_enq)
+# define enif_ioq_enq_binary ERL_NIF_API_FUNC_MACRO(enif_ioq_enq_binary)
+# define enif_ioq_enqv ERL_NIF_API_FUNC_MACRO(enif_ioq_enqv)
+# define enif_ioq_size ERL_NIF_API_FUNC_MACRO(enif_ioq_size)
+# define enif_ioq_deq ERL_NIF_API_FUNC_MACRO(enif_ioq_deq)
+# define enif_ioq_peek ERL_NIF_API_FUNC_MACRO(enif_ioq_peek)
+# define enif_inspect_iovec ERL_NIF_API_FUNC_MACRO(enif_inspect_iovec)
+# define enif_free_iovec ERL_NIF_API_FUNC_MACRO(enif_free_iovec)
/*
-** Add new entries here
+** ADD NEW ENTRIES HERE (before this comment)
*/
-#endif
+
+/*
+ * Conditional EXPERIMENTAL stuff always last
+ * Must be moved up and made unconditional to support binary backward
+ * compatibility on Windows.
+ */
+#endif /* ERL_NIF_API_FUNC_MACRO */
#if defined(__GNUC__) && !(defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_))
@@ -535,7 +603,7 @@ static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list9(ErlNifEnv* env,
#ifndef enif_make_pid
-# define enif_make_pid(ENV, PID) ((const ERL_NIF_TERM)((PID)->pid))
+# define enif_make_pid(ENV, PID) ((void)(ENV),(const ERL_NIF_TERM)((PID)->pid))
#if SIZEOF_LONG == 8
# define enif_get_int64 enif_get_long
diff --git a/erts/emulator/beam/erl_node_container_utils.h b/erts/emulator/beam/erl_node_container_utils.h
index 17f6b32bb1..6ec428e282 100644
--- a/erts/emulator/beam/erl_node_container_utils.h
+++ b/erts/emulator/beam/erl_node_container_utils.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -254,19 +255,16 @@ extern ErtsPTab erts_port;
* Refs *
\* */
-#if defined(ARCH_64) && !HALFWORD_HEAP
-
-#define internal_ref_no_of_numbers(x) \
- (internal_ref_data((x))[0])
-#define internal_thing_ref_no_of_numbers(thing) \
- (internal_thing_ref_data(thing)[0])
-#define internal_ref_numbers(x) \
- (&internal_ref_data((x))[1])
-#define internal_thing_ref_numbers(thing) \
- (&internal_thing_ref_data(thing)[1])
-#define external_ref_no_of_numbers(x) \
+#define internal_ref_no_numbers(x) ERTS_REF_NUMBERS
+#define internal_ref_numbers(x) (is_internal_ordinary_ref((x)) \
+ ? internal_ordinary_ref_numbers((x)) \
+ : (ASSERT(is_internal_magic_ref((x))), \
+ internal_magic_ref_numbers((x))))
+#if defined(ARCH_64)
+
+#define external_ref_no_numbers(x) \
(external_ref_data((x))[0])
-#define external_thing_ref_no_of_numbers(thing) \
+#define external_thing_ref_no_numbers(thing) \
(external_thing_ref_data(thing)[0])
#define external_ref_numbers(x) \
(&external_ref_data((x))[1])
@@ -276,12 +274,8 @@ extern ErtsPTab erts_port;
#else
-#define internal_ref_no_of_numbers(x) (internal_ref_data_words((x)))
-#define internal_thing_ref_no_of_numbers(t) (internal_thing_ref_data_words(t))
-#define internal_ref_numbers(x) (internal_ref_data((x)))
-#define internal_thing_ref_numbers(t) (internal_thing_ref_data(t))
-#define external_ref_no_of_numbers(x) (external_ref_data_words((x)))
-#define external_thing_ref_no_of_numbers(t) (external_thing_ref_data_words((t)))
+#define external_ref_no_numbers(x) (external_ref_data_words((x)))
+#define external_thing_ref_no_numbers(t) (external_thing_ref_data_words((t)))
#define external_ref_numbers(x) (external_ref_data((x)))
#define external_thing_ref_numbers(t) (external_thing_ref_data((t)))
@@ -298,15 +292,9 @@ extern ErtsPTab erts_port;
#define internal_ref_channel_no(x) (internal_channel_no((x)))
#define external_ref_channel_no(x) (external_channel_no((x)))
-#define ref_data_words(x) (is_internal_ref((x)) \
- ? internal_ref_data_words((x)) \
- : external_ref_data_words((x)))
-#define ref_data(x) (is_internal_ref((x)) \
- ? internal_ref_data((x)) \
- : external_ref_data((x)))
-#define ref_no_of_numbers(x) (is_internal_ref((x)) \
- ? internal_ref_no_of_numbers((x))\
- : external_ref_no_of_numbers((x)))
+#define ref_no_numbers(x) (is_internal_ref((x)) \
+ ? internal_ref_no_numbers((x))\
+ : external_ref_no_numbers((x)))
#define ref_numbers(x) (is_internal_ref((x)) \
? internal_ref_numbers((x)) \
: external_ref_numbers((x)))
@@ -327,8 +315,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 c6d136f951..deadf435e9 100644
--- a/erts/emulator/beam/erl_node_tables.c
+++ b/erts/emulator/beam/erl_node_tables.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -36,21 +37,24 @@ 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;
+static ErtsMonotonicTime orig_node_tab_delete_delay;
+static ErtsMonotonicTime node_tab_delete_delay;
+
/* -- The distribution table ---------------------------------------------- */
#ifdef DEBUG
@@ -81,24 +85,20 @@ dist_table_cmp(void *dep1, void *dep2)
static void*
dist_table_alloc(void *dep_tmpl)
{
- Eterm chnl_nr;
Eterm sysname;
DistEntry *dep;
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));
dist_entries++;
dep->prev = NULL;
- erts_refc_init(&dep->refc, -1);
- erts_smp_rwmtx_init_opt_x(&dep->rwmtx, &rwmtx_opt, "dist_entry", chnl_nr);
+ erts_smp_refc_init(&dep->refc, -1);
+ erts_smp_rwmtx_init_opt(&dep->rwmtx, &rwmtx_opt, "dist_entry", sysname,
+ ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
dep->sysname = sysname;
dep->cid = NIL;
dep->connection_id = 0;
@@ -106,12 +106,14 @@ dist_table_alloc(void *dep_tmpl)
dep->flags = 0;
dep->version = 0;
- erts_smp_mtx_init_x(&dep->lnk_mtx, "dist_entry_links", chnl_nr);
+ erts_smp_mtx_init(&dep->lnk_mtx, "dist_entry_links", sysname,
+ ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
dep->node_links = NULL;
dep->nlinks = NULL;
dep->monitors = NULL;
- erts_smp_mtx_init_x(&dep->qlock, "dist_entry_out_queue", chnl_nr);
+ erts_smp_mtx_init(&dep->qlock, "dist_entry_out_queue", sysname,
+ ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
dep->qflgs = 0;
dep->qsize = 0;
dep->out_queue.first = NULL;
@@ -128,7 +130,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);
@@ -145,9 +149,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);
@@ -182,13 +183,13 @@ 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--;
}
void
-erts_dist_table_info(int to, void *to_arg)
+erts_dist_table_info(fmtfn_t to, void *to_arg)
{
int lock = !ERTS_IS_CRASH_DUMPING;
if (lock)
@@ -208,7 +209,7 @@ erts_channel_no_to_dist_entry(Uint cno)
* to the node name is used as channel no.
*/
if(cno == ERST_INTERNAL_CHANNEL_NO) {
- erts_refc_inc(&erts_this_dist_entry->refc, 2);
+ erts_smp_refc_inc(&erts_this_dist_entry->refc, 2);
return erts_this_dist_entry;
}
@@ -231,16 +232,16 @@ erts_sysname_to_connected_dist_entry(Eterm sysname)
de.sysname = sysname;
if(erts_this_dist_entry->sysname == sysname) {
- erts_refc_inc(&erts_this_dist_entry->refc, 2);
+ erts_smp_refc_inc(&erts_this_dist_entry->refc, 2);
return erts_this_dist_entry;
}
erts_smp_rwmtx_rlock(&erts_dist_table_rwmtx);
res_dep = (DistEntry *) hash_get(&erts_dist_table, (void *) &de);
if (res_dep) {
- erts_aint_t refc = erts_refc_inctest(&res_dep->refc, 1);
+ erts_aint_t refc = erts_smp_refc_inctest(&res_dep->refc, 1);
if (refc < 2) /* Pending delete */
- erts_refc_inc(&res_dep->refc, 1);
+ erts_smp_refc_inc(&res_dep->refc, 1);
}
erts_smp_rwmtx_runlock(&erts_dist_table_rwmtx);
if (res_dep) {
@@ -267,9 +268,9 @@ DistEntry *erts_find_or_insert_dist_entry(Eterm sysname)
de.sysname = sysname;
erts_smp_rwmtx_rwlock(&erts_dist_table_rwmtx);
res = hash_put(&erts_dist_table, (void *) &de);
- refc = erts_refc_inctest(&res->refc, 0);
+ refc = erts_smp_refc_inctest(&res->refc, 0);
if (refc < 2) /* New or pending delete */
- erts_refc_inc(&res->refc, 1);
+ erts_smp_refc_inc(&res->refc, 1);
erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx);
return res;
}
@@ -282,29 +283,54 @@ DistEntry *erts_find_dist_entry(Eterm sysname)
erts_smp_rwmtx_rlock(&erts_dist_table_rwmtx);
res = hash_get(&erts_dist_table, (void *) &de);
if (res) {
- erts_aint_t refc = erts_refc_inctest(&res->refc, 1);
+ erts_aint_t refc = erts_smp_refc_inctest(&res->refc, 1);
if (refc < 2) /* Pending delete */
- erts_refc_inc(&res->refc, 1);
+ erts_smp_refc_inc(&res->refc, 1);
}
erts_smp_rwmtx_runlock(&erts_dist_table_rwmtx);
return res;
}
-void erts_delete_dist_entry(DistEntry *dep)
+static void try_delete_dist_entry(void *vdep)
+{
+ DistEntry *dep = (DistEntry *) vdep;
+ erts_aint_t refc;
+
+ erts_smp_rwmtx_rwlock(&erts_dist_table_rwmtx);
+ /*
+ * Another thread might have looked up this dist entry after
+ * we decided to delete it (refc became zero). If so, the other
+ * thread incremented refc twice. Once for the new reference
+ * and once for this thread.
+ *
+ * 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
+ * but has been used since we set up the timer. Set up a
+ * new timer.
+ *
+ * If refc > 0, the entry is in use. Keep the entry.
+ */
+ refc = erts_smp_refc_dectest(&dep->refc, -1);
+ if (refc == -1)
+ (void) hash_erase(&erts_dist_table, (void *) dep);
+ erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx);
+
+ if (refc == 0)
+ erts_schedule_delete_dist_entry(dep);
+}
+
+void erts_schedule_delete_dist_entry(DistEntry *dep)
{
ASSERT(dep != erts_this_dist_entry);
- if(dep != erts_this_dist_entry) {
- erts_smp_rwmtx_rwlock(&erts_dist_table_rwmtx);
- /*
- * Another thread might have looked up this dist entry after
- * we decided to delete it (refc became zero). If so, the other
- * thread incremented refc twice. Once for the new reference
- * and once for this thread. Therefore, delete dist entry if
- * refc is 0 or -1 after a decrement.
- */
- if (erts_refc_dectest(&dep->refc, -1) <= 0)
- (void) hash_erase(&erts_dist_table, (void *) dep);
- erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx);
+ if (dep != erts_this_dist_entry) {
+ if (node_tab_delete_delay == 0)
+ try_delete_dist_entry((void *) dep);
+ else if (node_tab_delete_delay > 0)
+ erts_start_timer_callback(node_tab_delete_delay,
+ try_delete_dist_entry,
+ (void *) dep);
}
}
@@ -340,8 +366,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)
@@ -473,31 +498,7 @@ node_table_hash(void *venp)
Uint32 cre = ((ErlNode *) venp)->creation;
HashValue h = atom_tab(atom_val(((ErlNode *) venp)->sysname))->slot.bucket.hvalue;
- h *= PRIME0;
- h += cre & 0xff;
-
-#if MAX_CREATION >= (1 << 8)
- h *= PRIME1;
- h += (cre >> 8) & 0xff;
-#endif
-
-#if MAX_CREATION >= (1 << 16)
- h *= PRIME2;
- h += (cre >> 16) & 0xff;
-#endif
-
-#if MAX_CREATION >= (1 << 24)
- h *= PRIME3;
- h += (cre >> 24) & 0xff;
-#endif
-
-#if 0
-/* XXX Problems in older versions of GCC */
- #if MAX_CREATION >= (1UL << 32)
- #error "MAX_CREATION larger than size of expected creation storage (Uint32)"
- #endif
-#endif
- return h;
+ return (h + cre) * PRIME0;
}
static int
@@ -514,14 +515,11 @@ 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++;
- erts_refc_init(&enp->refc, -1);
+ erts_smp_refc_init(&enp->refc, -1);
enp->creation = ((ErlNode *) venp_tmpl)->creation;
enp->sysname = ((ErlNode *) venp_tmpl)->sysname;
enp->dist_entry = erts_find_or_insert_dist_entry(((ErlNode *) venp_tmpl)->sysname);
@@ -534,8 +532,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
@@ -543,7 +540,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--;
}
@@ -556,30 +553,30 @@ erts_node_table_size(void)
#endif
int lock = !ERTS_IS_CRASH_DUMPING;
if (lock)
- erts_smp_rwmtx_rwlock(&erts_node_table_rwmtx);
+ erts_smp_rwmtx_rlock(&erts_node_table_rwmtx);
#ifdef DEBUG
hash_get_info(&hi, &erts_node_table);
ASSERT(node_entries == hi.objs);
#endif
res = hash_table_sz(&erts_node_table) + node_entries*sizeof(ErlNode);
if (lock)
- erts_smp_rwmtx_rwunlock(&erts_node_table_rwmtx);
+ erts_smp_rwmtx_runlock(&erts_node_table_rwmtx);
return res;
}
void
-erts_node_table_info(int to, void *to_arg)
+erts_node_table_info(fmtfn_t to, void *to_arg)
{
int lock = !ERTS_IS_CRASH_DUMPING;
if (lock)
- erts_smp_rwmtx_rwlock(&erts_node_table_rwmtx);
+ erts_smp_rwmtx_rlock(&erts_node_table_rwmtx);
hash_info(to, to_arg, &erts_node_table);
if (lock)
- erts_smp_rwmtx_rwunlock(&erts_node_table_rwmtx);
+ erts_smp_rwmtx_runlock(&erts_node_table_rwmtx);
}
-ErlNode *erts_find_or_insert_node(Eterm sysname, Uint creation)
+ErlNode *erts_find_or_insert_node(Eterm sysname, Uint32 creation)
{
ErlNode *res;
ErlNode ne;
@@ -589,9 +586,9 @@ ErlNode *erts_find_or_insert_node(Eterm sysname, Uint creation)
erts_smp_rwmtx_rlock(&erts_node_table_rwmtx);
res = hash_get(&erts_node_table, (void *) &ne);
if (res && res != erts_this_node) {
- erts_aint_t refc = erts_refc_inctest(&res->refc, 0);
+ erts_aint_t refc = erts_smp_refc_inctest(&res->refc, 0);
if (refc < 2) /* New or pending delete */
- erts_refc_inc(&res->refc, 1);
+ erts_smp_refc_inc(&res->refc, 1);
}
erts_smp_rwmtx_runlock(&erts_node_table_rwmtx);
if (res)
@@ -601,34 +598,59 @@ ErlNode *erts_find_or_insert_node(Eterm sysname, Uint creation)
res = hash_put(&erts_node_table, (void *) &ne);
ASSERT(res);
if (res != erts_this_node) {
- erts_aint_t refc = erts_refc_inctest(&res->refc, 0);
+ erts_aint_t refc = erts_smp_refc_inctest(&res->refc, 0);
if (refc < 2) /* New or pending delete */
- erts_refc_inc(&res->refc, 1);
+ erts_smp_refc_inc(&res->refc, 1);
}
erts_smp_rwmtx_rwunlock(&erts_node_table_rwmtx);
return res;
}
-void erts_delete_node(ErlNode *enp)
+static void try_delete_node(void *venp)
+{
+ ErlNode *enp = (ErlNode *) venp;
+ erts_aint_t refc;
+
+ erts_smp_rwmtx_rwlock(&erts_node_table_rwmtx);
+ /*
+ * Another thread might have looked up this node after we
+ * decided to delete it (refc became zero). If so, the other
+ * thread incremented refc twice. Once for the new reference
+ * and once for this thread.
+ *
+ * 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
+ * but has been used since we set up the timer. Set up a
+ * new timer.
+ *
+ * If refc > 0, the entry is in use. Keep the entry.
+ */
+ refc = erts_smp_refc_dectest(&enp->refc, -1);
+ if (refc == -1)
+ (void) hash_erase(&erts_node_table, (void *) enp);
+ erts_smp_rwmtx_rwunlock(&erts_node_table_rwmtx);
+
+ if (refc == 0)
+ erts_schedule_delete_node(enp);
+}
+
+void erts_schedule_delete_node(ErlNode *enp)
{
ASSERT(enp != erts_this_node);
- if(enp != erts_this_node) {
- erts_smp_rwmtx_rwlock(&erts_node_table_rwmtx);
- /*
- * Another thread might have looked up this node after we
- * decided to delete it (refc became zero). If so, the other
- * thread incremented refc twice. Once for the new reference
- * and once for this thread. Therefore, delete node if refc
- * is 0 or -1 after a decrement.
- */
- if (erts_refc_dectest(&enp->refc, -1) <= 0)
- (void) hash_erase(&erts_node_table, (void *) enp);
- erts_smp_rwmtx_rwunlock(&erts_node_table_rwmtx);
+ if (enp != erts_this_node) {
+ if (node_tab_delete_delay == 0)
+ try_delete_node((void *) enp);
+ else if (node_tab_delete_delay > 0)
+ erts_start_timer_callback(node_tab_delete_delay,
+ try_delete_node,
+ (void *) enp);
}
}
struct pn_data {
- int to;
+ fmtfn_t to;
void *to_arg;
Eterm sysname;
int no_sysname;
@@ -651,14 +673,14 @@ static void print_node(void *venp, void *vpndp)
erts_print(pndp->to, pndp->to_arg, " %d", enp->creation);
#ifdef DEBUG
erts_print(pndp->to, pndp->to_arg, " (refc=%ld)",
- erts_refc_read(&enp->refc, 1));
+ erts_smp_refc_read(&enp->refc, 0));
#endif
pndp->no_sysname++;
}
pndp->no_total++;
}
-void erts_print_node_info(int to,
+void erts_print_node_info(fmtfn_t to,
void *to_arg,
Eterm sysname,
int *no_sysname,
@@ -674,13 +696,13 @@ void erts_print_node_info(int to,
pnd.no_total = 0;
if (lock)
- erts_smp_rwmtx_rwlock(&erts_node_table_rwmtx);
+ erts_smp_rwmtx_rlock(&erts_node_table_rwmtx);
hash_foreach(&erts_node_table, print_node, (void *) &pnd);
if (pnd.no_sysname != 0) {
erts_print(to, to_arg, "\n");
}
if (lock)
- erts_smp_rwmtx_rwunlock(&erts_node_table_rwmtx);
+ erts_smp_rwmtx_runlock(&erts_node_table_rwmtx);
if(no_sysname)
*no_sysname = pnd.no_sysname;
@@ -693,45 +715,72 @@ 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_smp_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_smp_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),
- "%T", sysname);
- (void) hash_put(&erts_node_table, (void *) erts_this_node);
+ if (erts_smp_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_smp_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);
}
-void erts_init_node_tables(void)
+Uint
+erts_delayed_node_table_gc(void)
+{
+ if (node_tab_delete_delay < 0)
+ return (Uint) ERTS_NODE_TAB_DELAY_GC_INFINITY;
+ if (node_tab_delete_delay == 0)
+ return (Uint) 0;
+ return (Uint) ((node_tab_delete_delay-1)/1000 + 1);
+}
+
+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;
- rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_FREQUENT_READ;
- rwmtx_opt.lived = ERTS_SMP_RWMTX_LONG_LIVED;
+ if (dd_sec == ERTS_NODE_TAB_DELAY_GC_INFINITY)
+ node_tab_delete_delay = (ErtsMonotonicTime) -1;
+ else
+ node_tab_delete_delay = ((ErtsMonotonicTime) dd_sec)*1000;
- 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;
+ orig_node_tab_delete_delay = node_tab_delete_delay;
- erts_this_dist_entry = erts_alloc(ERTS_ALC_T_DIST_ENTRY, sizeof(DistEntry));
- dist_entries = 1;
+ rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_FREQUENT_READ;
+ rwmtx_opt.lived = ERTS_SMP_RWMTX_LONG_LIVED;
+ erts_smp_rwmtx_init_opt(&erts_node_table_rwmtx, &rwmtx_opt, "node_table", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
+ erts_smp_rwmtx_init_opt(&erts_dist_table_rwmtx, &rwmtx_opt, "dist_table", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
+
+ 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;
@@ -739,69 +788,23 @@ void erts_init_node_tables(void)
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);
+ 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_smp_refc_init(&erts_this_node->refc, 1);
- 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;
+ 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_smp_refc_init(&erts_this_dist_entry->refc, 2);
- hash_init(ERTS_ALC_T_NODE_TABLE, &erts_node_table, "node_table", 11, f);
- 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),
+ 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;
}
@@ -818,6 +821,33 @@ int erts_lc_is_de_rlocked(DistEntry *dep)
#endif
#endif
+#ifdef ERTS_ENABLE_LOCK_COUNT
+
+static void erts_lcnt_enable_dist_lock_count(void *dep_raw, void *enable) {
+ DistEntry *dep = (DistEntry*)dep_raw;
+
+ if(enable) {
+ erts_lcnt_install_new_lock_info(&dep->rwmtx.lcnt, "dist_entry", dep->sysname,
+ ERTS_LOCK_TYPE_RWMUTEX | ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
+ erts_lcnt_install_new_lock_info(&dep->lnk_mtx.lcnt, "dist_entry_links", dep->sysname,
+ ERTS_LOCK_TYPE_MUTEX | ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
+ erts_lcnt_install_new_lock_info(&dep->qlock.lcnt, "dist_entry_out_queue", dep->sysname,
+ ERTS_LOCK_TYPE_MUTEX | ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
+ } else {
+ erts_lcnt_uninstall(&dep->rwmtx.lcnt);
+ erts_lcnt_uninstall(&dep->lnk_mtx.lcnt);
+ erts_lcnt_uninstall(&dep->qlock.lcnt);
+ }
+}
+
+void erts_lcnt_update_distribution_locks(int enable) {
+ erts_smp_rwmtx_rlock(&erts_dist_table_rwmtx);
+ hash_foreach(&erts_dist_table, erts_lcnt_enable_dist_lock_count,
+ (void*)(UWord)enable);
+ erts_smp_rwmtx_runlock(&erts_dist_table_rwmtx);
+}
+#endif
+
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
* The following is only supposed to be used for testing, and debugging. *
* *
@@ -847,16 +877,18 @@ static Eterm AM_dist_references;
static Eterm AM_node_references;
static Eterm AM_system;
static Eterm AM_timer;
+static Eterm AM_delayed_delete_timer;
static void setup_reference_table(void);
-static Eterm reference_table_term(Uint **hpp, Uint *szp);
+static Eterm reference_table_term(Uint **hpp, ErlOffHeap *ohp, Uint *szp);
static void delete_reference_table(void);
-#if BIG_UINT_HEAP_SIZE > 3 /* 2-tuple */
-#define ID_HEAP_SIZE BIG_UINT_HEAP_SIZE
-#else
-#define ID_HEAP_SIZE 3 /* 2-tuple */
-#endif
+#undef ERTS_MAX__
+#define ERTS_MAX__(A, B) ((A) > (B) ? (A) : (B))
+
+#define ID_HEAP_SIZE \
+ ERTS_MAX__(ERTS_MAGIC_REF_THING_SIZE, \
+ ERTS_MAX__(BIG_UINT_HEAP_SIZE, 3))
typedef struct node_referrer_ {
struct node_referrer_ *next;
@@ -869,6 +901,7 @@ typedef struct node_referrer_ {
int system_ref;
Eterm id;
Uint id_heap[ID_HEAP_SIZE];
+ ErlOffHeap off_heap;
} NodeReferrer;
typedef struct {
@@ -881,8 +914,10 @@ typedef struct dist_referrer_ {
int heap_ref;
int node_ref;
int ctrl_ref;
+ int system_ref;
Eterm id;
Uint creation;
+ Uint id_heap[ID_HEAP_SIZE];
} DistReferrer;
typedef struct {
@@ -931,6 +966,7 @@ erts_get_node_and_dist_references(struct process *proc)
INIT_AM(node_references);
INIT_AM(timer);
INIT_AM(system);
+ INIT_AM(delayed_delete_timer);
references_atoms_need_init = 0;
}
@@ -938,7 +974,7 @@ erts_get_node_and_dist_references(struct process *proc)
/* Get term size */
size = 0;
- (void) reference_table_term(NULL, &size);
+ (void) reference_table_term(NULL, NULL, &size);
hp = HAlloc(proc, size);
#ifdef DEBUG
@@ -947,7 +983,7 @@ erts_get_node_and_dist_references(struct process *proc)
#endif
/* Write term */
- res = reference_table_term(&hp, NULL);
+ res = reference_table_term(&hp, &proc->off_heap, NULL);
ASSERT(endp == hp);
@@ -988,17 +1024,25 @@ insert_dist_referrer(ReferredDist *referred_dist,
sizeof(DistReferrer));
drp->next = referred_dist->referrers;
referred_dist->referrers = drp;
- drp->id = id;
+ if(IS_CONST(id))
+ drp->id = id;
+ else {
+ Uint *hp = &drp->id_heap[0];
+ ASSERT(is_tuple(id));
+ drp->id = copy_struct(id, size_object(id), &hp, NULL);
+ }
drp->creation = creation;
drp->heap_ref = 0;
drp->node_ref = 0;
drp->ctrl_ref = 0;
+ drp->system_ref = 0;
}
switch (type) {
case NODE_REF: drp->node_ref++; break;
case CTRL_REF: drp->ctrl_ref++; break;
case HEAP_REF: drp->heap_ref++; break;
+ case SYSTEM_REF: drp->system_ref++; break;
default: ASSERT(0);
}
}
@@ -1017,7 +1061,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);
@@ -1036,13 +1080,14 @@ insert_node_referrer(ReferredNode *referred_node, int type, Eterm id)
nrp = (NodeReferrer *) erts_alloc(ERTS_ALC_T_NC_TMP,
sizeof(NodeReferrer));
nrp->next = referred_node->referrers;
+ ERTS_INIT_OFF_HEAP(&nrp->off_heap);
referred_node->referrers = nrp;
if(IS_CONST(id))
nrp->id = id;
else {
Uint *hp = &nrp->id_heap[0];
- ASSERT(is_big(id) || is_tuple(id));
- nrp->id = copy_struct(id, size_object(id), &hp, NULL);
+ ASSERT(is_big(id) || is_tuple(id) || is_internal_magic_ref(id));
+ nrp->id = copy_struct(id, size_object(id), &hp, &nrp->off_heap);
}
nrp->heap_ref = 0;
nrp->link_ref = 0;
@@ -1078,7 +1123,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);
}
@@ -1114,48 +1159,33 @@ insert_offheap(ErlOffHeap *oh, int type, Eterm id)
for (u.hdr = oh->first; u.hdr; u.hdr = u.hdr->next) {
switch (thing_subtag(u.hdr->thing_word)) {
- case REFC_BINARY_SUBTAG:
- if(IsMatchProgBinary(u.pb->val)) {
+ case REF_SUBTAG:
+ if(IsMatchProgBinary(u.mref->mb)) {
InsertedBin *ib;
int insert_bin = 1;
for (ib = inserted_bins; ib; ib = ib->next)
- if(ib->bin_val == u.pb->val) {
+ if(ib->bin_val == (Binary *) u.mref->mb) {
insert_bin = 0;
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,
+ a.id = erts_bld_uint(&hp, NULL, (Uint) u.mref->mb);
+ erts_match_prog_foreach_offheap((Binary *) u.mref->mb,
insert_offheap2,
(void *) &a);
nib = erts_alloc(ERTS_ALC_T_NC_TMP, sizeof(InsertedBin));
- nib->bin_val = u.pb->val;
+ nib->bin_val = (Binary *) u.mref->mb;
nib->next = inserted_bins;
inserted_bins = nib;
-#if HALFWORD_HEAP
- UnUseTmpHeapNoproc(actual_need);
-#else
UnUseTmpHeapNoproc(BIG_UINT_HEAP_SIZE);
-#endif
}
}
break;
+ case REFC_BINARY_SUBTAG:
case FUN_SUBTAG:
break; /* No need to */
default:
@@ -1169,8 +1199,8 @@ insert_offheap(ErlOffHeap *oh, int type, Eterm id)
static void doit_insert_monitor(ErtsMonitor *monitor, void *p)
{
Eterm *idp = p;
- if(is_external(monitor->pid))
- insert_node(external_thing_ptr(monitor->pid)->node, MONITOR_REF, *idp);
+ if(monitor->type != MON_NIF_TARGET && is_external(monitor->u.pid))
+ insert_node(external_thing_ptr(monitor->u.pid)->node, MONITOR_REF, *idp);
if(is_external(monitor->ref))
insert_node(external_thing_ptr(monitor->ref)->node, MONITOR_REF, *idp);
}
@@ -1214,10 +1244,20 @@ insert_links2(ErtsLink *lnk, Eterm id)
static void
insert_ets_table(DbTable *tab, void *unused)
{
+ ErlOffHeap off_heap;
+ Eterm heap[ERTS_MAGIC_REF_THING_SIZE];
struct insert_offheap2_arg a;
a.type = ETS_REF;
- a.id = tab->common.id;
+ if (tab->common.status & DB_NAMED_TABLE)
+ a.id = tab->common.the_name;
+ else {
+ Eterm *hp = &heap[0];
+ ERTS_INIT_OFF_HEAP(&off_heap);
+ a.id = erts_mk_magic_ref(&hp, &off_heap, tab->common.btid);
+ }
erts_db_foreach_offheap(tab, insert_offheap2, (void *) &a);
+ if (is_not_atom(a.id))
+ erts_cleanup_offheap(&off_heap);
}
static void
@@ -1261,6 +1301,33 @@ insert_sys_msg(Eterm from, Eterm to, Eterm msg, ErlHeapFragment *bp)
#endif
static void
+insert_delayed_delete_node(void *state,
+ ErtsMonotonicTime timeout_pos,
+ void *vnp)
+{
+ DeclareTmpHeapNoproc(heap,3);
+ UseTmpHeapNoproc(3);
+ insert_node((ErlNode *) vnp,
+ SYSTEM_REF,
+ TUPLE2(&heap[0], AM_system, AM_delayed_delete_timer));
+ UnUseTmpHeapNoproc(3);
+}
+
+static void
+insert_delayed_delete_dist_entry(void *state,
+ ErtsMonotonicTime timeout_pos,
+ void *vdep)
+{
+ DeclareTmpHeapNoproc(heap,3);
+ UseTmpHeapNoproc(3);
+ insert_dist_entry((DistEntry *) vdep,
+ SYSTEM_REF,
+ TUPLE2(&heap[0], AM_system, AM_delayed_delete_timer),
+ 0);
+ UnUseTmpHeapNoproc(3);
+}
+
+static void
setup_reference_table(void)
{
ErlHeapFragment *hfp;
@@ -1288,11 +1355,22 @@ setup_reference_table(void)
/* Go through the hole system, and build a table of all references
to ErlNode and DistEntry structures */
+ erts_debug_callback_timer_foreach(try_delete_node,
+ insert_delayed_delete_node,
+ NULL);
+ erts_debug_callback_timer_foreach(try_delete_dist_entry,
+ insert_delayed_delete_dist_entry,
+ NULL);
+
UseTmpHeapNoproc(3);
insert_node(erts_this_node,
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);
@@ -1300,67 +1378,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);
- }
}
}
@@ -1469,7 +1535,7 @@ setup_reference_table(void)
erts_db_foreach_table(insert_ets_table, NULL);
/* Insert all bif timers */
- erts_bif_timer_foreach(insert_bif_timer, NULL);
+ erts_debug_bif_timer_foreach(insert_bif_timer, NULL);
/* Insert node table (references to dist) */
hash_foreach(&erts_node_table, insert_erl_node, NULL);
@@ -1495,7 +1561,7 @@ setup_reference_table(void)
*/
static Eterm
-reference_table_term(Uint **hpp, Uint *szp)
+reference_table_term(Uint **hpp, ErlOffHeap *ohp, Uint *szp)
{
#undef MK_2TUP
#undef MK_3TUP
@@ -1550,12 +1616,11 @@ reference_table_term(Uint **hpp, Uint *szp)
nrid = nrp->id;
if (!IS_CONST(nrp->id)) {
-
Uint nrid_sz = size_object(nrp->id);
if (szp)
*szp += nrid_sz;
if (hpp)
- nrid = copy_struct(nrp->id, nrid_sz, hpp, NULL);
+ nrid = copy_struct(nrp->id, nrid_sz, hpp, ohp);
}
if (is_internal_pid(nrid) || nrid == am_error_logger) {
@@ -1601,7 +1666,7 @@ reference_table_term(Uint **hpp, Uint *szp)
tup = MK_2TUP(referred_nodes[i].node->sysname,
MK_UINT(referred_nodes[i].node->creation));
- tup = MK_3TUP(tup, MK_UINT(erts_refc_read(&referred_nodes[i].node->refc, 1)), nril);
+ tup = MK_3TUP(tup, MK_UINT(erts_smp_refc_read(&referred_nodes[i].node->refc, 0)), nril);
nl = MK_CONS(tup, nl);
}
@@ -1624,6 +1689,10 @@ reference_table_term(Uint **hpp, Uint *szp)
tup = MK_2TUP(AM_heap, MK_UINT(drp->heap_ref));
drl = MK_CONS(tup, drl);
}
+ if(drp->system_ref) {
+ tup = MK_2TUP(AM_system, MK_UINT(drp->system_ref));
+ drl = MK_CONS(tup, drl);
+ }
if (is_internal_pid(drp->id)) {
ASSERT(!drp->node_ref);
@@ -1633,6 +1702,14 @@ reference_table_term(Uint **hpp, Uint *szp)
ASSERT(drp->ctrl_ref && !drp->node_ref);
tup = MK_2TUP(AM_port, drp->id);
}
+ else if (is_tuple(drp->id)) {
+ Eterm *t;
+ ASSERT(drp->system_ref && !drp->node_ref
+ && !drp->ctrl_ref && !drp->heap_ref);
+ t = tuple_val(drp->id);
+ ASSERT(2 == arityval(t[0]));
+ tup = MK_2TUP(t[1], t[2]);
+ }
else {
ASSERT(!drp->ctrl_ref && drp->node_ref);
ASSERT(is_atom(drp->id));
@@ -1650,7 +1727,7 @@ reference_table_term(Uint **hpp, Uint *szp)
/* DistList = [{Dist, Refc, ReferenceIdList}] */
tup = MK_3TUP(referred_dists[i].dist->sysname,
- MK_UINT(erts_refc_read(&referred_dists[i].dist->refc, 1)),
+ MK_UINT(erts_smp_refc_read(&referred_dists[i].dist->refc, 0)),
dril);
dl = MK_CONS(tup, dl);
}
@@ -1678,6 +1755,7 @@ delete_reference_table(void)
NodeReferrer *tnrp;
nrp = referred_nodes[i].referrers;
while(nrp) {
+ erts_cleanup_offheap(&nrp->off_heap);
tnrp = nrp;
nrp = nrp->next;
erts_free(ERTS_ALC_T_NC_TMP, (void *) tnrp);
@@ -1705,3 +1783,15 @@ delete_reference_table(void)
}
}
+void
+erts_debug_test_node_tab_delayed_delete(Sint64 millisecs)
+{
+ erts_smp_thr_progress_block();
+
+ if (millisecs < 0)
+ node_tab_delete_delay = orig_node_tab_delete_delay;
+ else
+ node_tab_delete_delay = millisecs;
+
+ erts_smp_thr_progress_unblock();
+}
diff --git a/erts/emulator/beam/erl_node_tables.h b/erts/emulator/beam/erl_node_tables.h
index af60071ea5..91bcb4fce1 100644
--- a/erts/emulator/beam/erl_node_tables.h
+++ b/erts/emulator/beam/erl_node_tables.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2012. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -40,12 +41,17 @@
#include "sys.h"
#include "hash.h"
+#include "erl_alloc.h"
#include "erl_process.h"
#include "erl_monitors.h"
#include "erl_smp.h"
#define ERTS_PORT_TASK_ONLY_BASIC_TYPES__
#include "erl_port_task.h"
#undef ERTS_PORT_TASK_ONLY_BASIC_TYPES__
+
+#define ERTS_NODE_TAB_DELAY_GC_DEFAULT (60)
+#define ERTS_NODE_TAB_DELAY_GC_MAX (100*1000*1000)
+#define ERTS_NODE_TAB_DELAY_GC_INFINITY (ERTS_NODE_TAB_DELAY_GC_MAX+1)
#define ERST_INTERNAL_CHANNEL_NO 0
@@ -61,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)
@@ -101,7 +107,7 @@ typedef struct dist_entry_ {
HashBucket hash_bucket; /* Hash bucket */
struct dist_entry_ *next; /* Next entry in dist_table (not sorted) */
struct dist_entry_ *prev; /* Previous entry in dist_table (not sorted) */
- erts_refc_t refc; /* Reference count */
+ erts_smp_refc_t refc; /* Reference count */
erts_smp_rwmtx_t rwmtx; /* Protects all fields below until lck_mtx. */
Eterm sysname; /* name@host atom for efficiency */
@@ -143,7 +149,7 @@ typedef struct dist_entry_ {
typedef struct erl_node_ {
HashBucket hash_bucket; /* Hash bucket */
- erts_refc_t refc; /* Reference count */
+ erts_smp_refc_t refc; /* Reference count */
Eterm sysname; /* name@host atom for efficiency */
Uint32 creation; /* Creation */
DistEntry *dist_entry; /* Corresponding dist entry */
@@ -166,28 +172,33 @@ extern DistEntry *erts_this_dist_entry;
extern ErlNode *erts_this_node;
extern char *erts_this_node_sysname; /* must match erl_node_tables.c */
+Uint erts_delayed_node_table_gc(void);
DistEntry *erts_channel_no_to_dist_entry(Uint);
DistEntry *erts_sysname_to_connected_dist_entry(Eterm);
DistEntry *erts_find_or_insert_dist_entry(Eterm);
DistEntry *erts_find_dist_entry(Eterm);
-void erts_delete_dist_entry(DistEntry *);
+void erts_schedule_delete_dist_entry(DistEntry *);
Uint erts_dist_table_size(void);
-void erts_dist_table_info(int, void *);
+void erts_dist_table_info(fmtfn_t, void *);
void erts_set_dist_entry_not_connected(DistEntry *);
void erts_set_dist_entry_connected(DistEntry *, Eterm, Uint);
-ErlNode *erts_find_or_insert_node(Eterm, Uint);
-void erts_delete_node(ErlNode *);
+ErlNode *erts_find_or_insert_node(Eterm, Uint32);
+void erts_schedule_delete_node(ErlNode *);
void erts_set_this_node(Eterm, Uint);
Uint erts_node_table_size(void);
-void erts_init_node_tables(void);
-void erts_node_table_info(int, void *);
-void erts_print_node_info(int, void *, Eterm, int*, int*);
+void erts_init_node_tables(int);
+void erts_node_table_info(fmtfn_t, void *);
+void erts_print_node_info(fmtfn_t, void *, Eterm, int*, int*);
Eterm erts_get_node_and_dist_references(struct process *);
#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
int erts_lc_is_de_rwlocked(DistEntry *);
int erts_lc_is_de_rlocked(DistEntry *);
#endif
+#ifdef ERTS_ENABLE_LOCK_COUNT
+void erts_lcnt_update_distribution_locks(int enable);
+#endif
+
ERTS_GLB_INLINE void erts_deref_dist_entry(DistEntry *dep);
ERTS_GLB_INLINE void erts_deref_node_entry(ErlNode *np);
ERTS_GLB_INLINE void erts_smp_de_rlock(DistEntry *dep);
@@ -203,16 +214,16 @@ ERTS_GLB_INLINE void
erts_deref_dist_entry(DistEntry *dep)
{
ASSERT(dep);
- if (erts_refc_dectest(&dep->refc, 0) == 0)
- erts_delete_dist_entry(dep);
+ if (erts_smp_refc_dectest(&dep->refc, 0) == 0)
+ erts_schedule_delete_dist_entry(dep);
}
ERTS_GLB_INLINE void
erts_deref_node_entry(ErlNode *np)
{
ASSERT(np);
- if (erts_refc_dectest(&np->refc, 0) == 0)
- erts_delete_node(np);
+ if (erts_smp_refc_dectest(&np->refc, 0) == 0)
+ erts_schedule_delete_node(np);
}
ERTS_GLB_INLINE void
@@ -253,5 +264,6 @@ erts_smp_de_links_unlock(DistEntry *dep)
#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
+void erts_debug_test_node_tab_delayed_delete(Sint64 millisecs);
#endif
diff --git a/erts/emulator/beam/erl_port.h b/erts/emulator/beam/erl_port.h
index ad3f104a68..b64de624dd 100644
--- a/erts/emulator/beam/erl_port.h
+++ b/erts/emulator/beam/erl_port.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2012-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2012-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -30,6 +31,9 @@ typedef struct ErtsProc2PortSigData_ ErtsProc2PortSigData;
#include "erl_ptab.h"
#include "erl_thr_progress.h"
#include "erl_trace.h"
+#define ERTS_IO_QUEUE_TYPES_ONLY__
+#include "erl_io_queue.h"
+#undef ERTS_IO_QUEUE_TYPES_ONLY__
#ifndef __WIN32__
#define ERTS_DEFAULT_MAX_PORTS (1 << 16)
@@ -74,23 +78,8 @@ typedef struct erts_driver_t_ erts_driver_t;
#define ERTS_Port2ErlDrvPort(PH) ((ErlDrvPort) (PH))
#endif
-#define SMALL_IO_QUEUE 5 /* Number of fixed elements */
-
-typedef struct {
- ErlDrvSizeT size; /* total size in bytes */
+typedef ErtsIOQueue ErlPortIOQueue;
- SysIOVec* v_start;
- SysIOVec* v_end;
- SysIOVec* v_head;
- SysIOVec* v_tail;
- SysIOVec v_small[SMALL_IO_QUEUE];
-
- ErlDrvBinary** b_start;
- ErlDrvBinary** b_end;
- ErlDrvBinary** b_head;
- ErlDrvBinary** b_tail;
- ErlDrvBinary* b_small[SMALL_IO_QUEUE];
-} ErlIOQueue;
typedef struct line_buf { /* Buffer used in line oriented I/O */
ErlDrvSizeT bufsiz; /* Size of character buffer */
@@ -171,7 +160,7 @@ struct _erl_drv_port {
Uint bytes_in; /* Number of bytes read */
Uint bytes_out; /* Number of bytes written */
- ErlIOQueue ioq; /* driver accessible i/o queue */
+ ErlPortIOQueue ioq; /* driver accessible i/o queue */
DistEntry *dist_entry; /* Dist entry used in DISTRIBUTION */
char *name; /* String used in the open */
erts_driver_t* drv_ptr;
@@ -184,8 +173,13 @@ struct _erl_drv_port {
int control_flags; /* Flags for port_control() */
ErlDrvPDL port_data_lock;
- ErtsPrtSD *psd; /* Port specific data */
+ erts_smp_atomic_t 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 */
};
@@ -246,28 +240,56 @@ ERTS_GLB_INLINE void *erts_prtsd_set(Port *p, int ix, void *new);
ERTS_GLB_INLINE void *
erts_prtsd_get(Port *prt, int ix)
{
- return prt->psd ? prt->psd->data[ix] : NULL;
+ ErtsPrtSD *psd = (ErtsPrtSD *) erts_smp_atomic_read_nob(&prt->psd);
+ if (!psd)
+ return NULL;
+ ERTS_SMP_DATA_DEPENDENCY_READ_MEMORY_BARRIER;
+ return psd->data[ix];
}
ERTS_GLB_INLINE void *
erts_prtsd_set(Port *prt, int ix, void *data)
{
- if (prt->psd) {
- void *old = prt->psd->data[ix];
- prt->psd->data[ix] = data;
+ ErtsPrtSD *psd, *new_psd;
+ void *old;
+ int i;
+
+ psd = (ErtsPrtSD *) erts_smp_atomic_read_nob(&prt->psd);
+
+ if (psd) {
+#ifdef ERTS_SMP
+#ifdef ETHR_ORDERED_READ_DEPEND
+ ETHR_MEMBAR(ETHR_LoadStore|ETHR_StoreStore);
+#else
+ ETHR_MEMBAR(ETHR_LoadLoad|ETHR_LoadStore|ETHR_StoreStore);
+#endif
+#endif
+ old = psd->data[ix];
+ psd->data[ix] = data;
return old;
}
- else {
- prt->psd = erts_alloc(ERTS_ALC_T_PRTSD, sizeof(ErtsPrtSD));
- prt->psd->data[ix] = data;
+
+ if (!data)
return NULL;
- }
+
+ new_psd = erts_alloc(ERTS_ALC_T_PRTSD, sizeof(ErtsPrtSD));
+ for (i = 0; i < ERTS_PRTSD_SIZE; i++)
+ new_psd->data[i] = NULL;
+ psd = (ErtsPrtSD *) erts_smp_atomic_cmpxchg_mb(&prt->psd,
+ (erts_aint_t) new_psd,
+ (erts_aint_t) NULL);
+ if (psd)
+ erts_free(ERTS_ALC_T_PRTSD, new_psd);
+ else
+ psd = new_psd;
+ old = psd->data[ix];
+ psd->data[ix] = data;
+ return old;
}
#endif
-extern erts_smp_atomic_t erts_bytes_out; /* no bytes written out */
-extern erts_smp_atomic_t erts_bytes_in; /* no bytes sent into the system */
+Eterm erts_request_io_bytes(Process *c_p);
/* port status flags */
@@ -327,13 +349,15 @@ extern erts_smp_atomic_t erts_bytes_in; /* no bytes sent into the system */
#define ERTS_PORT_REDS_CONNECT (CONTEXT_REDS/200)
#define ERTS_PORT_REDS_UNLINK (CONTEXT_REDS/200)
#define ERTS_PORT_REDS_LINK (CONTEXT_REDS/200)
+#define ERTS_PORT_REDS_MONITOR (CONTEXT_REDS/200)
+#define ERTS_PORT_REDS_DEMONITOR (CONTEXT_REDS/200)
#define ERTS_PORT_REDS_BADSIG (CONTEXT_REDS/200)
#define ERTS_PORT_REDS_CONTROL (CONTEXT_REDS/100)
#define ERTS_PORT_REDS_CALL (CONTEXT_REDS/50)
#define ERTS_PORT_REDS_INFO (CONTEXT_REDS/100)
#define ERTS_PORT_REDS_TERMINATE (CONTEXT_REDS/50)
-void print_port_info(Port *, int, void *);
+void print_port_info(Port *, fmtfn_t, void *);
void erts_port_free(Port *);
#ifndef ERTS_SMP
void erts_port_cleanup(Port *);
@@ -350,6 +374,7 @@ int erts_lc_is_port_locked(Port *);
ERTS_GLB_INLINE void erts_port_inc_refc(Port *prt);
ERTS_GLB_INLINE void erts_port_dec_refc(Port *prt);
ERTS_GLB_INLINE void erts_port_add_refc(Port *prt, Sint32 add_refc);
+ERTS_GLB_INLINE Sint erts_port_read_refc(Port *prt);
ERTS_GLB_INLINE int erts_smp_port_trylock(Port *prt);
ERTS_GLB_INLINE void erts_smp_port_lock(Port *prt);
@@ -359,37 +384,26 @@ ERTS_GLB_INLINE void erts_smp_port_unlock(Port *prt);
ERTS_GLB_INLINE void erts_port_inc_refc(Port *prt)
{
-#ifdef ERTS_SMP
- erts_ptab_inc_refc(&prt->common);
-#else
- erts_atomic32_inc_nob(&prt->refc);
-#endif
+ erts_ptab_atmc_inc_refc(&prt->common);
}
ERTS_GLB_INLINE void erts_port_dec_refc(Port *prt)
{
-#ifdef ERTS_SMP
- int referred = erts_ptab_dec_test_refc(&prt->common);
+ int referred = erts_ptab_atmc_dec_test_refc(&prt->common);
if (!referred)
erts_port_free(prt);
-#else
- int refc = erts_atomic32_dec_read_nob(&prt->refc);
- if (refc == 0)
- erts_port_free(prt);
-#endif
}
ERTS_GLB_INLINE void erts_port_add_refc(Port *prt, Sint32 add_refc)
{
-#ifdef ERTS_SMP
- int referred = erts_ptab_add_test_refc(&prt->common, add_refc);
+ int referred = erts_ptab_atmc_add_test_refc(&prt->common, add_refc);
if (!referred)
erts_port_free(prt);
-#else
- int refc = erts_atomic32_add_read_nob(&prt->refc, add_refc);
- if (refc == 0)
- erts_port_free(prt);
-#endif
+}
+
+ERTS_GLB_INLINE Sint erts_port_read_refc(Port *prt)
+{
+ return erts_ptab_atmc_read_refc(&prt->common);
}
ERTS_GLB_INLINE int
@@ -463,6 +477,7 @@ ERTS_GLB_INLINE Port*erts_id2port(Eterm id);
ERTS_GLB_INLINE Port *erts_id2port_sflgs(Eterm, Process *, ErtsProcLocks, Uint32);
ERTS_GLB_INLINE void erts_port_release(Port *);
#ifdef ERTS_SMP
+ERTS_GLB_INLINE Port *erts_thr_port_lookup(Eterm id, Uint32 invalid_sflgs);
ERTS_GLB_INLINE Port *erts_thr_id2port_sflgs(Eterm id, Uint32 invalid_sflgs);
ERTS_GLB_INLINE void erts_thr_port_release(Port *prt);
#endif
@@ -602,6 +617,44 @@ erts_port_release(Port *prt)
}
#ifdef ERTS_SMP
+/*
+ * erts_thr_id2port_sflgs() and erts_port_dec_refc(prt) can
+ * be used by unmanaged threads in the SMP case.
+ */
+ERTS_GLB_INLINE Port *
+erts_thr_port_lookup(Eterm id, Uint32 invalid_sflgs)
+{
+ Port *prt;
+ ErtsThrPrgrDelayHandle dhndl;
+
+ if (is_not_internal_port(id))
+ return NULL;
+
+ dhndl = erts_thr_progress_unmanaged_delay();
+
+ prt = (Port *) erts_ptab_pix2intptr_ddrb(&erts_port,
+ internal_port_index(id));
+
+ if (!prt || prt->common.id != id) {
+ erts_thr_progress_unmanaged_continue(dhndl);
+ return NULL;
+ }
+ else {
+ erts_aint32_t state;
+ erts_port_inc_refc(prt);
+
+ if (dhndl != ERTS_THR_PRGR_DHANDLE_MANAGED)
+ erts_thr_progress_unmanaged_continue(dhndl);
+
+ state = erts_atomic32_read_acqb(&prt->state);
+ if (state & invalid_sflgs) {
+ erts_port_dec_refc(prt);
+ return NULL;
+ }
+
+ return prt;
+ }
+}
/*
* erts_thr_id2port_sflgs() and erts_thr_port_release() can
@@ -668,7 +721,7 @@ erts_thr_drvport2port(ErlDrvPort drvport, int lock_pdl)
if (lock_pdl && prt->port_data_lock)
driver_pdl_lock(prt->port_data_lock);
-#if ERTS_ENABLE_LOCK_CHECK
+#ifdef ERTS_ENABLE_LOCK_CHECK
if (!ERTS_IS_CRASH_DUMPING) {
if (erts_lc_is_emu_thr()) {
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
@@ -697,7 +750,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)
@@ -787,16 +840,20 @@ void erts_port_resume_procs(Port *);
struct binary;
-#define ERTS_P2P_SIG_TYPE_BAD 0
-#define ERTS_P2P_SIG_TYPE_OUTPUT 1
-#define ERTS_P2P_SIG_TYPE_OUTPUTV 2
-#define ERTS_P2P_SIG_TYPE_CONNECT 3
-#define ERTS_P2P_SIG_TYPE_EXIT 4
-#define ERTS_P2P_SIG_TYPE_CONTROL 5
-#define ERTS_P2P_SIG_TYPE_CALL 6
-#define ERTS_P2P_SIG_TYPE_INFO 7
-#define ERTS_P2P_SIG_TYPE_LINK 8
-#define ERTS_P2P_SIG_TYPE_UNLINK 9
+enum {
+ ERTS_P2P_SIG_TYPE_BAD = 0,
+ ERTS_P2P_SIG_TYPE_OUTPUT = 1,
+ ERTS_P2P_SIG_TYPE_OUTPUTV = 2,
+ ERTS_P2P_SIG_TYPE_CONNECT = 3,
+ ERTS_P2P_SIG_TYPE_EXIT = 4,
+ ERTS_P2P_SIG_TYPE_CONTROL = 5,
+ ERTS_P2P_SIG_TYPE_CALL = 6,
+ ERTS_P2P_SIG_TYPE_INFO = 7,
+ ERTS_P2P_SIG_TYPE_LINK = 8,
+ ERTS_P2P_SIG_TYPE_UNLINK = 9,
+ ERTS_P2P_SIG_TYPE_MONITOR = 10,
+ ERTS_P2P_SIG_TYPE_DEMONITOR = 11
+};
#define ERTS_P2P_SIG_TYPE_BITS 4
#define ERTS_P2P_SIG_TYPE_MASK \
@@ -858,6 +915,15 @@ struct ErtsProc2PortSigData_ {
struct {
Eterm from;
} unlink;
+ struct {
+ Eterm origin; /* who receives monitor event, pid */
+ Eterm name; /* either name for named monitor, or port id */
+ } monitor;
+ struct {
+ Eterm origin; /* who is at the other end of the monitor, pid */
+ Eterm name; /* port id */
+ Uint32 ref[ERTS_MAX_REF_NUMBERS]; /* box contents of a ref */
+ } demonitor;
} u;
} ;
@@ -910,17 +976,7 @@ typedef enum {
ERTS_PORT_OP_DONE
} ErtsPortOpResult;
-ErtsPortOpResult
-erts_schedule_proc2port_signal(Process *,
- Port *,
- Eterm,
- Eterm *,
- ErtsProc2PortSigData *,
- int,
- ErtsPortTaskHandle *,
- ErtsProc2PortSigCallback);
-
-int erts_deliver_port_exit(Port *, Eterm, Eterm, int);
+int erts_deliver_port_exit(Port *, Eterm, Eterm, int, int);
/*
* Port signal flags
@@ -954,4 +1010,34 @@ 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 *);
+/* Creates monitor between Origin and Target. Ref must be initialized to
+ * a reference (ref may be rewritten to be used to serve additionally as a
+ * signal id). Name is atom if user monitors port by name or NIL */
+ErtsPortOpResult erts_port_monitor(Process *origin, Port *target, Eterm name,
+ Eterm *ref);
+
+typedef enum {
+ /* Normal demonitor rules apply with locking and reductions bump */
+ ERTS_PORT_DEMONITOR_NORMAL = 1,
+ /* Relaxed demonitor rules when process is about to die, which means that
+ * pid lookup won't work, locks won't work, no reductions bump. */
+ ERTS_PORT_DEMONITOR_ORIGIN_ON_DEATHBED = 2,
+} ErtsDemonitorMode;
+
+/* Removes monitor between origin and target, identified by ref.
+ * origin_is_dying can be 0 (false, normal locking rules and reductions bump
+ * apply) or 1 (true, in case when we avoid origin locking) */
+ErtsPortOpResult erts_port_demonitor(Process *origin, ErtsDemonitorMode mode,
+ Port *target, Eterm ref,
+ Eterm *trap_ref);
+/* defined in erl_bif_port.c */
+Port *erts_sig_lookup_port(Process *c_p, Eterm id_or_name);
+
+int erts_port_output_async(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 31d9a1e26e..4d7a86398a 100644
--- a/erts/emulator/beam/erl_port_task.c
+++ b/erts/emulator/beam/erl_port_task.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2006-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2006-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -32,7 +33,9 @@
#include "global.h"
#include "erl_port_task.h"
#include "dist.h"
+#include "erl_check_io.h"
#include "dtrace-wrapper.h"
+#include "lttng-wrapper.h"
#include <stdarg.h>
/*
@@ -67,6 +70,25 @@ static void chk_task_queues(Port *pp, ErtsPortTask *execq, int processing_busy_q
#else
#define DTRACE_DRIVER(PROBE_NAME, PP) do {} while(0)
#endif
+#ifdef USE_LTTNG_VM_TRACEPOINTS
+#define LTTNG_DRIVER(TRACEPOINT, PP) \
+ if (LTTNG_ENABLED(TRACEPOINT)) { \
+ lttng_decl_portbuf(port_str); \
+ lttng_decl_procbuf(proc_str); \
+ lttng_pid_to_str(ERTS_PORT_GET_CONNECTED(PP), proc_str); \
+ lttng_port_to_str((PP), port_str); \
+ LTTNG3(TRACEPOINT, proc_str, port_str, (PP)->name); \
+ }
+#else
+#define LTTNG_DRIVER(TRACEPOINT, PP) do {} while(0)
+#endif
+
+#define ERTS_SMP_LC_VERIFY_RQ(RQ, PP) \
+ do { \
+ ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq)); \
+ ERTS_SMP_LC_ASSERT((RQ) == ((ErtsRunQueue *) \
+ erts_smp_atomic_read_nob(&(PP)->run_queue))); \
+ } while (0)
erts_smp_atomic_t erts_port_task_outstanding_io_tasks;
@@ -171,10 +193,9 @@ p2p_sig_data_to_task(ErtsProc2PortSigData *sigdp)
return ptp;
}
-ErtsProc2PortSigData *
-erts_port_task_alloc_p2p_sig_data(void)
+static ERTS_INLINE ErtsProc2PortSigData *
+p2p_sig_data_init(ErtsPortTask *ptp)
{
- ErtsPortTask *ptp = port_task_alloc();
ptp->type = ERTS_PORT_TASK_PROC_SIG;
ptp->u.alive.flags = ERTS_PT_FLG_SIG_DEP;
@@ -185,6 +206,31 @@ erts_port_task_alloc_p2p_sig_data(void)
return &ptp->u.alive.td.psig.data;
}
+ErtsProc2PortSigData *
+erts_port_task_alloc_p2p_sig_data(void)
+{
+ ErtsPortTask *ptp = port_task_alloc();
+
+ return p2p_sig_data_init(ptp);
+}
+
+ErtsProc2PortSigData *
+erts_port_task_alloc_p2p_sig_data_extra(size_t extra, void **extra_ptr)
+{
+ ErtsPortTask *ptp = erts_alloc(ERTS_ALC_T_PORT_TASK,
+ sizeof(ErtsPortTask) + extra);
+
+ *extra_ptr = ptp+1;
+
+ return p2p_sig_data_init(ptp);
+}
+
+void
+erts_port_task_free_p2p_sig_data(ErtsProc2PortSigData *sigdp)
+{
+ schedule_port_task_free(p2p_sig_data_to_task(sigdp));
+}
+
static ERTS_INLINE Eterm
task_caller(ErtsPortTask *ptp)
{
@@ -543,6 +589,16 @@ reset_handle(ErtsPortTask *ptp)
}
static ERTS_INLINE void
+reset_executed_io_task_handle(ErtsPortTask *ptp)
+{
+ if (ptp->u.alive.handle) {
+ ASSERT(ptp == handle2task(ptp->u.alive.handle));
+ erts_io_notify_port_task_executed(ptp->u.alive.handle);
+ reset_port_task_handle(ptp->u.alive.handle);
+ }
+}
+
+static ERTS_INLINE void
set_handle(ErtsPortTask *ptp, ErtsPortTaskHandle *pthp)
{
ptp->u.alive.handle = pthp;
@@ -796,28 +852,40 @@ schedule_port_task_handle_list_free(ErtsPortTaskHandleList *pthlp)
}
static ERTS_INLINE void
-abort_nosuspend_task(Port *pp,
- ErtsPortTaskType type,
- ErtsPortTaskTypeData *tdp)
+abort_signal_task(Port *pp,
+ int abort_type,
+ ErtsPortTaskType type,
+ ErtsPortTaskTypeData *tdp,
+ int bpq_data)
{
ASSERT(type == ERTS_PORT_TASK_PROC_SIG);
- if (!pp->sched.taskq.bpq)
+ if (!bpq_data)
tdp->psig.callback(NULL,
ERTS_PORT_SFLG_INVALID,
- ERTS_PROC2PORT_SIG_ABORT_NOSUSPEND,
+ abort_type,
&tdp->psig.data);
else {
ErlDrvSizeT size = erts_proc2port_sig_command_data_size(&tdp->psig.data);
tdp->psig.callback(NULL,
ERTS_PORT_SFLG_INVALID,
- ERTS_PROC2PORT_SIG_ABORT_NOSUSPEND,
+ abort_type,
&tdp->psig.data);
aborted_proc2port_data(pp, size);
}
}
+
+static ERTS_INLINE void
+abort_nosuspend_task(Port *pp,
+ ErtsPortTaskType type,
+ ErtsPortTaskTypeData *tdp,
+ int bpq_data)
+{
+ abort_signal_task(pp, ERTS_PROC2PORT_SIG_ABORT_NOSUSPEND, type, tdp, bpq_data);
+}
+
static ErtsPortTaskHandleList *
get_free_nosuspend_handles(Port *pp)
{
@@ -879,7 +947,7 @@ enqueue_port(ErtsRunQueue *runq, Port *pp)
erts_smp_inc_runq_len(runq, &runq->ports.info, ERTS_PORT_PRIO_LEVEL);
#ifdef ERTS_SMP
- if (runq->halt_in_progress)
+ if (ERTS_RUNQ_FLGS_GET_NOB(runq) & ERTS_RUNQ_FLG_HALTING)
erts_non_empty_runq(runq);
#endif
}
@@ -991,6 +1059,7 @@ static ERTS_INLINE int
finalize_exec(Port *pp, ErtsPortTask **execq, int processing_busy_q)
{
erts_aint32_t act;
+ unsigned int prof_runnable_ports;
if (!processing_busy_q)
pp->sched.taskq.local.first = *execq;
@@ -1007,6 +1076,10 @@ finalize_exec(Port *pp, ErtsPortTask **execq, int processing_busy_q)
if (act & ERTS_PTS_FLG_CHK_UNSET_BUSY_PORT_Q)
act = check_unset_busy_port_q(pp, act, pp->sched.taskq.bpq);
+ prof_runnable_ports = erts_system_profile_flags.runnable_ports;
+ if (prof_runnable_ports)
+ erts_port_task_sched_lock(&pp->sched);
+
while (1) {
erts_aint32_t new, exp;
@@ -1018,12 +1091,24 @@ finalize_exec(Port *pp, ErtsPortTask **execq, int processing_busy_q)
act = erts_smp_atomic32_cmpxchg_relb(&pp->sched.flags, new, exp);
- ASSERT(!(act & ERTS_PTS_FLG_IN_RUNQ));
+ ERTS_LC_ASSERT(!(act & ERTS_PTS_FLG_IN_RUNQ));
+ ERTS_LC_ASSERT(!(act & ERTS_PTS_FLG_EXEC_IMM));
if (exp == act)
break;
}
+ if (prof_runnable_ports | IS_TRACED_FL(pp, F_TRACE_SCHED_PORTS)) {
+ /* trace port scheduling, out */
+ if (IS_TRACED_FL(pp, F_TRACE_SCHED_PORTS))
+ trace_sched_ports(pp, am_out);
+ if (prof_runnable_ports) {
+ if (!(act & (ERTS_PTS_FLG_EXEC_IMM|ERTS_PTS_FLG_HAVE_TASKS)))
+ profile_runnable_port(pp, am_inactive);
+ erts_port_task_sched_unlock(&pp->sched);
+ }
+ }
+
return (act & ERTS_PTS_FLG_HAVE_TASKS) != 0;
}
@@ -1345,7 +1430,7 @@ erts_port_task_abort_nosuspend_tasks(Port *pp)
#endif
schedule_port_task_handle_list_free(pthlp);
- abort_nosuspend_task(pp, type, &td);
+ abort_nosuspend_task(pp, type, &td, pp->sched.taskq.bpq != NULL);
}
}
@@ -1369,11 +1454,9 @@ erts_port_task_schedule(Eterm id,
Port *pp;
ErtsPortTask *ptp = NULL;
erts_aint32_t act, add_flags;
+ unsigned int prof_runnable_ports;
- if (pthp && erts_port_task_is_scheduled(pthp)) {
- ASSERT(0);
- erts_port_task_abort(pthp);
- }
+ ERTS_LC_ASSERT(!pthp || !erts_port_task_is_scheduled(pthp));
ASSERT(is_internal_port(id));
@@ -1391,10 +1474,10 @@ erts_port_task_schedule(Eterm id,
}
#endif
- if (!pp)
- goto fail;
-
if (type != ERTS_PORT_TASK_PROC_SIG) {
+ if (!pp)
+ goto fail;
+
ptp = port_task_alloc();
ptp->type = type;
@@ -1432,6 +1515,9 @@ erts_port_task_schedule(Eterm id,
ptp->u.alive.td.psig.callback = va_arg(argp, ErtsProc2PortSigCallback);
ptp->u.alive.flags |= va_arg(argp, int);
va_end(argp);
+ if (!pp)
+ goto fail;
+
if (!(ptp->u.alive.flags & ERTS_PT_FLG_NOSUSPEND))
set_tmp_handle(ptp, pthp);
else {
@@ -1457,6 +1543,10 @@ erts_port_task_schedule(Eterm id,
if (ns_pthlp)
add_flags |= ERTS_PTS_FLG_HAVE_NS_TASKS;
+ prof_runnable_ports = erts_system_profile_flags.runnable_ports;
+ if (prof_runnable_ports)
+ erts_port_task_sched_lock(&pp->sched);
+
while (1) {
erts_aint32_t new, exp;
@@ -1481,6 +1571,13 @@ erts_port_task_schedule(Eterm id,
goto done; /* Died after our task insert... */
}
+ if (prof_runnable_ports) {
+ if (!(act & ERTS_PTS_FLG_EXEC_IMM))
+ profile_runnable_port(pp, am_active);
+ erts_port_task_sched_unlock(&pp->sched);
+ prof_runnable_ports = 0;
+ }
+
/* Enqueue port on run-queue */
runq = erts_port_runq(pp);
@@ -1489,8 +1586,10 @@ erts_port_task_schedule(Eterm id,
#ifdef ERTS_SMP
xrunq = erts_check_emigration_need(runq, ERTS_PORT_PRIO_LEVEL);
+ ERTS_SMP_LC_ASSERT(runq != xrunq);
+ ERTS_SMP_LC_VERIFY_RQ(runq, pp);
if (xrunq) {
- /* Port emigrated ... */
+ /* Emigrate port ... */
erts_smp_atomic_set_nob(&pp->run_queue, (erts_aint_t) xrunq);
erts_smp_runq_unlock(runq);
runq = erts_port_runq(pp);
@@ -1500,10 +1599,6 @@ erts_port_task_schedule(Eterm id,
#endif
enqueue_port(runq, pp);
-
- if (erts_system_profile_flags.runnable_ports) {
- profile_runnable_port(pp, am_active);
- }
erts_smp_runq_unlock(runq);
@@ -1511,6 +1606,9 @@ erts_port_task_schedule(Eterm id,
done:
+ if (prof_runnable_ports)
+ erts_port_task_sched_unlock(&pp->sched);
+
#ifdef ERTS_SMP
if (dhndl != ERTS_THR_PRGR_DHANDLE_MANAGED)
erts_port_dec_refc(pp);
@@ -1525,12 +1623,13 @@ abort_nosuspend:
erts_port_dec_refc(pp);
#endif
- abort_nosuspend_task(pp, ptp->type, &ptp->u.alive.td);
+ abort_nosuspend_task(pp, ptp->type, &ptp->u.alive.td, 0);
ASSERT(ns_pthlp);
erts_free(ERTS_ALC_T_PT_HNDL_LIST, ns_pthlp);
- if (ptp)
- port_task_free(ptp);
+
+ ASSERT(ptp);
+ port_task_free(ptp);
return 0;
@@ -1541,12 +1640,15 @@ fail:
erts_port_dec_refc(pp);
#endif
+ if (ptp) {
+ abort_signal_task(pp, ERTS_PROC2PORT_SIG_ABORT,
+ ptp->type, &ptp->u.alive.td, 0);
+ port_task_free(ptp);
+ }
+
if (ns_pthlp)
erts_free(ERTS_ALC_T_PT_HNDL_LIST, ns_pthlp);
- if (ptp)
- port_task_free(ptp);
-
return -1;
}
@@ -1600,6 +1702,8 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
erts_aint32_t state;
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));
@@ -1609,12 +1713,13 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
goto done;
}
+ ERTS_SMP_LC_VERIFY_RQ(runq, pp);
+
erts_smp_runq_unlock(runq);
*curr_port_pp = pp;
if (erts_sched_stat.enabled) {
- ErtsSchedulerData *esdp = erts_get_scheduler_data();
Uint old = ERTS_PORT_SCHED_ID(pp, esdp->no);
int migrated = old && old != esdp->no;
@@ -1641,6 +1746,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) {
@@ -1659,8 +1765,6 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
goto aborted_port_task;
}
- reset_handle(ptp);
-
if (erts_system_monitor_long_schedule != 0) {
start_time = erts_timestamp_millis();
}
@@ -1671,41 +1775,57 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
switch (ptp->type) {
case ERTS_PORT_TASK_TIMEOUT:
- reds = ERTS_PORT_REDS_TIMEOUT;
- if (!(state & ERTS_PORT_SFLGS_DEAD)) {
- DTRACE_DRIVER(driver_timeout, pp);
- (*pp->drv_ptr->timeout)((ErlDrvData) pp->drv_data);
- }
+ reset_handle(ptp);
+ if (!ERTS_PTMR_IS_TIMED_OUT(pp))
+ reds = 0;
+ else {
+ ERTS_PTMR_CLEAR(pp);
+ reds = ERTS_PORT_REDS_TIMEOUT;
+ if (!(state & ERTS_PORT_SFLGS_DEAD)) {
+ DTRACE_DRIVER(driver_timeout, pp);
+ LTTNG_DRIVER(driver_timeout, pp);
+ if (IS_TRACED_FL(pp, F_TRACE_RECEIVE))
+ trace_port(pp, am_receive, am_timeout);
+ (*pp->drv_ptr->timeout)((ErlDrvData) pp->drv_data);
+ }
+ }
break;
case ERTS_PORT_TASK_INPUT:
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
+ LTTNG_DRIVER(driver_ready_input, pp);
+ /* 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);
+ reset_executed_io_task_handle(ptp);
io_tasks_executed++;
break;
case ERTS_PORT_TASK_OUTPUT:
reds = ERTS_PORT_REDS_OUTPUT;
ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0);
DTRACE_DRIVER(driver_ready_output, pp);
+ LTTNG_DRIVER(driver_ready_output, pp);
(*pp->drv_ptr->ready_output)((ErlDrvData) pp->drv_data,
ptp->u.alive.td.io.event);
+ reset_executed_io_task_handle(ptp);
io_tasks_executed++;
break;
case ERTS_PORT_TASK_EVENT:
reds = ERTS_PORT_REDS_EVENT;
ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0);
DTRACE_DRIVER(driver_event, pp);
+ LTTNG_DRIVER(driver_event, pp);
(*pp->drv_ptr->event)((ErlDrvData) pp->drv_data,
ptp->u.alive.td.io.event,
ptp->u.alive.td.io.event_data);
+ reset_executed_io_task_handle(ptp);
io_tasks_executed++;
break;
case ERTS_PORT_TASK_PROC_SIG: {
ErtsProc2PortSigData *sigdp = &ptp->u.alive.td.psig.data;
+ reset_handle(ptp);
ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0);
if (!pp->sched.taskq.bpq)
reds = ptp->u.alive.td.psig.callback(pp,
@@ -1723,10 +1843,11 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
break;
}
case ERTS_PORT_TASK_DIST_CMD:
+ reset_handle(ptp);
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;
@@ -1764,11 +1885,8 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
}
erts_unblock_fpe(fpe_was_unmasked);
+ ERTS_MSACC_POP_STATE_M();
- /* trace port scheduling, out */
- if (IS_TRACED_FL(pp, F_TRACE_SCHED_PORTS)) {
- trace_sched_ports(pp, am_out);
- }
if (io_tasks_executed) {
ASSERT(erts_smp_atomic_read_nob(&erts_port_task_outstanding_io_tasks)
@@ -1791,11 +1909,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
erts_smp_runq_lock(runq);
- if (!active) {
- if (erts_system_profile_flags.runnable_ports)
- profile_runnable_port(pp, am_inactive);
- }
- else {
+ if (active) {
#ifdef ERTS_SMP
ErtsRunQueue *xrunq;
#endif
@@ -1804,6 +1918,8 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
#ifdef ERTS_SMP
xrunq = erts_check_emigration_need(runq, ERTS_PORT_PRIO_LEVEL);
+ ERTS_SMP_LC_ASSERT(runq != xrunq);
+ ERTS_SMP_LC_VERIFY_RQ(runq, pp);
if (!xrunq) {
#endif
enqueue_port(runq, pp);
@@ -1811,7 +1927,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
#ifdef ERTS_SMP
}
else {
- /* Port emigrated ... */
+ /* Emigrate port... */
erts_smp_atomic_set_nob(&pp->run_queue, (erts_aint_t) xrunq);
erts_smp_runq_unlock(runq);
@@ -1833,7 +1949,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
runq->scheduler->reductions += reds;
ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq));
- ERTS_PORT_REDUCTIONS_EXECUTED(runq, reds);
+ ERTS_PORT_REDUCTIONS_EXECUTED(esdp, runq, reds);
return res;
}
@@ -1996,7 +2112,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);
}
@@ -2063,13 +2179,6 @@ begin_port_cleanup(Port *pp, ErtsPortTask **execqp, int *processing_busy_q_p)
#endif
}
-int
-erts_port_is_scheduled(Port *pp)
-{
- erts_aint32_t flags = erts_smp_atomic32_read_acqb(&pp->sched.flags);
- return (flags & (ERTS_PTS_FLG_IN_RUNQ|ERTS_PTS_FLG_EXEC)) != 0;
-}
-
#ifdef ERTS_SMP
void
diff --git a/erts/emulator/beam/erl_port_task.h b/erts/emulator/beam/erl_port_task.h
index 1d30465ec9..39f403b443 100644
--- a/erts/emulator/beam/erl_port_task.h
+++ b/erts/emulator/beam/erl_port_task.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2006-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2006-2017. 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.
+ * 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%
*/
@@ -78,6 +79,7 @@ extern erts_smp_atomic_t erts_port_task_outstanding_io_tasks;
#define ERTS_PTS_FLG_PARALLELISM (((erts_aint32_t) 1) << 9)
#define ERTS_PTS_FLG_FORCE_SCHED (((erts_aint32_t) 1) << 10)
#define ERTS_PTS_FLG_EXITING (((erts_aint32_t) 1) << 11)
+#define ERTS_PTS_FLG_EXEC_IMM (((erts_aint32_t) 1) << 12)
#define ERTS_PTS_FLGS_BUSY \
(ERTS_PTS_FLG_BUSY_PORT | ERTS_PTS_FLG_BUSY_PORT_Q)
@@ -87,6 +89,7 @@ extern erts_smp_atomic_t erts_port_task_outstanding_io_tasks;
| ERTS_PTS_FLG_HAVE_BUSY_TASKS \
| ERTS_PTS_FLG_HAVE_TASKS \
| ERTS_PTS_FLG_EXEC \
+ | ERTS_PTS_FLG_EXEC_IMM \
| ERTS_PTS_FLG_FORCE_SCHED \
| ERTS_PTS_FLG_EXITING)
@@ -154,7 +157,7 @@ erts_port_task_handle_init(ErtsPortTaskHandle *pthp)
ERTS_GLB_INLINE int
erts_port_task_is_scheduled(ErtsPortTaskHandle *pthp)
{
- return ((void *) erts_smp_atomic_read_nob(pthp)) != NULL;
+ return ((void *) erts_smp_atomic_read_acqb(pthp)) != NULL;
}
ERTS_GLB_INLINE void erts_port_task_pre_init_sched(ErtsPortTaskSched *ptsp,
@@ -185,13 +188,7 @@ erts_port_task_init_sched(ErtsPortTaskSched *ptsp, Eterm instr_id)
ptsp->taskq.in.last = NULL;
erts_smp_atomic32_init_nob(&ptsp->flags, 0);
#ifdef ERTS_SMP
- erts_mtx_init_x(&ptsp->mtx, lock_str, instr_id,
-#ifdef ERTS_ENABLE_LOCK_COUNT
- (erts_lcnt_rt_options & ERTS_LCNT_OPT_PORTLOCK)
-#else
- 1
-#endif
- );
+ erts_mtx_init(&ptsp->mtx, lock_str, instr_id, ERTS_LOCK_FLAGS_CATEGORY_IO);
#endif
}
@@ -264,8 +261,9 @@ int erts_port_task_schedule(Eterm,
ErtsPortTaskType,
...);
void erts_port_task_free_port(Port *);
-int erts_port_is_scheduled(Port *);
ErtsProc2PortSigData *erts_port_task_alloc_p2p_sig_data(void);
+ErtsProc2PortSigData *erts_port_task_alloc_p2p_sig_data_extra(size_t extra, void **extra_ptr);
+void erts_port_task_free_p2p_sig_data(ErtsProc2PortSigData *sigdp);
#ifdef ERTS_SMP
void erts_enqueue_port(ErtsRunQueue *rq, Port *pp);
diff --git a/erts/emulator/beam/erl_printf_term.c b/erts/emulator/beam/erl_printf_term.c
index d18760dc43..e6f8460164 100644
--- a/erts/emulator/beam/erl_printf_term.c
+++ b/erts/emulator/beam/erl_printf_term.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2005-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2005-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -25,6 +26,7 @@
#include "sys.h"
#include "big.h"
#include "erl_map.h"
+#include "erl_binary.h"
#define PRINT_CHAR(CNT, FN, ARG, C) \
do { \
@@ -115,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))
@@ -138,6 +139,25 @@ is_printable_string(Eterm list, Eterm* base)
return 0;
}
+static int is_printable_ascii(byte* bytep, Uint bytesize, Uint bitoffs)
+{
+ if (!bitoffs) {
+ while (bytesize--) {
+ if (*bytep < ' ' || *bytep >= 127)
+ return 0;
+ bytep++;
+ }
+ } else {
+ while (bytesize--) {
+ byte octet = (bytep[0] << bitoffs) | (bytep[1] >> (8-bitoffs));
+ if (octet < ' ' || octet >= 127)
+ return 0;
+ bytep++;
+ }
+ }
+ return 1;
+}
+
/* print a atom doing what quoting is necessary */
static int print_atom_name(fmtfn_t fn, void* arg, Eterm atom, long *dcount)
{
@@ -227,10 +247,19 @@ static int print_atom_name(fmtfn_t fn, void* arg, Eterm atom, long *dcount)
#define PRT_PATCH_FUN_SIZE ((Eterm) 7)
#define PRT_LAST_ARRAY_ELEMENT ((Eterm) 8) /* Note! Must be last... */
+#if 0
+static char *format_binary(Uint16 x, char *b) {
+ int z;
+ b[16] = '\0';
+ for (z = 0; z < 16; z++) {
+ b[15-z] = ((x>>z) & 0x1) ? '1' : '0';
+ }
+ return 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;
@@ -276,20 +305,16 @@ 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);
tl = CDR(cons);
if (is_not_nil(tl)) {
if (is_list(tl)) {
- WSTACK_PUSH(s, tl);
- WSTACK_PUSH(s, PRT_ONE_CONS);
- WSTACK_PUSH(s, PRT_COMMA);
+ WSTACK_PUSH3(s, tl, PRT_ONE_CONS, PRT_COMMA);
} else {
- WSTACK_PUSH(s, tl);
- WSTACK_PUSH(s, PRT_TERM);
- WSTACK_PUSH(s, PRT_BAR);
+ WSTACK_PUSH3(s, tl, PRT_TERM, PRT_BAR);
}
}
}
@@ -299,9 +324,7 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount,
break;
default: /* PRT_LAST_ARRAY_ELEMENT+1 and upwards */
obj = *popped.ptr;
- WSTACK_PUSH(s, (UWord) (popped.ptr + 1));
- WSTACK_PUSH(s, val-1);
- WSTACK_PUSH(s, PRT_COMMA);
+ WSTACK_PUSH3(s, (UWord) (popped.ptr + 1), val-1, PRT_COMMA);
break;
}
break;
@@ -318,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, "[]");
@@ -363,12 +382,15 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount,
break;
}
case REF_DEF:
+ if (!ERTS_IS_CRASH_DUMPING)
+ erts_magic_ref_save_bin(obj);
+ /* fall through... */
case EXTERNAL_REF_DEF:
PRINT_STRING(res, fn, arg, "#Ref<");
PRINT_UWORD(res, fn, arg, 'u', 0, 1,
(ErlPfUWord) ref_channel_no(wobj));
ref_num = ref_numbers(wobj);
- for (i = ref_no_of_numbers(wobj)-1; i >= 0; i--) {
+ for (i = ref_no_numbers(wobj)-1; i >= 0; i--) {
PRINT_CHAR(res, fn, arg, '.');
PRINT_UWORD(res, fn, arg, 'u', 0, 1, (ErlPfUWord) ref_num[i]);
}
@@ -398,10 +420,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;
@@ -415,7 +437,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 {
@@ -431,8 +453,7 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount,
WSTACK_PUSH(s,PRT_CLOSE_TUPLE);
++nobj;
if (i > 0) {
- WSTACK_PUSH(s, (UWord) nobj);
- WSTACK_PUSH(s, PRT_LAST_ARRAY_ELEMENT+i-1);
+ WSTACK_PUSH2(s, (UWord) nobj, PRT_LAST_ARRAY_ELEMENT+i-1);
}
break;
case FLOAT_DEF: {
@@ -442,25 +463,74 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount,
}
break;
case BINARY_DEF:
- if (header_is_bin_matchstate(*boxed_val(wobj))) {
- PRINT_STRING(res, fn, arg, "#MatchState");
- }
- else {
- ProcBin* pb = (ProcBin *) binary_val(wobj);
- if (pb->size == 1)
- PRINT_STRING(res, fn, arg, "<<1 byte>>");
- else {
+ {
+ byte* bytep;
+ Uint bytesize = binary_size(obj);
+ Uint bitoffs;
+ Uint bitsize;
+ byte octet;
+ ERTS_GET_BINARY_BYTES(obj, bytep, bitoffs, bitsize);
+
+ if (bitsize || !bytesize
+ || !is_printable_ascii(bytep, bytesize, bitoffs)) {
+ int is_first = 1;
PRINT_STRING(res, fn, arg, "<<");
- PRINT_UWORD(res, fn, arg, 'u', 0, 1, (ErlPfUWord) pb->size);
- PRINT_STRING(res, fn, arg, " bytes>>");
+ while (bytesize) {
+ if (is_first)
+ is_first = 0;
+ else
+ PRINT_CHAR(res, fn, arg, ',');
+ if (bitoffs)
+ octet = (bytep[0] << bitoffs) | (bytep[1] >> (8-bitoffs));
+ else
+ octet = bytep[0];
+ PRINT_UWORD(res, fn, arg, 'u', 0, 1, octet);
+ ++bytep;
+ --bytesize;
+ }
+ if (bitsize) {
+ Uint bits = bitoffs + bitsize;
+ octet = bytep[0];
+ if (bits < 8)
+ octet >>= 8 - bits;
+ else if (bits > 8) {
+ bits -= 8; /* bits in last byte */
+ octet <<= bits;
+ octet |= bytep[1] >> (8 - bits);
+ }
+ octet &= (1 << bitsize) - 1;
+ if (is_first)
+ is_first = 0;
+ else
+ PRINT_CHAR(res, fn, arg, ',');
+ PRINT_UWORD(res, fn, arg, 'u', 0, 1, octet);
+ PRINT_CHAR(res, fn, arg, ':');
+ PRINT_UWORD(res, fn, arg, 'u', 0, 1, bitsize);
+ }
+ PRINT_STRING(res, fn, arg, ">>");
+ }
+ else {
+ PRINT_STRING(res, fn, arg, "<<\"");
+ while (bytesize) {
+ if (bitoffs)
+ octet = (bytep[0] << bitoffs) | (bytep[1] >> (8-bitoffs));
+ else
+ octet = bytep[0];
+ if (octet == '"')
+ PRINT_CHAR(res, fn, arg, '\\');
+ PRINT_CHAR(res, fn, arg, octet);
+ ++bytep;
+ --bytesize;
+ }
+ PRINT_STRING(res, fn, arg, "\">>");
}
}
break;
case EXPORT_DEF:
{
Export* ep = *((Export **) (export_val(wobj) + 1));
- Atom* module = atom_tab(atom_val(ep->code[0]));
- Atom* name = atom_tab(atom_val(ep->code[1]));
+ Atom* module = atom_tab(atom_val(ep->info.mfa.module));
+ Atom* name = atom_tab(atom_val(ep->info.mfa.function));
PRINT_STRING(res, fn, arg, "#Fun<");
PRINT_BUF(res, fn, arg, module->name, module->len);
@@ -468,7 +538,7 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount,
PRINT_BUF(res, fn, arg, name->name, name->len);
PRINT_CHAR(res, fn, arg, '.');
PRINT_SWORD(res, fn, arg, 'd', 0, 1,
- (ErlPfSWord) ep->code[2]);
+ (ErlPfSWord) ep->info.mfa.arity);
PRINT_CHAR(res, fn, arg, '>');
}
break;
@@ -489,37 +559,77 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount,
}
break;
case MAP_DEF:
- {
- Uint n;
- Eterm *ks, *vs;
- map_t *mp = (map_t *)map_val(wobj);
- n = map_get_size(mp);
- ks = map_get_keys(mp);
- vs = map_get_values(mp);
-
- PRINT_CHAR(res, fn, arg, '#');
- PRINT_CHAR(res, fn, arg, '{');
- WSTACK_PUSH(s, PRT_CLOSE_TUPLE);
- if (n > 0) {
- n--;
- WSTACK_PUSH(s, vs[n]);
- WSTACK_PUSH(s, PRT_TERM);
- WSTACK_PUSH(s, PRT_ASSOC);
- WSTACK_PUSH(s, ks[n]);
- WSTACK_PUSH(s, PRT_TERM);
-
- while (n--) {
- WSTACK_PUSH(s, PRT_COMMA);
- WSTACK_PUSH(s, vs[n]);
- WSTACK_PUSH(s, PRT_TERM);
- WSTACK_PUSH(s, PRT_ASSOC);
- WSTACK_PUSH(s, ks[n]);
- WSTACK_PUSH(s, PRT_TERM);
- }
- }
- }
+ if (is_flatmap(wobj)) {
+ Uint n;
+ Eterm *ks, *vs;
+ flatmap_t *mp = (flatmap_t *)flatmap_val(wobj);
+ n = flatmap_get_size(mp);
+ ks = flatmap_get_keys(mp);
+ vs = flatmap_get_values(mp);
+
+ PRINT_CHAR(res, fn, arg, '#');
+ PRINT_CHAR(res, fn, arg, '{');
+ WSTACK_PUSH(s, PRT_CLOSE_TUPLE);
+ if (n > 0) {
+ n--;
+ WSTACK_PUSH5(s, vs[n], PRT_TERM, PRT_ASSOC, ks[n], PRT_TERM);
+ while (n--) {
+ WSTACK_PUSH6(s, PRT_COMMA, vs[n], PRT_TERM, PRT_ASSOC,
+ ks[n], PRT_TERM);
+ }
+ }
+ } else {
+ Uint n, mapval;
+ Eterm *head;
+ head = hashmap_val(wobj);
+ mapval = MAP_HEADER_VAL(*head);
+ switch (MAP_HEADER_TYPE(*head)) {
+ case MAP_HEADER_TAG_HAMT_HEAD_ARRAY:
+ case MAP_HEADER_TAG_HAMT_HEAD_BITMAP:
+ PRINT_STRING(res, fn, arg, "#<");
+ PRINT_UWORD(res, fn, arg, 'x', 0, 1, mapval);
+ PRINT_STRING(res, fn, arg, ">{");
+ WSTACK_PUSH(s,PRT_CLOSE_TUPLE);
+ n = hashmap_bitcount(mapval);
+ ASSERT(n < 17);
+ head += 2;
+ if (n > 0) {
+ n--;
+ WSTACK_PUSH(s, head[n]);
+ WSTACK_PUSH(s, PRT_TERM);
+ while (n--) {
+ WSTACK_PUSH(s, PRT_COMMA);
+ WSTACK_PUSH(s, head[n]);
+ WSTACK_PUSH(s, PRT_TERM);
+ }
+ }
+ break;
+ case MAP_HEADER_TAG_HAMT_NODE_BITMAP:
+ n = hashmap_bitcount(mapval);
+ head++;
+ PRINT_CHAR(res, fn, arg, '<');
+ PRINT_UWORD(res, fn, arg, 'x', 0, 1, mapval);
+ PRINT_STRING(res, fn, arg, ">{");
+ WSTACK_PUSH(s,PRT_CLOSE_TUPLE);
+ ASSERT(n < 17);
+ if (n > 0) {
+ n--;
+ WSTACK_PUSH(s, head[n]);
+ WSTACK_PUSH(s, PRT_TERM);
+ while (n--) {
+ WSTACK_PUSH(s, PRT_COMMA);
+ WSTACK_PUSH(s, head[n]);
+ WSTACK_PUSH(s, PRT_TERM);
+ }
+ }
+ break;
+ }
+ }
+ break;
+ case MATCHSTATE_DEF:
+ PRINT_STRING(res, fn, arg, "#MatchState");
break;
- default:
+ default:
PRINT_STRING(res, fn, arg, "<unknown:");
PRINT_POINTER(res, fn, arg, wobj);
PRINT_CHAR(res, fn, arg, '>');
@@ -528,19 +638,17 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount,
}
L_done:
-
DESTROY_WSTACK(s);
return res;
}
+
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;
- ASSERT(sizeof(ErlPfEterm) == sizeof(Eterm));
+ 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 f92c99d713..8a30286fd8 100644
--- a/erts/emulator/beam/erl_printf_term.h
+++ b/erts/emulator/beam/erl_printf_term.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2005-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2005-2016. 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.
+ * 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%
*/
@@ -21,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 fd02f10540..1f8a756305 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2014. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -42,9 +43,14 @@
#include "erl_thr_queue.h"
#include "erl_async.h"
#include "dtrace-wrapper.h"
+#include "lttng-wrapper.h"
#include "erl_ptab.h"
+#include "erl_bif_unique.h"
+#define ERTS_WANT_TIMER_WHEEL_API
+#include "erl_time.h"
+#include "erl_nfunc_sched.h"
-
+#define ERTS_CHECK_TIME_REDS CONTEXT_REDS
#define ERTS_DELAYED_WAKEUP_INFINITY (~(Uint64) 0)
#define ERTS_DELAYED_WAKEUP_REDUCTIONS ((Uint64) CONTEXT_REDS/2)
@@ -54,11 +60,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
@@ -105,9 +107,33 @@
#define LOW_BIT (1 << PRIORITY_LOW)
#define PORT_BIT (1 << ERTS_PORT_PRIO_LEVEL)
-#define ERTS_EMPTY_RUNQ(RQ) \
- ((ERTS_RUNQ_FLGS_GET_NOB((RQ)) & ERTS_RUNQ_FLGS_QMASK) == 0 \
- && (RQ)->misc.start == NULL)
+#define ERTS_IS_RUNQ_EMPTY_FLGS(FLGS) \
+ (!((FLGS) & (ERTS_RUNQ_FLGS_QMASK|ERTS_RUNQ_FLG_MISC_OP)))
+
+#define ERTS_IS_RUNQ_EMPTY_PORTS_FLGS(FLGS) \
+ (!((FLGS) & (PORT_BIT|ERTS_RUNQ_FLG_MISC_OP)))
+
+#define ERTS_EMPTY_RUNQ(RQ) \
+ ERTS_IS_RUNQ_EMPTY_FLGS(ERTS_RUNQ_FLGS_GET_NOB((RQ)))
+
+#define ERTS_EMPTY_RUNQ_PORTS(RQ) \
+ ERTS_IS_RUNQ_EMPTY_FLGS(ERTS_RUNQ_FLGS_GET_NOB((RQ)))
+
+static ERTS_INLINE int
+runq_got_work_to_execute_flags(Uint32 flags)
+{
+ if (flags & ERTS_RUNQ_FLG_HALTING)
+ return !ERTS_IS_RUNQ_EMPTY_PORTS_FLGS(flags);
+ return !ERTS_IS_RUNQ_EMPTY_FLGS(flags);
+}
+
+#ifdef ERTS_SMP
+static ERTS_INLINE int
+runq_got_work_to_execute(ErtsRunQueue *rq)
+{
+ return runq_got_work_to_execute_flags(ERTS_RUNQ_FLGS_GET_NOB(rq));
+}
+#endif
#undef RUNQ_READ_RQ
#undef RUNQ_SET_RQ
@@ -115,7 +141,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) \
@@ -139,22 +165,23 @@ do { \
# define ERTS_DBG_VERIFY_VALID_RUNQP(RQP)
#endif
-#define ERTS_EMPTY_RUNQ_PORTS(RQ) \
- (RUNQ_READ_LEN(&(RQ)->ports.info.len) == 0 && (RQ)->misc.start == NULL)
-
const Process erts_invalid_process = {{ERTS_INVALID_PID}};
extern BeamInstr beam_apply[];
extern BeamInstr beam_exit[];
extern BeamInstr beam_continue_exit[];
-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) = SPO_ON_HEAP_MSGQ;
+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_total_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;
#define ERTS_THR_PRGR_LATER_CLEANUP_OP_THRESHOLD_VERY_LAZY (4*1024*1024)
#define ERTS_THR_PRGR_LATER_CLEANUP_OP_THRESHOLD_LAZY (512*1024)
@@ -167,7 +194,10 @@ static UWord thr_prgr_later_cleanup_op_threshold = ERTS_THR_PRGR_LATER_CLEANUP_O
ErtsPTab erts_proc erts_align_attribute(ERTS_CACHE_LINE_SIZE);
int erts_sched_thread_suggested_stack_size = -1;
-
+#ifdef ERTS_DIRTY_SCHEDULERS
+int erts_dcpu_sched_thread_suggested_stack_size = -1;
+int erts_dio_sched_thread_suggested_stack_size = -1;
+#endif
#ifdef ERTS_ENABLE_LOCK_CHECK
ErtsLcPSDLocks erts_psd_required_locks[ERTS_PSD_SIZE];
#endif
@@ -183,84 +213,153 @@ 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 struct {
+ int ongoing;
+ ErtsProcList *blckrs;
+ ErtsProcList *chngq;
+} ErtsMultiSchedulingBlock;
-#define ERTS_SCHDLR_SSPND_CHNG_SET(VAL, OLD_VAL) \
- erts_smp_atomic32_set_nob(&schdlr_sspnd.changing, (VAL))
+typedef struct {
+ Uint32 normal;
+#ifdef ERTS_DIRTY_SCHEDULERS
+ Uint32 dirty_cpu;
+ Uint32 dirty_io;
+#endif
+} ErtsSchedTypeCounters;
+static struct {
+ erts_smp_mtx_t mtx;
+ ErtsSchedTypeCounters online;
+ ErtsSchedTypeCounters curr_online;
+ ErtsSchedTypeCounters active;
+ erts_smp_atomic32_t changing;
+ ErtsProcList *chngq;
+ Eterm changer;
+ ErtsMultiSchedulingBlock nmsb; /* Normal multi Scheduling Block */
+ ErtsMultiSchedulingBlock msb; /* Multi Scheduling Block */
#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))
+ ErtsSchedType last_msb_dirty_type;
#endif
+} schdlr_sspnd;
-#else
+static void init_scheduler_suspend(void);
-#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)
+static ERTS_INLINE Uint32
+schdlr_sspnd_eq_nscheds(ErtsSchedTypeCounters *val1p, ErtsSchedTypeCounters *val2p)
+{
+ int res = val1p->normal == val2p->normal;
+#ifdef ERTS_DIRTY_SCHEDULERS
+ res &= val1p->dirty_cpu == val2p->dirty_cpu;
+ res &= val1p->dirty_io == val2p->dirty_io;
+#endif
+ return res;
+}
+static ERTS_INLINE Uint32
+schdlr_sspnd_get_nscheds(ErtsSchedTypeCounters *valp,
+ ErtsSchedType type)
+{
+ switch (type) {
+ case ERTS_SCHED_NORMAL:
+ return valp->normal;
#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)
+ case ERTS_SCHED_DIRTY_CPU:
+ return valp->dirty_cpu;
+ case ERTS_SCHED_DIRTY_IO:
+ return valp->dirty_io;
+#else
+ case ERTS_SCHED_DIRTY_CPU:
+ case ERTS_SCHED_DIRTY_IO:
+ return 0;
#endif
+ default:
+ ERTS_INTERNAL_ERROR("Invalid scheduler type");
+ return 0;
+ }
+}
+#ifdef DEBUG
+static ERTS_INLINE Uint32
+schdlr_sspnd_get_nscheds_tot(ErtsSchedTypeCounters *valp)
+{
+ Uint32 res = valp->normal;
+#ifdef ERTS_DIRTY_SCHEDULERS
+ res += valp->dirty_cpu;
+ res += valp->dirty_io;
+#endif
+ return res;
+}
#endif
+static ERTS_INLINE void
+schdlr_sspnd_dec_nscheds(ErtsSchedTypeCounters *valp,
+ ErtsSchedType type)
+{
+ ASSERT(schdlr_sspnd_get_nscheds(valp, type) > 0);
-static struct {
- erts_smp_mtx_t mtx;
- erts_smp_cnd_t cnd;
- int online;
- int curr_online;
- int wait_curr_online;
+ switch (type) {
+ case ERTS_SCHED_NORMAL:
+ valp->normal--;
+ break;
#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;
+ case ERTS_SCHED_DIRTY_CPU:
+ valp->dirty_cpu--;
+ break;
+ case ERTS_SCHED_DIRTY_IO:
+ valp->dirty_io--;
+ break;
#endif
- erts_smp_atomic32_t changing;
- erts_smp_atomic32_t active;
+ default:
+ ERTS_INTERNAL_ERROR("Invalid scheduler type");
+ }
+}
+
+static ERTS_INLINE void
+schdlr_sspnd_inc_nscheds(ErtsSchedTypeCounters *valp,
+ ErtsSchedType type)
+{
+ switch (type) {
+ case ERTS_SCHED_NORMAL:
+ valp->normal++;
+ break;
#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;
+ case ERTS_SCHED_DIRTY_CPU:
+ valp->dirty_cpu++;
+ break;
+ case ERTS_SCHED_DIRTY_IO:
+ valp->dirty_io++;
+ break;
#endif
- struct {
- int ongoing;
- long wait_active;
+ default:
+ ERTS_INTERNAL_ERROR("Invalid scheduler type");
+ }
+}
+
+static ERTS_INLINE void
+schdlr_sspnd_set_nscheds(ErtsSchedTypeCounters *valp,
+ ErtsSchedType type, Uint32 no)
+{
+ switch (type) {
+ case ERTS_SCHED_NORMAL:
+ valp->normal = no;
+ break;
#ifdef ERTS_DIRTY_SCHEDULERS
- long dirty_cpu_wait_active;
- long dirty_io_wait_active;
+ case ERTS_SCHED_DIRTY_CPU:
+ valp->dirty_cpu = no;
+ break;
+ case ERTS_SCHED_DIRTY_IO:
+ valp->dirty_io = no;
+ break;
#endif
- ErtsProcList *procs;
- } msb; /* Multi Scheduling Block */
-} schdlr_sspnd;
+ default:
+ ERTS_INTERNAL_ERROR("Invalid scheduler type");
+ }
+}
static struct {
erts_smp_mtx_t update_mtx;
@@ -290,7 +389,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;
@@ -306,13 +405,63 @@ static erts_atomic_t runq_supervisor_sleeping;
ErtsSchedulerData *erts_scheduler_data;
#endif
-ErtsAlignedRunQueue *erts_aligned_run_queues;
-Uint erts_no_run_queues;
+ErtsAlignedRunQueue * ERTS_WRITE_UNLIKELY(erts_aligned_run_queues);
+Uint ERTS_WRITE_UNLIKELY(erts_no_run_queues);
-ErtsAlignedSchedulerData *erts_aligned_scheduler_data;
#ifdef ERTS_DIRTY_SCHEDULERS
-ErtsAlignedSchedulerData *erts_aligned_dirty_cpu_scheduler_data;
-ErtsAlignedSchedulerData *erts_aligned_dirty_io_scheduler_data;
+
+struct {
+ union {
+ erts_smp_atomic32_t active;
+ char align__[ERTS_CACHE_LINE_SIZE];
+ } cpu;
+ union {
+ erts_smp_atomic32_t active;
+ char align__[ERTS_CACHE_LINE_SIZE];
+ } io;
+} dirty_count erts_align_attribute(ERTS_CACHE_LINE_SIZE);
+
+#endif
+
+static ERTS_INLINE void
+dirty_active(ErtsSchedulerData *esdp, erts_aint32_t add)
+{
+#ifdef ERTS_DIRTY_SCHEDULERS
+ erts_aint32_t val;
+ erts_smp_atomic32_t *ap;
+ switch (esdp->type) {
+ case ERTS_SCHED_DIRTY_CPU:
+ ap = &dirty_count.cpu.active;
+ break;
+ case ERTS_SCHED_DIRTY_IO:
+ ap = &dirty_count.io.active;
+ break;
+ default:
+ ap = NULL;
+ ERTS_INTERNAL_ERROR("Not a dirty scheduler");
+ break;
+ }
+
+ /*
+ * All updates done under run-queue lock, so
+ * no inc or dec needed...
+ */
+ ERTS_SMP_ASSERT(erts_smp_lc_runq_is_locked(esdp->run_queue));
+
+ val = erts_smp_atomic32_read_nob(ap);
+ val += add;
+ erts_smp_atomic32_set_nob(ap, val);
+#endif
+}
+
+ErtsAlignedSchedulerData * ERTS_WRITE_UNLIKELY(erts_aligned_scheduler_data);
+#ifdef ERTS_DIRTY_SCHEDULERS
+ErtsAlignedSchedulerData * ERTS_WRITE_UNLIKELY(erts_aligned_dirty_cpu_scheduler_data);
+ErtsAlignedSchedulerData * ERTS_WRITE_UNLIKELY(erts_aligned_dirty_io_scheduler_data);
+typedef union {
+ Process dsp;
+ char align[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(Process))];
+} ErtsAlignedDirtyShadowProcess;
#endif
typedef union {
@@ -330,24 +479,29 @@ 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"
#endif
typedef enum {
- ERTS_PSTT_GC, /* Garbage Collect */
- ERTS_PSTT_CPC /* Check Process Code */
+ ERTS_PSTT_GC_MAJOR, /* Garbage Collect: Fullsweep */
+ ERTS_PSTT_GC_MINOR, /* Garbage Collect: Generational */
+ ERTS_PSTT_CPC, /* Check Process Code */
+ ERTS_PSTT_CLA, /* Copy Literal Area */
+ ERTS_PSTT_COHMQ, /* Change off heap message queue */
+ ERTS_PSTT_FTMQ, /* Flush trace msg queue */
+ ERTS_PSTT_ETS_FREE_FIXATION
} ErtsProcSysTaskType;
#define ERTS_MAX_PROC_SYS_TASK_ARGS 2
@@ -420,8 +574,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; } \
@@ -429,35 +585,39 @@ do { \
} \
} while (0)
-#define ERTS_ATOMIC_FOREACH_RUNQ_X(RQVAR, DO, DOX) \
+#define ERTS_ATOMIC_FOREACH_RUNQ_X(RQVAR, NRQS, DO, DOX) \
do { \
ErtsRunQueue *RQVAR; \
+ int nrqs = (NRQS); \
int ix__; \
- for (ix__ = 0; ix__ < erts_no_run_queues; ix__++) { \
+ for (ix__ = 0; ix__ < nrqs; ix__++) { \
RQVAR = ERTS_RUNQ_IX(ix__); \
erts_smp_runq_lock(RQVAR); \
{ DO; } \
} \
{ DOX; } \
- for (ix__ = 0; ix__ < erts_no_run_queues; ix__++) \
+ for (ix__ = 0; ix__ < nrqs; ix__++) \
erts_smp_runq_unlock(ERTS_RUNQ_IX(ix__)); \
} while (0)
-#define ERTS_ATOMIC_FOREACH_RUNQ(RQVAR, DO) \
- ERTS_ATOMIC_FOREACH_RUNQ_X(RQVAR, DO, )
+#define ERTS_ATOMIC_FOREACH_RUNQ(RQVAR, DO) \
+ ERTS_ATOMIC_FOREACH_RUNQ_X(RQVAR, erts_no_run_queues + ERTS_NUM_DIRTY_RUNQS, DO, )
+
+#define ERTS_ATOMIC_FOREACH_NORMAL_RUNQ(RQVAR, DO) \
+ ERTS_ATOMIC_FOREACH_RUNQ_X(RQVAR, erts_no_run_queues, DO, )
+
+
/*
* Local functions.
*/
static void exec_misc_ops(ErtsRunQueue *);
-static void print_function_from_pc(int to, void *to_arg, BeamInstr* x);
-static int stack_element_dump(int to, void *to_arg, Process* p, Eterm* sp,
- int yreg);
+static void print_function_from_pc(fmtfn_t to, void *to_arg, BeamInstr* x);
+static int stack_element_dump(fmtfn_t to, void *to_arg, Eterm* sp, int yreg);
static void aux_work_timeout(void *unused);
static void aux_work_timeout_early_init(int no_schedulers);
-static void aux_work_timeout_late_init(void);
-static void setup_aux_work_timer(void);
+static void setup_aux_work_timer(ErtsSchedulerData *esdp);
static int execute_sys_tasks(Process *c_p,
erts_aint32_t *statep,
@@ -487,20 +647,22 @@ dbg_chk_aux_work_val(erts_aint32_t value)
valid |= ERTS_SSI_AUX_WORK_MISC_THR_PRGR;
valid |= ERTS_SSI_AUX_WORK_DD;
valid |= ERTS_SSI_AUX_WORK_DD_THR_PRGR;
+ valid |= ERTS_SSI_AUX_WORK_CNCLD_TMRS;
+ valid |= ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR;
valid |= ERTS_SSI_AUX_WORK_THR_PRGR_LATER_OP;
+ valid |= ERTS_SSI_AUX_WORK_PENDING_EXITERS;
#endif
#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;
+ valid |= ERTS_SSI_AUX_WORK_YIELD;
if (~valid & value)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"Invalid aux_work value found: 0x%x\n",
~valid & value);
}
@@ -512,7 +674,7 @@ dbg_chk_aux_work_val(erts_aint32_t value)
#endif
#ifdef ERTS_SMP
-static void handle_pending_exiters(ErtsProcList *);
+static void do_handle_pending_exiters(ErtsProcList *);
static void wake_scheduler(ErtsRunQueue *rq);
#endif
@@ -556,63 +718,92 @@ erts_pre_init_process(void)
erts_tsd_key_create(&sched_data_key, "erts_sched_data_key");
#endif
+ erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_DELAYED_AW_WAKEUP_IX]
+ = "DELAYED_AW_WAKEUP";
+ erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_DD_IX]
+ = "DD";
+ erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_DD_THR_PRGR_IX]
+ = "DD_THR_PRGR";
+ erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC_IX]
+ = "FIX_ALLOC_DEALLOC";
+ erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM_IX]
+ = "FIX_ALLOC_LOWER_LIM";
+ erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_THR_PRGR_LATER_OP_IX]
+ = "THR_PRGR_LATER_OP";
+ erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_CNCLD_TMRS_IX]
+ = "CNCLD_TMRS";
+ erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR_IX]
+ = "CNCLD_TMRS_THR_PRGR";
+ erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_ASYNC_READY_IX]
+ = "ASYNC_READY";
+ erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN_IX]
+ = "ASYNC_READY_CLEAN";
+ erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_MISC_THR_PRGR_IX]
+ = "MISC_THR_PRGR";
+ erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_MISC_IX]
+ = "MISC";
+ erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_PENDING_EXITERS_IX]
+ = "PENDING_EXITERS";
+ 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]
+ = "MSEG_CACHE_CHECK";
+ erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_YIELD_IX]
+ = "YIELD";
+ erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_REAP_PORTS_IX]
+ = "REAP_PORTS";
+ erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_DEBUG_WAIT_COMPLETED_IX]
+ = "DEBUG_WAIT_COMPLETED";
+
#ifdef ERTS_ENABLE_LOCK_CHECK
- {
- int ix;
-
- erts_psd_required_locks[ERTS_PSD_ERROR_HANDLER].get_locks
- = ERTS_PSD_ERROR_HANDLER_BUF_GET_LOCKS;
- erts_psd_required_locks[ERTS_PSD_ERROR_HANDLER].set_locks
- = ERTS_PSD_ERROR_HANDLER_BUF_SET_LOCKS;
-
- erts_psd_required_locks[ERTS_PSD_SAVED_CALLS_BUF].get_locks
- = ERTS_PSD_SAVED_CALLS_BUF_GET_LOCKS;
- erts_psd_required_locks[ERTS_PSD_SAVED_CALLS_BUF].set_locks
- = ERTS_PSD_SAVED_CALLS_BUF_SET_LOCKS;
-
- erts_psd_required_locks[ERTS_PSD_SCHED_ID].get_locks
- = ERTS_PSD_SCHED_ID_GET_LOCKS;
- 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
- = ERTS_PSD_CALL_TIME_BP_SET_LOCKS;
-
- erts_psd_required_locks[ERTS_PSD_DELAYED_GC_TASK_QS].get_locks
- = ERTS_PSD_DELAYED_GC_TASK_QS_GET_LOCKS;
- erts_psd_required_locks[ERTS_PSD_DELAYED_GC_TASK_QS].set_locks
- = ERTS_PSD_DELAYED_GC_TASK_QS_SET_LOCKS;
-#ifdef ERTS_DIRTY_SCHEDULERS
- erts_psd_required_locks[ERTS_PSD_DIRTY_SCHED_TRAP_EXPORT].get_locks
- = ERTS_PSD_DIRTY_SCHED_TRAP_EXPORT_GET_LOCKS;
- erts_psd_required_locks[ERTS_PSD_DIRTY_SCHED_TRAP_EXPORT].set_locks
- = ERTS_PSD_DIRTY_SCHED_TRAP_EXPORT_SET_LOCKS;
-#endif
+ erts_psd_required_locks[ERTS_PSD_ERROR_HANDLER].get_locks
+ = ERTS_PSD_ERROR_HANDLER_BUF_GET_LOCKS;
+ erts_psd_required_locks[ERTS_PSD_ERROR_HANDLER].set_locks
+ = ERTS_PSD_ERROR_HANDLER_BUF_SET_LOCKS;
+
+ erts_psd_required_locks[ERTS_PSD_SAVED_CALLS_BUF].get_locks
+ = ERTS_PSD_SAVED_CALLS_BUF_GET_LOCKS;
+ erts_psd_required_locks[ERTS_PSD_SAVED_CALLS_BUF].set_locks
+ = ERTS_PSD_SAVED_CALLS_BUF_SET_LOCKS;
+
+ erts_psd_required_locks[ERTS_PSD_SCHED_ID].get_locks
+ = ERTS_PSD_SCHED_ID_GET_LOCKS;
+ erts_psd_required_locks[ERTS_PSD_SCHED_ID].set_locks
+ = ERTS_PSD_SCHED_ID_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
+ = ERTS_PSD_CALL_TIME_BP_SET_LOCKS;
+
+ erts_psd_required_locks[ERTS_PSD_DELAYED_GC_TASK_QS].get_locks
+ = ERTS_PSD_DELAYED_GC_TASK_QS_GET_LOCKS;
+ erts_psd_required_locks[ERTS_PSD_DELAYED_GC_TASK_QS].set_locks
+ = ERTS_PSD_DELAYED_GC_TASK_QS_SET_LOCKS;
- /* Check that we have locks for all entries */
- for (ix = 0; ix < ERTS_PSD_SIZE; ix++) {
- ERTS_SMP_LC_ASSERT(erts_psd_required_locks[ix].get_locks);
- ERTS_SMP_LC_ASSERT(erts_psd_required_locks[ix].set_locks);
- }
- }
+ erts_psd_required_locks[ERTS_PSD_NIF_TRAP_EXPORT].get_locks
+ = ERTS_PSD_NIF_TRAP_EXPORT_GET_LOCKS;
+ erts_psd_required_locks[ERTS_PSD_NIF_TRAP_EXPORT].set_locks
+ = ERTS_PSD_NIF_TRAP_EXPORT_SET_LOCKS;
+
+ erts_psd_required_locks[ERTS_PSD_ETS_OWNED_TABLES].get_locks
+ = ERTS_PSD_ETS_OWNED_TABLES_GET_LOCKS;
+ erts_psd_required_locks[ERTS_PSD_ETS_OWNED_TABLES].set_locks
+ = ERTS_PSD_ETS_OWNED_TABLES_SET_LOCKS;
+
+ erts_psd_required_locks[ERTS_PSD_ETS_FIXED_TABLES].get_locks
+ = ERTS_PSD_ETS_FIXED_TABLES_GET_LOCKS;
+ erts_psd_required_locks[ERTS_PSD_ETS_FIXED_TABLES].set_locks
+ = ERTS_PSD_ETS_FIXED_TABLES_SET_LOCKS;
#endif
}
-#ifdef ERTS_SMP
static void
release_process(void *vproc)
{
- erts_smp_proc_dec_refc((Process *) vproc);
+ erts_proc_dec_refc((Process *) vproc);
}
-#endif
/* initialize the scheduler */
void
@@ -628,20 +819,21 @@ erts_init_process(int ncpu, int proc_tab_size, int legacy_proc_tab)
erts_ptab_init_table(&erts_proc,
ERTS_ALC_T_PROC_TABLE,
-#ifdef ERTS_SMP
release_process,
-#else
- NULL,
-#endif
(ErtsPTabElementCommon *) &erts_invalid_process.common,
proc_tab_size,
sizeof(Process),
"process_table",
- legacy_proc_tab);
+ legacy_proc_tab,
+#ifdef ERTS_SMP
+ 1
+#else
+ 0
+#endif
+ );
last_reductions = 0;
last_exact_reductions = 0;
- erts_default_process_flags = 0;
}
void
@@ -649,7 +841,9 @@ erts_late_init_process(void)
{
int ix;
- erts_smp_spinlock_init(&erts_sched_stat.lock, "sched_stat");
+ erts_smp_spinlock_init(&erts_sched_stat.lock, "sched_stat", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_SCHEDULER);
+
for (ix = 0; ix < ERTS_NO_PRIO_LEVELS; ix++) {
Eterm atom;
char *atom_str;
@@ -684,22 +878,35 @@ erts_late_init_process(void)
}
+#define ERTS_SCHED_WTIME_IDLE ~((Uint64) 0)
+
static void
-init_sched_wall_time(ErtsSchedWallTime *swtp)
+init_sched_wall_time(ErtsSchedulerData *esdp, Uint64 time_stamp)
{
- swtp->need = erts_sched_balance_util;
- swtp->enabled = 0;
- swtp->start = 0;
- swtp->working.total = 0;
- swtp->working.start = 0;
- swtp->working.currently = 0;
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (esdp->type != ERTS_SCHED_NORMAL) {
+ erts_atomic32_init_nob(&esdp->sched_wall_time.u.mod, 0);
+ esdp->sched_wall_time.enabled = 1;
+ esdp->sched_wall_time.start = time_stamp;
+ esdp->sched_wall_time.working.total = 0;
+ esdp->sched_wall_time.working.start = ERTS_SCHED_WTIME_IDLE;
+ }
+ else
+#endif
+ {
+ esdp->sched_wall_time.u.need = erts_sched_balance_util;
+ esdp->sched_wall_time.enabled = 0;
+ esdp->sched_wall_time.start = 0;
+ esdp->sched_wall_time.working.total = 0;
+ esdp->sched_wall_time.working.start = 0;
+ }
}
static ERTS_INLINE Uint64
sched_wall_time_ts(void)
{
-#ifdef HAVE_GETHRTIME
- return (Uint64) sys_gethrtime();
+#ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT
+ return (Uint64) erts_os_monotonic_time();
#else
Uint64 res;
SysTimeval tv;
@@ -712,72 +919,24 @@ sched_wall_time_ts(void)
#if ERTS_HAVE_SCHED_UTIL_BALANCING_SUPPORT
-#ifdef ARCH_64
-
static ERTS_INLINE Uint64
aschedtime_read(ErtsAtomicSchedTime *var)
{
- return (Uint64) erts_atomic_read_nob((erts_atomic_t *) var);
-}
-
-static ERTS_INLINE void
-aschedtime_set(ErtsAtomicSchedTime *var, Uint64 val)
-{
- erts_atomic_set_nob((erts_atomic_t *) var, (erts_aint_t) val);
-}
-
-static ERTS_INLINE void
-aschedtime_init(ErtsAtomicSchedTime *var)
-{
- erts_atomic_init_nob((erts_atomic_t *) var, (erts_aint_t) 0);
-}
-
-#elif defined(ARCH_32)
-
-static ERTS_INLINE Uint64
-aschedtime_read(ErtsAtomicSchedTime *var)
-{
- erts_dw_aint_t dw;
- erts_dw_atomic_read_nob((erts_dw_atomic_t *) var, &dw);
-#ifdef ETHR_SU_DW_NAINT_T__
- return (Uint64) dw.dw_sint;
-#else
- {
- Uint64 res;
- res = (Uint64) ((Uint32) dw.sint[ERTS_DW_AINT_HIGH_WORD]);
- res <<= 32;
- res |= (Uint64) ((Uint32) dw.sint[ERTS_DW_AINT_LOW_WORD]);
- return res;
- }
-#endif
+ return (Uint64) erts_atomic64_read_nob((erts_atomic64_t *) var);
}
static ERTS_INLINE void
aschedtime_set(ErtsAtomicSchedTime *var, Uint64 val)
{
- erts_dw_aint_t dw;
-#ifdef ETHR_SU_DW_NAINT_T__
- dw.dw_sint = (ETHR_SU_DW_NAINT_T__) val;
-#else
- dw.sint[ERTS_DW_AINT_LOW_WORD] = (erts_aint_t) (val & 0xffffffff);
- dw.sint[ERTS_DW_AINT_HIGH_WORD] = (erts_aint_t) ((val >> 32) & 0xffffffff);
-#endif
- erts_dw_atomic_set_nob((erts_dw_atomic_t *) var, &dw);
+ erts_atomic64_set_nob((erts_atomic64_t *) var, (erts_aint64_t) val);
}
static ERTS_INLINE void
aschedtime_init(ErtsAtomicSchedTime *var)
{
- erts_dw_aint_t dw;
- dw.sint[ERTS_DW_AINT_LOW_WORD] = (erts_aint_t) 0;
- dw.sint[ERTS_DW_AINT_HIGH_WORD] = (erts_aint_t) 0;
- erts_dw_atomic_init_nob((erts_dw_atomic_t *) var, &dw);
+ erts_atomic64_init_nob((erts_atomic64_t *) var, (erts_aint64_t) 0);
}
-#else
-# error :-/
-#endif
-
#define ERTS_GET_AVG_MAX_UNLOCKED_TRY 50
#define ERTS_SCHED_AVG_UTIL_WRITE_MARKER (~((Uint64) 0))
@@ -931,34 +1090,154 @@ init_runq_sched_util(ErtsRunQueueSchedUtil *rqsu, int enabled)
#endif /* ERTS_HAVE_SCHED_UTIL_BALANCING_SUPPORT */
-static ERTS_INLINE void
+#ifdef ERTS_DIRTY_SCHEDULERS
+
+typedef struct {
+ Uint64 working;
+ Uint64 total;
+} ErtsDirtySchedWallTime;
+
+static void
+read_dirty_sched_wall_time(ErtsSchedulerData *esdp, ErtsDirtySchedWallTime *info)
+{
+ erts_aint32_t mod1;
+ Uint64 working, start, ts;
+
+ mod1 = erts_atomic32_read_nob(&esdp->sched_wall_time.u.mod);
+
+ while (1) {
+ erts_aint32_t mod2;
+
+ /* Spin until values are not written... */
+ while (1) {
+ if ((mod1 & 1) == 0)
+ break;
+ ERTS_SPIN_BODY;
+ mod1 = erts_atomic32_read_nob(&esdp->sched_wall_time.u.mod);
+ }
+
+ ERTS_THR_READ_MEMORY_BARRIER;
+
+ working = esdp->sched_wall_time.working.total;
+ start = esdp->sched_wall_time.working.start;
+
+ ERTS_THR_READ_MEMORY_BARRIER;
+
+ mod2 = erts_atomic32_read_nob(&esdp->sched_wall_time.u.mod);
+ if (mod1 == mod2)
+ break;
+ mod1 = mod2;
+ }
+
+ ts = sched_wall_time_ts();
+ ts -= esdp->sched_wall_time.start;
+
+ info->total = ts;
+
+ if (start == ERTS_SCHED_WTIME_IDLE || ts < start)
+ info->working = working;
+ else
+ info->working = working + (ts - start);
+
+ if (info->working > info->total)
+ info->working = info->total;
+}
+
+#endif
+
+#ifdef ERTS_SMP
+
+static void
+dirty_sched_wall_time_change(ErtsSchedulerData *esdp, int working)
+{
+ erts_aint32_t mod;
+ Uint64 ts = sched_wall_time_ts();
+
+ ts -= esdp->sched_wall_time.start;
+
+ /*
+ * This thread is the only thread writing in
+ * this sched_wall_time struct. We set 'mod' to
+ * an odd value while writing...
+ */
+ mod = erts_atomic32_read_dirty(&esdp->sched_wall_time.u.mod);
+ ASSERT((mod & 1) == 0);
+ mod++;
+
+ erts_atomic32_set_nob(&esdp->sched_wall_time.u.mod, mod);
+ ERTS_THR_WRITE_MEMORY_BARRIER;
+
+ if (working) {
+ ASSERT(esdp->sched_wall_time.working.start
+ == ERTS_SCHED_WTIME_IDLE);
+
+ esdp->sched_wall_time.working.start = ts;
+
+ }
+ else {
+ Uint64 total;
+
+ ASSERT(esdp->sched_wall_time.working.start
+ != ERTS_SCHED_WTIME_IDLE);
+
+ total = esdp->sched_wall_time.working.total;
+ total += ts - esdp->sched_wall_time.working.start;
+
+ esdp->sched_wall_time.working.total = total;
+ esdp->sched_wall_time.working.start = ERTS_SCHED_WTIME_IDLE;
+
+
+ }
+
+ ERTS_THR_WRITE_MEMORY_BARRIER;
+ mod++;
+ erts_atomic32_set_nob(&esdp->sched_wall_time.u.mod, mod);
+
+#if 0
+ if (!working) {
+ ERTS_MSACC_SET_STATE_M_X(ERTS_MSACC_STATE_BUSY_WAIT);
+ } else {
+ ERTS_MSACC_SET_STATE_M_X(ERTS_MSACC_STATE_OTHER);
+ }
+#endif
+}
+
+#endif /* ERTS_SMP */
+
+static void
sched_wall_time_change(ErtsSchedulerData *esdp, int working)
{
- if (esdp->sched_wall_time.need) {
+ if (esdp->sched_wall_time.u.need) {
Uint64 ts = sched_wall_time_ts();
#if ERTS_HAVE_SCHED_UTIL_BALANCING_SUPPORT
- update_avg_sched_util(esdp, ts, working);
+ update_avg_sched_util(esdp, ts, working);
#endif
if (esdp->sched_wall_time.enabled) {
if (working) {
-#ifdef DEBUG
- ASSERT(!esdp->sched_wall_time.working.currently);
- esdp->sched_wall_time.working.currently = 1;
-#endif
+ ASSERT(esdp->sched_wall_time.working.start
+ == ERTS_SCHED_WTIME_IDLE);
ts -= esdp->sched_wall_time.start;
esdp->sched_wall_time.working.start = ts;
}
else {
-#ifdef DEBUG
- ASSERT(esdp->sched_wall_time.working.currently);
- esdp->sched_wall_time.working.currently = 0;
-#endif
+ ASSERT(esdp->sched_wall_time.working.start
+ != ERTS_SCHED_WTIME_IDLE);
ts -= esdp->sched_wall_time.start;
ts -= esdp->sched_wall_time.working.start;
esdp->sched_wall_time.working.total += ts;
+#ifdef DEBUG
+ esdp->sched_wall_time.working.start
+ = ERTS_SCHED_WTIME_IDLE;
+#endif
}
}
}
+ 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 {
@@ -966,30 +1245,34 @@ typedef struct {
int enable;
Process *proc;
Eterm ref;
- Eterm ref_heap[REF_THING_SIZE];
+ Eterm ref_heap[ERTS_REF_THING_SIZE];
Uint req_sched;
erts_smp_atomic32_t refc;
+#ifdef ERTS_DIRTY_SCHEDULERS
+ int want_dirty_cpu;
+ int want_dirty_io;
+#endif
} ErtsSchedWallTimeReq;
-#if !HALFWORD_HEAP
+typedef struct {
+ Process *proc;
+ Eterm ref;
+ Eterm ref_heap[ERTS_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 +1289,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
@@ -1014,23 +1297,23 @@ reply_sched_wall_time(void *vswtrp)
#endif
if (swtrp->set) {
if (!swtrp->enable && esdp->sched_wall_time.enabled) {
- esdp->sched_wall_time.need = erts_sched_balance_util;
+ esdp->sched_wall_time.u.need = erts_sched_balance_util;
esdp->sched_wall_time.enabled = 0;
}
else if (swtrp->enable && !esdp->sched_wall_time.enabled) {
Uint64 ts = sched_wall_time_ts();
- esdp->sched_wall_time.need = 1;
+ esdp->sched_wall_time.u.need = 1;
esdp->sched_wall_time.enabled = 1;
esdp->sched_wall_time.start = ts;
esdp->sched_wall_time.working.total = 0;
esdp->sched_wall_time.working.start = 0;
- esdp->sched_wall_time.working.currently = 1;
}
}
if (esdp->sched_wall_time.enabled) {
Uint64 ts = sched_wall_time_ts();
- ASSERT(esdp->sched_wall_time.working.currently);
+ ASSERT(esdp->sched_wall_time.working.start
+ != ERTS_SCHED_WTIME_IDLE);
ts -= esdp->sched_wall_time.start;
total = ts;
ts -= esdp->sched_wall_time.working.start;
@@ -1041,37 +1324,120 @@ reply_sched_wall_time(void *vswtrp)
hpp = NULL;
szp = &sz;
- while (1) {
- if (hpp)
- ref_copy = STORE_NC(hpp, ohp, swtrp->ref);
- else
- *szp += REF_THING_SIZE;
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (esdp->sched_wall_time.enabled
+ && swtrp->req_sched == esdp->no
+ && (swtrp->want_dirty_cpu || swtrp->want_dirty_io)) {
+ /* Reply with info about this scheduler and all dirty schedulers... */
+ ErtsDirtySchedWallTime *dswt;
+ int ix, no_dirty_scheds, want_dcpu, want_dio, soffset;
+
+ want_dcpu = swtrp->want_dirty_cpu;
+ want_dio = swtrp->want_dirty_io;
+
+ no_dirty_scheds = 0;
+ if (want_dcpu)
+ no_dirty_scheds += erts_no_dirty_cpu_schedulers;
+ if (want_dio)
+ no_dirty_scheds += erts_no_dirty_io_schedulers;
+
+ ASSERT(no_dirty_scheds);
+
+ dswt = erts_alloc(ERTS_ALC_T_TMP,
+ sizeof(ErtsDirtySchedWallTime)
+ * no_dirty_scheds);
+
+ for (ix = 0; ix < no_dirty_scheds; ix++) {
+ ErtsSchedulerData *esdp;
+ if (want_dcpu && ix < erts_no_dirty_cpu_schedulers)
+ esdp = &erts_aligned_dirty_cpu_scheduler_data[ix].esd;
+ else {
+ int dio_ix = ix - erts_no_dirty_cpu_schedulers;
+ esdp = &erts_aligned_dirty_io_scheduler_data[dio_ix].esd;
+ }
+ read_dirty_sched_wall_time(esdp, &dswt[ix]);
+ }
- if (swtrp->set)
- msg = ref_copy;
- else {
- msg = (!esdp->sched_wall_time.enabled
- ? am_notsup
- : erts_bld_tuple(hpp, szp, 3,
- make_small(esdp->no),
- erts_bld_uint64(hpp, szp, working),
- erts_bld_uint64(hpp, szp, total)));
+ soffset = erts_no_schedulers + 1;
- msg = erts_bld_tuple(hpp, szp, 2, ref_copy, msg);
- }
- if (hpp)
- break;
+ if (!want_dcpu) {
+ ASSERT(want_dio);
+ soffset += erts_no_dirty_cpu_schedulers;
+ }
- hp = erts_alloc_message_heap(sz, &bp, &ohp, rp, &rp_locks);
- szp = NULL;
- hpp = &hp;
- }
+ while (1) {
+ if (hpp)
+ ref_copy = STORE_NC(hpp, ohp, swtrp->ref);
+ else
+ *szp += ERTS_REF_THING_SIZE;
+
+ ASSERT(!swtrp->set);
+
+ /* info about dirty schedulers... */
+ msg = NIL;
+ for (ix = no_dirty_scheds-1; ix >= 0; ix--) {
+ msg = erts_bld_cons(hpp, szp,
+ erts_bld_tuple(hpp, szp, 3,
+ make_small(ix+soffset),
+ erts_bld_uint64(hpp, szp,
+ dswt[ix].working),
+ erts_bld_uint64(hpp, szp,
+ dswt[ix].total)),
+ msg);
+ }
+ /* info about this scheduler... */
+ msg = erts_bld_cons(hpp, szp,
+ erts_bld_tuple(hpp, szp, 3,
+ make_small(esdp->no),
+ erts_bld_uint64(hpp, szp, working),
+ erts_bld_uint64(hpp, szp, total)),
+ msg);
- erts_queue_message(rp, &rp_locks, bp, msg, NIL
-#ifdef USE_VM_PROBES
- , NIL
+ msg = erts_bld_tuple(hpp, szp, 2, ref_copy, msg);
+
+ if (hpp)
+ break;
+
+ mp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp);
+ szp = NULL;
+ hpp = &hp;
+ }
+
+ erts_free(ERTS_ALC_T_TMP, dswt);
+ }
+ else
#endif
- );
+ {
+ /* Reply with info about this scheduler only... */
+
+ while (1) {
+ if (hpp)
+ ref_copy = STORE_NC(hpp, ohp, swtrp->ref);
+ else
+ *szp += ERTS_REF_THING_SIZE;
+
+ if (swtrp->set)
+ msg = ref_copy;
+ else {
+ msg = (!esdp->sched_wall_time.enabled
+ ? am_undefined
+ : erts_bld_tuple(hpp, szp, 3,
+ make_small(esdp->no),
+ erts_bld_uint64(hpp, szp, working),
+ erts_bld_uint64(hpp, szp, total)));
+
+ msg = erts_bld_tuple(hpp, szp, 2, ref_copy, msg);
+ }
+ if (hpp)
+ break;
+
+ mp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp);
+ szp = NULL;
+ hpp = &hp;
+ }
+ }
+
+ erts_queue_message(rp, rp_locks, mp, msg, am_system);
if (swtrp->req_sched == esdp->no)
rp_locks &= ~ERTS_PROC_LOCK_MAIN;
@@ -1079,16 +1445,17 @@ reply_sched_wall_time(void *vswtrp)
if (rp_locks)
erts_smp_proc_unlock(rp, rp_locks);
- erts_smp_proc_dec_refc(rp);
+ erts_proc_dec_refc(rp);
if (erts_smp_atomic32_dec_read_nob(&swtrp->refc) == 0)
swtreq_free(vswtrp);
}
Eterm
-erts_sched_wall_time_request(Process *c_p, int set, int enable)
+erts_sched_wall_time_request(Process *c_p, int set, int enable,
+ int want_dirty_cpu, int want_dirty_io)
{
- ErtsSchedulerData *esdp = ERTS_PROC_GET_SCHDATA(c_p);
+ ErtsSchedulerData *esdp = erts_proc_sched_data(c_p);
Eterm ref;
ErtsSchedWallTimeReq *swtrp;
Eterm *hp;
@@ -1108,10 +1475,14 @@ erts_sched_wall_time_request(Process *c_p, int set, int enable)
swtrp->proc = c_p;
swtrp->ref = STORE_NC(&hp, NULL, ref);
swtrp->req_sched = esdp->no;
+#ifdef ERTS_DIRTY_SCHEDULERS
+ swtrp->want_dirty_cpu = want_dirty_cpu;
+ swtrp->want_dirty_io = want_dirty_io;
+#endif
erts_smp_atomic32_init_nob(&swtrp->refc,
(erts_aint32_t) erts_no_schedulers);
- erts_smp_proc_add_refc(c_p, (Sint32) erts_no_schedulers);
+ erts_proc_add_refc(c_p, (Sint32) erts_no_schedulers);
#ifdef ERTS_SMP
if (erts_no_schedulers > 1)
@@ -1126,6 +1497,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 = ERTS_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, am_system);
+
+ 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_sched_data(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)
{
@@ -1136,6 +1576,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)
{
@@ -1148,6 +1597,12 @@ erts_proclist_create(Process *p)
return proclist_create(p);
}
+ErtsProcList *
+erts_proclist_copy(ErtsProcList *plp)
+{
+ return proclist_copy(plp);
+}
+
void
erts_proclist_destroy(ErtsProcList *plp)
{
@@ -1155,46 +1610,25 @@ erts_proclist_destroy(ErtsProcList *plp)
}
void *
-erts_psd_set_init(Process *p, ErtsProcLocks plocks, int ix, void *data)
+erts_psd_set_init(Process *p, int ix, void *data)
{
void *old;
- ErtsProcLocks xplocks;
- int refc = 0;
- ErtsPSD *psd = erts_alloc(ERTS_ALC_T_PSD, sizeof(ErtsPSD));
+ ErtsPSD *psd, *new_psd;
int i;
- for (i = 0; i < ERTS_PSD_SIZE; i++)
- psd->data[i] = NULL;
- ERTS_SMP_LC_ASSERT(plocks);
- ERTS_SMP_LC_ASSERT(plocks == erts_proc_lc_my_proc_locks(p));
+ new_psd = erts_alloc(ERTS_ALC_T_PSD, sizeof(ErtsPSD));
+ for (i = 0; i < ERTS_PSD_SIZE; i++)
+ new_psd->data[i] = NULL;
- xplocks = ERTS_PROC_LOCKS_ALL;
- xplocks &= ~plocks;
- if (xplocks && erts_smp_proc_trylock(p, xplocks) == EBUSY) {
- if (xplocks & ERTS_PROC_LOCK_MAIN) {
- erts_smp_proc_inc_refc(p);
- erts_smp_proc_unlock(p, plocks);
- erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL);
- refc = 1;
- }
- else {
- if (plocks & ERTS_PROC_LOCKS_ALL_MINOR)
- erts_smp_proc_unlock(p, plocks & ERTS_PROC_LOCKS_ALL_MINOR);
- erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR);
- }
- }
- if (!p->psd)
- p->psd = psd;
- if (xplocks)
- erts_smp_proc_unlock(p, xplocks);
- if (refc)
- erts_smp_proc_dec_refc(p);
- ASSERT(p->psd);
- if (p->psd != psd)
- erts_free(ERTS_ALC_T_PSD, psd);
- old = p->psd->data[ix];
- p->psd->data[ix] = data;
- ERTS_SMP_LC_ASSERT(plocks == erts_proc_lc_my_proc_locks(p));
+ psd = (ErtsPSD *) erts_smp_atomic_cmpxchg_mb(&p->psd,
+ (erts_aint_t) new_psd,
+ (erts_aint_t) NULL);
+ if (psd)
+ erts_free(ERTS_ALC_T_PSD, new_psd);
+ else
+ psd = new_psd;
+ old = psd->data[ix];
+ psd->data[ix] = data;
return old;
}
@@ -1220,7 +1654,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;
}
@@ -1237,11 +1671,11 @@ set_aux_work_flags_wakeup_nob(ErtsSchedulerSleepInfo *ssi,
ERTS_DBG_CHK_SSI_AUX_WORK(ssi);
old_flgs = erts_atomic32_read_nob(&ssi->aux_work);
- if ((old_flgs & flgs) == 0) {
+ if ((old_flgs & flgs) != flgs) {
old_flgs = erts_atomic32_read_bor_nob(&ssi->aux_work, flgs);
- if ((old_flgs & flgs) == 0) {
+ if ((old_flgs & flgs) != flgs) {
#ifdef ERTS_SMP
erts_sched_poke(ssi);
#else
@@ -1261,7 +1695,7 @@ set_aux_work_flags_wakeup_relb(ErtsSchedulerSleepInfo *ssi,
old_flgs = erts_atomic32_read_bor_relb(&ssi->aux_work, flgs);
- if ((old_flgs & flgs) == 0) {
+ if ((old_flgs & flgs) != flgs) {
#ifdef ERTS_SMP
erts_sched_poke(ssi);
#else
@@ -1584,12 +2018,13 @@ erts_schedule_multi_misc_aux_work(int ignore_self,
int id, self = 0;
if (ignore_self) {
- ErtsSchedulerData *esdp = erts_get_scheduler_data();
-#ifdef ERTS_DIRTY_SCHEDULERS
- ASSERT(!ERTS_SCHEDULER_IS_DIRTY(esdp));
-#endif
- if (esdp)
- self = (int) esdp->no;
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
+
+ /* ignore_self is meaningless on dirty schedulers since aux work can
+ * only run on normal schedulers, and their ids do not translate. */
+ if(esdp && !ERTS_SCHEDULER_IS_DIRTY(esdp)) {
+ self = (int)esdp->no;
+ }
}
ASSERT(0 < max_sched && max_sched <= erts_no_schedulers);
@@ -1733,15 +2168,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) {
@@ -1759,11 +2196,6 @@ handle_delayed_dealloc(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waitin
awdp->dd.thr_prgr = wakeup;
haw_thr_prgr_soft_wakeup(awdp, wakeup);
}
- else if (awdp->dd.completed_callback) {
- awdp->dd.completed_callback(awdp->dd.completed_arg);
- awdp->dd.completed_callback = NULL;
- awdp->dd.completed_arg = NULL;
- }
return aux_work & ~ERTS_SSI_AUX_WORK_DD;
}
@@ -1805,17 +2237,107 @@ handle_delayed_dealloc_thr_prgr(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, i
}
else {
unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DD_THR_PRGR);
- if (awdp->dd.completed_callback) {
- awdp->dd.completed_callback(awdp->dd.completed_arg);
- awdp->dd.completed_callback = NULL;
- awdp->dd.completed_arg = NULL;
- }
}
return aux_work & ~ERTS_SSI_AUX_WORK_DD_THR_PRGR;
}
/*
+ * Canceled timers
+ */
+
+void
+erts_notify_canceled_timer(ErtsSchedulerData *esdp, int rsid)
+{
+ ASSERT(esdp && esdp == erts_get_scheduler_data());
+ if (esdp && !ERTS_SCHEDULER_IS_DIRTY(esdp))
+ schedule_aux_work_wakeup(&esdp->aux_work_data,
+ rsid,
+ ERTS_SSI_AUX_WORK_CNCLD_TMRS);
+ else
+ set_aux_work_flags_wakeup_relb(ERTS_SCHED_SLEEP_INFO_IX(rsid-1),
+ ERTS_SSI_AUX_WORK_CNCLD_TMRS);
+}
+
+static ERTS_INLINE erts_aint32_t
+handle_canceled_timers(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting)
+{
+ ErtsSchedulerSleepInfo *ssi = awdp->ssi;
+ int need_thr_progress = 0;
+ ErtsThrPrgrVal wakeup = ERTS_THR_PRGR_INVALID;
+ int more_work = 0;
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+ ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp));
+#endif
+ unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_CNCLD_TMRS);
+ erts_handle_canceled_timers((void *) awdp->esdp,
+ &need_thr_progress,
+ &wakeup,
+ &more_work);
+ if (more_work) {
+ if (set_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_CNCLD_TMRS)
+ & ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR) {
+ unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR);
+ aux_work &= ~ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR;
+ }
+ return aux_work;
+ }
+
+ if (need_thr_progress) {
+ if (wakeup == ERTS_THR_PRGR_INVALID)
+ wakeup = erts_thr_progress_later(awdp->esdp);
+ awdp->cncld_tmrs.thr_prgr = wakeup;
+ set_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR);
+ haw_thr_prgr_soft_wakeup(awdp, wakeup);
+ }
+ return aux_work & ~ERTS_SSI_AUX_WORK_CNCLD_TMRS;
+}
+
+static ERTS_INLINE erts_aint32_t
+handle_canceled_timers_thr_prgr(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting)
+{
+ ErtsSchedulerSleepInfo *ssi;
+ int need_thr_progress;
+ int more_work;
+ ErtsThrPrgrVal wakeup = ERTS_THR_PRGR_INVALID;
+ ErtsThrPrgrVal current = haw_thr_prgr_current(awdp);
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+ ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp));
+#endif
+ if (!erts_thr_progress_has_reached_this(current, awdp->cncld_tmrs.thr_prgr))
+ return aux_work & ~ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR;
+
+ ssi = awdp->ssi;
+ need_thr_progress = 0;
+ more_work = 0;
+
+ erts_handle_canceled_timers((void *) awdp->esdp,
+ &need_thr_progress,
+ &wakeup,
+ &more_work);
+ if (more_work) {
+ set_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_CNCLD_TMRS);
+ unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR);
+ return ((aux_work & ~ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR)
+ | ERTS_SSI_AUX_WORK_CNCLD_TMRS);
+ }
+
+ if (need_thr_progress) {
+ if (wakeup == ERTS_THR_PRGR_INVALID)
+ wakeup = erts_thr_progress_later(awdp->esdp);
+ awdp->cncld_tmrs.thr_prgr = wakeup;
+ haw_thr_prgr_soft_wakeup(awdp, wakeup);
+ }
+ else {
+ unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR);
+ }
+
+ return aux_work & ~ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR;
+}
+
+/*
* Handle scheduled thread progress later operations.
*/
#define ERTS_MAX_THR_PRGR_LATER_OPS 50
@@ -1831,6 +2353,7 @@ handle_thr_prgr_later_op(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int wait
#endif
for (lops = 0; lops < ERTS_MAX_THR_PRGR_LATER_OPS; lops++) {
ErtsThrPrgrLaterOp *lop = awdp->later_op.first;
+
if (!erts_thr_progress_has_reached_this(current, lop->later))
return aux_work & ~ERTS_SSI_AUX_WORK_THR_PRGR_LATER_OP;
awdp->later_op.first = lop->next;
@@ -1904,109 +2427,154 @@ erts_schedule_thr_prgr_later_cleanup_op(void (*later_func)(void *),
#endif
}
-#ifdef ERTS_SMP
+static ERTS_INLINE erts_aint32_t
+handle_debug_wait_completed(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting)
+{
+ ErtsSchedulerSleepInfo *ssi = awdp->ssi;
+ erts_aint32_t saved_aux_work, flags;
-static erts_atomic32_t completed_dealloc_count;
+#ifdef ERTS_DIRTY_SCHEDULERS
+ ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp));
+#endif
+
+ flags = awdp->debug.wait_completed.flags;
+
+ if (aux_work & flags)
+ return aux_work;
+
+ saved_aux_work = erts_atomic32_read_acqb(&ssi->aux_work);
+
+ if (saved_aux_work & flags)
+ return aux_work & ~ERTS_SSI_AUX_WORK_DEBUG_WAIT_COMPLETED;
+
+ awdp->debug.wait_completed.callback(awdp->debug.wait_completed.arg);
+
+ awdp->debug.wait_completed.flags = 0;
+ awdp->debug.wait_completed.callback = NULL;
+ awdp->debug.wait_completed.arg = NULL;
+
+ unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DEBUG_WAIT_COMPLETED);
+
+ return aux_work & ~ERTS_SSI_AUX_WORK_DEBUG_WAIT_COMPLETED;
+}
+
+static erts_atomic32_t debug_wait_completed_count;
+static int debug_wait_completed_flags;
static void
-completed_dealloc(void *vproc)
+thr_debug_wait_completed(void *vproc)
{
- if (erts_atomic32_dec_read_mb(&completed_dealloc_count) == 0) {
+ if (erts_atomic32_dec_read_mb(&debug_wait_completed_count) == 0) {
erts_resume((Process *) vproc, (ErtsProcLocks) 0);
- erts_smp_proc_dec_refc((Process *) vproc);
+ erts_proc_dec_refc((Process *) vproc);
}
}
static void
-setup_completed_dealloc(void *vproc)
+setup_thr_debug_wait_completed(void *vproc)
{
ErtsSchedulerData *esdp = erts_get_scheduler_data();
- ErtsAuxWorkData *awdp = (esdp
- ? &esdp->aux_work_data
- : aux_thread_aux_work_data);
- erts_alloc_fix_alloc_shrink(awdp->sched_id, 0);
- set_aux_work_flags_wakeup_nob(awdp->ssi, ERTS_SSI_AUX_WORK_DD);
- awdp->dd.completed_callback = completed_dealloc;
- awdp->dd.completed_arg = vproc;
+ ErtsAuxWorkData *awdp;
+ erts_aint32_t wait_flags, aux_work_flags;
+#ifdef ERTS_SMP
+ awdp = esdp ? &esdp->aux_work_data : aux_thread_aux_work_data;
+#else
+ awdp = &esdp->aux_work_data;
+#endif
+
+ wait_flags = 0;
+ aux_work_flags = ERTS_SSI_AUX_WORK_DEBUG_WAIT_COMPLETED;
+
+ if (debug_wait_completed_flags & ERTS_DEBUG_WAIT_COMPLETED_DEALLOCATIONS) {
+ erts_alloc_fix_alloc_shrink(awdp->sched_id, 0);
+ wait_flags |= (ERTS_SSI_AUX_WORK_DD
+ | ERTS_SSI_AUX_WORK_DD_THR_PRGR);
+#ifdef ERTS_SMP
+ aux_work_flags |= ERTS_SSI_AUX_WORK_DD;
+#endif
+ }
+
+ if (debug_wait_completed_flags & ERTS_DEBUG_WAIT_COMPLETED_TIMER_CANCELLATIONS) {
+ wait_flags |= (ERTS_SSI_AUX_WORK_CNCLD_TMRS
+ | ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR);
+#ifdef ERTS_SMP
+ if (awdp->esdp && !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp))
+ aux_work_flags |= ERTS_SSI_AUX_WORK_CNCLD_TMRS;
+#endif
+ }
+
+ set_aux_work_flags_wakeup_nob(awdp->ssi, aux_work_flags);
+
+ awdp->debug.wait_completed.flags = wait_flags;
+ awdp->debug.wait_completed.callback = thr_debug_wait_completed;
+ awdp->debug.wait_completed.arg = vproc;
}
-static void
-prep_setup_completed_dealloc(void *vproc)
+struct debug_lop {
+ ErtsThrPrgrLaterOp lop;
+ Process *proc;
+};
+
+static void later_thr_debug_wait_completed(void *vlop)
{
- erts_aint32_t count = (erts_aint32_t) (erts_no_schedulers+1);
- if (erts_atomic32_dec_read_mb(&completed_dealloc_count) == count) {
- /* scheduler threads */
- erts_schedule_multi_misc_aux_work(0,
- erts_no_schedulers,
- setup_completed_dealloc,
- vproc);
- /* aux_thread */
- erts_schedule_misc_aux_work(0,
- setup_completed_dealloc,
- vproc);
+ struct debug_lop *lop = vlop;
+ erts_aint32_t count = (erts_aint32_t) erts_no_schedulers;
+#ifdef ERTS_SMP
+ count += 1; /* aux thread */
+#endif
+ if (erts_atomic32_dec_read_mb(&debug_wait_completed_count) == count) {
+ /* scheduler threads */
+ erts_schedule_multi_misc_aux_work(0,
+ erts_no_schedulers,
+ setup_thr_debug_wait_completed,
+ lop->proc);
+#ifdef ERTS_SMP
+ /* aux_thread */
+ erts_schedule_misc_aux_work(0,
+ setup_thr_debug_wait_completed,
+ lop->proc);
+#endif
}
+ erts_free(ERTS_ALC_T_DEBUG, lop);
+}
+
+
+static void
+init_thr_debug_wait_completed(void *vproc)
+{
+ struct debug_lop* lop = erts_alloc(ERTS_ALC_T_DEBUG,
+ sizeof(struct debug_lop));
+ lop->proc = vproc;
+ erts_schedule_thr_prgr_later_op(later_thr_debug_wait_completed, lop, &lop->lop);
}
-#endif /* ERTS_SMP */
int
-erts_debug_wait_deallocations(Process *c_p)
+erts_debug_wait_completed(Process *c_p, int flags)
{
-#ifndef ERTS_SMP
- erts_alloc_fix_alloc_shrink(1, 0);
- return 1;
-#else
/* Only one process at a time can do this */
- erts_aint32_t count = (erts_aint32_t) (2*(erts_no_schedulers+1));
- if (0 == erts_atomic32_cmpxchg_mb(&completed_dealloc_count,
+ erts_aint32_t count = (erts_aint32_t) (2*erts_no_schedulers);
+#ifdef ERTS_SMP
+ count += 1; /* aux thread */
+#endif
+ if (0 == erts_atomic32_cmpxchg_mb(&debug_wait_completed_count,
count,
0)) {
+ debug_wait_completed_flags = flags;
erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL);
- erts_smp_proc_inc_refc(c_p);
- /* scheduler threads */
+ erts_proc_inc_refc(c_p);
+
+ /* First flush later-ops on all scheduler threads */
erts_schedule_multi_misc_aux_work(0,
erts_no_schedulers,
- prep_setup_completed_dealloc,
+ init_thr_debug_wait_completed,
(void *) c_p);
- /* aux_thread */
- erts_schedule_misc_aux_work(0,
- prep_setup_completed_dealloc,
- (void *) c_p);
return 1;
}
return 0;
-#endif
}
-#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)
{
@@ -2024,7 +2592,8 @@ static ERTS_INLINE erts_aint32_t
handle_reap_ports(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting)
{
unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_REAP_PORTS);
- awdp->esdp->run_queue->halt_in_progress = 1;
+ ERTS_RUNQ_FLGS_SET(awdp->esdp->run_queue, ERTS_RUNQ_FLG_HALTING);
+
if (erts_smp_atomic32_dec_read_acqb(&erts_halt_progress) == 0) {
int i, max = erts_ptab_max(&erts_port);
erts_smp_atomic32_set_nob(&erts_halt_progress, 1);
@@ -2049,18 +2618,60 @@ handle_reap_ports(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting)
ERTS_PORT_SFLG_HALT);
erts_smp_atomic32_inc_nob(&erts_halt_progress);
if (!(state & (ERTS_PORT_SFLG_EXITING|ERTS_PORT_SFLG_CLOSING)))
- erts_deliver_port_exit(prt, prt->common.id, am_killed, 0);
+ erts_deliver_port_exit(prt, prt->common.id, am_killed, 0, 1);
}
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;
}
+void
+erts_notify_new_aux_yield_work(ErtsSchedulerData *esdp)
+{
+ ASSERT(esdp == erts_get_scheduler_data());
+ /* Always called by the scheduler itself... */
+ set_aux_work_flags_wakeup_nob(esdp->ssi, ERTS_SSI_AUX_WORK_YIELD);
+}
+
+static ERTS_INLINE erts_aint32_t
+handle_yield(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting)
+{
+ int yield = 0;
+ /*
+ * Yield operations are always requested by the scheduler itself.
+ *
+ * The following handlers should *not* set the ERTS_SSI_AUX_WORK_YIELD
+ * flag in order to indicate more work. They should instead return
+ * information so this "main handler" can manipulate the flag...
+ *
+ * The following handlers should be able to handle being called
+ * even though no work is to be done...
+ */
+
+ /* Various yielding operations... */
+
+ yield |= erts_handle_yielded_ets_all_request(awdp->esdp,
+ &awdp->yield.ets_all);
+
+ /*
+ * Other yielding operations...
+ *
+ */
+
+ if (!yield) {
+ unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_YIELD);
+ return aux_work & ~ERTS_SSI_AUX_WORK_YIELD;
+ }
+
+ return aux_work;
+}
+
+
#if HAVE_ERTS_MSEG
static ERTS_INLINE erts_aint32_t
@@ -2073,11 +2684,35 @@ handle_mseg_cache_check(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiti
#endif
+#ifdef ERTS_SMP
+
+static ERTS_INLINE erts_aint32_t
+handle_pending_exiters(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting)
+{
+ ErtsProcList *pnd_xtrs;
+ ErtsRunQueue *rq;
+
+ rq = awdp->esdp->run_queue;
+ unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_PENDING_EXITERS);
+
+ erts_smp_runq_lock(rq);
+ pnd_xtrs = rq->procs.pending_exiters;
+ rq->procs.pending_exiters = NULL;
+ erts_smp_runq_unlock(rq);
+
+ if (erts_proclist_fetch(&pnd_xtrs, NULL))
+ do_handle_pending_exiters(pnd_xtrs);
+
+ return aux_work & ~ERTS_SSI_AUX_WORK_PENDING_EXITERS;
+}
+
+#endif
+
static ERTS_INLINE erts_aint32_t
handle_setup_aux_work_timer(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting)
{
unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_SET_TMO);
- setup_aux_work_timer();
+ setup_aux_work_timer(awdp->esdp);
return aux_work & ~ERTS_SSI_AUX_WORK_SET_TMO;
}
@@ -2092,13 +2727,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
@@ -2137,6 +2776,11 @@ handle_aux_work(ErtsAuxWorkData *awdp, erts_aint32_t orig_aux_work, int waiting)
#ifdef ERTS_SMP
HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_THR_PRGR_LATER_OP,
handle_thr_prgr_later_op);
+ HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_CNCLD_TMRS,
+ handle_canceled_timers);
+ /* CNCLD_TMRS must be before CNCLD_TMRS_THR_PRGR */
+ HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR,
+ handle_canceled_timers_thr_prgr);
#endif
#if ERTS_USE_ASYNC_READY_Q
@@ -2155,9 +2799,9 @@ 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);
+#ifdef ERTS_SMP
+ HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_PENDING_EXITERS,
+ handle_pending_exiters);
#endif
HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_SET_TMO,
@@ -2168,9 +2812,20 @@ handle_aux_work(ErtsAuxWorkData *awdp, erts_aint32_t orig_aux_work, int waiting)
handle_mseg_cache_check);
#endif
+ HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_YIELD,
+ handle_yield);
+
HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_REAP_PORTS,
handle_reap_ports);
+ /*
+ * ERTS_SSI_AUX_WORK_DEBUG_WAIT_COMPLETED *need* to be
+ * the last flag checked!
+ */
+
+ HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_DEBUG_WAIT_COMPLETED,
+ handle_debug_wait_completed);
+
ERTS_DBG_CHK_AUX_WORK_VAL(aux_work);
#ifdef ERTS_SMP
@@ -2178,6 +2833,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
@@ -2186,17 +2843,42 @@ handle_aux_work(ErtsAuxWorkData *awdp, erts_aint32_t orig_aux_work, int waiting)
typedef struct {
union {
- ErlTimer data;
- char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErlTimer))];
+ ErtsTWheelTimer data;
+ char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsTWheelTimer))];
} timer;
int initialized;
erts_atomic32_t refc;
+#ifdef DEBUG
+ erts_atomic32_t used;
+#endif
erts_atomic32_t type[1];
} ErtsAuxWorkTmo;
static ErtsAuxWorkTmo *aux_work_tmo;
+static ERTS_INLINE void
+start_aux_work_timer(ErtsSchedulerData *esdp)
+{
+ ErtsMonotonicTime tmo = erts_get_monotonic_time(esdp);
+#ifdef DEBUG
+ Uint no = (Uint) erts_atomic32_xchg_mb(&aux_work_tmo->used,
+ (erts_aint32_t) esdp->no);
+ ASSERT(esdp->type == ERTS_SCHED_NORMAL);
+ ASSERT(!no);
+#endif
+
+ tmo = ERTS_MONOTONIC_TO_CLKTCKS(tmo-1);
+ tmo += ERTS_MSEC_TO_CLKTCKS(1000) + 1;
+ erts_twheel_init_timer(&aux_work_tmo->timer.data);
+ ASSERT(esdp);
+ erts_twheel_set_timer(esdp->timer_wheel,
+ &aux_work_tmo->timer.data,
+ aux_work_timeout,
+ (void *) esdp,
+ tmo);
+}
+
static void
aux_work_timeout_early_init(int no_schedulers)
{
@@ -2211,6 +2893,9 @@ aux_work_timeout_early_init(int no_schedulers)
p = (UWord) malloc((sizeof(ErtsAuxWorkTmo)
+ sizeof(erts_atomic32_t)*(no_schedulers+1))
+ ERTS_CACHE_LINE_SIZE-1);
+ if (!p) {
+ ERTS_INTERNAL_ERROR("malloc failed to allocate memory!");
+ }
if (p & ERTS_CACHE_LINE_MASK)
p = (p & ~ERTS_CACHE_LINE_MASK) + ERTS_CACHE_LINE_SIZE;
ASSERT((p & ERTS_CACHE_LINE_MASK) == 0);
@@ -2218,29 +2903,33 @@ aux_work_timeout_early_init(int no_schedulers)
aux_work_tmo = (ErtsAuxWorkTmo *) p;
aux_work_tmo->initialized = 0;
erts_atomic32_init_nob(&aux_work_tmo->refc, 0);
+#ifdef DEBUG
+ erts_atomic32_init_nob(&aux_work_tmo->used, 0);
+#endif
for (i = 0; i <= no_schedulers; i++)
erts_atomic32_init_nob(&aux_work_tmo->type[i], 0);
}
void
-aux_work_timeout_late_init(void)
+erts_aux_work_timeout_late_init(ErtsSchedulerData *esdp)
{
aux_work_tmo->initialized = 1;
- if (erts_atomic32_read_nob(&aux_work_tmo->refc)) {
- aux_work_tmo->timer.data.active = 0;
- erts_set_timer(&aux_work_tmo->timer.data,
- aux_work_timeout,
- NULL,
- NULL,
- 1000);
- }
+ if (erts_atomic32_read_acqb(&aux_work_tmo->refc))
+ start_aux_work_timer(esdp);
}
static void
-aux_work_timeout(void *unused)
+aux_work_timeout(void *vesdp)
{
erts_aint32_t refc;
int i;
+#ifdef DEBUG
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
+ Uint no = (Uint) erts_atomic32_xchg_mb(&aux_work_tmo->used, 0);
+ ASSERT(no == esdp->no);
+ ASSERT(esdp == (ErtsSchedulerData *) vesdp);
+#endif
+
#ifdef ERTS_SMP
i = 0;
#else
@@ -2260,32 +2949,18 @@ aux_work_timeout(void *unused)
if (refc != 1
|| 1 != erts_atomic32_cmpxchg_relb(&aux_work_tmo->refc, 0, 1)) {
/* Setup next timeout... */
- aux_work_tmo->timer.data.active = 0;
- erts_set_timer(&aux_work_tmo->timer.data,
- aux_work_timeout,
- NULL,
- NULL,
- 1000);
+ start_aux_work_timer((ErtsSchedulerData *) vesdp);
}
}
static void
-setup_aux_work_timer(void)
+setup_aux_work_timer(ErtsSchedulerData *esdp)
{
-#ifndef ERTS_SMP
- if (!erts_get_scheduler_data())
+ if (!esdp || !esdp->timer_wheel)
set_aux_work_flags_wakeup_nob(ERTS_SCHED_SLEEP_INFO_IX(0),
ERTS_SSI_AUX_WORK_SET_TMO);
else
-#endif
- {
- aux_work_tmo->timer.data.active = 0;
- erts_set_timer(&aux_work_tmo->timer.data,
- aux_work_timeout,
- NULL,
- NULL,
- 1000);
- }
+ start_aux_work_timer(esdp);
}
erts_aint32_t
@@ -2316,7 +2991,7 @@ erts_set_aux_work_timeout(int ix, erts_aint32_t type, int enable)
if (refc == 1) {
erts_atomic32_inc_acqb(&aux_work_tmo->refc);
if (aux_work_tmo->initialized)
- setup_aux_work_timer();
+ setup_aux_work_timer(erts_get_scheduler_data());
}
}
return old;
@@ -2357,9 +3032,8 @@ erts_active_schedulers(void)
{
Uint as = erts_no_schedulers;
- ERTS_ATOMIC_FOREACH_RUNQ(rq, as -= abs(rq->waiting));
+ ERTS_ATOMIC_FOREACH_NORMAL_RUNQ(rq, as -= abs(rq->waiting));
- ASSERT(as >= 0);
return as;
}
@@ -2380,29 +3054,28 @@ try_set_sys_scheduling(void)
#endif
static ERTS_INLINE int
-prepare_for_sys_schedule(ErtsSchedulerData *esdp)
+prepare_for_sys_schedule(int non_blocking)
{
+ if (non_blocking && erts_eager_check_io) {
#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 try_set_sys_scheduling();
+#else
return 1;
- clear_sys_scheduling();
+#endif
}
- return 0;
+ else {
+#ifdef ERTS_SMP
+ while (!erts_port_task_have_outstanding_io_tasks()
+ && try_set_sys_scheduling()) {
+ if (!erts_port_task_have_outstanding_io_tasks())
+ return 1;
+ clear_sys_scheduling();
+ }
+ return 0;
#else
- return !erts_port_task_have_outstanding_io_tasks();
+ return !erts_port_task_have_outstanding_io_tasks();
#endif
+ }
}
#ifdef ERTS_SMP
@@ -2445,13 +3118,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)
{
@@ -2531,11 +3197,12 @@ static erts_aint32_t
sched_prep_spin_wait(ErtsSchedulerSleepInfo *ssi)
{
erts_aint32_t oflgs;
- erts_aint32_t nflgs = (ERTS_SSI_FLG_SLEEPING
- | ERTS_SSI_FLG_WAITING);
+ erts_aint32_t nflgs;
erts_aint32_t xflgs = 0;
do {
+ nflgs = (xflgs & ERTS_SSI_FLG_MSB_EXEC);
+ nflgs |= ERTS_SSI_FLG_SLEEPING|ERTS_SSI_FLG_WAITING;
oflgs = erts_smp_atomic32_cmpxchg_acqb(&ssi->flags, nflgs, xflgs);
if (oflgs == xflgs)
return nflgs;
@@ -2557,7 +3224,7 @@ sched_prep_cont_spin_wait(ErtsSchedulerSleepInfo *ssi)
if (oflgs == xflgs)
return nflgs;
xflgs = oflgs;
- nflgs |= oflgs & ERTS_SSI_FLG_SUSPENDED;
+ nflgs |= oflgs & (ERTS_SSI_FLG_SUSPENDED|ERTS_SSI_FLG_MSB_EXEC);
} while (oflgs & ERTS_SSI_FLG_WAITING);
return oflgs;
}
@@ -2607,7 +3274,7 @@ sched_set_sleeptype(ErtsSchedulerSleepInfo *ssi, erts_aint32_t sleep_type)
return oflgs;
}
xflgs = oflgs;
- nflgs |= oflgs & ERTS_SSI_FLG_SUSPENDED;
+ nflgs |= oflgs & (ERTS_SSI_FLG_SUSPENDED|ERTS_SSI_FLG_MSB_EXEC);
}
}
@@ -2672,8 +3339,17 @@ aux_thread(void *unused)
ErtsThrPrgrCallbacks callbacks;
int thr_prgr_active = 1;
+#ifdef ERTS_ENABLE_LOCK_CHECK
+ {
+ char buf[] = "aux_thread";
+ erts_lc_set_thread_name(buf);
+ }
+#endif
+
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;
@@ -2684,6 +3360,7 @@ aux_thread(void *unused)
init_aux_work_data(awdp, NULL, NULL);
awdp->ssi = ssi;
+
sched_prep_spin_wait(ssi);
while (1) {
@@ -2703,8 +3380,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) {
@@ -2727,6 +3402,8 @@ aux_thread(void *unused)
return NULL;
}
+static void suspend_scheduler(ErtsSchedulerData *esdp);
+
#endif /* ERTS_SMP */
static void
@@ -2739,6 +3416,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));
@@ -2764,6 +3444,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
rq->sleepers.list->prev = ssi;
rq->sleepers.list = ssi;
erts_smp_spin_unlock(&rq->sleepers.lock);
+ dirty_active(esdp, -1);
}
#endif
@@ -2772,7 +3453,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)) {
+ if (ERTS_SCHEDULER_IS_DIRTY(esdp) || !prepare_for_sys_schedule(0)) {
sched_waiting(esdp->no, rq);
@@ -2782,51 +3463,98 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
tse_wait:
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && thr_prgr_active != working)
- sched_wall_time_change(esdp, thr_prgr_active);
+ if (ERTS_SCHEDULER_IS_DIRTY(esdp))
+ dirty_sched_wall_time_change(esdp, working = 0);
+ else if (thr_prgr_active != working)
+ sched_wall_time_change(esdp, working = thr_prgr_active);
while (1) {
+ 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);
}
- if (aux_work)
- flgs = erts_smp_atomic32_read_acqb(&ssi->flags);
+ if (aux_work) {
+ if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
+ flgs = erts_smp_atomic32_read_acqb(&ssi->flags);
+ 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)) {
- if (thr_prgr_active) {
- erts_thr_progress_active(esdp, thr_prgr_active = 0);
- sched_wall_time_change(esdp, 0);
+ timeout_time = erts_check_next_timeout_time(esdp);
+ current_time = erts_get_monotonic_time(esdp);
+ do_timeout = (current_time >= timeout_time);
+ } 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);
+ sched_wall_time_change(esdp, 1);
}
- erts_thr_progress_prepare_wait(esdp);
}
+ else {
+ if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
+ 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);
+ }
- ERTS_SCHED_FAIR_YIELD();
-
- flgs = sched_spin_wait(ssi, spincount);
- if (flgs & ERTS_SSI_FLG_SLEEPING) {
- ASSERT(flgs & ERTS_SSI_FLG_WAITING);
- flgs = sched_set_sleeptype(ssi, ERTS_SSI_FLG_TSE_SLEEPING);
+ flgs = sched_spin_wait(ssi, spincount);
if (flgs & ERTS_SSI_FLG_SLEEPING) {
- int res;
- ASSERT(flgs & ERTS_SSI_FLG_TSE_SLEEPING);
ASSERT(flgs & ERTS_SSI_FLG_WAITING);
- do {
- res = erts_tse_wait(ssi->event);
- } while (res == EINTR);
+ flgs = sched_set_sleeptype(ssi, ERTS_SSI_FLG_TSE_SLEEPING);
+ if (flgs & ERTS_SSI_FLG_SLEEPING) {
+ int res;
+ ASSERT(flgs & ERTS_SSI_FLG_TSE_SLEEPING);
+ ASSERT(flgs & ERTS_SSI_FLG_WAITING);
+ current_time = ERTS_SCHEDULER_IS_DIRTY(esdp) ? 0 :
+ erts_get_monotonic_time(esdp);
+ do {
+ Sint64 timeout;
+ if (current_time >= timeout_time)
+ break;
+ if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
+ timeout = ERTS_MONOTONIC_TO_NSEC(timeout_time
+ - current_time
+ - 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);
+ }
}
+ if (!ERTS_SCHEDULER_IS_DIRTY(esdp))
+ erts_thr_progress_finalize_wait(esdp);
}
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp))
- erts_thr_progress_finalize_wait(esdp);
+ if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && current_time >= timeout_time)
+ erts_bump_timers(esdp->timer_wheel, current_time);
}
if (!(flgs & ERTS_SSI_FLG_WAITING)) {
@@ -2844,13 +3572,17 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
}
- if (flgs & ~ERTS_SSI_FLG_SUSPENDED)
- erts_smp_atomic32_read_band_nob(&ssi->flags, ERTS_SSI_FLG_SUSPENDED);
+ if (flgs & ~(ERTS_SSI_FLG_SUSPENDED|ERTS_SSI_FLG_MSB_EXEC))
+ erts_smp_atomic32_read_band_nob(&ssi->flags,
+ (ERTS_SSI_FLG_SUSPENDED
+ | ERTS_SSI_FLG_MSB_EXEC));
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && !thr_prgr_active) {
+ if (ERTS_SCHEDULER_IS_DIRTY(esdp))
+ dirty_sched_wall_time_change(esdp, working = 1);
+ else if (!thr_prgr_active) {
erts_thr_progress_active(esdp, thr_prgr_active = 1);
sched_wall_time_change(esdp, 1);
- }
+ }
erts_smp_runq_lock(rq);
sched_active(esdp->no, rq);
@@ -2859,7 +3591,6 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
else
#endif
{
- erts_aint_t dt;
erts_smp_atomic32_set_relb(&function_calls, 0);
*fcalls = 0;
@@ -2867,13 +3598,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);
@@ -2884,17 +3610,26 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
goto sys_aux_work;
while (spincount-- > 0) {
+ ErtsMonotonicTime current_time;
sys_poll_aux_work:
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());
+ LTTNG2(scheduler_poll, esdp->no, 1);
erl_sys_schedule(1); /* Might give us something to do */
- dt = erts_do_time_read_and_reset();
- if (dt) erts_bump_timer(dt);
+ 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))
+ erts_bump_timers(esdp->timer_wheel, current_time);
+ }
sys_aux_work:
#ifndef ERTS_SMP
@@ -2902,7 +3637,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
#endif
aux_work = erts_atomic32_read_acqb(&ssi->aux_work);
- if (aux_work) {
+ if (aux_work && !ERTS_SCHEDULER_IS_DIRTY(esdp)) {
if (!working)
sched_wall_time_change(esdp, working = 1);
#ifdef ERTS_SMP
@@ -2910,6 +3645,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
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 (aux_work && erts_thr_progress_update(esdp))
erts_thr_progress_leader_update(esdp);
@@ -2917,7 +3653,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_woken;
#else
flgs = erts_smp_atomic32_read_acqb(&ssi->flags);
@@ -2936,7 +3672,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)) {
+ if (!prepare_for_sys_schedule(0)) {
spincount *= ERTS_SCHED_TSE_SLEEP_SPINCOUNT_FACT;
goto tse_wait;
}
@@ -2958,7 +3694,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)) {
+ if (!prepare_for_sys_schedule(0)) {
/*
* Not allowed to wait in erl_sys_schedule;
* do tse wait instead...
@@ -3007,13 +3743,21 @@ 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);
+ LTTNG2(scheduler_poll, esdp->no, 0);
+
erl_sys_schedule(0);
- dt = erts_do_time_read_and_reset();
- if (dt) erts_bump_timer(dt);
+ 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))
+ erts_bump_timers(esdp->timer_wheel, current_time);
+ }
#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
@@ -3032,14 +3776,19 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
erts_smp_runq_lock(rq);
}
clear_sys_scheduling();
- if (flgs & ~ERTS_SSI_FLG_SUSPENDED)
- erts_smp_atomic32_read_band_nob(&ssi->flags, ERTS_SSI_FLG_SUSPENDED);
+ if (flgs & ~(ERTS_SSI_FLG_SUSPENDED|ERTS_SSI_FLG_MSB_EXEC))
+ erts_smp_atomic32_read_band_nob(&ssi->flags,
+ (ERTS_SSI_FLG_SUSPENDED
+ | ERTS_SSI_FLG_MSB_EXEC));
#endif
if (!working)
sched_wall_time_change(esdp, working = 1);
sched_active_sys(esdp->no, rq);
}
+ if (ERTS_SCHEDULER_IS_DIRTY(esdp))
+ dirty_active(esdp, 1);
+
ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq));
}
@@ -3056,17 +3805,54 @@ ssi_flags_set_wake(ErtsSchedulerSleepInfo *ssi)
oflgs = erts_smp_atomic32_cmpxchg_relb(&ssi->flags, nflgs, xflgs);
if (oflgs == xflgs)
return oflgs;
- nflgs = oflgs & ERTS_SSI_FLG_SUSPENDED;
+ nflgs = oflgs & (ERTS_SSI_FLG_SUSPENDED|ERTS_SSI_FLG_MSB_EXEC);
xflgs = oflgs;
}
}
+static ERTS_INLINE void
+ssi_wake(ErtsSchedulerSleepInfo *ssi)
+{
+ erts_sched_finish_poke(ssi, ssi_flags_set_wake(ssi));
+}
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+
static void
-wake_scheduler(ErtsRunQueue *rq)
+dcpu_sched_ix_suspend_wake(Uint ix)
{
- ErtsSchedulerSleepInfo *ssi;
- erts_aint32_t flgs;
+ ErtsSchedulerSleepInfo* ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix);
+ erts_smp_atomic32_read_bor_nob(&ssi->flags, ERTS_SSI_FLG_SUSPENDED);
+ ssi_wake(ssi);
+}
+static void
+dio_sched_ix_suspend_wake(Uint ix)
+{
+ ErtsSchedulerSleepInfo* ssi = ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix);
+ erts_smp_atomic32_read_bor_nob(&ssi->flags, ERTS_SSI_FLG_SUSPENDED);
+ ssi_wake(ssi);
+}
+
+static void
+dcpu_sched_ix_wake(Uint ix)
+{
+ ssi_wake(ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix));
+}
+
+#if 0
+static void
+dio_sched_ix_wake(Uint ix)
+{
+ ssi_wake(ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix));
+}
+#endif
+
+#endif
+
+static void
+wake_scheduler(ErtsRunQueue *rq)
+{
/*
* The unlocked run queue is not strictly necessary
* from a thread safety or deadlock prevention
@@ -3075,12 +3861,10 @@ 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));
-
- ssi = rq->scheduler->ssi;
+ ERTS_SMP_LC_ASSERT(!erts_smp_lc_runq_is_locked(rq)
+ || ERTS_RUNQ_IX_IS_DIRTY(rq->ix));
- flgs = ssi_flags_set_wake(ssi);
- erts_sched_finish_poke(ssi, flgs);
+ ssi_wake(rq->scheduler->ssi);
}
#ifdef ERTS_DIRTY_SCHEDULERS
@@ -3127,10 +3911,17 @@ wake_dirty_schedulers(ErtsRunQueue *rq, int one)
} while (ssi);
}
}
+
+static void
+wake_dirty_scheduler(ErtsRunQueue *rq)
+{
+ wake_dirty_schedulers(rq, 1);
+}
+
#endif
#define ERTS_NO_USED_RUNQS_SHIFT 16
-#define ERTS_NO_RUNQS_MASK 0xffff
+#define ERTS_NO_RUNQS_MASK 0xffffU
#if ERTS_MAX_NO_OF_SCHEDULERS > ERTS_NO_RUNQS_MASK
# error "Too large amount of schedulers allowed"
@@ -3212,11 +4003,11 @@ chk_wake_sched(ErtsRunQueue *crq, int ix, int activate)
return 0;
wrq = ERTS_RUNQ_IX(ix);
flags = ERTS_RUNQ_FLGS_GET(wrq);
+ if (activate && !(flags & ERTS_RUNQ_FLG_SUSPENDED)) {
+ if (try_inc_no_active_runqs(ix+1))
+ (void) ERTS_RUNQ_FLGS_UNSET(wrq, ERTS_RUNQ_FLG_INACTIVE);
+ }
if (!(flags & (ERTS_RUNQ_FLG_SUSPENDED|ERTS_RUNQ_FLG_NONEMPTY))) {
- if (activate) {
- if (try_inc_no_active_runqs(ix+1))
- (void) ERTS_RUNQ_FLGS_UNSET(wrq, ERTS_RUNQ_FLG_INACTIVE);
- }
wake_scheduler(wrq);
return 1;
}
@@ -3267,7 +4058,7 @@ smp_notify_inc_runq(ErtsRunQueue *runq)
if (runq) {
#ifdef ERTS_DIRTY_SCHEDULERS
if (ERTS_RUNQ_IX_IS_DIRTY(runq->ix))
- wake_dirty_schedulers(runq, 1);
+ wake_dirty_scheduler(runq);
else
#endif
wake_scheduler(runq);
@@ -3400,6 +4191,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 *
@@ -3482,7 +4280,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;
@@ -3506,7 +4304,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);
@@ -3564,38 +4362,46 @@ suspend_run_queue(ErtsRunQueue *rq)
wake_scheduler(rq);
}
-static void scheduler_ix_resume_wake(Uint ix);
-static void scheduler_ssi_resume_wake(ErtsSchedulerSleepInfo *ssi);
+static void nrml_sched_ix_resume_wake(Uint ix);
static ERTS_INLINE void
resume_run_queue(ErtsRunQueue *rq)
{
int pix;
+ Uint32 oflgs;
+
+ ASSERT(!ERTS_RUNQ_IX_IS_DIRTY(rq->ix));
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_MSB_EXEC),
+ (ERTS_RUNQ_FLG_OUT_OF_WORK
+ | ERTS_RUNQ_FLG_HALFTIME_OUT_OF_WORK));
+
+ if (oflgs & (ERTS_RUNQ_FLG_SUSPENDED|ERTS_RUNQ_FLG_MSB_EXEC)) {
+ 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);
-#ifdef ERTS_DIRTY_SCHEDULERS
- if (!ERTS_RUNQ_IX_IS_DIRTY(rq->ix))
-#endif
- scheduler_ix_resume_wake(rq->ix);
+ nrml_sched_ix_resume_wake(rq->ix);
}
typedef struct {
@@ -3619,6 +4425,33 @@ schedule_bound_processes(ErtsRunQueue *rq,
}
}
+#ifdef ERTS_DIRTY_SCHEDULERS
+
+static ERTS_INLINE void
+clear_proc_dirty_queue_bit(Process *p, ErtsRunQueue *rq, int prio_bit)
+{
+#ifdef DEBUG
+ erts_aint32_t old;
+#endif
+ erts_aint32_t qb = prio_bit;
+ if (rq == ERTS_DIRTY_CPU_RUNQ)
+ qb <<= ERTS_PDSFLGS_IN_CPU_PRQ_MASK_OFFSET;
+ else {
+ ASSERT(rq == ERTS_DIRTY_IO_RUNQ);
+ qb <<= ERTS_PDSFLGS_IN_IO_PRQ_MASK_OFFSET;
+ }
+#ifdef DEBUG
+ old = (int)
+#else
+ (void)
+#endif
+ erts_smp_atomic32_read_band_mb(&p->dirty_state, ~qb);
+ ASSERT(old & qb);
+}
+
+#endif /* ERTS_DIRTY_SCHEDULERS */
+
+
static void
evacuate_run_queue(ErtsRunQueue *rq,
ErtsStuckBoundProcesses *sbpp)
@@ -3626,28 +4459,22 @@ evacuate_run_queue(ErtsRunQueue *rq,
int prio_q;
ErtsRunQueue *to_rq;
ErtsMigrationPaths *mps;
- ErtsMigrationPath *mp = NULL;
+ ErtsMigrationPath *mp;
ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq));
(void) ERTS_RUNQ_FLGS_UNSET(rq, ERTS_RUNQ_FLG_PROTECTED);
-#ifdef ERTS_DIRTY_SCHEDULERS
- if (!ERTS_RUNQ_IX_IS_DIRTY(rq->ix))
-#endif
- {
- mps = erts_get_migration_paths_managed();
- mp = &mps->mpath[rq->ix];
- }
+ ASSERT(!ERTS_RUNQ_IX_IS_DIRTY(rq->ix));
+
+ mps = erts_get_migration_paths_managed();
+ mp = &mps->mpath[rq->ix];
/* Evacuate scheduled misc ops */
if (rq->misc.start) {
ErtsMiscOpList *start, *end;
-#ifdef ERTS_DIRTY_SCHEDULERS
- ASSERT(!ERTS_RUNQ_IX_IS_DIRTY(rq->ix));
-#endif
to_rq = mp->misc_evac_runq;
if (!to_rq)
return;
@@ -3656,6 +4483,7 @@ evacuate_run_queue(ErtsRunQueue *rq,
end = rq->misc.end;
rq->misc.start = NULL;
rq->misc.end = NULL;
+ ERTS_RUNQ_FLGS_UNSET_NOB(rq, ERTS_RUNQ_FLG_MISC_OP);
erts_smp_runq_unlock(rq);
erts_smp_runq_lock(to_rq);
@@ -3676,9 +4504,6 @@ evacuate_run_queue(ErtsRunQueue *rq,
if (rq->ports.start) {
Port *prt;
-#ifdef ERTS_DIRTY_SCHEDULERS
- ASSERT(!ERTS_RUNQ_IX_IS_DIRTY(rq->ix));
-#endif
to_rq = mp->prio[ERTS_PORT_PRIO_LEVEL].runq;
if (!to_rq)
return;
@@ -3697,7 +4522,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);
@@ -3714,27 +4539,68 @@ 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
- if (!ERTS_RUNQ_IX_IS_DIRTY(rq->ix))
-#endif
- {
- if (!mp->prio[prio_q].runq)
- return;
- if (prio_q == PRIORITY_NORMAL && !mp->prio[PRIORITY_LOW].runq)
- return;
- }
+ if (!mp->prio[prio_q].runq)
+ return;
+ if (prio_q == PRIORITY_NORMAL && !mp->prio[PRIORITY_LOW].runq)
+ return;
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
+
+ clr_bits = ERTS_PSFLG_IN_RUNQ;
+ clr_bits |= qbit << ERTS_PSFLGS_IN_PRQ_MASK_OFFSET;
+
+#ifdef DEBUG
+ old =
+#else
+ (void)
#endif
- if (ERTS_PSFLG_BOUND & state) {
+ erts_smp_atomic32_read_band_mb(&proc->state,
+ ~clr_bits);
+ ASSERT((old & clr_bits) == clr_bits);
+
+ }
+
+ goto handle_next_proc;
+ }
+
+ if (ERTS_PSFLG_BOUND & real_state) {
/* Bound processes get stuck here... */
proc->next = NULL;
if (sbpp->last)
@@ -3742,43 +4608,12 @@ evacuate_run_queue(ErtsRunQueue *rq,
else
sbpp->first = proc;
sbpp->last = proc;
-#ifdef ERTS_DIRTY_SCHEDULERS
- requeue = 0;
-#endif
}
-#ifdef ERTS_DIRTY_SCHEDULERS
- else if (state & ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q) {
- erts_aint32_t old;
- old = 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) {
- erts_aint32_t old;
- old = 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)));
- }
- if (requeue) {
-#else
else {
-#endif
int prio = (int) ERTS_PSFLGS_GET_PRQ_PRIO(state);
erts_smp_runq_unlock(rq);
-#ifdef ERTS_DIRTY_SCHEDULERS
- if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix))
- /*
- * dirty run queues evacuate only to run
- * queue 0 during multi-scheduling blocking
- */
- to_rq = ERTS_RUNQ_IX(0);
- else
-#endif
- to_rq = mp->prio[prio].runq;
+ to_rq = mp->prio[prio].runq;
RUNQ_SET_RQ(&proc->run_queue, to_rq);
erts_smp_runq_lock(to_rq);
@@ -3788,6 +4623,8 @@ evacuate_run_queue(ErtsRunQueue *rq,
erts_smp_runq_lock(rq);
}
+
+ handle_next_proc:
proc = dequeue_process(rq, prio_q, &state);
}
if (notify)
@@ -3811,7 +4648,7 @@ try_steal_task_from_victim(ErtsRunQueue *rq, int *rq_lockedp, ErtsRunQueue *vrq,
erts_smp_runq_lock(vrq);
- if (rq->halt_in_progress)
+ if (ERTS_RUNQ_FLGS_GET_NOB(rq) & ERTS_RUNQ_FLG_HALTING)
goto no_procs;
/*
@@ -3890,7 +4727,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;
@@ -3910,8 +4747,7 @@ check_possible_steal_victim(ErtsRunQueue *rq, int *rq_lockedp, int vix)
{
ErtsRunQueue *vrq = ERTS_RUNQ_IX(vix);
Uint32 flags = ERTS_RUNQ_FLGS_GET(vrq);
- if ((flags & (ERTS_RUNQ_FLG_NONEMPTY
- | ERTS_RUNQ_FLG_PROTECTED)) == ERTS_RUNQ_FLG_NONEMPTY)
+ if (runq_got_work_to_execute_flags(flags) & (!(flags & ERTS_RUNQ_FLG_PROTECTED)))
return try_steal_task_from_victim(rq, rq_lockedp, vrq, flags);
else
return 0;
@@ -3979,11 +4815,9 @@ try_steal_task(ErtsRunQueue *rq)
if (!rq_locked)
erts_smp_runq_lock(rq);
- if (!res)
- res = rq->halt_in_progress ?
- !ERTS_EMPTY_RUNQ_PORTS(rq) : !ERTS_EMPTY_RUNQ(rq);
-
- return res;
+ if (res)
+ return res;
+ return runq_got_work_to_execute(rq);
}
/* Run queue balancing */
@@ -4350,7 +5184,7 @@ check_balance(ErtsRunQueue *c_rq)
sched_util_balancing = 1;
/*
* In order to avoid renaming a large amount of fields
- * we write utilization values instead of lenght values
+ * we write utilization values instead of length values
* in the 'max_len' and 'migration_limit' fields...
*/
for (qix = 0; qix < blnc_no_rqs; qix++) {
@@ -4722,7 +5556,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
@@ -4880,7 +5714,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;
@@ -4893,9 +5727,11 @@ wakeup_other_check(ErtsRunQueue *rq, Uint32 flags)
+ ERTS_WAKEUP_OTHER_FIXED_INC);
if (rq->wakeup_other > wakeup_other.limit) {
#ifdef ERTS_DIRTY_SCHEDULERS
- if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix) && rq->waiting)
- wake_dirty_schedulers(rq, 1);
- else
+ if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) {
+ if (rq->waiting) {
+ wake_dirty_scheduler(rq);
+ }
+ } else
#endif
{
int empty_rqs =
@@ -4951,7 +5787,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)
@@ -5047,7 +5883,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);
}
@@ -5066,17 +5902,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
@@ -5192,22 +6022,37 @@ erts_sched_set_wake_cleanup_threshold(char *str)
static void
init_aux_work_data(ErtsAuxWorkData *awdp, ErtsSchedulerData *esdp, char *dawwp)
{
- if (!esdp)
- awdp->sched_id = 0;
+ int id = 0;
+ if (esdp) {
+ switch (esdp->type) {
+ case ERTS_SCHED_NORMAL:
+ id = (int) esdp->no;
+ break;
#ifdef ERTS_DIRTY_SCHEDULERS
- else if (ERTS_SCHEDULER_IS_DIRTY(esdp))
- awdp->sched_id = (int) ERTS_DIRTY_SCHEDULER_NO(esdp);
-#endif
- else
- awdp->sched_id = (int) esdp->no;
+ case ERTS_SCHED_DIRTY_CPU:
+ id = (int) erts_no_schedulers;
+ id += (int) esdp->dirty_no;
+ break;
+ case ERTS_SCHED_DIRTY_IO:
+ id = (int) erts_no_schedulers;
+ id += (int) erts_no_dirty_cpu_schedulers;
+ id += (int) esdp->dirty_no;
+ break;
+#endif
+ default:
+ ERTS_INTERNAL_ERROR("Invalid scheduler type");
+ break;
+ }
+ }
+
+ awdp->sched_id = id;
awdp->esdp = esdp;
awdp->ssi = esdp ? esdp->ssi : NULL;
#ifdef ERTS_SMP
awdp->latest_wakeup = ERTS_THR_PRGR_VAL_FIRST;
awdp->misc.thr_prgr = ERTS_THR_PRGR_VAL_WAITING;
awdp->dd.thr_prgr = ERTS_THR_PRGR_VAL_WAITING;
- awdp->dd.completed_callback = NULL;
- awdp->dd.completed_arg = NULL;
+ awdp->cncld_tmrs.thr_prgr = ERTS_THR_PRGR_VAL_WAITING;
awdp->later_op.thr_prgr = ERTS_THR_PRGR_VAL_FIRST;
awdp->later_op.size = 0;
awdp->later_op.first = NULL;
@@ -5237,14 +6082,20 @@ init_aux_work_data(ErtsAuxWorkData *awdp, ErtsSchedulerData *esdp, char *dawwp)
awdp->delayed_wakeup.sched2jix[i] = -1;
}
#endif
+ awdp->debug.wait_completed.flags = 0;
+ awdp->debug.wait_completed.callback = NULL;
+ awdp->debug.wait_completed.arg = NULL;
}
static void
init_scheduler_data(ErtsSchedulerData* esdp, int num,
ErtsSchedulerSleepInfo* ssi,
ErtsRunQueue* runq,
- char** daww_ptr, size_t daww_sz)
+ char** daww_ptr, size_t daww_sz,
+ Process *shadow_proc,
+ Uint64 time_stamp)
{
+ esdp->timer_wheel = NULL;
#ifdef ERTS_SMP
erts_bits_init_state(&esdp->erl_bits_state);
esdp->match_pseudo_process = NULL;
@@ -5257,21 +6108,47 @@ 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
+ esdp->run_queue = runq;
if (ERTS_RUNQ_IX_IS_DIRTY(runq->ix)) {
esdp->no = 0;
- ERTS_DIRTY_SCHEDULER_NO(esdp) = (Uint) num;
+ if (runq == ERTS_DIRTY_CPU_RUNQ)
+ esdp->type = ERTS_SCHED_DIRTY_CPU;
+ else {
+ ASSERT(runq == ERTS_DIRTY_IO_RUNQ);
+ esdp->type = ERTS_SCHED_DIRTY_IO;
+ }
+ esdp->dirty_no = (Uint) num;
+ if (num == 1) {
+ /*
+ * Multi-scheduling block functionality depends
+ * on finding dirty scheduler number 1 here...
+ */
+ runq->scheduler = esdp;
+ }
}
else {
+ esdp->type = ERTS_SCHED_NORMAL;
esdp->no = (Uint) num;
- ERTS_DIRTY_SCHEDULER_NO(esdp) = 0;
+ esdp->dirty_no = 0;
+ runq->scheduler = esdp;
+ }
+ esdp->dirty_shadow_process = shadow_proc;
+ if (shadow_proc) {
+ erts_init_empty_process(shadow_proc);
+ erts_smp_atomic32_init_nob(&shadow_proc->state,
+ (ERTS_PSFLG_ACTIVE
+ | ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_PROXY));
+ shadow_proc->static_flags = ERTS_STC_FLG_SHADOW_PROC;
}
#else
+ runq->scheduler = esdp;
+ esdp->run_queue = runq;
esdp->no = (Uint) num;
+ esdp->type = ERTS_SCHED_NORMAL;
#endif
+
esdp->ssi = ssi;
esdp->current_process = NULL;
esdp->current_port = NULL;
@@ -5281,8 +6158,14 @@ init_scheduler_data(ErtsSchedulerData* esdp, int num,
erts_init_atom_cache_map(&esdp->atom_cache_map);
- esdp->run_queue = runq;
- esdp->run_queue->scheduler = esdp;
+ esdp->last_monotonic_time = 0;
+ esdp->check_time_reds = 0;
+
+ esdp->thr_id = (Uint32) num;
+ erts_sched_bif_unique_init(esdp);
+
+ esdp->io.out = (Uint64) 0;
+ esdp->io.in = (Uint64) 0;
if (daww_ptr) {
init_aux_work_data(&esdp->aux_work_data, esdp, *daww_ptr);
@@ -5293,7 +6176,7 @@ init_scheduler_data(ErtsSchedulerData* esdp, int num,
esdp->reductions = 0;
- init_sched_wall_time(&esdp->sched_wall_time);
+ init_sched_wall_time(esdp, time_stamp);
erts_port_task_handle_init(&esdp->nosuspend_port_task_handle);
}
@@ -5305,10 +6188,13 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online
#endif
)
{
- int ix, n, no_ssi;
+ int ix, n, no_ssi, tot_rqs;
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();
@@ -5335,26 +6221,19 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online
/* Create and initialize run queues */
n = no_schedulers;
- size_runqs = sizeof(ErtsAlignedRunQueue) * (n + ERTS_NUM_DIRTY_RUNQS);
+ tot_rqs = (n + ERTS_NUM_DIRTY_RUNQS);
+ size_runqs = sizeof(ErtsAlignedRunQueue) * tot_rqs;
erts_aligned_run_queues =
erts_alloc_permanent_cache_aligned(ERTS_ALC_T_RUNQS, size_runqs);
#ifdef ERTS_SMP
-#ifdef ERTS_DIRTY_SCHEDULERS
- erts_aligned_run_queues += ERTS_NUM_DIRTY_RUNQS;
-#endif
erts_smp_atomic32_init_nob(&no_empty_run_queues, 0);
#endif
erts_no_run_queues = n;
- for (ix = -(ERTS_NUM_DIRTY_RUNQS); ix < n; ix++) {
+ for (ix = 0; ix < tot_rqs; ix++) {
int pix, rix;
-#ifdef ERTS_DIRTY_SCHEDULERS
- ErtsRunQueue *rq = ERTS_RUNQ_IX_IS_DIRTY(ix) ?
- ERTS_DIRTY_RUNQ_IX(ix) : ERTS_RUNQ_IX(ix);
-#else
ErtsRunQueue *rq = ERTS_RUNQ_IX(ix);
-#endif
rq->ix = ix;
@@ -5362,13 +6241,17 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online
* id if the esdp->no <-> ix+1 mapping change.
*/
- erts_smp_mtx_init_x(&rq->mtx, "run_queue", make_small(ix + 1));
+ erts_smp_mtx_init(&rq->mtx, "run_queue", make_small(ix + 1),
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_SCHEDULER);
erts_smp_cnd_init(&rq->cnd);
#ifdef ERTS_DIRTY_SCHEDULERS
#ifdef ERTS_SMP
- if (ERTS_RUNQ_IX_IS_DIRTY(ix))
- erts_smp_spinlock_init(&rq->sleepers.lock, "dirty_run_queue_sleep_list");
+ if (ERTS_RUNQ_IX_IS_DIRTY(ix)) {
+ erts_smp_spinlock_init(&rq->sleepers.lock, "dirty_run_queue_sleep_list",
+ make_small(ix + 1),
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_SCHEDULER);
+ }
rq->sleepers.list = NULL;
#endif
#endif
@@ -5384,10 +6267,9 @@ 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;
rq->procs.pending_exiters = NULL;
rq->procs.context_switches = 0;
@@ -5433,9 +6315,12 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online
n = (int) no_schedulers;
erts_no_schedulers = n;
+ erts_no_total_schedulers = n;
#ifdef ERTS_DIRTY_SCHEDULERS
erts_no_dirty_cpu_schedulers = no_dirty_cpu_schedulers;
+ erts_no_total_schedulers += no_dirty_cpu_schedulers;
erts_no_dirty_io_schedulers = no_dirty_io_schedulers;
+ erts_no_total_schedulers += no_dirty_io_schedulers;
#endif
/* Create and initialize scheduler sleep info */
@@ -5502,73 +6387,65 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online
erts_aligned_scheduler_data =
erts_alloc_permanent_cache_aligned(ERTS_ALC_T_SCHDLR_DATA,
- n*sizeof(ErtsAlignedSchedulerData));
+ n*sizeof(ErtsAlignedSchedulerData));
for (ix = 0; ix < n; ix++) {
ErtsSchedulerData *esdp = ERTS_SCHEDULER_IX(ix);
init_scheduler_data(esdp, ix+1, ERTS_SCHED_SLEEP_INFO_IX(ix),
- ERTS_RUNQ_IX(ix), &daww_ptr, daww_sz);
+ ERTS_RUNQ_IX(ix), &daww_ptr, daww_sz,
+ NULL, 0);
}
#ifdef ERTS_DIRTY_SCHEDULERS
-#ifdef ERTS_SMP
- erts_aligned_dirty_cpu_scheduler_data =
- erts_alloc_permanent_cache_aligned(
- ERTS_ALC_T_SCHDLR_DATA,
- no_dirty_cpu_schedulers*sizeof(ErtsAlignedSchedulerData));
- for (ix = 0; ix < no_dirty_cpu_schedulers; ix++) {
- ErtsSchedulerData *esdp = ERTS_DIRTY_CPU_SCHEDULER_IX(ix);
- init_scheduler_data(esdp, ix+1, ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix),
- ERTS_DIRTY_CPU_RUNQ, NULL, 0);
- }
- erts_aligned_dirty_io_scheduler_data =
- erts_alloc_permanent_cache_aligned(
- ERTS_ALC_T_SCHDLR_DATA,
- no_dirty_io_schedulers*sizeof(ErtsAlignedSchedulerData));
- for (ix = 0; ix < no_dirty_io_schedulers; ix++) {
- ErtsSchedulerData *esdp = ERTS_DIRTY_IO_SCHEDULER_IX(ix);
- init_scheduler_data(esdp, ix+1, ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix),
- ERTS_DIRTY_IO_RUNQ, NULL, 0);
+ {
+ Uint64 ts = sched_wall_time_ts();
+ int dirty_scheds = no_dirty_cpu_schedulers + no_dirty_io_schedulers;
+ int adspix = 0;
+ ErtsAlignedDirtyShadowProcess *adsp =
+ erts_alloc_permanent_cache_aligned(
+ ERTS_ALC_T_SCHDLR_DATA,
+ dirty_scheds * sizeof(ErtsAlignedDirtyShadowProcess));
+
+ erts_aligned_dirty_cpu_scheduler_data =
+ erts_alloc_permanent_cache_aligned(
+ ERTS_ALC_T_SCHDLR_DATA,
+ dirty_scheds * sizeof(ErtsAlignedSchedulerData));
+
+ erts_aligned_dirty_io_scheduler_data =
+ &erts_aligned_dirty_cpu_scheduler_data[no_dirty_cpu_schedulers];
+
+ for (ix = 0; ix < no_dirty_cpu_schedulers; ix++) {
+ ErtsSchedulerData *esdp = ERTS_DIRTY_CPU_SCHEDULER_IX(ix);
+ init_scheduler_data(esdp, ix+1, ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix),
+ ERTS_DIRTY_CPU_RUNQ, NULL, 0,
+ &adsp[adspix++].dsp, ts);
+ }
+ for (ix = 0; ix < no_dirty_io_schedulers; ix++) {
+ ErtsSchedulerData *esdp = ERTS_DIRTY_IO_SCHEDULER_IX(ix);
+ init_scheduler_data(esdp, ix+1, ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix),
+ ERTS_DIRTY_IO_RUNQ, NULL, 0,
+ &adsp[adspix++].dsp, ts);
+ }
}
#endif
-#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;
#ifdef ERTS_SMP
- erts_atomic32_init_nob(&completed_dealloc_count, 0); /* debug only */
-
aux_thread_aux_work_data =
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");
+ erts_smp_mtx_init(&balance_info.update_mtx, "migration_info_update", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_SCHEDULER);
balance_info.forced_check_balance = 0;
balance_info.halftime = 1;
balance_info.full_reds_history_index = 0;
@@ -5580,32 +6457,71 @@ 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);
+
+ erts_smp_atomic32_init_nob(&dirty_count.cpu.active,
+ (erts_aint32_t) no_dirty_cpu_schedulers);
+ erts_smp_atomic32_init_nob(&dirty_count.io.active,
+ (erts_aint32_t) 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();
@@ -5619,20 +6535,15 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online
erts_tsd_set(sched_data_key, (void *) esdp);
#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);
/* init port tasks */
erts_port_task_init();
- aux_work_timeout_late_init();
-
#ifndef ERTS_SMP
#ifdef ERTS_DO_VERIFY_UNUSED_TEMP_ALLOC
erts_scheduler_data->verify_unused_temp_alloc
@@ -5716,19 +6627,106 @@ 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;
+
+ /* Do not enqueue free process... */
+ if (actual & ERTS_PSFLG_FREE) {
+ *newp &= ~ERTS_PSFLGS_DIRTY_WORK;
+ return ERTS_ENQUEUE_NOT;
+ }
+
+ /* Termination should be done on an ordinary scheduler */
+ if ((*newp) & 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 ((*newp) & 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;
+ }
+
+ /*
+ * Enqueue using process struct.
+ */
+ *newp &= ~ERTS_PSFLGS_PRQ_PRIO_MASK;
+ *newp |= ERTS_PSFLG_IN_RUNQ | (aprio << ERTS_PSFLGS_PRQ_PRIO_OFFSET);
+ 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,
@@ -5744,61 +6742,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;
@@ -5830,31 +6781,115 @@ 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.
+ *
+ * Return non-zero value if caller should decrease
+ * reference count on the process when done with it...
*/
static ERTS_INLINE int
-schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, Process *proxy)
+schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p,
+ Process *proxy, int is_normal_sched)
{
- erts_aint32_t a, e, n, enq_prio = -1;
+ erts_aint32_t a, e, n, enq_prio = -1, running_flgs;
int enqueue; /* < 0 -> use proxy */
- Process* sched_p;
ErtsRunQueue* runq;
-#ifdef ERTS_SMP
- int check_emigration_need;
+
+ if (!is_normal_sched)
+ running_flgs = ERTS_PSFLG_DIRTY_RUNNING|ERTS_PSFLG_DIRTY_RUNNING_SYS;
+ else {
+ running_flgs = ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS;
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (state & ERTS_PSFLG_DIRTY_ACTIVE_SYS
+ && (p->flags & (F_DELAY_GC|F_DISABLE_GC))) {
+ /*
+ * Delay dirty GC; will be enabled automatically
+ * again by next GC...
+ */
+
+ /*
+ * No normal execution until dirty CLA or hibernat has
+ * been handled...
+ */
+ ASSERT(!(p->flags & (F_DIRTY_CLA | F_DIRTY_GC_HIBERNATE)));
+
+ state = erts_smp_atomic32_read_band_nob(&p->state,
+ ~ERTS_PSFLG_DIRTY_ACTIVE_SYS);
+ state &= ~ERTS_PSFLG_DIRTY_ACTIVE_SYS;
+ }
#endif
+ }
a = state;
while (1) {
n = e = a;
- ASSERT(a & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS));
+ ASSERT(a & running_flgs);
enqueue = ERTS_ENQUEUE_NOT;
- n &= ~(ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS);
- if (a & ERTS_PSFLG_ACTIVE_SYS
+ n &= ~running_flgs;
+ 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);
}
@@ -5863,13 +6898,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) {
- if (!(a & ERTS_PSFLG_ACTIVE_SYS)
- && (!(a & ERTS_PSFLG_ACTIVE)
- || (a & ERTS_PSFLG_SUSPENDED))) {
+ /* 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|ERTS_PSFLG_DIRTY_ACTIVE_SYS))
+ && (!(a & ERTS_PSFLG_ACTIVE) || (a & ERTS_PSFLG_SUSPENDED))) {
/* Process inactive */
profile_runnable_proc(p, am_inactive);
}
@@ -5879,100 +6918,103 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, Proces
free_proxy_proc(proxy);
erts_smp_runq_lock(c_rq);
- 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;
+#if !defined(ERTS_SMP)
+ /* Decrement refc if process struct is free... */
+ return !!(n & ERTS_PSFLG_FREE);
+#else
+ /* Decrement refc if scheduled out from dirty scheduler... */
+ return !is_normal_sched;
#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_FREE));
+ 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);
- }
+ if (is_normal_sched && sched_p == p && ERTS_RUNQ_IX_IS_DIRTY(runq->ix))
+ erts_proc_inc_refc(p); /* Needs to be done before enqueue_process() */
-#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
+ /* Enqueue the process */
+ enqueue_process(runq, (int) enq_prio, sched_p);
- ASSERT(runq);
+ if (runq == c_rq)
+ return 0;
- erts_smp_runq_lock(runq);
+ erts_smp_runq_unlock(runq);
- /* Enqueue the process */
- enqueue_process(runq, (int) enq_prio, sched_p);
+ smp_notify_inc_runq(runq);
- if (runq == c_rq)
- return 1;
- erts_smp_runq_unlock(runq);
- smp_notify_inc_runq(runq);
- erts_smp_runq_lock(c_rq);
- return 1;
+ erts_smp_runq_lock(c_rq);
+
+ /*
+ * Decrement refc if process is scheduled out by a
+ * dirty scheduler, and we have not just scheduled
+ * the process using the ordinary process struct
+ * on a dirty run-queue again...
+ */
+ return !is_normal_sched && (sched_p != p
+ || !ERTS_RUNQ_IX_IS_DIRTY(runq->ix));
+ }
}
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;
+ /*
+ * Refc on process struct (i.e. true struct,
+ * not proxy-struct) increased while in a
+ * dirty run-queue or executing on a dirty
+ * scheduler.
+ */
+ if (ERTS_RUNQ_IX_IS_DIRTY(runq->ix))
+ erts_proc_inc_refc(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
@@ -5980,24 +7022,38 @@ change_proc_schedule_state(Process *p,
erts_aint32_t clear_state_flags,
erts_aint32_t set_state_flags,
erts_aint32_t *statep,
- erts_aint32_t *enq_prio_p)
+ erts_aint32_t *enq_prio_p,
+ ErtsProcLocks locks)
{
/*
- * NOTE: ERTS_PSFLG_RUNNING, ERTS_PSFLG_RUNNING_SYS and
- * ERTS_PSFLG_ACTIVE_SYS are not allowed to be
+ * NOTE: ERTS_PSFLG_RUNNING, ERTS_PSFLG_RUNNING_SYS,
+ * ERTS_PSFLG_DIRTY_RUNNING, ERTS_PSFLG_DIRTY_RUNNING_SYS
+ * and ERTS_PSFLG_ACTIVE_SYS are not allowed to be
* altered by this function!
*/
erts_aint32_t a = *statep, n;
int enqueue; /* < 0 -> use proxy */
+ unsigned int prof_runnable_procs = erts_system_profile_flags.runnable_procs;
+ unsigned int lock_status = (prof_runnable_procs
+ && !(locks & ERTS_PROC_LOCK_STATUS));
+
+ ERTS_SMP_LC_ASSERT(locks == erts_proc_lc_my_proc_locks(p));
ASSERT(!(a & ERTS_PSFLG_PROXY));
ASSERT((clear_state_flags & (ERTS_PSFLG_RUNNING
| ERTS_PSFLG_RUNNING_SYS
+ | ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS
| ERTS_PSFLG_ACTIVE_SYS)) == 0);
ASSERT((set_state_flags & (ERTS_PSFLG_RUNNING
| ERTS_PSFLG_RUNNING_SYS
+ | ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS
| ERTS_PSFLG_ACTIVE_SYS)) == 0);
+ if (lock_status)
+ erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+
while (1) {
erts_aint32_t e;
n = e = a;
@@ -6016,8 +7072,16 @@ change_proc_schedule_state(Process *p,
if ((n & (ERTS_PSFLG_SUSPENDED
| ERTS_PSFLG_RUNNING
| ERTS_PSFLG_RUNNING_SYS
+ | ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS
| ERTS_PSFLG_IN_RUNQ
- | ERTS_PSFLG_ACTIVE)) == ERTS_PSFLG_ACTIVE) {
+ | ERTS_PSFLG_ACTIVE)) == ERTS_PSFLG_ACTIVE
+#ifdef ERTS_DIRTY_SCHEDULERS
+ || (n & (ERTS_PSFLG_RUNNING
+ | ERTS_PSFLG_RUNNING_SYS
+ | ERTS_PSFLG_EXITING)) == ERTS_PSFLG_EXITING
+#endif
+ ) {
/*
* Active and seemingly need to be enqueued, but
* process may be in a run queue via proxy, need
@@ -6033,28 +7097,35 @@ change_proc_schedule_state(Process *p,
break;
}
- if (erts_system_profile_flags.runnable_procs) {
+ if (prof_runnable_procs) {
+
+ /* Status lock prevents out of order "runnable proc" trace msgs */
if (((n & (ERTS_PSFLG_SUSPENDED
| ERTS_PSFLG_ACTIVE)) == ERTS_PSFLG_ACTIVE)
&& (!(a & (ERTS_PSFLG_ACTIVE_SYS
| ERTS_PSFLG_RUNNING
- | ERTS_PSFLG_RUNNING_SYS)
+ | ERTS_PSFLG_RUNNING_SYS
+ | ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS)
&& (!(a & ERTS_PSFLG_ACTIVE)
|| (a & ERTS_PSFLG_SUSPENDED))))) {
/* We activated a prevously inactive process */
profile_runnable_proc(p, am_active);
}
+ if (lock_status)
+ erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
}
+
*statep = a;
return enqueue;
}
static ERTS_INLINE void
-schedule_process(Process *p, erts_aint32_t in_state)
+schedule_process(Process *p, erts_aint32_t in_state, ErtsProcLocks locks)
{
erts_aint32_t enq_prio = -1;
erts_aint32_t state = in_state;
@@ -6062,24 +7133,114 @@ schedule_process(Process *p, erts_aint32_t in_state)
0,
ERTS_PSFLG_ACTIVE,
&state,
- &enq_prio);
- if (enqueue != ERTS_ENQUEUE_NOT)
- add2runq(enqueue > 0 ? p : make_proxy_proc(NULL, p, enq_prio),
- state,
- enq_prio);
+ &enq_prio,
+ locks);
+ add2runq(enqueue, enq_prio, p, state, NULL);
}
void
-erts_schedule_process(Process *p, erts_aint32_t state)
+erts_schedule_process(Process *p, erts_aint32_t state, ErtsProcLocks locks)
{
- schedule_process(p, state);
+ 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,
+ erts_aint32_t *fail_state_p)
{
- erts_aint32_t a = state, n, enq_prio = -1;
+ int res;
+ int locked;
+ ErtsProcSysTaskQs *stqs, *free_stqs;
+ erts_aint32_t fail_state, state, a, n, enq_prio;
int enqueue; /* < 0 -> use proxy */
+ unsigned int prof_runnable_procs;
+
+ fail_state = *fail_state_p;
+
+ 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 & fail_state) {
+ *fail_state_p = (state & fail_state);
+ 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) {
+ erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+ locked = 0;
+ }
ASSERT(!(state & ERTS_PSFLG_PROXY));
@@ -6088,11 +7249,14 @@ schedule_process_sys_task(Process *p, erts_aint32_t state, Process *proxy)
n = e = a;
if (a & ERTS_PSFLG_FREE)
- return; /* We don't want to schedule free processes... */
+ goto cleanup; /* We don't want to schedule free processes... */
enqueue = ERTS_ENQUEUE_NOT;
n |= ERTS_PSFLG_ACTIVE_SYS;
- if (!(a & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS)))
+ if (!(a & (ERTS_PSFLG_RUNNING
+ | ERTS_PSFLG_RUNNING_SYS
+ | ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS)))
enqueue = check_enqueue_in_prio_queue(p, &enq_prio, &n, a);
a = erts_smp_atomic32_cmpxchg_mb(&p->state, n, e);
if (a == e)
@@ -6101,32 +7265,35 @@ schedule_process_sys_task(Process *p, erts_aint32_t state, Process *proxy)
goto cleanup;
}
- if (erts_system_profile_flags.runnable_procs) {
+ if (prof_runnable_procs) {
if (!(a & (ERTS_PSFLG_ACTIVE_SYS
| ERTS_PSFLG_RUNNING
- | ERTS_PSFLG_RUNNING_SYS))
+ | ERTS_PSFLG_RUNNING_SYS
+ | ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS))
&& (!(a & ERTS_PSFLG_ACTIVE) || (a & ERTS_PSFLG_SUSPENDED))) {
/* We activated a prevously inactive process */
profile_runnable_proc(p, am_active);
}
+ erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+ 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 (proxy)
- free_proxy_proc(proxy);
+
+ if (locked)
+ erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+
+ 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
@@ -6144,11 +7311,16 @@ suspend_process(Process *c_p, Process *p)
if (c_p == p) {
state = erts_smp_atomic32_read_bor_relb(&p->state,
ERTS_PSFLG_SUSPENDED);
- ASSERT(state & ERTS_PSFLG_RUNNING);
+ ASSERT(state & (ERTS_PSFLG_RUNNING
+ | ERTS_PSFLG_RUNNING_SYS
+ | ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS));
suspended = (state & ERTS_PSFLG_SUSPENDED) ? -1: 1;
}
else {
- while (!(state & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_EXITING))) {
+ while (!(state & (ERTS_PSFLG_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_EXITING))) {
erts_aint32_t n, e;
n = e = state;
@@ -6168,17 +7340,17 @@ 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... */
if ((state & (ERTS_PSFLG_ACTIVE
| ERTS_PSFLG_ACTIVE_SYS
+ | ERTS_PSFLG_DIRTY_ACTIVE_SYS
| ERTS_PSFLG_RUNNING
| ERTS_PSFLG_RUNNING_SYS
+ | ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS
| ERTS_PSFLG_SUSPENDED)) == ERTS_PSFLG_ACTIVE) {
/* We made process inactive */
profile_runnable_proc(p, am_inactive);
@@ -6193,7 +7365,7 @@ suspend_process(Process *c_p, Process *p)
}
static ERTS_INLINE void
-resume_process(Process *p)
+resume_process(Process *p, ErtsProcLocks locks)
{
erts_aint32_t state, enq_prio = -1;
int enqueue;
@@ -6210,37 +7382,15 @@ resume_process(Process *p)
ERTS_PSFLG_SUSPENDED,
0,
&state,
- &enq_prio);
- if (enqueue)
- add2runq(enqueue > 0 ? p : make_proxy_proc(NULL, p, enq_prio),
- state,
- enq_prio);
+ &enq_prio,
+ locks);
+ add2runq(enqueue, enq_prio, p, state, NULL);
}
-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
-}
-#ifdef ERTS_SMP
-
-static void
-scheduler_ix_resume_wake(Uint ix)
-{
- ErtsSchedulerSleepInfo *ssi = ERTS_SCHED_SLEEP_INFO_IX(ix);
- scheduler_ssi_resume_wake(ssi);
-}
-
-static void
-scheduler_ssi_resume_wake(ErtsSchedulerSleepInfo *ssi)
+static ERTS_INLINE void
+sched_resume_wake__(ErtsSchedulerSleepInfo *ssi)
{
erts_aint32_t xflgs = (ERTS_SSI_FLG_SLEEPING
| ERTS_SSI_FLG_TSE_SLEEPING
@@ -6254,9 +7404,31 @@ scheduler_ssi_resume_wake(ErtsSchedulerSleepInfo *ssi)
break;
}
xflgs = oflgs;
- } while (oflgs & ERTS_SSI_FLG_SUSPENDED);
+ } while (oflgs & (ERTS_SSI_FLG_MSB_EXEC|ERTS_SSI_FLG_SUSPENDED));
}
+static void
+nrml_sched_ix_resume_wake(Uint ix)
+{
+ sched_resume_wake__(ERTS_SCHED_SLEEP_INFO_IX(ix));
+}
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+
+static void
+dcpu_sched_ix_resume_wake(Uint ix)
+{
+ sched_resume_wake__(ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix));
+}
+
+static void
+dio_sched_ix_resume_wake(Uint ix)
+{
+ sched_resume_wake__(ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix));
+}
+
+#endif
+
static erts_aint32_t
sched_prep_spin_suspended(ErtsSchedulerSleepInfo *ssi, erts_aint32_t xpct)
{
@@ -6332,441 +7504,642 @@ sched_set_suspended_sleeptype(ErtsSchedulerSleepInfo *ssi)
}
}
-#ifdef ERTS_DIRTY_SCHEDULERS
-
static void
-suspend_scheduler(ErtsSchedulerData *esdp)
+init_scheduler_suspend(void)
{
- erts_aint32_t flgs;
- erts_aint32_t changing;
+ erts_smp_mtx_init(&schdlr_sspnd.mtx, "schdlr_sspnd", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_SCHEDULER);
+ schdlr_sspnd.online.normal = 1;
+ schdlr_sspnd.curr_online.normal = 1;
+ schdlr_sspnd.active.normal = 1;
#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;
+ schdlr_sspnd.online.dirty_cpu = 0;
+ schdlr_sspnd.curr_online.dirty_cpu = 0;
+ schdlr_sspnd.active.dirty_cpu = 0;
+ schdlr_sspnd.online.dirty_io = 0;
+ schdlr_sspnd.curr_online.dirty_io = 0;
+ schdlr_sspnd.active.dirty_io = 0;
+ schdlr_sspnd.last_msb_dirty_type = ERTS_SCHED_DIRTY_IO;
#endif
- 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};
- 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;
+ 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;
+}
- /*
- * 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.
- *
- * Regardless of why a scheduler is suspended, it ends up here.
- */
+typedef struct {
+ struct {
+ Eterm chngr;
+ Eterm nxt;
+ } onln;
+ struct {
+ ErtsProcList *chngrs;
+ } msb;
+} ErtsSchdlrSspndResume;
- ASSERT(ERTS_SCHEDULER_IS_DIRTY(esdp) || no != 1);
+static void
+schdlr_sspnd_resume_proc(ErtsSchedType sched_type, Eterm pid)
+{
+ Process *p;
+ p = erts_pid2proc_opt(NULL, 0, pid, ERTS_PROC_LOCK_STATUS,
+ (sched_type != ERTS_SCHED_NORMAL
+ ? ERTS_P2P_FLG_INC_REFC
+ : 0));
+ if (p) {
+ resume_process(p, ERTS_PROC_LOCK_STATUS);
+ erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+ if (sched_type != ERTS_SCHED_NORMAL)
+ erts_proc_dec_refc(p);
+ }
+}
+
+static ERTS_INLINE void
+schdlr_sspnd_resume_procs(ErtsSchedType sched_type,
+ ErtsSchdlrSspndResume *resume)
+{
+ if (is_internal_pid(resume->onln.chngr)) {
+ schdlr_sspnd_resume_proc(sched_type,
+ resume->onln.chngr);
+ resume->onln.chngr = NIL;
+ }
+ if (is_internal_pid(resume->onln.nxt)) {
+ schdlr_sspnd_resume_proc(sched_type,
+ 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(sched_type,
+ plp->pid);
+ proclist_destroy(plp);
+ }
+}
#ifdef ERTS_DIRTY_SCHEDULERS
- if (ERTS_SCHEDULER_IS_DIRTY(esdp)) {
- 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())
- evacuate_run_queue(esdp->run_queue, &sbp);
- } else
-#endif
- evacuate_run_queue(esdp->run_queue, &sbp);
- erts_smp_runq_unlock(esdp->run_queue);
+static ERTS_INLINE int
+have_dirty_work(void)
+{
+ return !(ERTS_EMPTY_RUNQ(ERTS_DIRTY_CPU_RUNQ)
+ | ERTS_EMPTY_RUNQ(ERTS_DIRTY_IO_RUNQ));
+}
-#ifdef ERTS_DIRTY_SCHEDULERS
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp))
-#endif
- {
- erts_sched_check_cpu_bind_prep_suspend(esdp);
+#define ERTS_MSB_NONE_PRIO_BIT PORT_BIT
- if (erts_system_profile_flags.scheduler)
- profile_scheduler(make_small(esdp->no), am_inactive);
+static ERTS_INLINE Uint32
+msb_runq_prio_bit(Uint32 flgs)
+{
+ int pbit;
- sched_wall_time_change(esdp, 0);
+ pbit = (int) (flgs & ERTS_RUNQ_FLGS_PROCS_QMASK);
+ if (flgs & PORT_BIT) {
+ /* rate ports as proc prio high */
+ pbit |= HIGH_BIT;
+ }
+ if (flgs & ERTS_RUNQ_FLG_MISC_OP) {
+ /* rate misc ops as proc prio normal */
+ pbit |= NORMAL_BIT;
+ }
+ if (flgs & LOW_BIT) {
+ /* rate low prio as normal (avoid starvation) */
+ pbit |= NORMAL_BIT;
+ }
+ if (!pbit)
+ pbit = (int) ERTS_MSB_NONE_PRIO_BIT;
+ else
+ pbit &= -pbit; /* least significant bit set... */
+ ASSERT(pbit);
- erts_smp_mtx_lock(&schdlr_sspnd.mtx);
+ /* High prio low value; low prio high value... */
+ return (Uint32) pbit;
+}
+
+static ERTS_INLINE void
+msb_runq_prio_bits(Uint32 *nrmlp, Uint32 *dcpup, Uint32 *diop)
+{
+ Uint32 flgs = ERTS_RUNQ_FLGS_GET(ERTS_RUNQ_IX(0));
+ if (flgs & ERTS_RUNQ_FLG_HALTING) {
+ /*
+ * Emulator is halting; only execute port jobs
+ * on normal scheduler. Ensure that we switch
+ * to the normal scheduler.
+ */
+ *nrmlp = HIGH_BIT;
+ *dcpup = ERTS_MSB_NONE_PRIO_BIT;
+ *diop = ERTS_MSB_NONE_PRIO_BIT;
}
+ else {
+ *nrmlp = msb_runq_prio_bit(flgs);
- flgs = sched_prep_spin_suspended(ssi, ERTS_SSI_FLG_SUSPENDED);
- if (flgs & ERTS_SSI_FLG_SUSPENDED) {
+ flgs = ERTS_RUNQ_FLGS_GET(ERTS_DIRTY_CPU_RUNQ);
+ *dcpup = msb_runq_prio_bit(flgs);
-#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
+ flgs = ERTS_RUNQ_FLGS_GET(ERTS_DIRTY_IO_RUNQ);
+ *diop = msb_runq_prio_bit(flgs);
+ }
+}
+
+static int
+msb_scheduler_type_switch(ErtsSchedType sched_type,
+ ErtsSchedulerData *esdp,
+ long no)
+{
+ Uint32 nrml_prio, dcpu_prio, dio_prio;
+ ErtsSchedType exec_type;
+ ErtsRunQueue *exec_rq;
+#ifdef DEBUG
+ erts_aint32_t dbg_val;
#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;
- }
- }
+ ASSERT(schdlr_sspnd.msb.ongoing);
- if (wake) {
- erts_smp_cnd_signal(&schdlr_sspnd.cnd);
- wake = 0;
- }
+ /*
+ * This function determines how to switch
+ * between scheduler types when multi-scheduling
+ * is blocked.
+ *
+ * If no dirty work exist, we always select
+ * execution of normal scheduler. If nothing
+ * executes, normal scheduler 1 should be waiting
+ * in sys_schedule(), otherwise we cannot react
+ * on I/O events.
+ *
+ * We unconditionally switch back to normal
+ * scheduler after executing dirty in order to
+ * make sure we check for I/O...
+ */
- 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);
+ msb_runq_prio_bits(&nrml_prio, &dcpu_prio, &dio_prio);
- while (1) {
- erts_aint32_t qmask;
- erts_aint32_t flgs;
+ exec_type = ERTS_SCHED_NORMAL;
+ if (sched_type == ERTS_SCHED_NORMAL) {
- 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);
- }
- }
- }
+ /*
+ * Check priorities of work in the
+ * different run-queues and determine
+ * run-queue with highest prio job...
+ */
- 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);
- }
- 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;
+ if ((dcpu_prio == ERTS_MSB_NONE_PRIO_BIT)
+ & (dio_prio == ERTS_MSB_NONE_PRIO_BIT)) {
+ /*
+ * No dirty work exist; continue on normal
+ * scheduler...
+ */
+ return 0;
+ }
- do {
- res = erts_tse_wait(ssi->event);
- } while (res == EINTR);
- }
- }
-#ifdef ERTS_DIRTY_SCHEDULERS
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp))
-#endif
- erts_thr_progress_finalize_wait(esdp);
- }
+ if (dcpu_prio < nrml_prio) {
+ exec_type = ERTS_SCHED_DIRTY_CPU;
+ if (dio_prio < dcpu_prio)
+ exec_type = ERTS_SCHED_DIRTY_IO;
+ }
+ else {
+ if (dio_prio < nrml_prio)
+ exec_type = ERTS_SCHED_DIRTY_IO;
+ }
- 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;
- }
+ /*
+ * Make sure to alternate between dirty types
+ * inbetween normal execution if highest
+ * priorities are equal.
+ */
- erts_smp_mtx_lock(&schdlr_sspnd.mtx);
- changing = erts_smp_atomic32_read_nob(ss_changingp);
- }
+ if (exec_type == ERTS_SCHED_NORMAL) {
+ if (dcpu_prio == nrml_prio)
+ exec_type = ERTS_SCHED_DIRTY_CPU;
+ else if (dio_prio == nrml_prio)
+ exec_type = ERTS_SCHED_DIRTY_IO;
+ else {
+ /*
+ * Normal work has higher prio than
+ * dirty work; continue on normal
+ * scheduler...
+ */
+ return 0;
+ }
+ }
- 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);
- }
+ ASSERT(exec_type != ERTS_SCHED_NORMAL);
+ if (dio_prio == dcpu_prio) {
+ /* Alter between dirty types... */
+ if (schdlr_sspnd.last_msb_dirty_type == ERTS_SCHED_DIRTY_IO)
+ exec_type = ERTS_SCHED_DIRTY_CPU;
+ else
+ exec_type = ERTS_SCHED_DIRTY_IO;
+ }
+ }
-#ifdef ERTS_DIRTY_SCHEDULERS
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp))
-#endif
- ASSERT(no <= *ss_onlinep);
- ASSERT(!ongoing_multi_scheduling_block());
+ ASSERT(sched_type != exec_type);
+ if (exec_type != ERTS_SCHED_NORMAL)
+ schdlr_sspnd.last_msb_dirty_type = exec_type;
+ else {
+ erts_aint32_t calls;
+ /*
+ * Going back to normal scheduler after
+ * dirty execution; make sure it will check
+ * for I/O...
+ */
+ if (ERTS_USE_MODIFIED_TIMING())
+ calls = ERTS_MODIFIED_TIMING_INPUT_REDS + 1;
+ else
+ calls = INPUT_REDUCTIONS + 1;
+ erts_smp_atomic32_set_nob(&function_calls, calls);
+
+ if ((nrml_prio == ERTS_MSB_NONE_PRIO_BIT)
+ & ((dcpu_prio != ERTS_MSB_NONE_PRIO_BIT)
+ | (dio_prio != ERTS_MSB_NONE_PRIO_BIT))) {
+ /*
+ * We have dirty work, but an empty
+ * normal run-queue.
+ *
+ * Since the normal run-queue is
+ * empty, the normal scheduler will
+ * go to sleep when selected for
+ * execution. We have dirty work to
+ * do, so we only want it to check
+ * I/O, and then come back here and
+ * switch to dirty execution.
+ *
+ * To prevent the scheduler from going
+ * to sleep we trick it into believing
+ * it has work to do...
+ */
+ ERTS_RUNQ_FLGS_SET_NOB(ERTS_RUNQ_IX(0),
+ ERTS_RUNQ_FLG_MISC_OP);
+ }
}
- erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
-
- ASSERT(curr_online);
+ /*
+ * Suspend this scheduler and wake up scheduler
+ * number one of another type...
+ */
+#ifdef DEBUG
+ dbg_val =
+#else
+ (void)
+#endif
+ erts_smp_atomic32_read_bset_mb(&esdp->ssi->flags,
+ (ERTS_SSI_FLG_SUSPENDED
+ | ERTS_SSI_FLG_MSB_EXEC),
+ ERTS_SSI_FLG_SUSPENDED);
+ ASSERT(dbg_val & ERTS_SSI_FLG_MSB_EXEC);
+
+ switch (exec_type) {
+ case ERTS_SCHED_NORMAL:
+ exec_rq = ERTS_RUNQ_IX(0);
+ break;
+ case ERTS_SCHED_DIRTY_CPU:
+ exec_rq = ERTS_DIRTY_CPU_RUNQ;
+ break;
+ case ERTS_SCHED_DIRTY_IO:
+ exec_rq = ERTS_DIRTY_IO_RUNQ;
+ break;
+ default:
+ ERTS_INTERNAL_ERROR("Invalid scheduler type");
+ exec_rq = NULL;
+ break;
+ }
-#ifdef ERTS_DIRTY_SCHEDULERS
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp))
+#ifdef DEBUG
+ dbg_val =
+#else
+ (void)
#endif
- {
- if (erts_system_profile_flags.scheduler)
- profile_scheduler(make_small(esdp->no), am_active);
+ erts_smp_atomic32_read_bset_mb(&exec_rq->scheduler->ssi->flags,
+ (ERTS_SSI_FLG_SUSPENDED
+ | ERTS_SSI_FLG_MSB_EXEC),
+ ERTS_SSI_FLG_MSB_EXEC);
+ ASSERT(dbg_val & ERTS_SSI_FLG_SUSPENDED);
- if (!thr_prgr_active) {
- erts_thr_progress_active(esdp, thr_prgr_active = 1);
- sched_wall_time_change(esdp, 1);
- }
- }
+ wake_scheduler(exec_rq);
- 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);
+ return 1; /* suspend this scheduler... */
- erts_sched_check_cpu_bind_post_suspend(esdp);
- }
}
-#else /* !ERTS_DIRTY_SCHEDULERS */
+#endif
static void
suspend_scheduler(ErtsSchedulerData *esdp)
{
erts_aint32_t flgs;
erts_aint32_t changing;
- long no = (long) esdp->no;
+ 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};
+ 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.
* - Multi scheduling is blocked. All schedulers except the
- * scheduler with scheduler id 1 are suspended.
+ * scheduler with scheduler id 1 are suspended, and all
+ * dirty CPU and dirty I/O schedulers are suspended.
*
* Regardless of why a scheduler is suspended, it ends up here.
*/
+
+#if !defined(ERTS_DIRTY_SCHEDULERS)
+
+ sched_type = ERTS_SCHED_NORMAL;
+ online_flag = ERTS_SCHDLR_SSPND_CHNG_ONLN;
+ no = esdp->no;
ASSERT(no != 1);
- evacuate_run_queue(esdp->run_queue, &sbp);
+#else
- erts_smp_runq_unlock(esdp->run_queue);
+ sched_type = esdp->type;
+ switch (sched_type) {
+ case ERTS_SCHED_NORMAL:
+ online_flag = ERTS_SCHDLR_SSPND_CHNG_ONLN;
+ no = esdp->no;
+ break;
+ case ERTS_SCHED_DIRTY_CPU:
+ online_flag = ERTS_SCHDLR_SSPND_CHNG_DCPU_ONLN;
+ no = esdp->dirty_no;
+ break;
+ case ERTS_SCHED_DIRTY_IO:
+ online_flag = 0;
+ no = esdp->dirty_no;
+ break;
+ default:
+ ERTS_INTERNAL_ERROR("Invalid scheduler type");
+ return;
+ }
- erts_sched_check_cpu_bind_prep_suspend(esdp);
+ if (erts_smp_atomic32_read_nob(&ssi->flags) & ERTS_SSI_FLG_MSB_EXEC) {
+ ASSERT(no == 1);
+ if (!msb_scheduler_type_switch(sched_type, esdp, no))
+ return;
+ /* Suspend and let scheduler 1 of another type execute... */
+ }
- if (erts_system_profile_flags.scheduler)
- profile_scheduler(make_small(esdp->no), am_inactive);
+#endif
- sched_wall_time_change(esdp, 0);
+ if (sched_type != ERTS_SCHED_NORMAL) {
+ dirty_active(esdp, -1);
+ erts_smp_runq_unlock(esdp->run_queue);
+ dirty_sched_wall_time_change(esdp, 0);
+ }
+ else {
+ if (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);
+ }
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);
+ schdlr_sspnd_dec_nscheds(&schdlr_sspnd.active, sched_type);
+
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 & (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;
+ }
+ else if (schdlr_sspnd_get_nscheds(&schdlr_sspnd.active,
+ ERTS_SCHED_NORMAL) == 1
+ && schdlr_sspnd_get_nscheds(&schdlr_sspnd.active,
+ ERTS_SCHED_DIRTY_CPU) == 0
+ && schdlr_sspnd_get_nscheds(&schdlr_sspnd.active,
+ ERTS_SCHED_DIRTY_IO) == 0) {
+ clr_flg = ERTS_SCHDLR_SSPND_CHNG_MSB;
+ }
+
+ 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;
+ if (plp) {
+ ASSERT(end_plp);
+ ASSERT(msb[i]->ongoing);
+ do {
+ erts_proclist_store_last(&msb[i]->blckrs,
+ proclist_copy(plp));
+ plp = plp->next;
+ } while (plp);
+ end_plp->next = resume.msb.chngrs;
+ resume.msb.chngrs = msb[i]->chngq;
+ msb[i]->chngq = NULL;
+ }
+ }
+ }
+ }
+
+ 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) {
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) {
- erts_aint32_t qmask;
+ ErtsMonotonicTime current_time;
erts_aint32_t flgs;
- 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 (!thr_prgr_active) {
- erts_thr_progress_active(esdp, thr_prgr_active = 1);
- sched_wall_time_change(esdp, 1);
+ if (sched_type != ERTS_SCHED_NORMAL)
+ aux_work = 0;
+ else {
+ int evacuate = no == 1 ? 0 : !ERTS_EMPTY_RUNQ(esdp->run_queue);
+
+ aux_work = erts_atomic32_read_acqb(&ssi->aux_work);
+
+ if (aux_work|evacuate) {
+ 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 (evacuate) {
+ erts_smp_runq_lock(esdp->run_queue);
+ evacuate_run_queue(esdp->run_queue, &sbp);
+ erts_smp_runq_unlock(esdp->run_queue);
+ }
}
- 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) {
+ 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;
- if (!aux_work) {
- if (thr_prgr_active) {
- erts_thr_progress_active(esdp, thr_prgr_active = 0);
- sched_wall_time_change(esdp, 0);
+ 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);
}
- erts_thr_progress_prepare_wait(esdp);
- 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);
+ 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 (sched_type == ERTS_SCHED_NORMAL) {
+ 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);
+ }
+ flgs = sched_spin_suspended(ssi,
+ ERTS_SCHED_SUSPEND_SLEEP_SPINCOUNT);
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_wait(ssi->event);
- } while (res == EINTR);
+ 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;
+
+ 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 (sched_type != ERTS_SCHED_NORMAL)
+ timeout = -1;
+ else
+ timeout = ERTS_MONOTONIC_TO_NSEC(timeout_time
+ - current_time
+ - 1) + 1;
+ res = erts_tse_twait(ssi->event, timeout);
+
+ if (sched_type == ERTS_SCHED_NORMAL)
+ current_time = erts_get_monotonic_time(esdp);
+ else
+ current_time = 0;
+
+ } while (res == EINTR);
+ }
}
+ if (sched_type == ERTS_SCHED_NORMAL)
+ erts_thr_progress_finalize_wait(esdp);
+ }
+
+ if (current_time >= timeout_time) {
+ ASSERT(sched_type == ERTS_SCHED_NORMAL);
+ erts_bump_timers(esdp->timer_wheel, current_time);
}
- erts_thr_progress_finalize_wait(esdp);
}
flgs = sched_prep_spin_suspended(ssi, (ERTS_SSI_FLG_WAITING
@@ -6774,7 +8147,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;
}
@@ -6782,704 +8155,569 @@ 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) {
- erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing,
- ~ERTS_SCHDLR_SSPND_CHNG_MSB);
- }
-
- ASSERT(no <= schdlr_sspnd.online);
- ASSERT(!ongoing_multi_scheduling_block());
-
+ if (changing) {
+ if ((changing & ERTS_SCHDLR_SSPND_CHNG_MSB)
+ && !schdlr_sspnd.msb.ongoing
+ && schdlr_sspnd_eq_nscheds(&schdlr_sspnd.online,
+ &schdlr_sspnd.active)) {
+ erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing,
+ ~ERTS_SCHDLR_SSPND_CHNG_MSB);
+ }
+ if ((changing & ERTS_SCHDLR_SSPND_CHNG_NMSB)
+ && !schdlr_sspnd.nmsb.ongoing
+ && (schdlr_sspnd_get_nscheds(&schdlr_sspnd.online,
+ ERTS_SCHED_NORMAL)
+ == schdlr_sspnd_get_nscheds(&schdlr_sspnd.active,
+ ERTS_SCHED_NORMAL))) {
+ erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing,
+ ~ERTS_SCHDLR_SSPND_CHNG_NMSB);
+ }
+ }
+ ASSERT(no <= schdlr_sspnd_get_nscheds(&schdlr_sspnd.online, sched_type));
}
erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
+ 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 (sched_type != ERTS_SCHED_NORMAL)
+ dirty_sched_wall_time_change(esdp, 1);
+ else {
+ (void) erts_get_monotonic_time(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);
+ }
}
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)
+ dirty_active(esdp, 1);
+ else {
+ 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(ERTS_SCHED_NORMAL, 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);
- }
- }
-#endif
- res = ERTS_SCHDLR_SSPND_DONE;
+ } else {
+ for (ix = dirty_online; ix < dirty_no; ix++)
+ dcpu_sched_ix_resume_wake(ix);
}
- 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);
- }
- }
- }
- }
-
-#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 (schdlr_sspnd.msb.ongoing|schdlr_sspnd.nmsb.ongoing) {
+ for (ix = online; ix < no; ix++)
+ erts_sched_poke(ERTS_SCHED_SLEEP_INFO_IX(ix));
}
- 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;
+ if (change_dirty) {
+ if (schdlr_sspnd.msb.ongoing) {
+ for (ix = dirty_no; ix < dirty_online; ix++)
+ erts_sched_poke(ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix));
+ }
+ else {
+ for (ix = dirty_no; ix < dirty_online; ix++)
+ dcpu_sched_ix_suspend_wake(ix);
+ /*
+ * Newly suspended scheduler may have just been
+ * about to handle a task. Make sure someone takes
+ * care of such a task...
+ */
+ dcpu_sched_ix_wake(0);
+ }
}
- 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));
- }
- 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));
- }
- res = ERTS_SCHDLR_SSPND_DONE;
+ 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));
}
- 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);
}
- 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);
- }
- }
- }
+ change_no_used_runqs(no);
+ for (ix = no; ix < erts_no_run_queues; ix++)
+ suspend_run_queue(ERTS_RUNQ_IX(ix));
- 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);
+ for (ix = no; ix < online; ix++) {
+ ErtsRunQueue *rq = ERTS_RUNQ_IX(ix);
+ wake_scheduler(rq);
}
- 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);
+ 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;
+ }
- 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);
+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 (end_wait) {
- erts_thr_progress_finalize_wait(esdp);
- erts_thr_progress_active(esdp, 1);
- }
+
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;
+ }
+
+ /*
+ * 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);
}
- else if (on) { /* ------ BLOCK ------ */
- if (schdlr_sspnd.msb.procs) {
+
+ 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 || (normal && erts_no_schedulers == 1)) {
+ ASSERT(!msbp->blckrs || msbp->ongoing);
+ msbp->ongoing = 1;
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
- 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;
+ erts_proclist_store_last(&msbp->blckrs, plp);
+ p->flags |= have_blckd_flg;
+ ASSERT(normal
+ ? 1 == schdlr_sspnd_get_nscheds(&schdlr_sspnd.active,
+ ERTS_SCHED_NORMAL)
+ : schdlr_sspnd_get_nscheds_tot(&schdlr_sspnd.active) == 1);
+ ASSERT(erts_proc_sched_data(p)->no == 1);
+ 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(p->scheduler_data->no == 1);
- }
- 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
- change_no_used_runqs(1);
- for (ix = 1; ix < erts_no_run_queues; ix++)
- suspend_run_queue(ERTS_RUNQ_IX(ix));
-
- for (ix = 1; ix < online; ix++) {
- ErtsRunQueue *rq = ERTS_RUNQ_IX(ix);
- 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);
- }
-
- esdp = ERTS_PROC_GET_SCHDATA(p);
+ ASSERT(!msbp->ongoing);
+ msbp->ongoing = 1;
- erts_thr_progress_active(esdp, 0);
- erts_thr_progress_prepare_wait(esdp);
+ 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));
- erts_smp_mtx_lock(&schdlr_sspnd.mtx);
+ for (ix = 1; ix < online; ix++) {
+ ErtsRunQueue *rq = ERTS_RUNQ_IX(ix);
+ wake_scheduler(rq);
+ }
- 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);
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (!normal) {
+ ERTS_RUNQ_FLGS_SET_NOB(ERTS_RUNQ_IX(0), ERTS_RUNQ_FLG_MSB_EXEC);
+ erts_smp_atomic32_read_bor_nob(&ERTS_RUNQ_IX(0)->scheduler->ssi->flags,
+ ERTS_SSI_FLG_MSB_EXEC);
+ for (ix = 0; ix < erts_no_dirty_cpu_schedulers; ix++)
+ dcpu_sched_ix_suspend_wake(ix);
+ for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++)
+ dio_sched_ix_suspend_wake(ix);
+ }
+#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(&schdlr_sspnd.msb.procs, plp);
- ASSERT(p->scheduler_data);
+ 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;
+ ASSERT(erts_proc_sched_data(p));
}
}
- 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 **plpps[3] = {0};
+ ErtsProcList *plp;
+
+ plpps[0] = &msbp->blckrs;
+ if (all)
+ plpps[1] = &msbp->chngq;
+
+ for (ix = 0; plpps[ix]; ix++) {
+ plp = erts_proclist_peek_first(*plpps[ix]);
+ while (plp) {
+ ErtsProcList *tmp_plp = plp;
+ plp = erts_proclist_peek_next(*plpps[ix], plp);
+ if (erts_proclist_same(tmp_plp, p)) {
+ erts_proclist_remove(plpps[ix], 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) {
- /* 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);
- }
- else {
- online = schdlr_sspnd.online;
- if (plocks) {
+ if (!msbp->blckrs && !msbp->chngq) {
+ int online;
+ erts_smp_atomic32_read_bor_nob(&schdlr_sspnd.changing,
+ chng_flg);
+ p->flags &= ~have_blckd_flg;
+ msbp->ongoing = 0;
+ if (!(schdlr_sspnd.msb.ongoing|schdlr_sspnd.nmsb.ongoing)) {
+ if (plocks) {
have_unlocked_plocks = 1;
erts_smp_proc_unlock(p, plocks);
}
+ online = (int) schdlr_sspnd_get_nscheds(&schdlr_sspnd.online,
+ ERTS_SCHED_NORMAL);
change_no_used_runqs(online);
/* Resume all online run queues */
@@ -7490,83 +8728,87 @@ 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 (!schdlr_sspnd.msb.ongoing) {
+ /* Get rid of msb-exec flag in run-queue of scheduler 1 */
+ resume_run_queue(ERTS_RUNQ_IX(0));
+ online = (int) schdlr_sspnd_get_nscheds(&schdlr_sspnd.online,
+ ERTS_SCHED_DIRTY_CPU);
+ for (ix = 0; ix < online; ix++)
+ dcpu_sched_ix_resume_wake(ix);
+ for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++)
+ dio_sched_ix_resume_wake(ix);
+ }
#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;
@@ -7586,13 +8828,29 @@ sched_thread_func(void *vesdp)
ErtsSchedulerData *esdp = vesdp;
Uint no = esdp->no;
#ifdef ERTS_SMP
- ERTS_SCHED_SLEEP_INFO_IX(no - 1)->event = erts_tse_fetch();
+ erts_tse_t *tse;
+#endif
+
+ erts_sched_init_time_sup(esdp);
+
+ if (no == 1)
+ erts_aux_work_timeout_late_init(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);
+ ERTS_SCHED_SLEEP_INFO_IX(no - 1)->event = tse;
callbacks.arg = (void *) esdp->ssi;
callbacks.wakeup = thr_prgr_wakeup;
callbacks.prepare_wait = thr_prgr_prep_wait;
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
@@ -7622,39 +8880,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(
@@ -7662,9 +8887,12 @@ sched_thread_func(void *vesdp)
ERTS_VERIFY_UNUSED_TEMP_ALLOC(NULL);
#endif
- process_main();
+ erts_ets_sched_spec_data_init(esdp);
+
+ process_main(esdp->x_reg_array, esdp->f_reg_array);
+
/* No schedulers should *ever* terminate */
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"Scheduler thread number %beu terminated\n",
no);
return NULL;
@@ -7677,8 +8905,7 @@ sched_dirty_cpu_thread_func(void *vesdp)
{
ErtsThrPrgrCallbacks callbacks;
ErtsSchedulerData *esdp = vesdp;
- Uint no = ERTS_DIRTY_SCHEDULER_NO(esdp);
- ERTS_DIRTY_SCHEDULER_TYPE(esdp) = ERTS_DIRTY_CPU_SCHEDULER;
+ Uint no = esdp->dirty_no;
ASSERT(no != 0);
ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(no-1)->event = erts_tse_fetch();
callbacks.arg = (void *) esdp->ssi;
@@ -7687,6 +8914,12 @@ sched_dirty_cpu_thread_func(void *vesdp)
callbacks.wait = NULL;
callbacks.finalize_wait = NULL;
+ dirty_sched_wall_time_change(esdp, 1);
+
+ esdp->thr_id += erts_no_schedulers;
+
+ erts_msacc_init_thread("dirty_cpu_scheduler", no, 0);
+
erts_thr_progress_register_unmanaged_thread(&callbacks);
#ifdef ERTS_ENABLE_LOCK_CHECK
{
@@ -7707,27 +8940,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();
+ erts_dirty_process_main(esdp);
/* 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;
@@ -7738,8 +8953,7 @@ sched_dirty_io_thread_func(void *vesdp)
{
ErtsThrPrgrCallbacks callbacks;
ErtsSchedulerData *esdp = vesdp;
- Uint no = ERTS_DIRTY_SCHEDULER_NO(esdp);
- ERTS_DIRTY_SCHEDULER_TYPE(esdp) = ERTS_DIRTY_IO_SCHEDULER;
+ Uint no = esdp->dirty_no;
ASSERT(no != 0);
ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(no-1)->event = erts_tse_fetch();
callbacks.arg = (void *) esdp->ssi;
@@ -7748,6 +8962,12 @@ sched_dirty_io_thread_func(void *vesdp)
callbacks.wait = NULL;
callbacks.finalize_wait = NULL;
+ dirty_sched_wall_time_change(esdp, 1);
+
+ esdp->thr_id += erts_no_schedulers + erts_no_dirty_cpu_schedulers;
+
+ erts_msacc_init_thread("dirty_io_scheduler", no, 0);
+
erts_thr_progress_register_unmanaged_thread(&callbacks);
#ifdef ERTS_ENABLE_LOCK_CHECK
{
@@ -7768,27 +8988,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();
+ erts_dirty_process_main(esdp);
/* 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;
@@ -7805,28 +9007,25 @@ erts_start_schedulers(void)
Uint actual;
Uint wanted = erts_no_schedulers;
Uint wanted_no_schedulers = erts_no_schedulers;
+ char name[16];
ethr_thr_opts opts = ETHR_THR_OPTS_DEFAULT_INITER;
opts.detached = 1;
-#ifdef ETHR_HAVE_THREAD_NAMES
- opts.name = malloc(80);
-#endif
+ opts.name = name;
#ifdef ERTS_SMP
if (erts_runq_supervision_interval) {
opts.suggested_stack_size = 16;
-#ifdef ETHR_HAVE_THREAD_NAMES
- sprintf(opts.name, "runq_supervisor");
-#endif
+ 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
@@ -7845,14 +9044,7 @@ erts_start_schedulers(void)
ASSERT(actual == esdp->no - 1);
-#ifdef ETHR_HAVE_THREAD_NAMES
- sprintf(opts.name, "scheduler_%d", actual + 1);
-#endif
-
-#ifdef __OSE__
- /* This should be done in the bind strategy */
- opts.coreNo = (actual+1) % ose_num_cpus();
-#endif
+ erts_snprintf(opts.name, 16, "%lu_scheduler", actual + 1);
res = ethr_thr_create(&esdp->tid, sched_thread_func, (void*)esdp, &opts);
@@ -7860,7 +9052,6 @@ erts_start_schedulers(void)
break;
}
}
-
erts_no_schedulers = actual;
#ifdef ERTS_DIRTY_SCHEDULERS
@@ -7869,21 +9060,19 @@ erts_start_schedulers(void)
int ix;
for (ix = 0; ix < erts_no_dirty_cpu_schedulers; ix++) {
ErtsSchedulerData *esdp = ERTS_DIRTY_CPU_SCHEDULER_IX(ix);
-#ifdef ETHR_HAVE_THREAD_NAMES
- sprintf(opts.name,"dirty_cpu_scheduler_%d", ix + 1);
-#endif
+ erts_snprintf(opts.name, 16, "%d_dirty_cpu_scheduler", ix + 1);
+ opts.suggested_stack_size = erts_dcpu_sched_thread_suggested_stack_size;
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);
-#ifdef ETHR_HAVE_THREAD_NAMES
- sprintf(opts.name,"dirty_io_scheduler_%d", ix + 1);
-#endif
+ erts_snprintf(opts.name, 16, "%d_dirty_io_scheduler", ix + 1);
+ opts.suggested_stack_size = erts_dio_sched_thread_suggested_stack_size;
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
@@ -7891,20 +9080,14 @@ erts_start_schedulers(void)
ERTS_THR_MEMORY_BARRIER;
-#ifdef ETHR_HAVE_THREAD_NAMES
- sprintf(opts.name, "aux");
-#endif
-
-#ifdef __OSE__
- opts.coreNo = 0;
-#endif /* __OSE__ */
+ erts_snprintf(opts.name, 16, "aux");
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);
@@ -7918,10 +9101,6 @@ erts_start_schedulers(void)
actual, actual == 1 ? " was" : "s were");
erts_send_error_to_logger_nogl(dsbufp);
}
-
-#ifdef ETHR_HAVE_THREAD_NAMES
- free(opts.name);
-#endif
}
#endif /* ERTS_SMP */
@@ -7940,7 +9119,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;
@@ -8023,7 +9202,8 @@ handle_pend_sync_suspend(Process *suspendee,
}
/* suspender is suspended waiting for suspendee to suspend;
resume suspender */
- resume_process(suspender);
+ ASSERT(suspendee != suspender);
+ resume_process(suspender, ERTS_PROC_LOCK_STATUS);
erts_smp_proc_unlock(suspender, ERTS_PROC_LOCK_STATUS);
}
}
@@ -8058,12 +9238,11 @@ pid2proc_not_running(Process *c_p, ErtsProcLocks c_p_locks,
ASSERT(c_p->flags & F_P2PNR_RESCHED);
c_p->flags &= ~F_P2PNR_RESCHED;
if (!suspend && rp)
- resume_process(rp);
+ 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;
@@ -8072,40 +9251,104 @@ 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)))
+ /*
+ * 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 */
+
+ ASSERT((ERTS_PSFLG_RUNNING | ERTS_PSFLG_DIRTY_RUNNING)
+ & erts_smp_atomic32_read_nob(&rp->state));
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (!suspend
+ && (erts_smp_atomic32_read_nob(&rp->state)
+ & ERTS_PSFLG_DIRTY_RUNNING)) {
+ ErtsProcLocks need_locks = pid_locks & ~ERTS_PROC_LOCK_STATUS;
+ if (need_locks && erts_smp_proc_trylock(rp, need_locks) == EBUSY) {
+ erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS);
+ rp = erts_pid2proc(c_p, c_p_locks|ERTS_PROC_LOCK_STATUS,
+ pid, pid_locks|ERTS_PROC_LOCK_STATUS);
+ }
goto done;
+ }
+#endif
- }
+ running:
- /* Other process running */
+ /*
+ * 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));
- /*
- * 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_PSFLG_DIRTY_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;
+ }
- /* Suspend c_p; when rp is suspended c_p will be resumed. */
- suspend_process(c_p, c_p);
- c_p->flags |= F_P2PNR_RESCHED;
+ /*
+ * The previous suspend has prevented the process
+ * from being selected for normal execution regardless
+ * of locks held or not held on it...
+ */
+#ifdef DEBUG
+ {
+ erts_aint32_t state;
+ state = erts_smp_atomic32_read_nob(&rp->state);
+ ASSERT((state & ERTS_PSFLG_PENDING_EXIT)
+ || !(state & ERTS_PSFLG_RUNNING));
+ }
+#endif
+
+ 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)
@@ -8132,17 +9375,6 @@ erts_pid2proc_not_running(Process *c_p, ErtsProcLocks c_p_locks,
}
/*
- * Like erts_pid2proc_not_running(), but hands over the process
- * in a suspended state unless (c_p is looked up).
- */
-Process *
-erts_pid2proc_suspend(Process *c_p, ErtsProcLocks c_p_locks,
- Eterm pid, ErtsProcLocks pid_locks)
-{
- return pid2proc_not_running(c_p, c_p_locks, pid, pid_locks, 1);
-}
-
-/*
* erts_pid2proc_nropt() is normally the same as
* erts_pid2proc_not_running(). However it is only
* to be used when 'not running' is a pure optimization,
@@ -8216,7 +9448,8 @@ handle_pend_bif_sync_suspend(Process *suspendee,
}
/* suspender is suspended waiting for suspendee to suspend;
resume suspender */
- resume_process(suspender);
+ ASSERT(suspender != suspendee);
+ resume_process(suspender, ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS);
erts_smp_proc_unlock(suspender,
ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS);
}
@@ -8259,21 +9492,6 @@ handle_pend_bif_async_suspend(Process *suspendee,
}
}
-#else
-
-/*
- * Non-smp version of erts_pid2proc_suspend().
- */
-Process *
-erts_pid2proc_suspend(Process *c_p, ErtsProcLocks c_p_locks,
- Eterm pid, ErtsProcLocks pid_locks)
-{
- Process *rp = erts_pid2proc(c_p, c_p_locks, pid, pid_locks);
- if (rp)
- erts_suspend(rp, pid_locks, NULL);
- return rp;
-}
-
#endif /* ERTS_SMP */
/*
@@ -8576,7 +9794,8 @@ resume_process_1(BIF_ALIST_1)
ASSERT(ERTS_PSFLG_SUSPENDED
& erts_smp_atomic32_read_nob(&suspendee->state));
- resume_process(suspendee);
+ ASSERT(BIF_P != suspendee);
+ resume_process(suspendee, ERTS_PROC_LOCK_STATUS);
erts_smp_proc_unlock(suspendee, ERTS_PROC_LOCK_STATUS);
}
@@ -8597,51 +9816,133 @@ resume_process_1(BIF_ALIST_1)
BIF_ERROR(BIF_P, BADARG);
}
+BIF_RETTYPE
+erts_internal_is_process_executing_dirty_1(BIF_ALIST_1)
+{
+ if (is_not_internal_pid(BIF_ARG_1))
+ BIF_ERROR(BIF_P, BADARG);
+#ifdef ERTS_DIRTY_SCHEDULERS
+ else {
+ Process *rp = erts_proc_lookup(BIF_ARG_1);
+ if (rp) {
+ erts_aint32_t state = erts_smp_atomic32_read_nob(&rp->state);
+ if (state & (ERTS_PSFLG_DIRTY_RUNNING
+ |ERTS_PSFLG_DIRTY_RUNNING_SYS)) {
+ BIF_RET(am_true);
+ }
+ }
+ }
+#endif
+ BIF_RET(am_false);
+}
+
+static ERTS_INLINE void
+run_queues_len_aux(ErtsRunQueue *rq, Uint *tot_len, Uint *qlen, int *ip, int incl_active_sched, int locked)
+{
+ Sint rq_len;
+
+ if (locked)
+ rq_len = (Sint) erts_smp_atomic32_read_dirty(&rq->len);
+ else
+ rq_len = (Sint) erts_smp_atomic32_read_nob(&rq->len);
+ ASSERT(rq_len >= 0);
+
+ if (incl_active_sched) {
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) {
+ erts_aint32_t dcnt;
+ if (ERTS_RUNQ_IS_DIRTY_CPU_RUNQ(rq)) {
+ dcnt = erts_smp_atomic32_read_nob(&dirty_count.cpu.active);
+ ASSERT(0 <= dcnt && dcnt <= erts_no_dirty_cpu_schedulers);
+ }
+ else {
+ ASSERT(ERTS_RUNQ_IS_DIRTY_IO_RUNQ(rq));
+ dcnt = erts_smp_atomic32_read_nob(&dirty_count.io.active);
+ ASSERT(0 <= dcnt && dcnt <= erts_no_dirty_io_schedulers);
+ }
+ rq_len += (Sint) dcnt;
+ }
+ else
+#endif
+ {
+ if (ERTS_RUNQ_FLGS_GET_NOB(rq) & ERTS_RUNQ_FLG_EXEC)
+ rq_len++;
+ }
+ }
+ if (qlen)
+ qlen[(*ip)++] = rq_len;
+ *tot_len += (Uint) rq_len;
+}
+
Uint
-erts_run_queues_len(Uint *qlen)
+erts_run_queues_len(Uint *qlen, int atomic_queues_read, int incl_active_sched,
+ int incl_dirty_io)
{
- int i = 0;
+ int i = 0, j = 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);
+ int no_rqs = erts_no_run_queues;
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (incl_dirty_io)
+ no_rqs += ERTS_NUM_DIRTY_RUNQS;
+ else
+ no_rqs += ERTS_NUM_DIRTY_CPU_RUNQS;
+#endif
+
+ if (atomic_queues_read) {
+ ERTS_ATOMIC_FOREACH_RUNQ_X(rq, no_rqs,
+ run_queues_len_aux(rq, &len, qlen, &j,
+ incl_active_sched, 1),
+ /* Nothing... */);
+ }
+ else {
+ for (i = 0; i < no_rqs; i++) {
+ ErtsRunQueue *rq = ERTS_RUNQ_IX(i);
+ run_queues_len_aux(rq, &len, qlen, &j, incl_active_sched, 0);
+ }
- if (pqlen < 0)
- pqlen = 0;
- if (qlen)
- qlen[i++] = pqlen;
- len += pqlen;
}
- );
return len;
}
Eterm
-erts_process_status(Process *c_p, ErtsProcLocks c_p_locks,
- Process *rp, Eterm rpid)
+erts_process_state2status(erts_aint32_t state)
+{
+ if (state & ERTS_PSFLG_FREE)
+ return am_free;
+
+ if (state & ERTS_PSFLG_EXITING)
+ return am_exiting;
+
+ if (state & ERTS_PSFLG_GC)
+ return am_garbage_collecting;
+
+ if (state & ERTS_PSFLG_SUSPENDED)
+ return am_suspended;
+
+ if (state & (ERTS_PSFLG_RUNNING
+ | ERTS_PSFLG_RUNNING_SYS
+ | ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS))
+ return am_running;
+
+ if (state & (ERTS_PSFLG_ACTIVE
+ | ERTS_PSFLG_ACTIVE_SYS
+ | ERTS_PSFLG_DIRTY_ACTIVE_SYS))
+ return am_runnable;
+
+ return am_waiting;
+}
+
+Eterm
+erts_process_status(Process *rp, Eterm rpid)
{
Eterm res = am_undefined;
Process *p = rp ? rp : erts_proc_lookup_raw(rpid);
if (p) {
erts_aint32_t state = erts_smp_atomic32_read_acqb(&p->state);
- if (state & ERTS_PSFLG_FREE)
- res = am_free;
- else if (state & ERTS_PSFLG_EXITING)
- res = am_exiting;
- else if (state & ERTS_PSFLG_GC)
- res = am_garbage_collecting;
- else if (state & ERTS_PSFLG_SUSPENDED)
- res = am_suspended;
- else if (state & ERTS_PSFLG_RUNNING)
- res = am_running;
- else if (state & ERTS_PSFLG_ACTIVE)
- res = am_runnable;
- else
- res = am_waiting;
+ res = erts_process_state2status(state);
}
#ifdef ERTS_SMP
else {
@@ -8706,7 +10007,7 @@ erts_resume(Process* process, ErtsProcLocks process_locks)
ERTS_SMP_LC_ASSERT(process_locks == erts_proc_lc_my_proc_locks(process));
if (!(process_locks & ERTS_PROC_LOCK_STATUS))
erts_smp_proc_lock(process, ERTS_PROC_LOCK_STATUS);
- resume_process(process);
+ resume_process(process, process_locks|ERTS_PROC_LOCK_STATUS);
if (!(process_locks & ERTS_PROC_LOCK_STATUS))
erts_smp_proc_unlock(process, ERTS_PROC_LOCK_STATUS);
}
@@ -8725,7 +10026,7 @@ erts_resume_processes(ErtsProcList *list)
proc = erts_pid2proc(NULL, 0, plp->pid, ERTS_PROC_LOCK_STATUS);
if (proc) {
if (erts_proclist_same(plp, proc)) {
- resume_process(proc);
+ resume_process(proc, ERTS_PROC_LOCK_STATUS);
nresumed++;
}
erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_STATUS);
@@ -8828,6 +10129,10 @@ erts_set_process_priority(Process *p, Eterm value)
a = erts_smp_atomic32_cmpxchg_mb(&p->state, n, e);
} while (a != e);
+
+ if (slocked)
+ erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+
}
switch (oprio) {
@@ -8839,6 +10144,27 @@ erts_set_process_priority(Process *p, Eterm value)
}
}
+#ifdef __WIN32__
+Sint64
+erts_time2reds(ErtsMonotonicTime start, ErtsMonotonicTime end)
+{
+ return ERTS_TIME2REDS_IMPL__(start, end);
+}
+#endif
+
+static int
+scheduler_gc_proc(Process *c_p, int reds_left)
+{
+ int fcalls, reds;
+ if (!ERTS_PROC_GET_SAVED_CALLS_BUF(c_p))
+ fcalls = reds_left;
+ else
+ fcalls = reds_left - CONTEXT_REDS;
+ reds = erts_garbage_collect_nobump(c_p, 0, c_p->arg_reg, c_p->arity, fcalls);
+ ASSERT(reds_left >= reds);
+ return reds;
+}
+
/*
* schedule() is called from BEAM (process_main()) or HiPE
* (hipe_mode_switch()) when the current process is to be
@@ -8857,12 +10183,10 @@ erts_set_process_priority(Process *p, Eterm value)
* so that normal processes get to run more frequently.
*/
-Process *schedule(Process *p, int calls)
+Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
{
Process *proxy_p = NULL;
ErtsRunQueue *rq;
- erts_aint_t dt;
- ErtsSchedulerData *esdp;
int context_reds;
int fcalls;
int input_reductions;
@@ -8870,6 +10194,9 @@ Process *schedule(Process *p, int calls)
int reds;
Uint32 flags;
erts_aint32_t state = 0; /* Supress warning... */
+ int is_normal_sched;
+
+ ERTS_MSACC_DECLARE_CACHE();
#ifdef USE_VM_PROBES
if (p != NULL && DTRACE_ENABLED(process_unscheduled)) {
@@ -8896,25 +10223,54 @@ Process *schedule(Process *p, int calls)
* Clean up after the process being scheduled out.
*/
if (!p) { /* NULL in the very first schedule() call */
+#ifdef ERTS_DIRTY_SCHEDULERS
+ is_normal_sched = !esdp;
+ if (is_normal_sched) {
+ esdp = erts_get_scheduler_data();
+ ASSERT(!ERTS_SCHEDULER_IS_DIRTY(esdp));
+ }
+ else {
+ ASSERT(ERTS_SCHEDULER_IS_DIRTY(esdp));
+ }
+#else
esdp = erts_get_scheduler_data();
+ is_normal_sched = 1;
+#endif
rq = erts_get_runq_current(esdp);
ASSERT(esdp);
fcalls = (int) erts_smp_atomic32_read_acqb(&function_calls);
actual_reds = reds = 0;
erts_smp_runq_lock(rq);
} else {
- sched_out_proc:
-
#ifdef ERTS_SMP
- ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p);
+#ifdef ERTS_DIRTY_SCHEDULERS
+ is_normal_sched = !esdp;
+ if (is_normal_sched) {
+ esdp = p->scheduler_data;
+ ASSERT(!ERTS_SCHEDULER_IS_DIRTY(esdp));
+ }
+ else {
+ ASSERT(ERTS_SCHEDULER_IS_DIRTY(esdp));
+ }
+#else
esdp = p->scheduler_data;
+ is_normal_sched = 1;
+#endif
ASSERT(esdp->current_process == p
|| esdp->free_process == p);
#else
esdp = erts_scheduler_data;
ASSERT(esdp->current_process == p);
+ is_normal_sched = 1;
#endif
+
+ sched_out_proc:
+
+ ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p);
+
reds = actual_reds = calls - esdp->virtual_reds;
+
+ ASSERT(actual_reds >= 0);
if (reds < ERTS_PROC_MIN_CONTEXT_SWITCH_REDS_COST)
reds = ERTS_PROC_MIN_CONTEXT_SWITCH_REDS_COST;
esdp->virtual_reds = 0;
@@ -8926,63 +10282,91 @@ Process *schedule(Process *p, int calls)
p->reds += actual_reds;
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
-
- state = erts_smp_atomic32_read_acqb(&p->state);
+ state = erts_smp_atomic32_read_nob(&p->state);
if (IS_TRACED(p)) {
if (IS_TRACED_FL(p, F_TRACE_CALLS) && !(state & ERTS_PSFLG_FREE))
erts_schedule_time_break(p, ERTS_BP_CALL_TIME_SCHEDULE_OUT);
- if (state & (ERTS_PSFLG_FREE|ERTS_PSFLG_EXITING)) {
+ if ((state & (ERTS_PSFLG_FREE|ERTS_PSFLG_EXITING)) == ERTS_PSFLG_EXITING) {
if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_EXIT))
- trace_sched(p, ((state & ERTS_PSFLG_FREE)
- ? am_out_exited
- : am_out_exiting));
+ trace_sched(p, ERTS_PROC_LOCK_MAIN,
+ ((state & ERTS_PSFLG_FREE)
+ ? am_out_exited
+ : am_out_exiting));
}
else {
- if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED))
- trace_sched(p, am_out);
- else if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_PROCS))
- trace_virtual_sched(p, am_out);
+ if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED) ||
+ ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_PROCS))
+ trace_sched(p, ERTS_PROC_LOCK_MAIN, am_out);
}
}
+ erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE);
+
#ifdef ERTS_SMP
- if (state & ERTS_PSFLG_PENDING_EXIT)
+ if (p->trace_msg_q) {
+ erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE);
+ erts_schedule_flush_trace_messages(p, 1);
+ erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE);
+ }
+#endif
+
+ /* have to re-read state after taking lock */
+ state = erts_smp_atomic32_read_nob(&p->state);
+
+#ifdef ERTS_SMP
+ if (is_normal_sched && (state & ERTS_PSFLG_PENDING_EXIT))
erts_handle_pending_exit(p, (ERTS_PROC_LOCK_MAIN
+ | ERTS_PROC_LOCK_TRACE
| ERTS_PROC_LOCK_STATUS));
if (p->pending_suspenders)
handle_pending_suspend(p, (ERTS_PROC_LOCK_MAIN
+ | ERTS_PROC_LOCK_TRACE
| ERTS_PROC_LOCK_STATUS));
#endif
esdp->reductions += reds;
- schedule_out_process(rq, state, p, proxy_p); /* Returns with rq locked! */
- proxy_p = NULL;
+ {
+ int dec_refc;
+
+ /* schedule_out_process() returns with rq locked! */
+ dec_refc = schedule_out_process(rq, state, p,
+ proxy_p, is_normal_sched);
+ proxy_p = NULL;
- ERTS_PROC_REDUCTIONS_EXECUTED(rq,
- (int) ERTS_PSFLGS_GET_USR_PRIO(state),
- reds,
- actual_reds);
+ ERTS_PROC_REDUCTIONS_EXECUTED(esdp, rq,
+ (int) ERTS_PSFLGS_GET_USR_PRIO(state),
+ reds,
+ actual_reds);
- esdp->current_process = NULL;
+ esdp->current_process = NULL;
#ifdef ERTS_SMP
- p->scheduler_data = NULL;
+ if (is_normal_sched)
+ p->scheduler_data = NULL;
#endif
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS);
+ erts_smp_proc_unlock(p, (ERTS_PROC_LOCK_MAIN
+ | ERTS_PROC_LOCK_STATUS
+ | ERTS_PROC_LOCK_TRACE));
+
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_OTHER);
- if (state & ERTS_PSFLG_FREE) {
#ifdef ERTS_SMP
- ASSERT(esdp->free_process == p);
- esdp->free_process = NULL;
-#else
- state = erts_smp_atomic32_read_nob(&p->state);
- if (!(state & ERTS_PSFLG_IN_RUNQ))
- erts_free_proc(p);
+ if (state & ERTS_PSFLG_FREE) {
+ if (!is_normal_sched) {
+ ASSERT(p->flags & F_DELAYED_DEL_PROC);
+ }
+ else {
+ ASSERT(esdp->free_process == p);
+ esdp->free_process = NULL;
+ }
+ }
#endif
- }
+
+ if (dec_refc)
+ erts_proc_dec_refc(p);
+ }
#ifdef ERTS_SMP
ASSERT(!esdp->free_process);
@@ -8991,32 +10375,27 @@ Process *schedule(Process *p, int calls)
ERTS_SMP_CHK_NO_PROC_LOCKS;
- dt = erts_do_time_read_and_reset();
- if (dt) {
- erts_smp_runq_unlock(rq);
- erts_bump_timer(dt);
- erts_smp_runq_lock(rq);
- }
- BM_STOP_TIMER(system);
+ if (is_normal_sched) {
+ if (esdp->check_time_reds >= ERTS_CHECK_TIME_REDS)
+ (void) erts_get_monotonic_time(esdp);
+ if (esdp->last_monotonic_time >= erts_next_timeout_time(esdp->next_tmo_ref)) {
+ erts_smp_runq_unlock(rq);
+ erts_bump_timers(esdp->timer_wheel, esdp->last_monotonic_time);
+ erts_smp_runq_lock(rq);
+ }
+ }
}
- ERTS_SMP_LC_ASSERT(ERTS_SCHEDULER_IS_DIRTY(esdp)
- || !erts_thr_progress_is_blocking());
+ ERTS_SMP_LC_ASSERT(!is_normal_sched || !erts_thr_progress_is_blocking());
check_activities_to_run: {
+ erts_aint32_t psflg_running, psflg_running_sys;
#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)) {
+ if (is_normal_sched) {
if (rq->check_balance_reds <= 0)
check_balance(rq);
@@ -9033,45 +10412,48 @@ Process *schedule(Process *p, int calls)
continue_check_activities_to_run:
flags = ERTS_RUNQ_FLGS_GET_NOB(rq);
continue_check_activities_to_run_known_flags:
- ASSERT(ERTS_SCHEDULER_IS_DIRTY(esdp)
- || flags & ERTS_RUNQ_FLG_NONEMPTY);
+ ASSERT(!is_normal_sched || (flags & ERTS_RUNQ_FLG_NONEMPTY));
- if (flags & (ERTS_RUNQ_FLG_CHK_CPU_BIND|ERTS_RUNQ_FLG_SUSPENDED)) {
- if (flags & ERTS_RUNQ_FLG_SUSPENDED) {
+ if (!is_normal_sched) {
+ if (erts_smp_atomic32_read_acqb(&esdp->ssi->flags)
+ & (ERTS_SSI_FLG_SUSPENDED|ERTS_SSI_FLG_MSB_EXEC)) {
suspend_scheduler(esdp);
- flags = ERTS_RUNQ_FLGS_GET_NOB(rq);
- }
- if (flags & ERTS_RUNQ_FLG_CHK_CPU_BIND) {
- flags = ERTS_RUNQ_FLGS_UNSET(rq, ERTS_RUNQ_FLG_CHK_CPU_BIND);
- flags &= ~ ERTS_RUNQ_FLG_CHK_CPU_BIND;
- erts_sched_check_cpu_bind(esdp);
}
}
-#ifdef ERTS_DIRTY_SCHEDULERS
- else if (ERTS_SCHEDULER_IS_DIRTY(esdp)
- && (erts_smp_atomic32_read_acqb(&esdp->ssi->flags)
- & ERTS_SSI_FLG_SUSPENDED))
- suspend_scheduler(esdp);
-#endif
-
- {
+ else {
erts_aint32_t aux_work;
- int leader_update = ERTS_SCHEDULER_IS_DIRTY(esdp) ? 0
- : erts_thr_progress_update(esdp);
+ int leader_update;
+
+ ASSERT(is_normal_sched);
+
+ if (flags & (ERTS_RUNQ_FLG_CHK_CPU_BIND
+ | ERTS_RUNQ_FLG_SUSPENDED
+ | ERTS_RUNQ_FLG_MSB_EXEC)) {
+ if (flags & (ERTS_RUNQ_FLG_SUSPENDED|ERTS_RUNQ_FLG_MSB_EXEC)) {
+ (void) ERTS_RUNQ_FLGS_UNSET_NOB(rq, ERTS_RUNQ_FLG_EXEC);
+ suspend_scheduler(esdp);
+ 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);
+ flags &= ~ERTS_RUNQ_FLG_CHK_CPU_BIND;
+ erts_sched_check_cpu_bind(esdp);
+ }
+ }
+
+ 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));
@@ -9086,19 +10468,12 @@ Process *schedule(Process *p, int calls)
flags = ERTS_RUNQ_FLGS_GET_NOB(rq);
-#ifdef ERTS_DIRTY_SCHEDULERS
- if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix) && rq->halt_in_progress) {
- /*
- * TODO: if halt in progress, need to put the dirty scheduler
- * to sleep somewhere around here to prevent it from picking up
- * new work
- */
+ if (!is_normal_sched & !!(flags & ERTS_RUNQ_FLG_HALTING)) {
+ /* Wait for emulator to terminate... */
+ while (1)
+ erts_milli_sleep(1000*1000);
}
- else
-#endif
-
- if ((!(flags & ERTS_RUNQ_FLGS_QMASK) && !rq->misc.start)
- || (rq->halt_in_progress && ERTS_EMPTY_RUNQ_PORTS(rq))) {
+ else if (!runq_got_work_to_execute_flags(flags)) {
/* Prepare for scheduler wait */
#ifdef ERTS_SMP
ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq));
@@ -9112,51 +10487,85 @@ Process *schedule(Process *p, int calls)
if (flags & ERTS_RUNQ_FLG_INACTIVE)
empty_runq(rq);
else {
- if (!ERTS_RUNQ_IX_IS_DIRTY(rq->ix) && try_steal_task(rq))
- goto continue_check_activities_to_run;
-
- empty_runq(rq);
-
- /*
- * Check for ERTS_RUNQ_FLG_SUSPENDED has to be done
- * after trying to steal a task.
- */
- flags = ERTS_RUNQ_FLGS_GET_NOB(rq);
- if (flags & ERTS_RUNQ_FLG_SUSPENDED) {
- non_empty_runq(rq);
- flags |= ERTS_RUNQ_FLG_NONEMPTY;
- goto continue_check_activities_to_run_known_flags;
+ ASSERT(!runq_got_work_to_execute(rq));
+ if (!is_normal_sched) {
+ /* Dirty scheduler */
+ if (erts_smp_atomic32_read_acqb(&esdp->ssi->flags)
+ & (ERTS_SSI_FLG_SUSPENDED|ERTS_SSI_FLG_MSB_EXEC)) {
+ /* Go suspend... */
+ goto continue_check_activities_to_run_known_flags;
+ }
+ }
+ else {
+ /* Normal scheduler */
+ if (try_steal_task(rq))
+ goto continue_check_activities_to_run;
+ /*
+ * Check for suspend has to be done after trying
+ * to steal a task...
+ */
+ flags = ERTS_RUNQ_FLGS_GET_NOB(rq);
+ if ((flags & ERTS_RUNQ_FLG_SUSPENDED)
+#ifdef ERTS_DIRTY_SCHEDULERS
+ /* If multi scheduling block and we have
+ * dirty work, suspend and let dirty
+ * scheduler handle work... */
+ || ((((flags & (ERTS_RUNQ_FLG_HALTING
+ | ERTS_RUNQ_FLG_MSB_EXEC))
+ == ERTS_RUNQ_FLG_MSB_EXEC))
+ && have_dirty_work())
+#endif
+ ) {
+ non_empty_runq(rq);
+ flags |= ERTS_RUNQ_FLG_NONEMPTY;
+ /*
+ * Go suspend...
+ */
+ goto continue_check_activities_to_run_known_flags;
+ }
}
+ empty_runq(rq);
}
#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
goto check_activities_to_run;
}
- else if (!ERTS_SCHEDULER_IS_DIRTY(esdp) &&
- (fcalls > input_reductions &&
- prepare_for_sys_schedule(esdp))) {
+ else if (is_normal_sched
+ && (fcalls > input_reductions
+ && 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;
- ASSERT(!erts_port_task_have_outstanding_io_tasks());
-
#if 0 /* Not needed since we wont wait in sys schedule */
erts_sys_schedule_interrupt(0);
#endif
erts_smp_runq_unlock(rq);
+
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_CHECK_IO);
+ LTTNG2(scheduler_poll, esdp->no, 1);
+
erl_sys_schedule(1);
- dt = erts_do_time_read_and_reset();
- if (dt) erts_bump_timer(dt);
+ ERTS_MSACC_POP_STATE_M();
+
+ current_time = erts_get_monotonic_time(esdp);
+ if (current_time >= erts_next_timeout_time(esdp->next_tmo_ref))
+ erts_bump_timers(esdp->timer_wheel, current_time);
#ifdef ERTS_SMP
erts_smp_runq_lock(rq);
@@ -9167,7 +10576,7 @@ Process *schedule(Process *p, int calls)
#endif
}
- if (rq->misc.start)
+ if (flags & ERTS_RUNQ_FLG_MISC_OP)
exec_misc_ops(rq);
#ifdef ERTS_SMP
@@ -9178,11 +10587,15 @@ Process *schedule(Process *p, int calls)
* Find a new port to run.
*/
- if (RUNQ_READ_LEN(&rq->ports.info.len)) {
+ flags = ERTS_RUNQ_FLGS_GET_NOB(rq);
+
+ if (flags & PORT_BIT) {
int have_outstanding_io;
have_outstanding_io = erts_port_task_execute(rq, &esdp->current_port);
- if ((have_outstanding_io && fcalls > 2*input_reductions)
- || rq->halt_in_progress) {
+ if ((!erts_eager_check_io
+ && have_outstanding_io
+ && fcalls > 2*input_reductions)
+ || (flags & ERTS_RUNQ_FLG_HALTING)) {
/*
* If we have performed more than 2*INPUT_REDUCTIONS since
* last call to erl_sys_schedule() and we still haven't
@@ -9208,11 +10621,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;
@@ -9228,11 +10642,10 @@ 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;
}
- BM_START_TIMER(system);
-
/*
* Take the chosen process out of the queue.
*/
@@ -9240,26 +10653,27 @@ 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);
+ if (is_normal_sched) {
+ psflg_running = ERTS_PSFLG_RUNNING;
+ psflg_running_sys = ERTS_PSFLG_RUNNING_SYS;
+ psflg_band_mask = ~(((erts_aint32_t) 1) << (ERTS_PSFLGS_GET_PRQ_PRIO(state)
+ + ERTS_PSFLGS_IN_PRQ_MASK_OFFSET));
+ }
+ else {
+ psflg_running = ERTS_PSFLG_DIRTY_RUNNING;
+ psflg_running_sys = ERTS_PSFLG_DIRTY_RUNNING_SYS;
+ psflg_band_mask = ~((erts_aint32_t) 0);
}
-#endif
if (!(state & ERTS_PSFLG_PROXY))
psflg_band_mask &= ~ERTS_PSFLG_IN_RUNQ;
else {
+ Eterm pid = p->common.id;
proxy_p = p;
- p = erts_proc_lookup_raw(proxy_p->common.id);
+ p = (is_normal_sched
+ ? erts_proc_lookup_raw(pid)
+ : erts_pid2proc_opt(NULL, 0, pid, 0,
+ ERTS_P2P_FLG_INC_REFC));
if (!p) {
free_proxy_proc(proxy_p);
proxy_p = NULL;
@@ -9268,42 +10682,72 @@ Process *schedule(Process *p, int calls)
state = erts_smp_atomic32_read_nob(&p->state);
}
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (!is_normal_sched)
+ clear_proc_dirty_queue_bit(p, rq, qbit);
+#endif
+
while (1) {
- erts_aint32_t exp, new, tmp;
- tmp = new = exp = state;
+ erts_aint32_t exp, new;
+ int run_process;
+ new = exp = state;
new &= psflg_band_mask;
- if (!(state & (ERTS_PSFLG_RUNNING
- | ERTS_PSFLG_RUNNING_SYS))) {
- tmp = state & (ERTS_PSFLG_SUSPENDED
- | ERTS_PSFLG_PENDING_EXIT
- | ERTS_PSFLG_ACTIVE_SYS);
- if (tmp != ERTS_PSFLG_SUSPENDED) {
- if (state & ERTS_PSFLG_ACTIVE_SYS)
- new |= ERTS_PSFLG_RUNNING_SYS;
- else
- new |= ERTS_PSFLG_RUNNING;
- }
+ /*
+ * Run process if not already running (or free)
+ * or exiting and not running on a normal
+ * scheduler, and not suspended (and not in a
+ * state where suspend should be ignored).
+ */
+ run_process = (((!(state & (ERTS_PSFLG_RUNNING
+ | ERTS_PSFLG_RUNNING_SYS
+ | ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS
+ | ERTS_PSFLG_FREE)))
+#ifdef ERTS_DIRTY_SCHEDULERS
+ | (((state & (ERTS_PSFLG_RUNNING
+
+ | ERTS_PSFLG_FREE
+ | ERTS_PSFLG_RUNNING_SYS
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS
+ | ERTS_PSFLG_EXITING))
+ == ERTS_PSFLG_EXITING)
+ & (!!is_normal_sched))
+#endif
+ )
+ & ((state & (ERTS_PSFLG_SUSPENDED
+ | ERTS_PSFLG_EXITING
+ | ERTS_PSFLG_FREE
+ | ERTS_PSFLG_PENDING_EXIT
+ | ERTS_PSFLG_ACTIVE_SYS
+ | ERTS_PSFLG_DIRTY_ACTIVE_SYS))
+ != ERTS_PSFLG_SUSPENDED)
+#ifdef ERTS_DIRTY_SCHEDULERS
+ & (!(state & (ERTS_PSFLG_EXITING
+ | ERTS_PSFLG_PENDING_EXIT))
+ | (!!is_normal_sched))
+#endif
+ );
+
+ if (run_process) {
+ if (state & (ERTS_PSFLG_ACTIVE_SYS
+ | ERTS_PSFLG_DIRTY_ACTIVE_SYS))
+ new |= psflg_running_sys;
+ else
+ new |= psflg_running;
}
state = erts_smp_atomic32_cmpxchg_relb(&p->state, new, exp);
if (state == exp) {
- if ((state & (ERTS_PSFLG_RUNNING
- | ERTS_PSFLG_RUNNING_SYS
- | ERTS_PSFLG_FREE))
- || ((state & (ERTS_PSFLG_SUSPENDED
- | ERTS_PSFLG_PENDING_EXIT
- | ERTS_PSFLG_ACTIVE_SYS))
- == ERTS_PSFLG_SUSPENDED)) {
- if (state & ERTS_PSFLG_FREE) {
-#ifdef ERTS_SMP
- erts_smp_proc_dec_refc(p);
-#else
- erts_free_proc(p);
-#endif
- }
+ if (!run_process) {
if (proxy_p) {
free_proxy_proc(proxy_p);
proxy_p = NULL;
}
+ else if (state & ERTS_PSFLG_FREE) {
+ /* free and not queued by proxy */
+ erts_proc_dec_refc(p);
+ }
+ if (!is_normal_sched)
+ erts_proc_dec_refc(p);
goto pick_next_process;
}
state = new;
@@ -9315,10 +10759,16 @@ Process *schedule(Process *p, int calls)
esdp->current_process = p;
+ calls = 0;
+ reds = context_reds;
+
+ erts_smp_runq_unlock(rq);
+
}
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_EMULATOR);
+
#ifdef ERTS_SMP
- erts_smp_runq_unlock(rq);
if (flags & ERTS_RUNQ_FLG_PROTECTED)
(void) ERTS_RUNQ_FLGS_UNSET(rq, ERTS_RUNQ_FLG_PROTECTED);
@@ -9327,17 +10777,14 @@ 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,
- (ERTS_PROC_LOCK_MAIN
- | ERTS_PROC_LOCK_STATUS),
- (UWord) esdp->no);
+ UWord old = ERTS_PROC_SCHED_ID(p, (UWord) esdp->no);
int migrated = old && old != esdp->no;
-#ifdef ERTS_DIRTY_SCHEDULERS
- ASSERT(!ERTS_SCHEDULER_IS_DIRTY(esdp));
-#endif
+ ASSERT(is_normal_sched);
prio = (int) ERTS_PSFLGS_GET_USR_PRIO(state);
@@ -9351,109 +10798,195 @@ Process *schedule(Process *p, int calls)
erts_smp_spin_unlock(&erts_sched_stat.lock);
}
- if (ERTS_PROC_PENDING_EXIT(p)) {
+ state = erts_smp_atomic32_read_nob(&p->state);
+
+#ifndef ERTS_DIRTY_SCHEDULERS
+ ASSERT(!p->scheduler_data);
+ p->scheduler_data = esdp;
+#else /* ERTS_DIRTY_SCHEDULERS */
+ if (is_normal_sched) {
+ 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);
+ goto sched_out_proc;
+ }
+ ASSERT(!p->scheduler_data);
+ p->scheduler_data = esdp;
+ }
+ else {
+ if (state & (ERTS_PSFLG_ACTIVE_SYS
+ | ERTS_PSFLG_PENDING_EXIT
+ | ERTS_PSFLG_EXITING)) {
+ /*
+ * IMPORTANT! We need to take care of
+ * scheduled check-process-code requests
+ * before continuing with dirty execution!
+ */
+ /* 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(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;
- if (IS_TRACED(p)) {
+#endif /* ERTS_SMP */
+
+ erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+
+ /* Clear tracer if it has been removed */
+ if (IS_TRACED(p) && erts_is_tracer_proc_enabled(
+ p, ERTS_PROC_LOCK_MAIN, &p->common)) {
+
if (state & ERTS_PSFLG_EXITING) {
if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_EXIT))
- trace_sched(p, am_in_exiting);
+ trace_sched(p, ERTS_PROC_LOCK_MAIN, am_in_exiting);
}
else {
- if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED))
- trace_sched(p, am_in);
- else if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_PROCS))
- trace_virtual_sched(p, am_in);
+ if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED) ||
+ ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_PROCS))
+ trace_sched(p, ERTS_PROC_LOCK_MAIN, am_in);
}
if (IS_TRACED_FL(p, F_TRACE_CALLS)) {
erts_schedule_time_break(p, ERTS_BP_CALL_TIME_SCHEDULE_IN);
}
}
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
-
-#ifdef ERTS_SMP
- if (is_not_nil(ERTS_TRACER_PROC(p)))
- erts_check_my_tracer_proc(p);
-#endif
+ if (is_normal_sched) {
- if (state & ERTS_PSFLG_RUNNING_SYS) {
- reds -= execute_sys_tasks(p, &state, reds);
- if (reds <= 0
+ if (state & ERTS_PSFLG_RUNNING_SYS) {
+ /*
+ * GC is normally never delayed when a process
+ * is scheduled out, but might be when executing
+ * hand written beam assembly in
+ * prim_eval:'receive'. If GC is delayed we are
+ * not allowed to execute system tasks.
+ */
+ if (!(p->flags & F_DELAY_GC)) {
+ int cost = execute_sys_tasks(p, &state, reds);
+ calls += cost;
+ reds -= cost;
+ if (reds <= 0)
+ goto sched_out_proc;
#ifdef ERTS_DIRTY_SCHEDULERS
- || (state & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC))
+ if (state & ERTS_PSFLGS_DIRTY_WORK)
+ goto sched_out_proc;
#endif
- ) {
- p->fcalls = reds;
- goto sched_out_proc;
- }
+ }
- ASSERT(state & ERTS_PSFLG_RUNNING_SYS);
- ASSERT(!(state & ERTS_PSFLG_RUNNING));
+ ASSERT(state & psflg_running_sys);
+ ASSERT(!(state & psflg_running));
- while (1) {
- erts_aint32_t n, e;
+ while (1) {
+ erts_aint32_t n, e;
- if (((state & (ERTS_PSFLG_SUSPENDED
- | ERTS_PSFLG_ACTIVE)) != ERTS_PSFLG_ACTIVE)
- && !(state & ERTS_PSFLG_EXITING))
- goto sched_out_proc;
+ if (((state & (ERTS_PSFLG_SUSPENDED
+ | ERTS_PSFLG_ACTIVE)) != ERTS_PSFLG_ACTIVE)
+ && !(state & ERTS_PSFLG_EXITING)) {
+ goto sched_out_proc;
+ }
- n = e = state;
- n &= ~ERTS_PSFLG_RUNNING_SYS;
- n |= ERTS_PSFLG_RUNNING;
+ n = e = state;
+ n &= ~psflg_running_sys;
+ n |= psflg_running;
- state = erts_smp_atomic32_cmpxchg_mb(&p->state, n, e);
- if (state == e) {
- state = n;
- break;
- }
+ state = erts_smp_atomic32_cmpxchg_mb(&p->state, n, e);
+ if (state == e) {
+ state = n;
+ break;
+ }
- ASSERT(state & ERTS_PSFLG_RUNNING_SYS);
- ASSERT(!(state & ERTS_PSFLG_RUNNING));
- }
- }
+ ASSERT(state & psflg_running_sys);
+ ASSERT(!(state & psflg_running));
+ }
+ }
- 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_DELAY_GC|F_DISABLE_GC))) {
+ int cost = scheduler_gc_proc(p, reds);
+ calls += cost;
+ reds -= cost;
+ if (reds <= 0)
+ goto sched_out_proc;
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (p->flags & (F_DIRTY_MAJOR_GC|F_DIRTY_MINOR_GC))
+ goto sched_out_proc;
+#endif
+ }
+ }
+ }
if (proxy_p) {
free_proxy_proc(proxy_p);
proxy_p = NULL;
}
-
+
p->fcalls = reds;
+
ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p);
/* Never run a suspended process */
- ASSERT(!(ERTS_PSFLG_SUSPENDED & erts_smp_atomic32_read_nob(&p->state)));
+#ifdef DEBUG
+ {
+ erts_aint32_t dstate = erts_smp_atomic32_read_nob(&p->state);
+ ASSERT(!(ERTS_PSFLG_SUSPENDED & dstate)
+ || (ERTS_PSFLG_DIRTY_RUNNING_SYS & dstate));
+ }
+#endif
+
+ ASSERT(erts_proc_read_refc(p) > 0);
+
+ if (!(state & ERTS_PSFLG_EXITING) && ERTS_PTMR_IS_TIMED_OUT(p)) {
+ BeamInstr** pi;
+#ifdef ERTS_SMP
+ ETHR_MEMBAR(ETHR_LoadLoad|ETHR_LoadStore);
+#endif
+ pi = (BeamInstr **) p->def_arg_reg;
+ p->i = *pi;
+ p->flags &= ~F_INSLPQUEUE;
+ p->flags |= F_TIMO;
+ ERTS_PTMR_CLEAR(p);
+ }
return p;
}
}
static int
-notify_sys_task_executed(Process *c_p, ErtsProcSysTask *st, Eterm st_result)
+notify_sys_task_executed(Process *c_p, ErtsProcSysTask *st,
+ Eterm st_result, int normal_sched)
{
- Process *rp = erts_proc_lookup(st->requester);
+ Process *rp;
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (!normal_sched)
+ rp = erts_pid2proc_opt(c_p, ERTS_PROC_LOCK_MAIN,
+ st->requester, 0,
+ ERTS_P2P_FLG_INC_REFC);
+ else
+#endif
+ rp = erts_proc_lookup(st->requester);
if (rp) {
ErtsProcLocks rp_locks;
ErlOffHeap *ohp;
- ErlHeapFragment* bp;
+ ErtsMessage *mp;
Eterm *hp, msg, req_id, result;
Uint st_result_sz, hsz;
#ifdef DEBUG
@@ -9465,11 +10998,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;
@@ -9494,21 +11023,18 @@ 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
-#ifdef USE_VM_PROBES
- , NIL
-#endif
- );
+ erts_queue_message(rp, rp_locks, mp, msg, c_p->common.id);
if (c_p == rp)
rp_locks &= ~ERTS_PROC_LOCK_MAIN;
if (rp_locks)
erts_smp_proc_unlock(rp, rp_locks);
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (!normal_sched)
+ erts_proc_dec_refc(rp);
+#endif
}
erts_cleanup_offheap(&st->off_heap);
@@ -9664,19 +11190,23 @@ done:
}
static void save_gc_task(Process *c_p, ErtsProcSysTask *st, int prio);
+#ifdef ERTS_DIRTY_SCHEDULERS
+static void save_dirty_task(Process *c_p, ErtsProcSysTask *st);
+#endif
static int
execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds)
{
- int garbage_collected = 0;
+ int minor_gc = 0, major_gc = 0;
erts_aint32_t state = *statep;
- int max_reds = in_reds;
- int reds = 0;
+ int reds = in_reds;
int qmask = 0;
+ ASSERT(!ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(c_p)));
ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) == ERTS_PROC_LOCK_MAIN);
do {
+ ErtsProcSysTaskType type;
ErtsProcSysTask *st;
int st_prio;
Eterm st_res;
@@ -9694,50 +11224,121 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds)
if (!st)
break;
- switch (st->type) {
- case ERTS_PSTT_GC:
+ type = st->type;
+
+ switch (type) {
+ case ERTS_PSTT_GC_MAJOR:
+ case ERTS_PSTT_GC_MINOR:
if (c_p->flags & F_DISABLE_GC) {
save_gc_task(c_p, st, st_prio);
st = NULL;
- reds++;
+ 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);
- garbage_collected = 1;
+ if ((!minor_gc
+ || (!major_gc && type == ERTS_PSTT_GC_MAJOR))
+ && !(c_p->flags & F_HIBERNATED)) {
+ if (type == ERTS_PSTT_GC_MAJOR) {
+ FLAGS(c_p) |= F_NEED_FULLSWEEP;
+ }
+ reds -= scheduler_gc_proc(c_p, reds);
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (c_p->flags & (F_DIRTY_MAJOR_GC|F_DIRTY_MINOR_GC)) {
+ save_dirty_task(c_p, st);
+ st = NULL;
+ break;
+ }
+#endif
+ if (type == ERTS_PSTT_GC_MAJOR)
+ minor_gc = major_gc = 1;
+ else
+ minor_gc = 1;
}
st_res = am_true;
}
break;
- case ERTS_PSTT_CPC:
+ case ERTS_PSTT_CPC: {
+ int fcalls;
+ int cpc_reds = 0;
+ if (!ERTS_PROC_GET_SAVED_CALLS_BUF(c_p))
+ fcalls = reds;
+ else
+ fcalls = reds - CONTEXT_REDS;
st_res = erts_check_process_code(c_p,
st->arg[0],
- st->arg[1] == am_true,
- &reds);
+ &cpc_reds,
+ fcalls);
+ reds -= cpc_reds;
if (is_non_value(st_res)) {
/* Needed gc, but gc was disabled */
save_gc_task(c_p, st, st_prio);
st = NULL;
}
break;
+ }
+ case ERTS_PSTT_CLA: {
+ int fcalls;
+ int cla_reds = 0;
+ int do_gc;
+
+ if (!ERTS_PROC_GET_SAVED_CALLS_BUF(c_p))
+ fcalls = reds;
+ else
+ fcalls = reds - CONTEXT_REDS;
+ do_gc = st->arg[0] == am_true;
+ st_res = erts_proc_copy_literal_area(c_p, &cla_reds,
+ fcalls, do_gc);
+ reds -= cla_reds;
+ if (is_non_value(st_res)) {
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (c_p->flags & F_DIRTY_CLA) {
+ save_dirty_task(c_p, st);
+ st = NULL;
+ break;
+ }
+#endif
+ /* Needed gc, but gc was disabled */
+ save_gc_task(c_p, st, st_prio);
+ st = NULL;
+ break;
+ }
+ if (do_gc) /* We did a major gc */
+ minor_gc = major_gc = 1;
+ break;
+ }
+ case ERTS_PSTT_COHMQ:
+ reds -= erts_complete_off_heap_message_queue_change(c_p);
+ st_res = am_true;
+ break;
+#ifdef ERTS_SMP
+ case ERTS_PSTT_FTMQ:
+ reds -= erts_flush_trace_messages(c_p, ERTS_PROC_LOCK_MAIN);
+ st_res = am_true;
+ break;
+#endif
+#ifdef ERTS_SMP
+ case ERTS_PSTT_ETS_FREE_FIXATION:
+ reds -= erts_db_execute_free_fixation(c_p, (DbFixation*)st->arg[0]);
+ st_res = am_true;
+ break;
+#endif
default:
ERTS_INTERNAL_ERROR("Invalid process sys task type");
st_res = am_false;
}
if (st)
- reds += notify_sys_task_executed(c_p, st, st_res);
+ reds += notify_sys_task_executed(c_p, st, st_res, 1);
state = erts_smp_atomic32_read_acqb(&c_p->state);
- } while (qmask && reds < max_reds);
+ } while (qmask && reds > 0);
*statep = state;
- return reds;
+ if (in_reds < reds)
+ return in_reds;
+
+ return in_reds - reds;
}
static int
@@ -9746,7 +11347,9 @@ cleanup_sys_tasks(Process *c_p, erts_aint32_t in_state, int in_reds)
erts_aint32_t state = in_state;
int max_reds = in_reds;
int reds = 0;
- int qmask = 0;
+ int qmask = 1; /* Set to 1 to force looping as long as there
+ * are dirty tasks.
+ */
ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) == ERTS_PROC_LOCK_MAIN);
@@ -9755,24 +11358,43 @@ cleanup_sys_tasks(Process *c_p, erts_aint32_t in_state, int in_reds)
Eterm st_res;
int st_prio;
- st = fetch_sys_task(c_p, state, &qmask, &st_prio);
- if (!st)
- break;
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (c_p->dirty_sys_tasks) {
+ st = c_p->dirty_sys_tasks;
+ c_p->dirty_sys_tasks = st->next;
+ }
+ else
+#endif
+ {
+ st = fetch_sys_task(c_p, state, &qmask, &st_prio);
+ if (!st)
+ break;
+ }
switch (st->type) {
- case ERTS_PSTT_GC:
- st_res = am_false;
- break;
+ case ERTS_PSTT_GC_MAJOR:
+ case ERTS_PSTT_GC_MINOR:
case ERTS_PSTT_CPC:
+ case ERTS_PSTT_COHMQ:
+ case ERTS_PSTT_ETS_FREE_FIXATION:
st_res = am_false;
break;
+ case ERTS_PSTT_CLA:
+ st_res = am_ok;
+ break;
+#ifdef ERTS_SMP
+ case ERTS_PSTT_FTMQ:
+ reds -= erts_flush_trace_messages(c_p, ERTS_PROC_LOCK_MAIN);
+ st_res = am_true;
+ break;
+#endif
default:
ERTS_INTERNAL_ERROR("Invalid process sys task type");
st_res = am_false;
break;
}
- reds += notify_sys_task_executed(c_p, st, st_res);
+ reds += notify_sys_task_executed(c_p, st, st_res, 1);
state = erts_smp_atomic32_read_acqb(&c_p->state);
} while (qmask && reds < max_reds);
@@ -9780,24 +11402,169 @@ cleanup_sys_tasks(Process *c_p, erts_aint32_t in_state, int in_reds)
return reds;
}
-BIF_RETTYPE
-erts_internal_request_system_task_3(BIF_ALIST_3)
+#ifdef ERTS_DIRTY_SCHEDULERS
+
+void
+erts_execute_dirty_system_task(Process *c_p)
{
- Process *rp = erts_proc_lookup(BIF_ARG_1);
- ErtsProcSysTaskQs *stqs, *free_stqs = NULL;
+ Eterm cla_res = THE_NON_VALUE;
+ ErtsProcSysTask *stasks;
+
+ /*
+ * If multiple operations, perform them in the following
+ * order (in order to avoid unnecessary GC):
+ * 1. Copy Literal Area (implies major GC).
+ * 2. GC Hibernate (implies major GC if not woken).
+ * 3. Major GC (implies minor GC).
+ * 4. Minor GC.
+ *
+ * System task requests are handled after the actual
+ * operations have been performed...
+ */
+
+ ASSERT(!(c_p->flags & (F_DELAY_GC|F_DISABLE_GC)));
+
+ if (c_p->flags & F_DIRTY_CLA) {
+ int cla_reds = 0;
+ cla_res = erts_proc_copy_literal_area(c_p, &cla_reds, c_p->fcalls, 1);
+ ASSERT(is_value(cla_res));
+ }
+
+ if (c_p->flags & F_DIRTY_GC_HIBERNATE) {
+ erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
+ ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p);
+ if (c_p->msg.len)
+ c_p->flags &= ~F_DIRTY_GC_HIBERNATE; /* operation aborted... */
+ else {
+ erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
+ c_p->fvalue = NIL;
+ erts_garbage_collect_hibernate(c_p);
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
+ erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
+ ASSERT(!ERTS_PROC_IS_EXITING(c_p));
+ }
+ erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
+ }
+
+ if (c_p->flags & (F_DIRTY_MAJOR_GC|F_DIRTY_MINOR_GC)) {
+ if (c_p->flags & F_DIRTY_MAJOR_GC)
+ c_p->flags |= F_NEED_FULLSWEEP;
+ (void) erts_garbage_collect_nobump(c_p, 0, c_p->arg_reg,
+ c_p->arity, c_p->fcalls);
+ }
+
+ ASSERT(!(c_p->flags & (F_DIRTY_CLA
+ | F_DIRTY_GC_HIBERNATE
+ | F_DIRTY_MAJOR_GC
+ | F_DIRTY_MINOR_GC)));
+
+ stasks = c_p->dirty_sys_tasks;
+ c_p->dirty_sys_tasks = NULL;
+
+ while (stasks) {
+ Eterm st_res;
+ ErtsProcSysTask *st = stasks;
+ stasks = st->next;
+
+ switch (st->type) {
+ case ERTS_PSTT_CLA:
+ ASSERT(is_value(cla_res));
+ st_res = cla_res;
+ break;
+ case ERTS_PSTT_GC_MAJOR:
+ st_res = am_true;
+ break;
+ case ERTS_PSTT_GC_MINOR:
+ st_res = am_true;
+ break;
+
+ default:
+ ERTS_INTERNAL_ERROR("Not supported dirty system task");
+ break;
+ }
+
+ (void) notify_sys_task_executed(c_p, st, st_res, 0);
+
+ }
+
+ erts_smp_atomic32_read_band_relb(&c_p->state, ~ERTS_PSFLG_DIRTY_ACTIVE_SYS);
+}
+
+static BIF_RETTYPE
+dispatch_system_task(Process *c_p, erts_aint_t fail_state,
+ ErtsProcSysTask *st, Eterm target,
+ Eterm prio, Eterm operation)
+{
+ Process *rp;
+ ErtsProcLocks rp_locks = 0;
+ ErlOffHeap *ohp;
+ ErtsMessage *mp;
+ Eterm *hp, msg;
+ Uint hsz, osz;
+ BIF_RETTYPE ret;
+
+ switch (st->type) {
+ case ERTS_PSTT_CPC:
+ rp = erts_dirty_process_code_checker;
+ ASSERT(fail_state & (ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS));
+ if (c_p == rp) {
+ ERTS_BIF_PREP_RET(ret, am_dirty_execution);
+ return ret;
+ }
+ break;
+ default:
+ rp = NULL;
+ ERTS_INTERNAL_ERROR("Non-dispatchable system task");
+ break;
+ }
+
+ ERTS_BIF_PREP_RET(ret, am_ok);
+
+ /*
+ * Send message on the form: {Requester, Target, Operation}
+ */
+
+ ASSERT(is_immed(st->requester));
+ ASSERT(is_immed(target));
+ ASSERT(is_immed(prio));
+
+ osz = size_object(operation);
+ hsz = 5 /* 4-tuple */ + osz;
+
+ mp = erts_alloc_message_heap(rp, &rp_locks, hsz, &hp, &ohp);
+
+ msg = copy_struct(operation, osz, &hp, ohp);
+ msg = TUPLE4(hp, st->requester, target, prio, msg);
+
+ erts_queue_message(rp, rp_locks, mp, msg, st->requester);
+
+ if (rp_locks)
+ erts_smp_proc_unlock(rp, rp_locks);
+
+ return ret;
+}
+
+#endif
+
+static BIF_RETTYPE
+request_system_task(Process *c_p, Eterm requester, Eterm target,
+ Eterm priority, Eterm operation)
+{
+ BIF_RETTYPE ret;
+ Process *rp = erts_proc_lookup(target);
ErtsProcSysTask *st = NULL;
- erts_aint32_t prio, rp_state;
- int rp_locked;
+ erts_aint32_t prio, fail_state = ERTS_PSFLG_EXITING;
Eterm noproc_res, req_type;
- if (!rp && !is_internal_pid(BIF_ARG_1)) {
- if (!is_external_pid(BIF_ARG_1))
+ if (!rp && !is_internal_pid(target)) {
+ if (!is_external_pid(target))
goto badarg;
- if (external_pid_dist_entry(BIF_ARG_1) != erts_this_dist_entry)
+ if (external_pid_dist_entry(target) != erts_this_dist_entry)
goto badarg;
}
- switch (BIF_ARG_2) {
+ switch (priority) {
case am_max: prio = PRIORITY_MAX; break;
case am_high: prio = PRIORITY_HIGH; break;
case am_normal: prio = PRIORITY_NORMAL; break;
@@ -9805,11 +11572,11 @@ erts_internal_request_system_task_3(BIF_ALIST_3)
default: goto badarg;
}
- if (is_not_tuple(BIF_ARG_3))
+ if (is_not_tuple(operation))
goto badarg;
else {
int i;
- Eterm *tp = tuple_val(BIF_ARG_3);
+ Eterm *tp = tuple_val(operation);
Uint arity = arityval(*tp);
Eterm req_id;
Uint req_id_sz;
@@ -9844,11 +11611,10 @@ 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];
- st->requester = BIF_P->common.id;
+ st->requester = requester;
st->reply_tag = req_type;
st->req_id_sz = req_id_sz;
st->req_id = req_id_sz == 0 ? req_id : copy_struct(req_id,
@@ -9867,125 +11633,226 @@ erts_internal_request_system_task_3(BIF_ALIST_3)
switch (req_type) {
case am_garbage_collect:
- st->type = ERTS_PSTT_GC;
- noproc_res = am_false;
- if (!rp)
+ switch (st->arg[0]) {
+ case am_minor: st->type = ERTS_PSTT_GC_MINOR; break;
+ case am_major: st->type = ERTS_PSTT_GC_MAJOR; break;
+ default: goto badarg;
+ }
+ noproc_res = am_false;
+ if (!rp)
goto noproc;
break;
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)
- goto badarg;
noproc_res = am_false;
st->type = ERTS_PSTT_CPC;
if (!rp)
goto noproc;
+#ifdef ERTS_DIRTY_SCHEDULERS
+ /*
+ * If the process should start executing dirty
+ * code it is important that this task is
+ * aborted. Therefore this strict fail state...
+ */
+ fail_state |= (ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS);
+#endif
+ break;
+
+ case am_copy_literals:
+ if (st->arg[0] != am_true && st->arg[0] != am_false)
+ goto badarg;
+ st->type = ERTS_PSTT_CLA;
+ noproc_res = am_ok;
+ if (!rp)
+ goto noproc;
break;
default:
goto badarg;
}
- rp_state = erts_smp_atomic32_read_nob(&rp->state);
+ if (!schedule_process_sys_task(rp, prio, st, &fail_state)) {
+ Eterm failure;
+ if (fail_state & ERTS_PSFLG_EXITING) {
+ noproc:
+ failure = noproc_res;
+ }
+#ifdef ERTS_DIRTY_SCHEDULERS
+ else if (fail_state & (ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS)) {
+ ret = dispatch_system_task(c_p, fail_state, st,
+ target, priority, operation);
+ goto cleanup_return;
+ }
+#endif
+ else {
+ ERTS_INTERNAL_ERROR("Unknown failure schedule_process_sys_task()");
+ failure = am_internal_error;
+ }
+ notify_sys_task_executed(c_p, st, failure, 1);
+ }
- rp_locked = 0;
+ ERTS_BIF_PREP_RET(ret, am_ok);
- 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;
- }
+ return ret;
- if (!rp_locked) {
- rp_locked = 1;
- erts_smp_proc_lock(rp, ERTS_PROC_LOCK_STATUS);
+badarg:
- 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;
- }
- }
+ ERTS_BIF_PREP_ERROR(ret, c_p, BADARG);
- if (!rp->sys_task_qs) {
- if (stqs)
- rp->sys_task_qs = stqs;
- else
- goto alloc_qs;
+#ifdef ERTS_DIRTY_SCHEDULERS
+cleanup_return:
+#endif
+
+ if (st) {
+ erts_cleanup_offheap(&st->off_heap);
+ erts_free(ERTS_ALC_T_PROC_SYS_TSK, st);
}
- 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));
- }
+
+ return ret;
+}
+
+BIF_RETTYPE
+erts_internal_request_system_task_3(BIF_ALIST_3)
+{
+ return request_system_task(BIF_P, BIF_P->common.id,
+ BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+}
+
+BIF_RETTYPE
+erts_internal_request_system_task_4(BIF_ALIST_4)
+{
+ return request_system_task(BIF_P, BIF_ARG_1,
+ BIF_ARG_2, BIF_ARG_3, BIF_ARG_4);
+}
+
+static void
+erts_schedule_generic_sys_task(Eterm pid, ErtsProcSysTaskType type, void* arg)
+{
+ Process *rp = erts_proc_lookup(pid);
+ if (rp) {
+ ErtsProcSysTask *st;
+ erts_aint32_t state, fail_state;
+
+ st = erts_alloc(ERTS_ALC_T_PROC_SYS_TSK,
+ ERTS_PROC_SYS_TASK_SIZE(0));
+ st->type = type;
+ st->requester = NIL;
+ st->reply_tag = NIL;
+ st->req_id = NIL;
+ st->req_id_sz = 0;
+ st->arg[0] = (Eterm)arg;
+ ERTS_INIT_OFF_HEAP(&st->off_heap);
+ state = erts_smp_atomic32_read_nob(&rp->state);
+
+ fail_state = ERTS_PSFLG_EXITING;
+
+ if (!schedule_process_sys_task(rp, ERTS_PSFLGS_GET_USR_PRIO(state),
+ st, &fail_state))
+ erts_free(ERTS_ALC_T_PROC_SYS_TSK, st);
}
+}
- 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;
+void
+erts_schedule_complete_off_heap_message_queue_change(Eterm pid)
+{
+ erts_schedule_generic_sys_task(pid, ERTS_PSTT_COHMQ, NULL);
+}
+
+void
+erts_schedule_ets_free_fixation(Eterm pid, DbFixation* fix)
+{
+ erts_schedule_generic_sys_task(pid, ERTS_PSTT_ETS_FREE_FIXATION, fix);
+}
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+
+static void
+flush_dirty_trace_messages(void *vpid)
+{
+ Process *proc;
+ Eterm pid;
+#ifdef ARCH_64
+ pid = (Eterm) vpid;
+#else
+ pid = *((Eterm *) vpid);
+ erts_free(ERTS_ALC_T_DIRTY_SL, vpid);
+#endif
+
+ proc = erts_pid2proc_opt(NULL, 0, pid, ERTS_PROC_LOCK_MAIN, 0);
+ if (proc) {
+ (void) erts_flush_trace_messages(proc, ERTS_PROC_LOCK_MAIN);
+ erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_MAIN);
}
+}
+
+#endif /* ERTS_DIRTY_SCHEDULERS */
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS);
+void
+erts_schedule_flush_trace_messages(Process *proc, int force_on_proc)
+{
+#ifdef ERTS_SMP
+ ErtsThrPrgrDelayHandle dhndl;
+#endif
+ Eterm pid = proc->common.id;
- schedule_process_sys_task(rp, rp_state, NULL);
+#ifdef ERTS_DIRTY_SCHEDULERS
+ erts_aint32_t state;
- if (free_stqs)
- proc_sys_task_queues_free(free_stqs);
+ if (!force_on_proc) {
+ state = erts_smp_atomic32_read_nob(&proc->state);
+ if (state & (ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS)) {
+ goto sched_flush_dirty;
+ }
+ }
+#endif
- BIF_RET(am_ok);
+#ifdef ERTS_SMP
+ dhndl = erts_thr_progress_unmanaged_delay();
+#endif
-noproc:
+ erts_schedule_generic_sys_task(pid, ERTS_PSTT_FTMQ, NULL);
- notify_sys_task_executed(BIF_P, st, noproc_res);
- if (free_stqs)
- proc_sys_task_queues_free(free_stqs);
- BIF_RET(am_ok);
+#ifdef ERTS_SMP
+ erts_thr_progress_unmanaged_continue(dhndl);
+#endif
-badarg:
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (!force_on_proc) {
+ state = erts_smp_atomic32_read_mb(&proc->state);
+ if (state & (ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS)) {
+ void *vargp;
- if (st) {
- erts_cleanup_offheap(&st->off_heap);
- erts_free(ERTS_ALC_T_PROC_SYS_TSK, st);
+ sched_flush_dirty:
+ /*
+ * We traced 'proc' from another thread than
+ * it is executing on, and it is executing
+ * on a dirty scheduler. It might take a
+ * significant amount of time before it is
+ * scheduled out (where it gets opportunity
+ * to flush messages). We therefore schedule
+ * the flush on the first ordinary scheduler.
+ */
+
+#ifdef ARCH_64
+ vargp = (void *) pid;
+#else
+ {
+ Eterm *argp = erts_alloc(ERTS_ALC_T_DIRTY_SL, sizeof(Eterm));
+ *argp = pid;
+ vargp = (void *) argp;
+ }
+#endif
+ erts_schedule_misc_aux_work(1, flush_dirty_trace_messages, vargp);
+ }
}
- if (free_stqs)
- proc_sys_task_queues_free(free_stqs);
- BIF_ERROR(BIF_P, BADARG);
+#endif
}
static void
@@ -10007,7 +11874,7 @@ save_gc_task(Process *c_p, ErtsProcSysTask *st, int prio)
qs->q[PRIORITY_NORMAL] = NULL;
qs->q[PRIORITY_LOW] = NULL;
qs->q[prio] = st;
- (void) ERTS_PROC_SET_DELAYED_GC_TASK_QS(c_p, ERTS_PROC_LOCK_MAIN, qs);
+ (void) ERTS_PROC_SET_DELAYED_GC_TASK_QS(c_p, qs);
}
else {
if (!qs->q[prio]) {
@@ -10025,7 +11892,10 @@ save_gc_task(Process *c_p, ErtsProcSysTask *st, int prio)
}
state = erts_smp_atomic32_read_nob(&c_p->state);
- ASSERT((ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS) & state);
+ ASSERT((ERTS_PSFLG_RUNNING
+ | ERTS_PSFLG_RUNNING_SYS
+ | ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS) & state);
while (!(state & ERTS_PSFLG_DELAYED_SYS)
|| prio < ERTS_PSFLGS_GET_ACT_PRIO(state)) {
@@ -10043,6 +11913,15 @@ save_gc_task(Process *c_p, ErtsProcSysTask *st, int prio)
}
}
+#ifdef ERTS_DIRTY_SCHEDULERS
+static void
+save_dirty_task(Process *c_p, ErtsProcSysTask *st)
+{
+ st->next = c_p->dirty_sys_tasks;
+ c_p->dirty_sys_tasks = st;
+}
+#endif
+
int
erts_set_gc_state(Process *c_p, int enable)
{
@@ -10154,7 +12033,7 @@ erts_set_gc_state(Process *c_p, int enable)
erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_STATUS);
- (void) ERTS_PROC_SET_DELAYED_GC_TASK_QS(c_p, ERTS_PROC_LOCK_MAIN, NULL);
+ (void) ERTS_PROC_SET_DELAYED_GC_TASK_QS(c_p, NULL);
if (dgc_tsk_qs)
proc_sys_task_queues_free(dgc_tsk_qs);
@@ -10265,6 +12144,8 @@ erts_schedule_misc_op(void (*func)(void *), void *arg)
non_empty_runq(rq);
#endif
+ ERTS_RUNQ_FLGS_SET_NOB(rq, ERTS_RUNQ_FLG_MISC_OP);
+
erts_smp_runq_unlock(rq);
smp_notify_inc_runq(rq);
@@ -10295,6 +12176,9 @@ exec_misc_ops(ErtsRunQueue *rq)
rq->misc.end = NULL;
}
+ if (!rq->misc.start)
+ ERTS_RUNQ_FLGS_UNSET_NOB(rq, ERTS_RUNQ_FLG_MISC_OP);
+
erts_smp_runq_unlock(rq);
while (molp) {
@@ -10321,6 +12205,8 @@ erts_get_total_reductions(Uint *redsp, Uint *diffp)
Uint reds = 0;
ERTS_ATOMIC_FOREACH_RUNQ_X(rq,
+ erts_no_run_queues + ERTS_NUM_DIRTY_RUNQS,
+
reds += rq->procs.reductions,
if (redsp) *redsp = reds;
@@ -10350,12 +12236,18 @@ erts_get_exact_total_reductions(Process *c_p, Uint *redsp, Uint *diffp)
erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
}
+static void delete_process(Process* p);
+
void
erts_free_proc(Process *p)
{
#ifdef ERTS_SMP
erts_proc_lock_fin(p);
#endif
+ ASSERT(erts_smp_atomic32_read_nob(&p->state) & ERTS_PSFLG_FREE);
+ ASSERT(0 == erts_proc_read_refc(p));
+ if (p->flags & F_DELAYED_DEL_PROC)
+ delete_process(p);
erts_free(ERTS_ALC_T_PROC, (void *) p);
}
@@ -10371,6 +12263,10 @@ 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);
+ proc->dirty_sys_tasks = NULL;
+#endif
erts_smp_atomic32_init_relb(&proc->state, arg->state);
#ifdef ERTS_SMP
@@ -10398,7 +12294,7 @@ alloc_process(ErtsRunQueue *rq, erts_aint32_t state)
init_arg.run_queue = rq;
init_arg.state = state;
- ASSERT(((char *) p) == ((char *) &p->common));
+ ERTS_CT_ASSERT(offsetof(Process,common) == 0);
if (!erts_ptab_new_element(&erts_proc,
&p->common,
@@ -10408,6 +12304,8 @@ alloc_process(ErtsRunQueue *rq, erts_aint32_t state)
return NULL;
}
+ ASSERT(erts_proc_read_refc(p) > 0);
+
ASSERT(internal_pid_serial(p->common.id) <= ERTS_MAX_PID_SERIAL);
p->approx_started = erts_get_approx_time();
@@ -10429,6 +12327,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. */
@@ -10438,10 +12337,16 @@ 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;
+ ErtsProcLocks locks = ERTS_PROC_LOCKS_ALL;
+#ifdef SHCOPY_SPAWN
+ erts_shcopy_t info;
+ INITIALIZE_SHCOPY(info);
+#else
+ erts_literal_area_t litarea;
+ INITIALIZE_LITERAL_PURGE_AREA(litarea);
+#endif
-#ifdef ERTS_SMP
erts_smp_proc_lock(parent, ERTS_PROC_LOCKS_ALL_MINOR);
-#endif
/*
* Check for errors.
@@ -10457,6 +12362,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
int ix = so->scheduler-1;
ASSERT(0 <= ix && ix < erts_no_run_queues);
rq = ERTS_RUNQ_IX(ix);
+ /* Unsupported feature... */
state |= ERTS_PSFLG_BOUND;
}
prio = (erts_aint32_t) so->priority;
@@ -10465,6 +12371,17 @@ 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;
+ }
+
+ ASSERT((flags & F_ON_HEAP_MSGQ) || (flags & F_OFF_HEAP_MSGQ));
+
if (!rq)
rq = erts_get_runq_proc(parent);
@@ -10477,33 +12394,42 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
goto error;
}
-#ifdef BM_COUNTERS
- processes_busy++;
-#endif
- BM_COUNT(processes_spawned);
+ ASSERT((erts_smp_atomic32_read_nob(&p->state)
+ & ERTS_PSFLG_ON_HEAP_MSGQ)
+ || (erts_smp_atomic32_read_nob(&p->state)
+ & ERTS_PSFLG_OFF_HEAP_MSGQ));
- BM_SWAP_TIMER(system,size);
- arg_size = size_object(args);
- BM_SWAP_TIMER(size,system);
+#ifdef SHCOPY_SPAWN
+ arg_size = copy_shared_calculate(args, &info);
+#else
+ arg_size = size_object_litopt(args, &litarea);
+#endif
heap_need = arg_size;
- p->flags = erts_default_process_flags;
+ p->flags = flags;
+ p->static_flags = 0;
+ if (so->flags & SPO_SYSTEM_PROC)
+ p->static_flags |= ERTS_STC_FLG_SYSTEM_PROC;
if (so->flags & SPO_USE_ARGS) {
p->min_heap_size = so->min_heap_size;
p->min_vheap_size = so->min_vheap_size;
p->max_gen_gcs = so->max_gen_gcs;
+ MAX_HEAP_SIZE_SET(p, so->max_heap_size);
+ MAX_HEAP_SIZE_FLAGS_SET(p, so->max_heap_flags);
} else {
p->min_heap_size = H_MIN_SIZE;
p->min_vheap_size = BIN_VH_MIN_SIZE;
+ MAX_HEAP_SIZE_SET(p, H_MAX_SIZE);
+ MAX_HEAP_SIZE_FLAGS_SET(p, H_MAX_FLAGS);
p->max_gen_gcs = (Uint16) erts_smp_atomic32_read_nob(&erts_max_gen_gcs);
}
p->schedule_count = 0;
ASSERT(p->min_heap_size == erts_next_heap_size(p->min_heap_size, 0));
-
- p->initial[INITIAL_MOD] = mod;
- p->initial[INITIAL_FUN] = func;
- p->initial[INITIAL_ARI] = (Uint) arity;
+
+ p->u.initial.module = mod;
+ p->u.initial.function = func;
+ p->u.initial.arity = (Uint) arity;
/*
* Must initialize binary lists here before copying binaries to process.
@@ -10533,18 +12459,19 @@ 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;
/* No need to initialize p->fcalls. */
- p->current = p->initial+INITIAL_MOD;
+ p->current = &p->u.initial;
p->i = (BeamInstr *) beam_apply;
p->cp = (BeamInstr *) beam_apply+1;
@@ -10553,13 +12480,12 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
p->max_arg_reg = sizeof(p->def_arg_reg)/sizeof(p->def_arg_reg[0]);
p->arg_reg[0] = mod;
p->arg_reg[1] = func;
- BM_STOP_TIMER(system);
- BM_MESSAGE(args,p,parent);
- BM_START_TIMER(system);
- BM_SWAP_TIMER(system,copy);
- p->arg_reg[2] = copy_struct(args, arg_size, &p->htop, &p->off_heap);
- BM_MESSAGE_COPIED(arg_size);
- BM_SWAP_TIMER(copy,system);
+#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_litopt(args, arg_size, &p->htop, &p->off_heap, &litarea);
+#endif
p->arity = 3;
p->fvalue = NIL;
@@ -10567,11 +12493,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
p->ftrace = NIL;
p->reds = 0;
-#ifdef ERTS_SMP
- p->common.u.alive.ptimer = NULL;
-#else
- sys_memset(&p->common.u.alive.tm, 0, sizeof(ErlTimer));
-#endif
+ ERTS_PTMR_INIT(p);
p->common.u.alive.reg = NULL;
ERTS_P_LINKS(p) = NULL;
@@ -10591,21 +12513,23 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
: STORE_NC(&p->htop, &p->off_heap, parent->group_leader);
}
- erts_get_default_tracing(&ERTS_TRACE_FLAGS(p), &ERTS_TRACER_PROC(p));
+ erts_get_default_proc_tracing(&ERTS_TRACE_FLAGS(p), &ERTS_TRACER(p));
p->msg.first = NULL;
p->msg.last = &p->msg.first;
p->msg.save = &p->msg.first;
+ p->msg.saved_last = &p->msg.first;
p->msg.len = 0;
#ifdef ERTS_SMP
p->msg_inq.first = NULL;
p->msg_inq.last = &p->msg_inq.first;
p->msg_inq.len = 0;
#endif
- p->u.bif_timers = NULL;
+ p->bif_timers = NULL;
p->mbuf = NULL;
+ p->msg_frag = NULL;
p->mbuf_sz = 0;
- p->psd = NULL;
+ erts_smp_atomic_init_nob(&p->psd, (erts_aint_t) NULL);
p->dictionary = NULL;
p->seq_trace_lastcnt = 0;
p->seq_trace_clock = 0;
@@ -10623,21 +12547,60 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
p->last_old_htop = NULL;
#endif
+#ifdef ERTS_SMP
+ p->trace_msg_q = NULL;
+ p->scheduler_data = NULL;
+ p->suspendee = NIL;
+ p->pending_suspenders = NULL;
+ p->pending_exit.reason = THE_NON_VALUE;
+ p->pending_exit.bp = NULL;
+#endif
+
+#if !defined(NO_FPE_SIGNALS) || defined(HIPE)
+ p->fp_exception = 0;
+#endif
+
if (IS_TRACED(parent)) {
if (ERTS_TRACE_FLAGS(parent) & F_TRACE_SOS) {
ERTS_TRACE_FLAGS(p) |= (ERTS_TRACE_FLAGS(parent) & TRACEE_FLAGS);
- ERTS_TRACER_PROC(p) = ERTS_TRACER_PROC(parent);
- }
- if (ARE_TRACE_FLAGS_ON(parent, F_TRACE_PROCS)) {
- trace_proc_spawn(parent, p->common.id, mod, func, args);
+ erts_tracer_replace(&p->common, ERTS_TRACER(parent));
}
- if (ERTS_TRACE_FLAGS(parent) & F_TRACE_SOS1) {
+ if (ERTS_TRACE_FLAGS(parent) & F_TRACE_SOS1) {
/* Overrides TRACE_CHILDREN */
ERTS_TRACE_FLAGS(p) |= (ERTS_TRACE_FLAGS(parent) & TRACEE_FLAGS);
- ERTS_TRACER_PROC(p) = ERTS_TRACER_PROC(parent);
+ erts_tracer_replace(&p->common, ERTS_TRACER(parent));
ERTS_TRACE_FLAGS(p) &= ~(F_TRACE_SOS1 | F_TRACE_SOS);
ERTS_TRACE_FLAGS(parent) &= ~(F_TRACE_SOS1 | F_TRACE_SOS);
}
+ if (so->flags & SPO_LINK && ERTS_TRACE_FLAGS(parent) & (F_TRACE_SOL|F_TRACE_SOL1)) {
+ ERTS_TRACE_FLAGS(p) |= (ERTS_TRACE_FLAGS(parent)&TRACEE_FLAGS);
+ erts_tracer_replace(&p->common, ERTS_TRACER(parent));
+ if (ERTS_TRACE_FLAGS(parent) & F_TRACE_SOL1) {/*maybe override*/
+ ERTS_TRACE_FLAGS(p) &= ~(F_TRACE_SOL1 | F_TRACE_SOL);
+ ERTS_TRACE_FLAGS(parent) &= ~(F_TRACE_SOL1 | F_TRACE_SOL);
+ }
+ }
+ if (ARE_TRACE_FLAGS_ON(parent, F_TRACE_PROCS)) {
+ locks &= ~(ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE);
+ erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE);
+ erts_smp_proc_unlock(parent, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE);
+ trace_proc_spawn(parent, am_spawn, p->common.id, mod, func, args);
+ if (so->flags & SPO_LINK)
+ trace_proc(parent, locks, parent, am_link, p->common.id);
+ }
+ }
+
+ if (IS_TRACED_FL(p, F_TRACE_PROCS)) {
+ if ((locks & (ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE))
+ == (ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE)) {
+ /* This happens when parent was not traced, but child is */
+ locks &= ~(ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE);
+ erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE);
+ erts_smp_proc_unlock(parent, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE);
+ }
+ trace_proc_spawn(p, am_spawned, parent->common.id, mod, func, args);
+ if (so->flags & SPO_LINK)
+ trace_proc(p, locks, p, am_getting_linked, parent->common.id);
}
/*
@@ -10648,10 +12611,6 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
#ifdef DEBUG
int ret;
#endif
- if (IS_TRACED_FL(parent, F_TRACE_PROCS)) {
- trace_proc(parent, parent, am_link, p->common.id);
- }
-
#ifdef DEBUG
ret = erts_add_link(&ERTS_P_LINKS(parent), LINK_PID, p->common.id);
ASSERT(ret == 0);
@@ -10662,17 +12621,6 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
erts_add_link(&ERTS_P_LINKS(p), LINK_PID, parent->common.id);
#endif
- if (IS_TRACED(parent)) {
- if (ERTS_TRACE_FLAGS(parent) & (F_TRACE_SOL|F_TRACE_SOL1)) {
- ERTS_TRACE_FLAGS(p) |= (ERTS_TRACE_FLAGS(parent)&TRACEE_FLAGS);
- ERTS_TRACER_PROC(p) = ERTS_TRACER_PROC(parent); /*maybe steal*/
-
- if (ERTS_TRACE_FLAGS(parent) & F_TRACE_SOL1) {/*maybe override*/
- ERTS_TRACE_FLAGS(p) &= ~(F_TRACE_SOL1 | F_TRACE_SOL);
- ERTS_TRACE_FLAGS(parent) &= ~(F_TRACE_SOL1 | F_TRACE_SOL);
- }
- }
- }
}
/*
@@ -10687,19 +12635,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
so->mref = mref;
}
-#ifdef ERTS_SMP
- p->scheduler_data = NULL;
- p->suspendee = NIL;
- p->pending_suspenders = NULL;
- p->pending_exit.reason = THE_NON_VALUE;
- p->pending_exit.bp = NULL;
-#endif
-
-#if !defined(NO_FPE_SIGNALS) || defined(HIPE)
- p->fp_exception = 0;
-#endif
-
- erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL);
+ erts_smp_proc_unlock(p, locks);
res = p->common.id;
@@ -10707,23 +12643,27 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
* Schedule process for execution.
*/
- schedule_process(p, state);
+ erts_smp_proc_unlock(parent, locks & ERTS_PROC_LOCKS_ALL_MINOR);
+
+ schedule_process(p, state, 0);
VERBOSE(DEBUG_PROCESSES, ("Created a new process: %T\n",p->common.id));
#ifdef USE_VM_PROBES
if (DTRACE_ENABLED(process_spawn)) {
+ ErtsCodeMFA cmfa = {mod, func, arity};
DTRACE_CHARBUF(process_name, DTRACE_TERM_BUF_SIZE);
- DTRACE_CHARBUF(mfa, DTRACE_TERM_BUF_SIZE);
+ DTRACE_CHARBUF(mfa_buf, DTRACE_TERM_BUF_SIZE);
- dtrace_fun_decode(p, mod, func, arity, process_name, mfa);
- DTRACE2(process_spawn, process_name, mfa);
+ dtrace_fun_decode(p, &cmfa, process_name, mfa_buf);
+ DTRACE2(process_spawn, process_name, mfa_buf);
}
#endif
+ return res;
error:
- erts_smp_proc_unlock(parent, ERTS_PROC_LOCKS_ALL_MINOR);
+ erts_smp_proc_unlock(parent, locks & ERTS_PROC_LOCKS_ALL_MINOR);
return res;
}
@@ -10739,6 +12679,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;
@@ -10746,7 +12688,7 @@ void erts_init_empty_process(Process *p)
p->rcount = 0;
p->common.id = ERTS_INVALID_PID;
p->reds = 0;
- ERTS_TRACER_PROC(p) = NIL;
+ ERTS_TRACER(p) = erts_tracer_nil;
ERTS_TRACE_FLAGS(p) = F_INITIAL_TRACE_FLAGS;
p->group_leader = ERTS_INVALID_PID;
p->flags = 0;
@@ -10759,12 +12701,7 @@ 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;
-#ifdef ERTS_SMP
- p->common.u.alive.ptimer = NULL;
-#else
- memset(&(p->common.u.alive.tm), 0, sizeof(ErlTimer));
-#endif
+ ERTS_PTMR_INIT(p);
p->next = NULL;
p->off_heap.first = NULL;
p->off_heap.overhead = 0;
@@ -10775,8 +12712,9 @@ 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_smp_atomic_init_nob(&p->psd, (erts_aint_t) NULL);
ERTS_P_MONITORS(p) = NULL;
ERTS_P_LINKS(p) = NULL; /* List of links */
p->nodes_monitors = NULL;
@@ -10785,14 +12723,14 @@ void erts_init_empty_process(Process *p)
p->msg.last = &p->msg.first;
p->msg.save = &p->msg.first;
p->msg.len = 0;
- p->u.bif_timers = NULL;
+ p->bif_timers = NULL;
p->dictionary = NULL;
p->seq_trace_clock = 0;
p->seq_trace_lastcnt = 0;
p->seq_trace_token = NIL;
- p->initial[0] = 0;
- p->initial[1] = 0;
- p->initial[2] = 0;
+ p->u.initial.module = 0;
+ p->u.initial.function = 0;
+ p->u.initial.arity = 0;
p->catches = 0;
p->cp = NULL;
p->i = NULL;
@@ -10813,6 +12751,8 @@ void erts_init_empty_process(Process *p)
p->parent = NIL;
p->approx_started = 0;
+ p->static_flags = 0;
+
p->common.u.alive.started_interval = 0;
#ifdef HIPE
@@ -10827,6 +12767,10 @@ 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);
+ p->dirty_sys_tasks = NULL;
+#endif
erts_smp_atomic32_init_nob(&p->state, (erts_aint32_t) PRIORITY_NORMAL);
#ifdef ERTS_SMP
@@ -10858,9 +12802,11 @@ 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);
+ ASSERT(ERTS_TRACER_IS_NIL(ERTS_TRACER(p)));
ASSERT(ERTS_TRACE_FLAGS(p) == F_INITIAL_TRACE_FLAGS);
ASSERT(p->group_leader == ERTS_INVALID_PID);
ASSERT(p->next == NULL);
@@ -10877,7 +12823,7 @@ erts_debug_verify_clean_empty_process(Process* p)
ASSERT(p->suspend_monitors == NULL);
ASSERT(p->msg.first == NULL);
ASSERT(p->msg.len == 0);
- ASSERT(p->u.bif_timers == NULL);
+ ASSERT(p->bif_timers == NULL);
ASSERT(p->dictionary == NULL);
ASSERT(p->catches == 0);
ASSERT(p->cp == NULL);
@@ -10926,20 +12872,38 @@ erts_cleanup_empty_process(Process* p)
#endif
}
-/*
- * p must be the currently executing process.
- */
static void
delete_process(Process* p)
{
- ErlMessage* mp;
+ ErtsPSD *psd;
+ struct saved_calls *scb;
+ process_breakpoint_time_t *pbt;
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)));
+
+ scb = ERTS_PROC_SET_SAVED_CALLS_BUF(p, NULL);
+
+ if (scb) {
+ p->fcalls += CONTEXT_REDS; /* Reduction counting depends on this... */
+ erts_free(ERTS_ALC_T_CALLS_BUF, (void *) scb);
+ }
+
+ pbt = ERTS_PROC_SET_CALL_TIME(p, NULL);
+ if (pbt)
+ erts_free(ERTS_ALC_T_BPD, (void *) pbt);
+
+ erts_destroy_nif_export(p);
/* Cleanup psd */
- if (p->psd)
- erts_free(ERTS_ALC_T_PSD, p->psd);
+ psd = (ErtsPSD *) erts_smp_atomic_read_nob(&p->psd);
+
+ if (psd) {
+ erts_smp_atomic_set_nob(&p->psd, (erts_aint_t) NULL); /* Reduction counting depends on this... */
+ erts_free(ERTS_ALC_T_PSD, psd);
+ }
/* Clean binaries and funs */
erts_cleanup_offheap(&p->off_heap);
@@ -10958,16 +12922,12 @@ 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));
+ erts_deallocate_young_generation(p);
+
if (p->old_heap != NULL) {
#ifdef DEBUG
@@ -10979,34 +12939,11 @@ delete_process(Process* p)
(p->old_hend-p->old_heap)*sizeof(Eterm));
}
- /*
- * Free all pending message buffers.
- */
- if (p->mbuf != NULL) {
- free_message_buffer(p->mbuf);
- }
-
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);
@@ -11025,10 +12962,13 @@ 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);
+ &enq_prio,
+ ERTS_PROC_LOCKS_ALL);
p->fvalue = reason;
if (bp)
@@ -11040,13 +12980,26 @@ set_proc_exiting(Process *p,
*/
p->freason = EXTAG_EXIT;
KILL_CATCHES(p);
- cancel_timer(p);
p->i = (BeamInstr *) beam_exit;
- if (enqueue)
- add2runq(enqueue > 0 ? p : make_proxy_proc(NULL, p, enq_prio),
- state,
- enq_prio);
+#ifndef ERTS_SMP
+ if (state & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS)
+ && !(state & ERTS_PSFLG_GC)) {
+ /*
+ * I non smp case:
+ *
+ * Currently executing process might be sent an exit
+ * signal if it is traced by a port that it also is
+ * linked to, and the port terminates during the
+ * trace. In this case we want schedule out the
+ * process as quickly as possible in order to detect
+ * the event as fast as possible.
+ */
+ ERTS_VBUMP_ALL_REDS(p);
+ }
+#endif
+
+ add2runq(enqueue, enq_prio, p, state, NULL);
}
static ERTS_INLINE erts_aint32_t
@@ -11060,7 +13013,10 @@ set_proc_self_exiting(Process *c_p)
ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) == ERTS_PROC_LOCKS_ALL);
state = erts_smp_atomic32_read_nob(&c_p->state);
- ASSERT(state & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS));
+ ASSERT(state & (ERTS_PSFLG_RUNNING
+ |ERTS_PSFLG_RUNNING_SYS
+ | ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS));
#ifdef DEBUG
enqueue =
@@ -11069,7 +13025,8 @@ set_proc_self_exiting(Process *c_p)
ERTS_PSFLG_SUSPENDED|ERTS_PSFLG_PENDING_EXIT,
ERTS_PSFLG_EXITING|ERTS_PSFLG_ACTIVE,
&state,
- &enq_prio);
+ &enq_prio,
+ ERTS_PROC_LOCKS_ALL);
ASSERT(!enqueue);
return state;
@@ -11109,42 +13066,73 @@ erts_handle_pending_exit(Process *c_p, ErtsProcLocks locks)
erts_smp_proc_unlock(c_p, xlocks);
}
+static void save_pending_exiter(Process *p, ErtsProcList *plp);
+
static void
-handle_pending_exiters(ErtsProcList *pnd_xtrs)
+do_handle_pending_exiters(ErtsProcList *pnd_xtrs)
{
/* 'list' is expected to have been fetched (i.e. not a ring anymore) */
ErtsProcList *plp = pnd_xtrs;
while (plp) {
- ErtsProcList *free_plp;
- Process *p = erts_pid2proc(NULL, 0, plp->pid, ERTS_PROC_LOCKS_ALL);
+ ErtsProcList *next_plp = plp->next;
+ Process *p = erts_proc_lookup(plp->pid);
if (p) {
- if (erts_proclist_same(plp, p)) {
- erts_aint32_t state = erts_smp_atomic32_read_acqb(&p->state);
- if (!(state & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS))) {
- ASSERT(state & ERTS_PSFLG_PENDING_EXIT);
- erts_handle_pending_exit(p, ERTS_PROC_LOCKS_ALL);
+ erts_aint32_t state;
+ /*
+ * If the process is running on a normal scheduler, the
+ * pending exit will soon be detected and handled by the
+ * scheduler running the process (at schedule in/out).
+ */
+ if (erts_smp_proc_trylock(p, ERTS_PROC_LOCKS_ALL) != EBUSY) {
+ if (erts_proclist_same(plp, p)) {
+ state = erts_smp_atomic32_read_acqb(&p->state);
+ if (!(state & (ERTS_PSFLG_RUNNING
+ | ERTS_PSFLG_RUNNING_SYS
+ | ERTS_PSFLG_EXITING))) {
+ ASSERT(state & ERTS_PSFLG_PENDING_EXIT);
+ erts_handle_pending_exit(p, ERTS_PROC_LOCKS_ALL);
+ }
}
+ erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL);
+ }
+ else {
+ erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+ if (erts_proclist_same(plp, p)) {
+ state = erts_smp_atomic32_read_acqb(&p->state);
+ if (!(state & (ERTS_PSFLG_RUNNING
+ | ERTS_PSFLG_RUNNING_SYS
+ | ERTS_PSFLG_EXITING))) {
+ /*
+ * Save process and try to acquire all
+ * locks at a later time...
+ */
+ save_pending_exiter(p, plp);
+ plp = NULL;
+ }
+ }
+ erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
}
- erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL);
}
- free_plp = plp;
- plp = plp->next;
- proclist_destroy(free_plp);
+ if (plp)
+ proclist_destroy(plp);
+ plp = next_plp;
}
}
static void
-save_pending_exiter(Process *p)
+save_pending_exiter(Process *p, ErtsProcList *plp)
{
- ErtsProcList *plp;
+ ErtsSchedulerSleepInfo *ssi;
ErtsRunQueue *rq;
ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p));
- rq = erts_get_runq_current(NULL);
+ rq = RUNQ_READ_RQ(&p->run_queue);
+ ASSERT(rq && !ERTS_RUNQ_IX_IS_DIRTY(rq->ix));
- plp = proclist_create(p);
+ if (!plp)
+ plp = proclist_create(p);
erts_smp_runq_lock(rq);
@@ -11152,13 +13140,11 @@ save_pending_exiter(Process *p)
non_empty_runq(rq);
+ ssi = rq->scheduler->ssi;
+
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);
+
+ set_aux_work_flags_wakeup_nob(ssi, ERTS_SSI_AUX_WORK_PENDING_EXITERS);
}
#endif
@@ -11172,43 +13158,47 @@ 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
-#ifdef USE_VM_PROBES
- , NIL
#endif
- );
+ erts_queue_message(to, *to_locksp, mp, mess, am_system);
} 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);
- /* 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
-#ifdef USE_VM_PROBES
- , NIL
+#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, to);
+ temp_token = copy_struct(token, sz_token, &hp, ohp);
+ ERL_MESSAGE_TOKEN(mp) = temp_token;
+ erts_queue_message(to, *to_locksp, mp, mess, am_system);
}
}
@@ -11317,11 +13307,10 @@ 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)
+ /* have to release the status and trace lock in order to send the exit message */
+ erts_smp_proc_unlock(rp, *rp_locks & (ERTS_PROC_LOCKS_XSIG_SEND|ERTS_PROC_LOCK_TRACE));
+ *rp_locks &= ~(ERTS_PROC_LOCKS_XSIG_SEND|ERTS_PROC_LOCK_TRACE);
+ 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);
@@ -11349,32 +13338,53 @@ send_exit_signal(Process *c_p, /* current process if and only
}
set_proc_exiting(c_p, state, rsn, NULL);
}
- else if (!(state & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS))) {
+ else if (!(state & (ERTS_PSFLG_RUNNING
+ | ERTS_PSFLG_RUNNING_SYS
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS))) {
/* Process not running ... */
ErtsProcLocks need_locks = ~(*rp_locks) & ERTS_PROC_LOCKS_ALL;
+ ErlHeapFragment *bp = NULL;
+ Eterm rsn_cpy;
if (need_locks
&& erts_smp_proc_trylock(rp, need_locks) == EBUSY) {
/* ... but we havn't got all locks on it ... */
- save_pending_exiter(rp);
+ save_pending_exiter(rp, NULL);
/*
* The pending exit will be discovered when next
* process is scheduled in
*/
- goto set_pending_exit;
+ goto set_pending_exit;
}
+ /* ...and we have all locks on it... */
+ *rp_locks = ERTS_PROC_LOCKS_ALL;
+
+ state = erts_smp_atomic32_read_nob(&rp->state);
+
+ if (is_immed(rsn))
+ rsn_cpy = rsn;
else {
- /* ...and we have all locks on it... */
- *rp_locks = ERTS_PROC_LOCKS_ALL;
- set_proc_exiting(rp,
- state,
- (is_immed(rsn)
- ? rsn
- : copy_object(rsn, rp)),
- NULL);
+ Eterm *hp;
+ ErlOffHeap *ohp;
+ Uint rsn_sz = size_object(rsn);
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (state & ERTS_PSFLG_DIRTY_RUNNING) {
+ bp = new_message_buffer(rsn_sz);
+ ohp = &bp->off_heap;
+ hp = &bp->mem[0];
+ }
+ else
+#endif
+ {
+ hp = HAlloc(rp, rsn_sz);
+ ohp = &rp->off_heap;
+ }
+ rsn_cpy = copy_struct(rsn, rsn_sz, &hp, ohp);
}
+
+ set_proc_exiting(rp, state, rsn_cpy, bp);
}
else { /* Process running... */
-
+
/*
* The pending exit will be discovered when the process
* is scheduled out if not discovered earlier.
@@ -11396,8 +13406,35 @@ send_exit_signal(Process *c_p, /* current process if and only
&bp->off_heap);
rp->pending_exit.bp = bp;
}
- erts_smp_atomic32_read_bor_relb(&rp->state,
- ERTS_PSFLG_PENDING_EXIT);
+
+ /*
+ * If no dirty work has been scheduled, pending exit will
+ * be discovered when the process is scheduled. If dirty work
+ * has been scheduled, we may need to add it to a normal run
+ * queue...
+ */
+#ifndef ERTS_DIRTY_SCHEDULERS
+ (void) erts_smp_atomic32_read_bor_relb(&rp->state,
+ ERTS_PSFLG_PENDING_EXIT);
+#else
+ {
+ erts_aint32_t a = erts_smp_atomic32_read_nob(&rp->state);
+ while (1) {
+ erts_aint32_t n, e;
+ int dwork;
+ n = e = a;
+ n |= ERTS_PSFLG_PENDING_EXIT;
+ dwork = !!(n & ERTS_PSFLGS_DIRTY_WORK);
+ n &= ~ERTS_PSFLGS_DIRTY_WORK;
+ a = erts_smp_atomic32_cmpxchg_mb(&rp->state, n, e);
+ if (a == e) {
+ if (dwork)
+ erts_schedule_process(rp, n, *rp_locks);
+ break;
+ }
+ }
+ }
+#endif
}
}
/* else:
@@ -11459,13 +13496,13 @@ static void doit_exit_monitor(ErtsMonitor *mon, void *vpcontext)
ExitMonitorContext *pcontext = vpcontext;
DistEntry *dep;
ErtsMonitor *rmon;
- Process *rp;
- if (mon->type == MON_ORIGIN) {
+ switch (mon->type) {
+ case MON_ORIGIN:
/* We are monitoring someone else, we need to demonitor that one.. */
- if (is_atom(mon->pid)) { /* remote by name */
- ASSERT(is_node_name_atom(mon->pid));
- dep = erts_sysname_to_connected_dist_entry(mon->pid);
+ if (is_atom(mon->u.pid)) { /* remote by name */
+ ASSERT(is_node_name_atom(mon->u.pid));
+ dep = erts_sysname_to_connected_dist_entry(mon->u.pid);
if (dep) {
erts_smp_de_links_lock(dep);
rmon = erts_remove_monitor(&(dep->monitors), mon->ref);
@@ -11476,7 +13513,7 @@ static void doit_exit_monitor(ErtsMonitor *mon, void *vpcontext)
ERTS_DSP_NO_LOCK, 0);
if (code == ERTS_DSIG_PREP_CONNECTED) {
code = erts_dsig_send_demonitor(&dsd,
- rmon->pid,
+ rmon->u.pid,
mon->name,
mon->ref,
1);
@@ -11487,9 +13524,10 @@ static void doit_exit_monitor(ErtsMonitor *mon, void *vpcontext)
erts_deref_dist_entry(dep);
}
} else {
- ASSERT(is_pid(mon->pid));
- if (is_internal_pid(mon->pid)) { /* local by pid or name */
- rp = erts_pid2proc(NULL, 0, mon->pid, ERTS_PROC_LOCK_LINK);
+ ASSERT(is_pid(mon->u.pid) || is_port(mon->u.pid));
+ /* if is local by pid or name */
+ if (is_internal_pid(mon->u.pid)) {
+ Process *rp = erts_pid2proc(NULL, 0, mon->u.pid, ERTS_PROC_LOCK_LINK);
if (!rp) {
goto done;
}
@@ -11499,9 +13537,18 @@ static void doit_exit_monitor(ErtsMonitor *mon, void *vpcontext)
goto done;
}
erts_destroy_monitor(rmon);
- } else { /* remote by pid */
- ASSERT(is_external_pid(mon->pid));
- dep = external_pid_dist_entry(mon->pid);
+ } else if (is_internal_port(mon->u.pid)) {
+ /* Is a local port */
+ Port *prt = erts_port_lookup_raw(mon->u.pid);
+ if (!prt) {
+ goto done;
+ }
+ erts_port_demonitor(pcontext->p,
+ ERTS_PORT_DEMONITOR_ORIGIN_ON_DEATHBED,
+ prt, mon->ref, NULL);
+ } else { /* remote by pid */
+ ASSERT(is_external_pid(mon->u.pid));
+ dep = external_pid_dist_entry(mon->u.pid);
ASSERT(dep != NULL);
if (dep) {
erts_smp_de_links_lock(dep);
@@ -11513,8 +13560,8 @@ static void doit_exit_monitor(ErtsMonitor *mon, void *vpcontext)
ERTS_DSP_NO_LOCK, 0);
if (code == ERTS_DSIG_PREP_CONNECTED) {
code = erts_dsig_send_demonitor(&dsd,
- rmon->pid,
- mon->pid,
+ rmon->u.pid,
+ mon->u.pid,
mon->ref,
1);
ASSERT(code == ERTS_DSIG_SEND_OK);
@@ -11524,22 +13571,23 @@ static void doit_exit_monitor(ErtsMonitor *mon, void *vpcontext)
}
}
}
- } else { /* type == MON_TARGET */
- ASSERT(mon->type == MON_TARGET);
- ASSERT(is_pid(mon->pid) || is_internal_port(mon->pid));
- if (is_internal_port(mon->pid)) {
- Port *prt = erts_id2port(mon->pid);
+ break;
+ case MON_TARGET:
+ ASSERT(is_pid(mon->u.pid) || is_internal_port(mon->u.pid));
+ if (is_internal_port(mon->u.pid)) {
+ Port *prt = erts_id2port(mon->u.pid);
if (prt == NULL) {
goto done;
}
erts_fire_port_monitor(prt, mon->ref);
erts_port_release(prt);
- } else if (is_internal_pid(mon->pid)) {/* local by name or pid */
+ } else if (is_internal_pid(mon->u.pid)) {/* local by name or pid */
Eterm watched;
+ Process *rp;
DeclareTmpHeapNoproc(lhp,3);
ErtsProcLocks rp_locks = (ERTS_PROC_LOCK_LINK
| ERTS_PROC_LOCKS_MSG_SEND);
- rp = erts_pid2proc(NULL, 0, mon->pid, rp_locks);
+ rp = erts_pid2proc(NULL, 0, mon->u.pid, rp_locks);
if (rp == NULL) {
goto done;
}
@@ -11558,8 +13606,8 @@ static void doit_exit_monitor(ErtsMonitor *mon, void *vpcontext)
/* else: demonitor while we exited, i.e. do nothing... */
erts_smp_proc_unlock(rp, rp_locks);
} else { /* external by pid or name */
- ASSERT(is_external_pid(mon->pid));
- dep = external_pid_dist_entry(mon->pid);
+ ASSERT(is_external_pid(mon->u.pid));
+ dep = external_pid_dist_entry(mon->u.pid);
ASSERT(dep != NULL);
if (dep) {
erts_smp_de_links_lock(dep);
@@ -11571,10 +13619,10 @@ static void doit_exit_monitor(ErtsMonitor *mon, void *vpcontext)
ERTS_DSP_NO_LOCK, 0);
if (code == ERTS_DSIG_PREP_CONNECTED) {
code = erts_dsig_send_m_exit(&dsd,
- mon->pid,
+ mon->u.pid,
(rmon->name != NIL
? rmon->name
- : rmon->pid),
+ : rmon->u.pid),
mon->ref,
pcontext->reason);
ASSERT(code == ERTS_DSIG_SEND_OK);
@@ -11583,6 +13631,17 @@ static void doit_exit_monitor(ErtsMonitor *mon, void *vpcontext)
}
}
}
+ break;
+ case MON_NIF_TARGET:
+ erts_fire_nif_monitor(mon->u.resource,
+ pcontext->p->common.id,
+ mon->ref);
+ break;
+ case MON_TIME_OFFSET:
+ erts_demonitor_time_offset(mon->ref);
+ break;
+ default:
+ ERTS_INTERNAL_ERROR("Invalid monitor type");
}
done:
/* As the monitors are previously removed from the process,
@@ -11612,6 +13671,7 @@ static void doit_exit_link(ErtsLink *lnk, void *vpcontext)
DistEntry *dep;
Process *rp;
+
switch(lnk->type) {
case LINK_PID:
if(is_internal_port(item)) {
@@ -11659,7 +13719,11 @@ static void doit_exit_link(ErtsLink *lnk, void *vpcontext)
if (xres >= 0 && IS_TRACED_FL(rp, F_TRACE_PROCS)) {
/* We didn't exit the process and it is traced */
if (IS_TRACED_FL(rp, F_TRACE_PROCS)) {
- trace_proc(p, rp, am_getting_unlinked, p->common.id);
+ if (rp_locks & ERTS_PROC_LOCKS_XSIG_SEND) {
+ erts_smp_proc_unlock(rp, ERTS_PROC_LOCKS_XSIG_SEND);
+ rp_locks &= ~ERTS_PROC_LOCKS_XSIG_SEND;
+ }
+ trace_proc(NULL, 0, rp, am_getting_unlinked, p->common.id);
}
}
}
@@ -11702,7 +13766,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);
@@ -11714,8 +13778,9 @@ resume_suspend_monitor(ErtsSuspendMonitor *smon, void *vc_p)
Process *suspendee = erts_pid2proc((Process *) vc_p, ERTS_PROC_LOCK_MAIN,
smon->pid, ERTS_PROC_LOCK_STATUS);
if (suspendee) {
+ ASSERT(suspendee != vc_p);
if (smon->active)
- resume_process(suspendee);
+ resume_process(suspendee, ERTS_PROC_LOCK_STATUS);
erts_smp_proc_unlock(suspendee, ERTS_PROC_LOCK_STATUS);
}
erts_destroy_suspend_monitor(smon);
@@ -11728,6 +13793,7 @@ erts_do_exit_process(Process* p, Eterm reason)
{
p->arity = 0; /* No live registers */
p->fvalue = reason;
+
#ifdef USE_VM_PROBES
if (DTRACE_ENABLED(process_exit)) {
@@ -11740,6 +13806,10 @@ erts_do_exit_process(Process* p, Eterm reason)
}
#endif
+ if (p->static_flags & ERTS_STC_FLG_SYSTEM_PROC)
+ erts_exit(ERTS_DUMP_EXIT, "System process %T terminated: %T\n",
+ p->common.id, reason);
+
#ifdef ERTS_SMP
ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p);
/* By locking all locks (main lock is already locked) when going
@@ -11770,8 +13840,6 @@ erts_do_exit_process(Process* p, Eterm reason)
if (IS_TRACED_FL(p, F_TRACE_CALLS))
erts_schedule_time_break(p, ERTS_BP_CALL_TIME_SCHEDULE_EXITING);
- if (IS_TRACED_FL(p,F_TRACE_PROCS))
- trace_proc(p, p, am_exit, reason);
}
erts_trace_check_exiting(p->common.id);
@@ -11779,20 +13847,24 @@ erts_do_exit_process(Process* p, Eterm reason)
ASSERT((ERTS_TRACE_FLAGS(p) & F_INITIAL_TRACE_FLAGS)
== F_INITIAL_TRACE_FLAGS);
- cancel_timer(p); /* Always cancel timer just in case */
-
- if (p->u.bif_timers)
- erts_cancel_bif_timers(p, ERTS_PROC_LOCKS_ALL);
+ ASSERT(erts_proc_read_refc(p) > 0);
+ if (ERTS_PTMR_IS_SET(p)) {
+ erts_cancel_proc_timer(p);
+ ASSERT(erts_proc_read_refc(p) > 0);
+ }
erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL_MINOR);
+ if (IS_TRACED_FL(p,F_TRACE_PROCS))
+ trace_proc(p, ERTS_PROC_LOCK_MAIN, p, am_exit, reason);
+
+
/*
- * The p->u.bif_timers of this process can *not* be used anymore;
+ * p->u.initial of this process can *not* be used anymore;
* will be overwritten by misc termination data.
*/
p->u.terminate = NULL;
-
erts_continue_exit_process(p);
}
@@ -11804,9 +13876,8 @@ erts_continue_exit_process(Process *p)
ErtsProcLocks curr_locks = ERTS_PROC_LOCK_MAIN;
Eterm reason = p->fvalue;
DistEntry *dep;
- struct saved_calls *scb;
- process_breakpoint_time_t *pbt;
erts_aint32_t state;
+ int delay_del_proc = 0;
#ifdef DEBUG
int yield_allowed = 1;
@@ -11816,22 +13887,57 @@ erts_continue_exit_process(Process *p)
ASSERT(ERTS_PROC_IS_EXITING(p));
+ ASSERT(erts_proc_read_refc(p) > 0);
+ if (p->bif_timers) {
+ if (erts_cancel_bif_timers(p, &p->bif_timers, &p->u.terminate)) {
+ ASSERT(erts_proc_read_refc(p) > 0);
+ goto yield;
+ }
+ ASSERT(erts_proc_read_refc(p) > 0);
+ p->bif_timers = NULL;
+ }
+
#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:
- 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);
+ }
+ }
+ 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:
+ erts_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error: %d\n",
__FILE__, __LINE__, (int) ssr);
}
}
@@ -11845,11 +13951,25 @@ erts_continue_exit_process(Process *p)
erts_set_gc_state(p, 1);
state = erts_smp_atomic32_read_acqb(&p->state);
- if (state & ERTS_PSFLG_ACTIVE_SYS) {
+ if (state & ERTS_PSFLG_ACTIVE_SYS
+#ifdef ERTS_DIRTY_SCHEDULERS
+ || p->dirty_sys_tasks
+#endif
+ ) {
if (cleanup_sys_tasks(p, state, CONTEXT_REDS) >= CONTEXT_REDS/2)
goto yield;
}
+#ifdef DEBUG
+ erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+ ASSERT(p->sys_task_qs == NULL);
+ ASSERT(ERTS_PROC_GET_DELAYED_GC_TASK_QS(p) == NULL);
+#ifdef ERTS_DIRTY_SCHEDULERS
+ ASSERT(p->dirty_sys_tasks == NULL);
+#endif
+ erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+#endif
+
if (p->flags & F_USING_DDLL) {
erts_ddll_proc_dead(p, ERTS_PROC_LOCK_MAIN);
p->flags &= ~F_USING_DDLL;
@@ -11877,6 +13997,9 @@ erts_continue_exit_process(Process *p)
ASSERT(!p->common.u.alive.reg);
}
+ if (IS_TRACED_FL(p, F_TRACE_SCHED_EXIT))
+ trace_sched(p, curr_locks, am_out_exited);
+
erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR);
curr_locks = ERTS_PROC_LOCKS_ALL;
@@ -11898,7 +14021,7 @@ erts_continue_exit_process(Process *p)
{
/* Do *not* use erts_get_runq_proc() */
ErtsRunQueue *rq;
- rq = erts_get_runq_current(ERTS_GET_SCHEDULER_DATA_FROM_PROC(p));
+ rq = erts_get_runq_current(erts_proc_sched_data(p));
erts_smp_runq_lock(rq);
@@ -11909,6 +14032,8 @@ erts_continue_exit_process(Process *p)
p->scheduler_data->current_process = NULL;
p->scheduler_data->free_process = p;
+#else
+ erts_proc_inc_refc(p); /* Decremented in schedule() */
#endif
/* Time of death! */
@@ -11927,46 +14052,43 @@ erts_continue_exit_process(Process *p)
{
/* Inactivate and notify free */
erts_aint32_t n, e, a = erts_smp_atomic32_read_nob(&p->state);
-#ifdef ERTS_SMP
int refc_inced = 0;
-#endif
while (1) {
n = e = a;
ASSERT(a & ERTS_PSFLG_EXITING);
n |= ERTS_PSFLG_FREE;
n &= ~ERTS_PSFLG_ACTIVE;
-#ifdef ERTS_SMP
if ((n & ERTS_PSFLG_IN_RUNQ) && !refc_inced) {
- erts_smp_proc_inc_refc(p);
+ erts_proc_inc_refc(p);
refc_inced = 1;
}
-#endif
a = erts_smp_atomic32_cmpxchg_mb(&p->state, n, e);
if (a == e)
break;
}
-#ifdef ERTS_SMP
- if (refc_inced && !(n & ERTS_PSFLG_IN_RUNQ))
- erts_smp_proc_dec_refc(p);
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (a & (ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS)) {
+ p->flags |= F_DELAYED_DEL_PROC;
+ delay_del_proc = 1;
+ /*
+ * The dirty scheduler decrease refc
+ * when done with the process...
+ */
+ }
#endif
+
+ if (refc_inced && !(n & ERTS_PSFLG_IN_RUNQ))
+ erts_proc_dec_refc(p);
}
- dep = ((p->flags & F_DISTRIBUTION)
- ? ERTS_PROC_SET_DIST_ENTRY(p, ERTS_PROC_LOCKS_ALL, NULL)
- : 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);
+ dep = (p->flags & F_DISTRIBUTION) ? erts_this_dist_entry : NULL;
erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL);
-#ifdef BM_COUNTERS
- processes_busy--;
-#endif
if (dep) {
erts_do_net_exits(dep, reason);
- if(dep)
- erts_deref_dist_entry(dep);
}
/*
@@ -11998,19 +14120,18 @@ erts_continue_exit_process(Process *p)
have none here */
}
- if (scb)
- erts_free(ERTS_ALC_T_CALLS_BUF, (void *) scb);
-
- if (pbt)
- erts_free(ERTS_ALC_T_BPD, (void *) pbt);
-
- delete_process(p);
-
-#ifdef ERTS_SMP
erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p);
+
+#ifdef ERTS_SMP
+ erts_flush_trace_messages(p, ERTS_PROC_LOCK_MAIN);
#endif
+ ERTS_TRACER_CLEAR(&ERTS_TRACER(p));
+
+ if (!delay_del_proc)
+ delete_process(p);
+
return;
yield:
@@ -12034,64 +14155,7 @@ erts_continue_exit_process(Process *p)
ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN == erts_proc_lc_my_proc_locks(p));
-}
-
-/* Callback for process timeout */
-static void
-timeout_proc(Process* p)
-{
- erts_aint32_t state;
- BeamInstr** pi = (BeamInstr **) p->def_arg_reg;
- p->i = *pi;
- p->flags |= F_TIMO;
- p->flags &= ~F_INSLPQUEUE;
-
- state = erts_smp_atomic32_read_acqb(&p->state);
- if (!(state & ERTS_PSFLG_ACTIVE))
- schedule_process(p, state);
-}
-
-
-void
-cancel_timer(Process* p)
-{
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p));
- p->flags &= ~(F_INSLPQUEUE|F_TIMO);
-#ifdef ERTS_SMP
- erts_cancel_smp_ptimer(p->common.u.alive.ptimer);
-#else
- erts_cancel_timer(&p->common.u.alive.tm);
-#endif
-}
-
-/*
- * Insert a process into the time queue, with a timeout 'timeout' in ms.
- */
-void
-set_timer(Process* p, Uint timeout)
-{
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p));
-
- /* check for special case timeout=0 DONT ADD TO time queue */
- if (timeout == 0) {
- p->flags |= F_TIMO;
- return;
- }
- p->flags |= F_INSLPQUEUE;
- p->flags &= ~F_TIMO;
-
-#ifdef ERTS_SMP
- erts_create_smp_ptimer(&p->common.u.alive.ptimer,
- p->common.id,
- (ErlTimeoutProc) timeout_proc,
- timeout);
-#else
- erts_set_timer(&p->common.u.alive.tm,
- (ErlTimeoutProc) timeout_proc,
- NULL,
- (void*) p,
- timeout);
-#endif
+ BUMP_ALL_REDS(p);
}
/*
@@ -12099,7 +14163,7 @@ set_timer(Process* p, Uint timeout)
*/
void
-erts_stack_dump(int to, void *to_arg, Process *p)
+erts_stack_dump(fmtfn_t to, void *to_arg, Process *p)
{
Eterm* sp;
int yreg = -1;
@@ -12109,12 +14173,12 @@ erts_stack_dump(int to, void *to_arg, Process *p)
}
erts_program_counter_info(to, to_arg, p);
for (sp = p->stop; sp < STACK_START(p); sp++) {
- yreg = stack_element_dump(to, to_arg, p, sp, yreg);
+ yreg = stack_element_dump(to, to_arg, sp, yreg);
}
}
void
-erts_program_counter_info(int to, void *to_arg, Process *p)
+erts_program_counter_info(fmtfn_t to, void *to_arg, Process *p)
{
erts_aint32_t state;
int i;
@@ -12144,10 +14208,10 @@ erts_program_counter_info(int to, void *to_arg, Process *p)
}
static void
-print_function_from_pc(int to, void *to_arg, BeamInstr* x)
+print_function_from_pc(fmtfn_t to, void *to_arg, BeamInstr* x)
{
- BeamInstr* addr = find_function_from_pc(x);
- if (addr == NULL) {
+ ErtsCodeMFA *cmfa = find_function_from_pc(x);
+ if (cmfa == NULL) {
if (x == beam_exit) {
erts_print(to, to_arg, "<terminate process>");
} else if (x == beam_continue_exit) {
@@ -12161,12 +14225,13 @@ print_function_from_pc(int to, void *to_arg, BeamInstr* x)
}
} else {
erts_print(to, to_arg, "%T:%T/%d + %d",
- addr[0], addr[1], addr[2], ((x-addr)-2) * sizeof(Eterm));
+ cmfa->module, cmfa->function, cmfa->arity,
+ (x-(BeamInstr*)cmfa) * sizeof(Eterm));
}
}
static int
-stack_element_dump(int to, void *to_arg, Process* p, Eterm* sp, int yreg)
+stack_element_dump(fmtfn_t to, void *to_arg, Eterm* sp, int yreg)
{
Eterm x = *sp;
@@ -12180,7 +14245,7 @@ stack_element_dump(int to, void *to_arg, Process* p, 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;
@@ -12195,30 +14260,220 @@ stack_element_dump(int to, void *to_arg, Process* p, Eterm* sp, int yreg)
}
/*
+ * Print scheduler information
+ */
+void
+erts_print_scheduler_info(fmtfn_t to, void *to_arg, ErtsSchedulerData *esdp) {
+ int i;
+ erts_aint32_t flg;
+ Process *p;
+
+ erts_print(to, to_arg, "=scheduler:%u\n", esdp->no);
+
+#ifdef ERTS_SMP
+ flg = erts_smp_atomic32_read_dirty(&esdp->ssi->flags);
+ erts_print(to, to_arg, "Scheduler Sleep Info Flags: ");
+ for (i = 0; i < ERTS_SSI_FLGS_MAX && flg; i++) {
+ erts_aint32_t chk = (1 << i);
+ if (flg & chk) {
+ switch (chk) {
+ case ERTS_SSI_FLG_SLEEPING:
+ erts_print(to, to_arg, "SLEEPING"); break;
+ case ERTS_SSI_FLG_POLL_SLEEPING:
+ erts_print(to, to_arg, "POLL_SLEEPING"); break;
+ case ERTS_SSI_FLG_TSE_SLEEPING:
+ erts_print(to, to_arg, "TSE_SLEEPING"); break;
+ case ERTS_SSI_FLG_WAITING:
+ erts_print(to, to_arg, "WAITING"); break;
+ case ERTS_SSI_FLG_SUSPENDED:
+ erts_print(to, to_arg, "SUSPENDED"); break;
+ case ERTS_SSI_FLG_MSB_EXEC:
+ erts_print(to, to_arg, "MSB_EXEC"); break;
+ default:
+ erts_print(to, to_arg, "UNKNOWN(%d)", flg); break;
+ }
+ if (flg > chk)
+ erts_print(to, to_arg, " | ");
+ flg -= chk;
+ }
+ }
+ erts_print(to, to_arg, "\n");
+#endif
+
+ flg = erts_atomic32_read_dirty(&esdp->ssi->aux_work);
+ erts_print(to, to_arg, "Scheduler Sleep Info Aux Work: ");
+ for (i = 0; i < ERTS_SSI_AUX_WORK_NO_FLAGS && flg; i++) {
+ erts_aint32_t chk = (1 << i);
+ if (flg & chk) {
+ if (erts_aux_work_flag_descr[i])
+ erts_print(to, to_arg, "%s", erts_aux_work_flag_descr[i]);
+ else
+ erts_print(to, to_arg, "1<<%d", i);
+ if (flg > chk)
+ erts_print(to, to_arg, " | ");
+ flg -= chk;
+ }
+ }
+ erts_print(to, to_arg, "\n");
+
+ erts_print(to, to_arg, "Current Port: ");
+ if (esdp->current_port)
+ erts_print(to, to_arg, "%T", esdp->current_port->common.id);
+ erts_print(to, to_arg, "\n");
+
+ for (i = 0; i < ERTS_NO_PROC_PRIO_LEVELS; i++) {
+ erts_print(to, to_arg, "Run Queue ");
+ switch (i) {
+ case PRIORITY_MAX:
+ erts_print(to, to_arg, "Max ");
+ break;
+ case PRIORITY_HIGH:
+ erts_print(to, to_arg, "High ");
+ break;
+ case PRIORITY_NORMAL:
+ erts_print(to, to_arg, "Normal ");
+ break;
+ case PRIORITY_LOW:
+ erts_print(to, to_arg, "Low ");
+ break;
+ default:
+ erts_print(to, to_arg, "Unknown ");
+ break;
+ }
+ erts_print(to, to_arg, "Length: %d\n",
+ erts_smp_atomic32_read_dirty(&esdp->run_queue->procs.prio_info[i].len));
+ }
+ erts_print(to, to_arg, "Run Queue Port Length: %d\n",
+ erts_smp_atomic32_read_dirty(&esdp->run_queue->ports.info.len));
+
+ flg = erts_smp_atomic32_read_dirty(&esdp->run_queue->flags);
+ erts_print(to, to_arg, "Run Queue Flags: ");
+ for (i = 0; i < ERTS_RUNQ_FLG_MAX && flg; i++) {
+ erts_aint32_t chk = (1 << i);
+ if (flg & chk) {
+ switch (chk) {
+ case (1 << PRIORITY_MAX):
+ erts_print(to, to_arg, "NONEMPTY_MAX"); break;
+ case (1 << PRIORITY_HIGH):
+ erts_print(to, to_arg, "NONEMPTY_HIGH"); break;
+ case (1 << PRIORITY_NORMAL):
+ erts_print(to, to_arg, "NONEMPTY_NORMAL"); break;
+ case (1 << PRIORITY_LOW):
+ erts_print(to, to_arg, "NONEMPTY_LOW"); break;
+ case (1 << (PRIORITY_MAX + ERTS_RUNQ_FLGS_EMIGRATE_SHFT)):
+ erts_print(to, to_arg, "EMIGRATE_MAX"); break;
+ case (1 << (PRIORITY_HIGH + ERTS_RUNQ_FLGS_EMIGRATE_SHFT)):
+ erts_print(to, to_arg, "EMIGRATE_HIGH"); break;
+ case (1 << (PRIORITY_NORMAL + ERTS_RUNQ_FLGS_EMIGRATE_SHFT)):
+ erts_print(to, to_arg, "EMIGRATE_NORMAL"); break;
+ case (1 << (PRIORITY_LOW + ERTS_RUNQ_FLGS_EMIGRATE_SHFT)):
+ erts_print(to, to_arg, "EMIGRATE_LOW"); break;
+ case (1 << (PRIORITY_MAX + ERTS_RUNQ_FLGS_IMMIGRATE_SHFT)):
+ erts_print(to, to_arg, "IMMIGRATE_MAX"); break;
+ case (1 << (PRIORITY_HIGH + ERTS_RUNQ_FLGS_IMMIGRATE_SHFT)):
+ erts_print(to, to_arg, "IMMIGRATE_HIGH"); break;
+ case (1 << (PRIORITY_NORMAL + ERTS_RUNQ_FLGS_IMMIGRATE_SHFT)):
+ erts_print(to, to_arg, "IMMIGRATE_NORMAL"); break;
+ case (1 << (PRIORITY_LOW + ERTS_RUNQ_FLGS_IMMIGRATE_SHFT)):
+ erts_print(to, to_arg, "IMMIGRATE_LOW"); break;
+ case (1 << (PRIORITY_MAX + ERTS_RUNQ_FLGS_EVACUATE_SHFT)):
+ erts_print(to, to_arg, "EVACUATE_MAX"); break;
+ case (1 << (PRIORITY_HIGH + ERTS_RUNQ_FLGS_EVACUATE_SHFT)):
+ erts_print(to, to_arg, "EVACUATE_HIGH"); break;
+ case (1 << (PRIORITY_NORMAL + ERTS_RUNQ_FLGS_EVACUATE_SHFT)):
+ erts_print(to, to_arg, "EVACUATE_NORMAL"); break;
+ case (1 << (PRIORITY_LOW + ERTS_RUNQ_FLGS_EVACUATE_SHFT)):
+ erts_print(to, to_arg, "EVACUATE_LOW"); break;
+ case ERTS_RUNQ_FLG_OUT_OF_WORK:
+ erts_print(to, to_arg, "OUT_OF_WORK"); break;
+ case ERTS_RUNQ_FLG_HALFTIME_OUT_OF_WORK:
+ erts_print(to, to_arg, "HALFTIME_OUT_OF_WORK"); break;
+ case ERTS_RUNQ_FLG_SUSPENDED:
+ erts_print(to, to_arg, "SUSPENDED"); break;
+ case ERTS_RUNQ_FLG_CHK_CPU_BIND:
+ erts_print(to, to_arg, "CHK_CPU_BIND"); break;
+ case ERTS_RUNQ_FLG_INACTIVE:
+ erts_print(to, to_arg, "INACTIVE"); break;
+ case ERTS_RUNQ_FLG_NONEMPTY:
+ erts_print(to, to_arg, "NONEMPTY"); break;
+ case ERTS_RUNQ_FLG_PROTECTED:
+ erts_print(to, to_arg, "PROTECTED"); break;
+ case ERTS_RUNQ_FLG_EXEC:
+ erts_print(to, to_arg, "EXEC"); break;
+ case ERTS_RUNQ_FLG_MSB_EXEC:
+ erts_print(to, to_arg, "MSB_EXEC"); break;
+ case ERTS_RUNQ_FLG_MISC_OP:
+ erts_print(to, to_arg, "MISC_OP"); break;
+ default:
+ erts_print(to, to_arg, "UNKNOWN(%d)", flg); break;
+ }
+ if (flg > chk)
+ erts_print(to, to_arg, " | ");
+ flg -= chk;
+ }
+ }
+ erts_print(to, to_arg, "\n");
+
+ /* This *MUST* to be the last information in scheduler block */
+ p = esdp->current_process;
+ erts_print(to, to_arg, "Current Process: ");
+ if (esdp->current_process && !(ERTS_TRACE_FLAGS(p) & F_SENSITIVE)) {
+ flg = erts_smp_atomic32_read_dirty(&p->state);
+ erts_print(to, to_arg, "%T\n", p->common.id);
+
+ erts_print(to, to_arg, "Current Process State: ");
+ erts_dump_process_state(to, to_arg, flg);
+
+ erts_print(to, to_arg, "Current Process Internal State: ");
+ erts_dump_extended_process_state(to, to_arg, flg);
+
+ erts_print(to, to_arg, "Current Process Program counter: %p (", p->i);
+ print_function_from_pc(to, to_arg, p->i);
+ erts_print(to, to_arg, ")\n");
+ erts_print(to, to_arg, "Current Process CP: %p (", p->cp);
+ print_function_from_pc(to, to_arg, p->cp);
+ erts_print(to, to_arg, ")\n");
+
+ /* Getting this stacktrace can segfault if we are very very
+ unlucky if called while a process is being garbage collected.
+ Therefore we only call this on other schedulers if we either
+ have protection against segfaults, or we know that the process
+ is not garbage collecting. It *should* always be safe to call
+ on a process owned by us, even if it is currently being garbage
+ collected.
+ */
+ erts_print(to, to_arg, "Current Process Limited Stack Trace:\n");
+ erts_limited_stack_trace(to, to_arg, p);
+ } else
+ erts_print(to, to_arg, "\n");
+
+}
+
+/*
* A nice system halt closing all open port goes as follows:
* 1) This function schedules the aux work ERTS_SSI_AUX_WORK_REAP_PORTS
* on all schedulers, then schedules itself out.
- * 2) All shedulers detect this and set the flag halt_in_progress
+ * 2) All shedulers detect this and set the flag ERTS_RUNQ_FLG_HALTING
* on their run queue. The last scheduler sets all non-closed ports
* ERTS_PORT_SFLG_HALT. Global atomic erts_halt_progress is used
* as refcount to determine which is last.
- * 3) While the run ques has flag halt_in_progress no processes
+ * 3) While the run queues has flag ERTS_RUNQ_FLG_HALTING no processes
* will be scheduled, only ports.
* 4) When the last port closes that scheduler calls erlang:halt/1.
* 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,
-1)) {
#ifdef ERTS_DIRTY_SCHEDULERS
- ERTS_DIRTY_CPU_RUNQ->halt_in_progress = 1;
- ERTS_DIRTY_IO_RUNQ->halt_in_progress = 1;
+ ERTS_RUNQ_FLGS_SET(ERTS_DIRTY_CPU_RUNQ, ERTS_RUNQ_FLG_HALTING);
+ ERTS_RUNQ_FLGS_SET(ERTS_DIRTY_IO_RUNQ, ERTS_RUNQ_FLG_HALTING);
#endif
erts_halt_code = code;
notify_reap_ports_relb();
@@ -12229,11 +14484,16 @@ void erl_halt(int code)
int
erts_dbg_check_halloc_lock(Process *p)
{
+ ErtsSchedulerData *esdp;
if (ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p))
return 1;
+ if ((p->static_flags & ERTS_STC_FLG_SHADOW_PROC)
+ && ERTS_SCHEDULER_IS_DIRTY(erts_get_scheduler_data()))
+ return 1;
if (p->common.id == ERTS_INVALID_PID)
return 1;
- if (p->scheduler_data && p == p->scheduler_data->match_pseudo_process)
+ esdp = erts_proc_sched_data(p);
+ if (esdp && p == esdp->match_pseudo_process)
return 1;
if (erts_thr_progress_is_blocking())
return 1;
diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h
index ed6dadbffa..639818c20c 100644
--- a/erts/emulator/beam/erl_process.h
+++ b/erts/emulator/beam/erl_process.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2014. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -20,6 +21,8 @@
#ifndef __PROCESS_H__
#define __PROCESS_H__
+#include "sys.h"
+
#undef ERTS_INCLUDE_SCHEDULER_INTERNALS
#if (defined(ERL_PROCESS_C__) \
|| defined(ERL_PORT_TASK_C__) \
@@ -36,8 +39,6 @@
typedef struct process Process;
-#include "sys.h"
-
#define ERTS_PROCESS_LOCK_ONLY_PROC_LOCK_TYPE__
#include "erl_process_lock.h" /* Only pull out important types... */
#undef ERTS_PROCESS_LOCK_ONLY_PROC_LOCK_TYPE__
@@ -52,12 +53,19 @@ typedef struct process Process;
#include "erl_node_container_utils.h"
#include "erl_node_tables.h"
#include "erl_monitors.h"
-#include "erl_bif_timer.h"
+#include "erl_hl_timer.h"
#include "erl_time.h"
#include "erl_atom_table.h"
#include "external.h"
#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
+#define ERTS_ONLY_SCHED_SPEC_ETS_DATA
+#include "erl_db.h"
+#undef ERTS_ONLY_SCHED_SPEC_ETS_DATA
#ifdef HIPE
#include "hipe_process.h"
@@ -74,10 +82,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)
@@ -90,10 +96,6 @@ struct ErtsNodesMonitor_;
#define ERTS_HEAP_FREE(Type, Ptr, Size) \
erts_free((Type), (Ptr))
-#define INITIAL_MOD 0
-#define INITIAL_FUN 1
-#define INITIAL_ARI 2
-
#include "export.h"
struct saved_calls {
@@ -104,16 +106,22 @@ struct saved_calls {
};
extern Export exp_send, exp_receive, exp_timeout;
+extern int erts_eager_check_io;
extern int erts_sched_compact_load;
extern int erts_sched_balance_util;
extern Uint erts_no_schedulers;
+extern Uint erts_no_total_schedulers;
#ifdef ERTS_DIRTY_SCHEDULERS
extern Uint erts_no_dirty_cpu_schedulers;
extern Uint erts_no_dirty_io_schedulers;
#endif
extern Uint erts_no_run_queues;
extern int erts_sched_thread_suggested_stack_size;
-#define ERTS_SCHED_THREAD_MIN_STACK_SIZE 4 /* Kilo words */
+#ifdef ERTS_DIRTY_SCHEDULERS
+extern int erts_dcpu_sched_thread_suggested_stack_size;
+extern int erts_dio_sched_thread_suggested_stack_size;
+#endif
+#define ERTS_SCHED_THREAD_MIN_STACK_SIZE 20 /* Kilo words */
#define ERTS_SCHED_THREAD_MAX_STACK_SIZE 8192 /* Kilo words */
#ifdef ERTS_SMP
@@ -167,6 +175,16 @@ 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_MSB_EXEC \
+ (((Uint32) 1) << (ERTS_RUNQ_FLG_BASE2 + 8))
+#define ERTS_RUNQ_FLG_MISC_OP \
+ (((Uint32) 1) << (ERTS_RUNQ_FLG_BASE2 + 9))
+#define ERTS_RUNQ_FLG_HALTING \
+ (((Uint32) 1) << (ERTS_RUNQ_FLG_BASE2 + 10))
+
+#define ERTS_RUNQ_FLG_MAX (ERTS_RUNQ_FLG_BASE2 + 11)
#define ERTS_RUNQ_FLGS_MIGRATION_QMASKS \
(ERTS_RUNQ_FLGS_EMIGRATE_QMASK \
@@ -210,6 +228,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), \
@@ -217,6 +238,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) \
@@ -230,7 +254,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,
@@ -249,6 +275,9 @@ typedef enum {
#define ERTS_SSI_FLG_TSE_SLEEPING (((erts_aint32_t) 1) << 2)
#define ERTS_SSI_FLG_WAITING (((erts_aint32_t) 1) << 3)
#define ERTS_SSI_FLG_SUSPENDED (((erts_aint32_t) 1) << 4)
+#define ERTS_SSI_FLG_MSB_EXEC (((erts_aint32_t) 1) << 5)
+
+#define ERTS_SSI_FLGS_MAX 6
#define ERTS_SSI_FLGS_SLEEP_TYPE \
(ERTS_SSI_FLG_TSE_SLEEPING|ERTS_SSI_FLG_POLL_SLEEPING)
@@ -259,27 +288,80 @@ typedef enum {
#define ERTS_SSI_FLGS_ALL \
(ERTS_SSI_FLGS_SLEEP \
| ERTS_SSI_FLG_WAITING \
- | ERTS_SSI_FLG_SUSPENDED)
+ | ERTS_SSI_FLG_SUSPENDED \
+ | ERTS_SSI_FLG_MSB_EXEC)
/*
- * Keep ERTS_SSI_AUX_WORK flags in expected frequency order relative
- * eachother. Most frequent - lowest bit number.
+ * Keep ERTS_SSI_AUX_WORK flags ordered in expected frequency
+ * order relative eachother. Most frequent at lowest at lowest
+ * index.
+ *
+ * ERTS_SSI_AUX_WORK_DEBUG_WAIT_COMPLETED_IX *need* to be
+ * highest index...
+ *
+ * Remember to update description in erts_pre_init_process()
+ * when adding new flags...
*/
-#define ERTS_SSI_AUX_WORK_DELAYED_AW_WAKEUP (((erts_aint32_t) 1) << 0)
-#define ERTS_SSI_AUX_WORK_DD (((erts_aint32_t) 1) << 1)
-#define ERTS_SSI_AUX_WORK_DD_THR_PRGR (((erts_aint32_t) 1) << 2)
-#define ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC (((erts_aint32_t) 1) << 3)
-#define ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM (((erts_aint32_t) 1) << 4)
-#define ERTS_SSI_AUX_WORK_THR_PRGR_LATER_OP (((erts_aint32_t) 1) << 5)
-#define ERTS_SSI_AUX_WORK_ASYNC_READY (((erts_aint32_t) 1) << 6)
-#define ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN (((erts_aint32_t) 1) << 7)
-#define ERTS_SSI_AUX_WORK_MISC_THR_PRGR (((erts_aint32_t) 1) << 8)
-#define ERTS_SSI_AUX_WORK_MISC (((erts_aint32_t) 1) << 9)
-#define ERTS_SSI_AUX_WORK_CHECK_CHILDREN (((erts_aint32_t) 1) << 10)
-#define ERTS_SSI_AUX_WORK_SET_TMO (((erts_aint32_t) 1) << 11)
-#define ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK (((erts_aint32_t) 1) << 12)
-#define ERTS_SSI_AUX_WORK_REAP_PORTS (((erts_aint32_t) 1) << 13)
+typedef enum {
+ ERTS_SSI_AUX_WORK_DELAYED_AW_WAKEUP_IX,
+ ERTS_SSI_AUX_WORK_DD_IX,
+ ERTS_SSI_AUX_WORK_DD_THR_PRGR_IX,
+ ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC_IX,
+ ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM_IX,
+ ERTS_SSI_AUX_WORK_THR_PRGR_LATER_OP_IX,
+ ERTS_SSI_AUX_WORK_CNCLD_TMRS_IX,
+ ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR_IX,
+ ERTS_SSI_AUX_WORK_ASYNC_READY_IX,
+ 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_PENDING_EXITERS_IX,
+ ERTS_SSI_AUX_WORK_SET_TMO_IX,
+ ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK_IX,
+ ERTS_SSI_AUX_WORK_YIELD_IX,
+ ERTS_SSI_AUX_WORK_REAP_PORTS_IX,
+ ERTS_SSI_AUX_WORK_DEBUG_WAIT_COMPLETED_IX, /* SHOULD be last flag index */
+
+ ERTS_SSI_AUX_WORK_NO_FLAGS /* Not a flag index... */
+} ErtsSsiAuxWorkFlagIndex;
+
+#define ERTS_SSI_AUX_WORK_DELAYED_AW_WAKEUP \
+ (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_DELAYED_AW_WAKEUP_IX)
+#define ERTS_SSI_AUX_WORK_DD \
+ (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_DD_IX)
+#define ERTS_SSI_AUX_WORK_DD_THR_PRGR \
+ (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_DD_THR_PRGR_IX)
+#define ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC \
+ (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC_IX)
+#define ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM \
+ (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM_IX)
+#define ERTS_SSI_AUX_WORK_THR_PRGR_LATER_OP \
+ (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_THR_PRGR_LATER_OP_IX)
+#define ERTS_SSI_AUX_WORK_CNCLD_TMRS \
+ (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_CNCLD_TMRS_IX)
+#define ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR \
+ (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR_IX)
+#define ERTS_SSI_AUX_WORK_ASYNC_READY \
+ (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_ASYNC_READY_IX)
+#define ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN \
+ (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN_IX)
+#define ERTS_SSI_AUX_WORK_MISC_THR_PRGR \
+ (((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_PENDING_EXITERS \
+ (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_PENDING_EXITERS_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 \
+ (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK_IX)
+#define ERTS_SSI_AUX_WORK_YIELD \
+ (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_YIELD_IX)
+#define ERTS_SSI_AUX_WORK_REAP_PORTS \
+ (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_REAP_PORTS_IX)
+#define ERTS_SSI_AUX_WORK_DEBUG_WAIT_COMPLETED \
+ (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_DEBUG_WAIT_COMPLETED_IX)
typedef struct ErtsSchedulerSleepInfo_ ErtsSchedulerSleepInfo;
@@ -329,6 +411,12 @@ typedef struct {
Process* last;
} ErtsRunPrioQueue;
+typedef enum {
+ ERTS_SCHED_NORMAL,
+ ERTS_SCHED_DIRTY_CPU,
+ ERTS_SCHED_DIRTY_IO
+} ErtsSchedType;
+
typedef struct ErtsSchedulerData_ ErtsSchedulerData;
typedef struct ErtsRunQueue_ ErtsRunQueue;
@@ -340,7 +428,7 @@ typedef struct {
} ErtsRunQueueInfo;
-#ifdef HAVE_GETHRTIME
+#ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT
# undef ERTS_HAVE_SCHED_UTIL_BALANCING_SUPPORT_OPT
# define ERTS_HAVE_SCHED_UTIL_BALANCING_SUPPORT_OPT 1
#endif
@@ -350,13 +438,7 @@ typedef struct {
#undef ERTS_HAVE_SCHED_UTIL_BALANCING_SUPPORT
#define ERTS_HAVE_SCHED_UTIL_BALANCING_SUPPORT ERTS_HAVE_SCHED_UTIL_BALANCING_SUPPORT_OPT
-#ifdef ARCH_64
-typedef erts_atomic_t ErtsAtomicSchedTime;
-#elif defined(ARCH_32)
-typedef erts_dw_atomic_t ErtsAtomicSchedTime;
-#else
-# error :-/
-#endif
+typedef erts_atomic64_t ErtsAtomicSchedTime;
#if ERTS_HAVE_SCHED_UTIL_BALANCING_SUPPORT
typedef struct {
@@ -417,10 +499,9 @@ 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;
struct {
ErtsProcList *pending_exiters;
@@ -461,38 +542,37 @@ typedef union {
extern ErtsAlignedRunQueue *erts_aligned_run_queues;
-#define ERTS_PROC_REDUCTIONS_EXECUTED(RQ, PRIO, REDS, AREDS) \
+#define ERTS_PROC_REDUCTIONS_EXECUTED(SD, RQ, PRIO, REDS, AREDS)\
do { \
(RQ)->procs.reductions += (AREDS); \
(RQ)->procs.prio_info[(PRIO)].reds += (REDS); \
(RQ)->check_balance_reds -= (REDS); \
(RQ)->wakeup_other_reds += (AREDS); \
+ (SD)->check_time_reds += (AREDS); \
} while (0)
-#define ERTS_PORT_REDUCTIONS_EXECUTED(RQ, REDS) \
+#define ERTS_PORT_REDUCTIONS_EXECUTED(SD, RQ, REDS) \
do { \
(RQ)->ports.info.reds += (REDS); \
(RQ)->check_balance_reds -= (REDS); \
(RQ)->wakeup_other_reds += (REDS); \
+ (SD)->check_time_reds += (REDS); \
} while (0)
typedef struct {
- int need; /* "+sbu true" or scheduler_wall_time enabled */
+ union {
+ erts_atomic32_t mod; /* on dirty schedulers */
+ int need; /* "+sbu true" or scheduler_wall_time enabled */
+ } u;
int enabled;
Uint64 start;
struct {
Uint64 total;
Uint64 start;
- int currently;
} working;
} ErtsSchedWallTime;
typedef struct {
- Uint64 reclaimed;
- Uint64 garbage_cols;
-} ErtsGCInfo;
-
-typedef struct {
int sched;
erts_aint32_t aux_work;
} ErtsDelayedAuxWorkWakeupJob;
@@ -514,11 +594,12 @@ typedef struct {
#ifdef ERTS_SMP
struct {
ErtsThrPrgrVal thr_prgr;
- void (*completed_callback)(void *);
- void (*completed_arg)(void *);
} dd;
struct {
ErtsThrPrgrVal thr_prgr;
+ } cncld_tmrs;
+ struct {
+ ErtsThrPrgrVal thr_prgr;
UWord size;
ErtsThrPrgrLaterOp *first;
ErtsThrPrgrLaterOp *last;
@@ -541,21 +622,29 @@ typedef struct {
ErtsDelayedAuxWorkWakeupJob *job;
} delayed_wakeup;
#endif
+ struct {
+ ErtsEtsAllYieldData ets_all;
+ /* Other yielding operations... */
+ } yield;
+ struct {
+ struct {
+ erts_aint32_t flags;
+ void (*callback)(void *);
+ void *arg;
+ } wait_completed;
+ } debug;
} ErtsAuxWorkData;
+#define ERTS_SCHED_AUX_YIELD_DATA(ESDP, NAME) \
+ (&(ESDP)->aux_work_data.yield.NAME)
+void erts_notify_new_aux_yield_work(ErtsSchedulerData *esdp);
+
#ifdef ERTS_DIRTY_SCHEDULERS
typedef enum {
ERTS_DIRTY_CPU_SCHEDULER,
ERTS_DIRTY_IO_SCHEDULER
} ErtsDirtySchedulerType;
-typedef union {
- struct {
- ErtsDirtySchedulerType type: 1;
- unsigned num: 31;
- } s;
- Uint no;
-} ErtsDirtySchedId;
#endif
struct ErtsSchedulerData_ {
@@ -567,6 +656,9 @@ struct ErtsSchedulerData_ {
Eterm* x_reg_array; /* X registers */
FloatDef* f_reg_array; /* Floating point registers. */
+ ErtsTimerWheel *timer_wheel;
+ ErtsNextTimeoutRef next_tmo_ref;
+ ErtsHLTimerService *timer_service;
#ifdef ERTS_SMP
ethr_tid tid; /* Thread id */
struct erl_bits_state erl_bits_state; /* erl_bits.c state */
@@ -574,17 +666,13 @@ 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;
+ ErtsSchedType type;
Uint no; /* Scheduler number for normal schedulers */
#ifdef ERTS_DIRTY_SCHEDULERS
- ErtsDirtySchedId dirty_no; /* Scheduler number for dirty schedulers */
+ Uint dirty_no; /* Scheduler number for dirty schedulers */
+ Process *dirty_shadow_process;
#endif
Port *current_port;
ErtsRunQueue *run_queue;
@@ -593,13 +681,25 @@ struct ErtsSchedulerData_ {
ErtsAuxWorkData aux_work_data;
ErtsAtomCacheMap atom_cache_map;
+ ErtsMonotonicTime last_monotonic_time;
+ int check_time_reds;
+
+ Uint32 thr_id;
+ Uint64 unique;
+ Uint64 ref;
+
ErtsSchedAllocData alloc_data;
+ struct {
+ Uint64 out;
+ Uint64 in;
+ } io;
+
Uint64 reductions;
ErtsSchedWallTime sched_wall_time;
ErtsGCInfo gc_info;
ErtsPortTaskHandle nosuspend_port_task_handle;
-
+ ErtsEtsTables ets_tables;
#ifdef ERTS_DO_VERIFY_UNUSED_TEMP_ALLOC
erts_alloc_verify_func_t verify_unused_temp_alloc;
Allctr_t *verify_unused_temp_alloc_data;
@@ -621,13 +721,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
@@ -658,7 +751,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)
@@ -671,15 +776,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
@@ -689,7 +785,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) {
@@ -700,8 +801,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
@@ -711,7 +810,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;
}
@@ -731,15 +830,19 @@ 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
-#ifdef ERTS_DIRTY_SCHEDULERS
-#define ERTS_PSD_DIRTY_SCHED_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_ETS_OWNED_TABLES 6
+#define ERTS_PSD_ETS_FIXED_TABLES 7
+#define ERTS_PSD_SUSPENDED_SAVED_CALLS_BUF 8
-#define ERTS_PSD_SIZE 7
-#else
-#define ERTS_PSD_SIZE 6
+#define ERTS_PSD_SIZE 9
+
+#if !defined(HIPE)
+# undef ERTS_PSD_SUSPENDED_SAVED_CALLS_BUF
+# undef ERTS_PSD_SIZE
+# define ERTS_PSD_SIZE 8
#endif
typedef struct {
@@ -752,25 +855,26 @@ typedef struct {
#define ERTS_PSD_ERROR_HANDLER_BUF_GET_LOCKS ERTS_PROC_LOCK_MAIN
#define ERTS_PSD_ERROR_HANDLER_BUF_SET_LOCKS ERTS_PROC_LOCK_MAIN
-#define ERTS_PSD_SAVED_CALLS_BUF_GET_LOCKS ERTS_PROC_LOCK_MAIN
-#define ERTS_PSD_SAVED_CALLS_BUF_SET_LOCKS ERTS_PROC_LOCK_MAIN
+#define ERTS_PSD_SAVED_CALLS_BUF_GET_LOCKS ((ErtsProcLocks) 0)
+#define ERTS_PSD_SAVED_CALLS_BUF_SET_LOCKS ((ErtsProcLocks) 0)
#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
#define ERTS_PSD_DELAYED_GC_TASK_QS_GET_LOCKS ERTS_PROC_LOCK_MAIN
#define ERTS_PSD_DELAYED_GC_TASK_QS_SET_LOCKS ERTS_PROC_LOCK_MAIN
-#ifdef ERTS_DIRTY_SCHEDULERS
-#define ERTS_PSD_DIRTY_SCHED_TRAP_EXPORT_GET_LOCKS ERTS_PROC_LOCK_MAIN
-#define ERTS_PSD_DIRTY_SCHED_TRAP_EXPORT_SET_LOCKS ERTS_PROC_LOCK_MAIN
-#endif
+#define ERTS_PSD_NIF_TRAP_EXPORT_GET_LOCKS ERTS_PROC_LOCK_MAIN
+#define ERTS_PSD_NIF_TRAP_EXPORT_SET_LOCKS ERTS_PROC_LOCK_MAIN
+
+#define ERTS_PSD_ETS_OWNED_TABLES_GET_LOCKS ERTS_PROC_LOCK_STATUS
+#define ERTS_PSD_ETS_OWNED_TABLES_SET_LOCKS ERTS_PROC_LOCK_STATUS
+
+#define ERTS_PSD_ETS_FIXED_TABLES_GET_LOCKS ERTS_PROC_LOCK_MAIN
+#define ERTS_PSD_ETS_FIXED_TABLES_SET_LOCKS ERTS_PROC_LOCK_MAIN
typedef struct {
ErtsProcLocks get_locks;
@@ -847,10 +951,18 @@ 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
+# define MAX_HEAP_SIZE_GET(p) ((p)->max_heap_size >> 2)
+# define MAX_HEAP_SIZE_SET(p, sz) ((p)->max_heap_size = ((sz) << 2) | \
+ MAX_HEAP_SIZE_FLAGS_GET(p))
+# define MAX_HEAP_SIZE_FLAGS_GET(p) ((p)->max_heap_size & 0x3)
+# define MAX_HEAP_SIZE_FLAGS_SET(p, flags) ((p)->max_heap_size = flags | \
+ ((p)->max_heap_size & ~0x3))
+# define MAX_HEAP_SIZE_KILL 1
+# define MAX_HEAP_SIZE_LOG 2
+
struct process {
ErtsPTabElementCommon common; /* *Need* to be first in struct */
@@ -865,9 +977,11 @@ 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). */
+ Uint max_heap_size; /* Maximum size of heap (in words). */
#if !defined(NO_FPE_SIGNALS) || defined(HIPE)
volatile unsigned long fp_exception;
@@ -899,8 +1013,7 @@ struct process {
Uint32 rcount; /* suspend count */
int schedule_count; /* Times left to reschedule a low prio process */
Uint reds; /* No of reductions for this process */
- Eterm group_leader; /* Pid in charge
- (can be boxed) */
+ Eterm group_leader; /* Pid in charge (can be boxed) */
Uint flags; /* Trap exit, etc (no trace flags anymore) */
Eterm fvalue; /* Exit & Throw value (failure reason) */
Uint freason; /* Reason for detected failure */
@@ -916,10 +1029,7 @@ struct process {
ErlMessageQueue msg; /* Message queue */
- union {
- ErtsBifTimer *bif_timers; /* Bif timers aiming at this process */
- void *terminate;
- } u;
+ ErtsBifTimers *bif_timers; /* Bif timers aiming at this process */
ProcDict *dictionary; /* Process dictionary, may be NULL */
@@ -930,21 +1040,27 @@ struct process {
#ifdef USE_VM_PROBES
Eterm dt_utag; /* Place to store the dynamc trace user tag */
Uint dt_utag_flags; /* flag field for the dt_utag */
-#endif
- BeamInstr initial[3]; /* Initial module(0), function(1), arity(2), often used instead
- of pointer to funcinfo instruction, hence the BeamInstr datatype */
- BeamInstr* current; /* Current Erlang function, part of the funcinfo:
+#endif
+ union {
+ void *terminate;
+ ErtsCodeMFA initial; /* Initial module(0), function(1), arity(2),
+ often used instead of pointer to funcinfo
+ instruction. */
+ } u;
+ ErtsCodeMFA* current; /* Current Erlang function, part of the funcinfo:
* module(0), function(1), arity(2)
* (module and functions are tagged atoms;
- * arity an untagged integer). BeamInstr * because it references code
+ * arity an untagged integer).
*/
-
+
/*
* Information mainly for post-mortem use (erl crash dump).
*/
Eterm parent; /* Pid of process that created this process. */
erts_approx_time_t approx_started; /* Time when started. */
+ Uint32 static_flags; /* Flags that do *not* change */
+
/* This is the place, where all fields that differs between memory
* architectures, have gone to.
*/
@@ -956,21 +1072,29 @@ 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 */
- ErtsPSD *psd; /* Rarely used process specific data */
+ 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 */
+ erts_smp_atomic_t 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;
+#ifdef ERTS_DIRTY_SCHEDULERS
+ ErtsProcSysTask *dirty_sys_tasks;
+#endif
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;
+ ErlTraceMessageQueue *trace_msg_q;
ErtsPendExit pending_exit;
erts_proc_lock_t lock;
ErtsSchedulerData *scheduler_data;
@@ -985,6 +1109,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
@@ -999,6 +1124,10 @@ struct process {
Uint space_verified; /* Avoid HAlloc forcing heap fragments when */
Eterm* space_verified_from; /* we rely on available heap space (TestHeap) */
#endif
+
+#ifdef DEBUG
+ Uint debug_reds_in;
+#endif
};
extern const Process erts_invalid_process;
@@ -1008,6 +1137,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))
@@ -1060,6 +1190,9 @@ void erts_check_for_holes(Process* p);
* USR_PRIO -> User prio. i.e., prio the user has set.
* PRQ_PRIO -> Prio queue prio, i.e., prio queue currently
* enqueued in.
+ *
+ * Update etp-proc-state-int in $ERL_TOP/erts/etc/unix/etp-commands.in
+ * when changing ERTS_PSFLG_*.
*/
#define ERTS_PSFLGS_ACT_PRIO_MASK \
(ERTS_PSFLGS_PRIO_MASK << ERTS_PSFLGS_ACT_PRIO_OFFSET)
@@ -1085,24 +1218,72 @@ 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)
-#endif
+#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_DIRTY_RUNNING ERTS_PSFLG_BIT(23)
+#define ERTS_PSFLG_DIRTY_RUNNING_SYS ERTS_PSFLG_BIT(24)
+
+#define ERTS_PSFLG_MAX (ERTS_PSFLGS_ZERO_BIT_OFFSET + 24)
+
+#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 \
| ERTS_PSFLG_IN_PRQ_NORMAL \
| ERTS_PSFLG_IN_PRQ_LOW)
+#define ERTS_PSFLGS_VOLATILE_HEAP (ERTS_PSFLG_EXITING \
+ | ERTS_PSFLG_PENDING_EXIT \
+ | ERTS_PSFLG_DIRTY_RUNNING \
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS)
+
#define ERTS_PSFLGS_GET_ACT_PRIO(PSFLGS) \
(((PSFLGS) >> ERTS_PSFLGS_ACT_PRIO_OFFSET) & ERTS_PSFLGS_PRIO_MASK)
#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.
+ */
+#define ERTS_STC_FLG_SYSTEM_PROC (((Uint32) 1) << 0)
+#define ERTS_STC_FLG_SHADOW_PROC (((Uint32) 1) << 1)
/* The sequential tracing token is a tuple of size 5:
*
@@ -1131,12 +1312,17 @@ void erts_check_for_holes(Process* p);
#define SPO_LINK 1
#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). */
@@ -1148,6 +1334,8 @@ typedef struct {
Uint min_vheap_size; /* Minimum virtual heap size */
int priority; /* Priority for process. */
Uint16 max_gen_gcs; /* Maximum number of gen GCs before fullsweep. */
+ Uint max_heap_size; /* Maximum heap size in words */
+ Uint max_heap_flags; /* Maximum heap flags (kill | log) */
int scheduler;
} ErlSpawnOpts;
@@ -1164,10 +1352,13 @@ ERTS_GLB_INLINE void erts_heap_frag_shrink(Process* p, Eterm* hp);
ERTS_GLB_INLINE void erts_heap_frag_shrink(Process* p, Eterm* hp)
{
ErlHeapFragment* hf = MBUF(p);
+ Uint sz;
- ASSERT(hf!=NULL && (hp - hf->mem < (unsigned long)hf->alloc_size));
+ ASSERT(hf!=NULL && (hp - hf->mem < hf->alloc_size));
- hf->used_size = hp - hf->mem;
+ sz = hp - hf->mem;
+ p->mbuf_sz -= hf->used_size - sz;
+ hf->used_size = sz;
}
#endif /* inline */
@@ -1176,7 +1367,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
@@ -1204,6 +1394,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 */
@@ -1217,65 +1408,117 @@ 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) /* On 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 */
+#define F_HIPE_MODE (1 << 19) /* Process is executing in HiPE mode */
+#define F_DELAYED_DEL_PROC (1 << 20) /* Delay delete process (dirty proc exit case) */
+#define F_DIRTY_CLA (1 << 21) /* Dirty copy literal area scheduled */
+#define F_DIRTY_GC_HIBERNATE (1 << 22) /* Dirty GC hibernate scheduled */
+#define F_DIRTY_MAJOR_GC (1 << 23) /* Dirty major GC scheduled */
+#define F_DIRTY_MINOR_GC (1 << 24) /* Dirty minor GC scheduled */
+#define F_HIBERNATED (1 << 25) /* Hibernated */
+
+/*
+ * 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_EXCEPTION_TRACE F_TRACE_FLAG(15) /* 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)
-#define ERTS_PORT_TRACEE_FLAGS \
- (ERTS_TRACEE_MODIFIER_FLAGS | F_TRACE_PORTS | F_TRACE_SCHED_PORTS)
+ (F_TRACE_SILENT | F_TIMESTAMP_MASK | F_TRACE_SCHED_NO \
+ | F_TRACE_RECEIVE | F_TRACE_SEND)
+#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)
+ ((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)
@@ -1288,33 +1531,40 @@ extern struct erts_system_profile_flags_t erts_system_profile_flags;
#define ERTS_XSIG_FLG_IGN_KILL (((Uint32) 1) << 0)
#define ERTS_XSIG_FLG_NO_IGN_NORMAL (((Uint32) 1) << 1)
-#define CANCEL_TIMER(p) \
- do { \
- if ((p)->flags & (F_INSLPQUEUE)) \
- cancel_timer(p); \
- else \
- (p)->flags &= ~F_TIMO; \
+#define CANCEL_TIMER(P) \
+ do { \
+ if ((P)->flags & (F_INSLPQUEUE|F_TIMO)) { \
+ if ((P)->flags & F_INSLPQUEUE) \
+ erts_cancel_proc_timer((P)); \
+ else \
+ (P)->flags &= ~F_TIMO; \
+ } \
} while (0)
#if defined(ERTS_DIRTY_SCHEDULERS) && defined(ERTS_SMP)
-#define ERTS_NUM_DIRTY_RUNQS 2
+#define ERTS_NUM_DIRTY_CPU_RUNQS 1
+#define ERTS_NUM_DIRTY_IO_RUNQS 1
#else
-#define ERTS_NUM_DIRTY_RUNQS 0
+#define ERTS_NUM_DIRTY_CPU_RUNQS 0
+#define ERTS_NUM_DIRTY_IO_RUNQS 0
#endif
+#define ERTS_NUM_DIRTY_RUNQS (ERTS_NUM_DIRTY_CPU_RUNQS+ERTS_NUM_DIRTY_IO_RUNQS)
+
#define ERTS_RUNQ_IX(IX) \
- (ASSERT(0 <= (IX) && (IX) < erts_no_run_queues), \
+ (ASSERT(0 <= (IX) && (IX) < erts_no_run_queues+ERTS_NUM_DIRTY_RUNQS), \
&erts_aligned_run_queues[(IX)].runq)
#ifdef ERTS_DIRTY_SCHEDULERS
#define ERTS_RUNQ_IX_IS_DIRTY(IX) \
- (-(ERTS_NUM_DIRTY_RUNQS) <= (IX) && (IX) < 0)
+ (ASSERT(0 <= (IX) && (IX) < erts_no_run_queues+ERTS_NUM_DIRTY_RUNQS), \
+ (erts_no_run_queues <= (IX)))
#define ERTS_DIRTY_RUNQ_IX(IX) \
(ASSERT(ERTS_RUNQ_IX_IS_DIRTY(IX)), \
&erts_aligned_run_queues[(IX)].runq)
-#define ERTS_DIRTY_CPU_RUNQ (&erts_aligned_run_queues[-1].runq)
-#define ERTS_DIRTY_IO_RUNQ (&erts_aligned_run_queues[-2].runq)
-#define ERTS_RUNQ_IS_DIRTY_CPU_RUNQ(RQ) ((RQ)->ix == -1)
-#define ERTS_RUNQ_IS_DIRTY_IO_RUNQ(RQ) ((RQ)->ix == -2)
+#define ERTS_DIRTY_CPU_RUNQ (&erts_aligned_run_queues[erts_no_run_queues].runq)
+#define ERTS_DIRTY_IO_RUNQ (&erts_aligned_run_queues[erts_no_run_queues+1].runq)
+#define ERTS_RUNQ_IS_DIRTY_CPU_RUNQ(RQ) ((RQ) == ERTS_DIRTY_CPU_RUNQ)
+#define ERTS_RUNQ_IS_DIRTY_IO_RUNQ(RQ) ((RQ) == ERTS_DIRTY_IO_RUNQ)
#else
#define ERTS_RUNQ_IX_IS_DIRTY(IX) 0
#endif
@@ -1328,23 +1578,13 @@ extern struct erts_system_profile_flags_t erts_system_profile_flags;
#define ERTS_DIRTY_IO_SCHEDULER_IX(IX) \
(ASSERT(0 <= (IX) && (IX) < erts_no_dirty_io_schedulers), \
&erts_aligned_dirty_io_scheduler_data[(IX)].esd)
-#define ERTS_DIRTY_SCHEDULER_NO(ESDP) \
- ((ESDP)->dirty_no.s.num)
-#define ERTS_DIRTY_SCHEDULER_TYPE(ESDP) \
- ((ESDP)->dirty_no.s.type)
-#ifdef ERTS_SMP
#define ERTS_SCHEDULER_IS_DIRTY(ESDP) \
- ((ESDP)->dirty_no.s.num != 0)
+ ((ESDP)->type != ERTS_SCHED_NORMAL)
#define ERTS_SCHEDULER_IS_DIRTY_CPU(ESDP) \
- ((ESDP)->dirty_no.s.type == 0)
+ ((ESDP)->type == ERTS_SCHED_DIRTY_CPU)
#define ERTS_SCHEDULER_IS_DIRTY_IO(ESDP) \
- ((ESDP)->dirty_no.s.type == 1)
-#else
-#define ERTS_SCHEDULER_IS_DIRTY(ESDP) 0
-#define ERTS_SCHEDULER_IS_DIRTY_CPU(ESDP) 0
-#define ERTS_SCHEDULER_IS_DIRTY_IO(ESDP) 0
-#endif
-#else
+ ((ESDP)->type == ERTS_SCHED_DIRTY_IO)
+#else /* !ERTS_DIRTY_SCHEDULERS */
#define ERTS_RUNQ_IX_IS_DIRTY(IX) 0
#define ERTS_SCHEDULER_IS_DIRTY(ESDP) 0
#define ERTS_SCHEDULER_IS_DIRTY_CPU(ESDP) 0
@@ -1359,15 +1599,20 @@ void erts_init_scheduling(int, int
, int, int, int
#endif
);
-
+#ifdef ERTS_DIRTY_SCHEDULERS
+void erts_execute_dirty_system_task(Process *c_p);
+#endif
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_sched_wall_time_request(Process *c_p, int set, int enable,
+ int dirty_cpu, int want_dirty_io);
+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);
Uint64 erts_step_proc_interval(void);
ErtsProcList *erts_proclist_create(Process *);
+ErtsProcList *erts_proclist_copy(ErtsProcList *);
void erts_proclist_destroy(ErtsProcList *);
ERTS_GLB_INLINE int erts_proclist_same(ErtsProcList *, Process *);
@@ -1461,7 +1706,7 @@ ERTS_GLB_INLINE ErtsProcList *erts_proclist_fetch_first(ErtsProcList **list)
return NULL;
else {
ErtsProcList *res = *list;
- if (res == *list)
+ if (res->next == *list)
*list = NULL;
else
*list = res->next;
@@ -1548,36 +1793,34 @@ void erts_schedule_thr_prgr_later_cleanup_op(void (*)(void *),
void *,
ErtsThrPrgrLaterOp *,
UWord);
+void erts_schedule_complete_off_heap_message_queue_change(Eterm pid);
+struct db_fixation;
+void erts_schedule_ets_free_fixation(Eterm pid, struct db_fixation*);
+void erts_schedule_flush_trace_messages(Process *proc, int force_on_proc);
+int erts_flush_trace_messages(Process *c_p, ErtsProcLocks locks);
#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);
-void erts_smp_notify_check_children_needed(void);
+void erts_notify_canceled_timer(ErtsSchedulerData *, int);
#endif
#if ERTS_USE_ASYNC_READY_Q
void erts_notify_check_async_ready_queue(void *);
@@ -1594,11 +1837,13 @@ void erts_schedule_multi_misc_aux_work(int ignore_self,
void (*func)(void *),
void *arg);
erts_aint32_t erts_set_aux_work_timeout(int, erts_aint32_t, int);
+void erts_aux_work_timeout_late_init(ErtsSchedulerData *esdp);
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 *);
+Eterm erts_process_state2status(erts_aint32_t);
+Eterm erts_process_status(Process *, Eterm);
+Uint erts_run_queues_len(Uint *, int, 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);
@@ -1606,13 +1851,11 @@ Eterm erts_get_schedulers_binds(Process *c_p);
Eterm erts_set_cpu_topology(Process *c_p, Eterm term);
Eterm erts_bind_schedulers(Process *c_p, Eterm how);
ErtsRunQueue *erts_schedid2runq(Uint);
-Process *schedule(Process*, int);
+Process *erts_schedule(ErtsSchedulerData *, Process*, int);
void erts_schedule_misc_op(void (*)(void *), void *);
Eterm erl_create_process(Process*, Eterm, Eterm, Eterm, ErlSpawnOpts*);
void erts_do_exit_process(Process*, Eterm);
void erts_continue_exit_process(Process *);
-void set_timer(Process*, Uint);
-void cancel_timer(Process*);
/* Begin System profile */
Uint erts_runnable_process_count(void);
/* End System profile */
@@ -1621,8 +1864,12 @@ void erts_cleanup_empty_process(Process* p);
#ifdef DEBUG
void erts_debug_verify_clean_empty_process(Process* p);
#endif
-void erts_stack_dump(int to, void *to_arg, Process *);
-void erts_program_counter_info(int to, void *to_arg, Process *);
+void erts_stack_dump(fmtfn_t to, void *to_arg, Process *);
+void erts_limited_stack_trace(fmtfn_t to, void *to_arg, Process *);
+void erts_program_counter_info(fmtfn_t to, void *to_arg, Process *);
+void erts_print_scheduler_info(fmtfn_t to, void *to_arg, ErtsSchedulerData *esdp);
+void erts_dump_extended_process_state(fmtfn_t to, void *to_arg, erts_aint32_t psflg);
+void erts_dump_process_state(fmtfn_t to, void *to_arg, erts_aint32_t psflg);
Eterm erts_get_process_priority(Process *p);
Eterm erts_set_process_priority(Process *p, Eterm prio);
@@ -1658,29 +1905,25 @@ void erts_handle_pending_exit(Process *, ErtsProcLocks);
#define ERTS_PROC_PENDING_EXIT(P) 0
#endif
-void erts_deep_process_dump(int, void *);
+void erts_deep_process_dump(fmtfn_t, void *);
Eterm erts_get_reader_groups_map(Process *c_p);
Eterm erts_debug_reader_groups_map(Process *c_p, int groups);
Uint erts_debug_nbalance(void);
-int erts_debug_wait_deallocations(Process *c_p);
-Uint erts_process_memory(Process *c_p);
+#define ERTS_DEBUG_WAIT_COMPLETED_DEALLOCATIONS (1 << 0)
+#define ERTS_DEBUG_WAIT_COMPLETED_TIMER_CANCELLATIONS (1 << 1)
-#ifdef ERTS_SMP
-# define ERTS_GET_SCHEDULER_DATA_FROM_PROC(PROC) ((PROC)->scheduler_data)
-# define ERTS_PROC_GET_SCHDATA(PROC) ((PROC)->scheduler_data)
-#else
-# define ERTS_GET_SCHEDULER_DATA_FROM_PROC(PROC) (erts_scheduler_data)
-# define ERTS_PROC_GET_SCHDATA(PROC) (erts_scheduler_data)
-#endif
+int erts_debug_wait_completed(Process *c_p, int flags);
+
+Uint erts_process_memory(Process *c_p, int incl_msg_inq);
#ifdef ERTS_DO_VERIFY_UNUSED_TEMP_ALLOC
# define ERTS_VERIFY_UNUSED_TEMP_ALLOC(P) \
do { \
ErtsSchedulerData *esdp__ = ((P) \
- ? ERTS_PROC_GET_SCHDATA((Process *) (P)) \
+ ? erts_proc_sched_data((Process *) (P)) \
: erts_get_scheduler_data()); \
if (esdp__ && !ERTS_SCHEDULER_IS_DIRTY(esdp__)) \
esdp__->verify_unused_temp_alloc( \
@@ -1704,18 +1947,48 @@ ErtsSchedulerData *erts_get_scheduler_data(void)
#endif
#endif
-void erts_schedule_process(Process *, erts_aint32_t);
+void erts_schedule_process(Process *, erts_aint32_t, ErtsProcLocks);
+
+ERTS_GLB_INLINE void erts_proc_notify_new_message(Process *p, ErtsProcLocks locks);
+ERTS_GLB_INLINE void erts_schedule_dirty_sys_execution(Process *c_p);
-ERTS_GLB_INLINE void erts_proc_notify_new_message(Process *p);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
ERTS_GLB_INLINE void
-erts_proc_notify_new_message(Process *p)
+erts_proc_notify_new_message(Process *p, ErtsProcLocks locks)
{
/* No barrier needed, due to msg lock */
erts_aint32_t state = erts_smp_atomic32_read_nob(&p->state);
if (!(state & ERTS_PSFLG_ACTIVE))
- erts_schedule_process(p, state);
+ erts_schedule_process(p, state, locks);
}
+
+ERTS_GLB_INLINE void
+erts_schedule_dirty_sys_execution(Process *c_p)
+{
+ erts_aint32_t a, n, e;
+
+ a = erts_smp_atomic32_read_nob(&c_p->state);
+
+ /*
+ * Only a currently executing process schedules
+ * itself for dirty-sys execution...
+ */
+
+ ASSERT(a & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS));
+
+ /* Don't set dirty-active-sys if we are about to exit... */
+
+ while (!(a & (ERTS_PSFLG_DIRTY_ACTIVE_SYS
+ | ERTS_PSFLG_EXITING
+ | ERTS_PSFLG_PENDING_EXIT))) {
+ e = a;
+ n = a | ERTS_PSFLG_DIRTY_ACTIVE_SYS;
+ a = erts_smp_atomic32_cmpxchg_mb(&c_p->state, n, e);
+ if (a == e)
+ break; /* dirty-active-sys set */
+ }
+}
+
#endif
#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
@@ -1735,18 +2008,19 @@ do { \
#define ERTS_SMP_LC_CHK_RUNQ_LOCK(RQ, L)
#endif
-void *erts_psd_set_init(Process *p, ErtsProcLocks plocks, int ix, void *data);
+void *erts_psd_set_init(Process *p, int ix, void *data);
ERTS_GLB_INLINE void *
erts_psd_get(Process *p, int ix);
ERTS_GLB_INLINE void *
-erts_psd_set(Process *p, ErtsProcLocks plocks, int ix, void *new);
+erts_psd_set(Process *p, int ix, void *new);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
ERTS_GLB_INLINE void *
erts_psd_get(Process *p, int ix)
{
+ ErtsPSD *psd;
#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
ErtsProcLocks locks = erts_proc_lc_my_proc_locks(p);
if (ERTS_LC_PSD_ANY_LOCK == erts_psd_required_locks[ix].get_locks)
@@ -1757,78 +2031,88 @@ erts_psd_get(Process *p, int ix)
|| erts_thr_progress_is_blocking());
}
#endif
+
+ psd = (ErtsPSD *) erts_smp_atomic_read_nob(&p->psd);
ASSERT(0 <= ix && ix < ERTS_PSD_SIZE);
- return p->psd ? p->psd->data[ix] : NULL;
+ if (!psd)
+ return NULL;
+ ERTS_SMP_DATA_DEPENDENCY_READ_MEMORY_BARRIER;
+ return psd->data[ix];
}
-
-/*
- * NOTE: erts_psd_set() might release and reacquire locks on 'p'.
- */
ERTS_GLB_INLINE void *
-erts_psd_set(Process *p, ErtsProcLocks plocks, int ix, void *data)
+erts_psd_set(Process *p, int ix, void *data)
{
+ ErtsPSD *psd;
#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
ErtsProcLocks locks = erts_proc_lc_my_proc_locks(p);
- if (ERTS_LC_PSD_ANY_LOCK == erts_psd_required_locks[ix].set_locks)
- ERTS_SMP_LC_ASSERT(locks || erts_thr_progress_is_blocking());
- else {
- locks &= erts_psd_required_locks[ix].set_locks;
- ERTS_SMP_LC_ASSERT(erts_psd_required_locks[ix].set_locks == locks
- || erts_thr_progress_is_blocking());
+ erts_aint32_t state = state = erts_smp_atomic32_read_nob(&p->state);
+ if (!(state & ERTS_PSFLG_FREE)) {
+ if (ERTS_LC_PSD_ANY_LOCK == erts_psd_required_locks[ix].set_locks)
+ ERTS_SMP_LC_ASSERT(locks || erts_thr_progress_is_blocking());
+ else {
+ locks &= erts_psd_required_locks[ix].set_locks;
+ ERTS_SMP_LC_ASSERT(erts_psd_required_locks[ix].set_locks == locks
+ || erts_thr_progress_is_blocking());
+ }
}
#endif
+ psd = (ErtsPSD *) erts_smp_atomic_read_nob(&p->psd);
ASSERT(0 <= ix && ix < ERTS_PSD_SIZE);
- if (p->psd) {
- void *old = p->psd->data[ix];
- p->psd->data[ix] = data;
+ if (psd) {
+ void *old;
+#ifdef ERTS_SMP
+#ifdef ETHR_ORDERED_READ_DEPEND
+ ETHR_MEMBAR(ETHR_LoadStore|ETHR_StoreStore);
+#else
+ ETHR_MEMBAR(ETHR_LoadLoad|ETHR_LoadStore|ETHR_StoreStore);
+#endif
+#endif
+ old = psd->data[ix];
+ psd->data[ix] = data;
return old;
}
- else {
- if (!data)
- return NULL;
- else
- return erts_psd_set_init(p, plocks, ix, data);
- }
+
+ if (!data)
+ return NULL;
+
+ return erts_psd_set_init(p, ix, data);
}
#endif
-#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_SCHED_ID(P, ID) \
+ ((UWord) erts_psd_set((P), ERTS_PSD_SCHED_ID, (void *) (ID)))
#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) \
- ((struct saved_calls *) erts_psd_set((P), (L), ERTS_PSD_SAVED_CALLS_BUF, (void *) (SCB)))
+#define ERTS_PROC_SET_SAVED_CALLS_BUF(P, SCB) \
+ ((struct saved_calls *) erts_psd_set((P), ERTS_PSD_SAVED_CALLS_BUF, (void *) (SCB)))
#define ERTS_PROC_GET_CALL_TIME(P) \
((process_breakpoint_time_t *) erts_psd_get((P), ERTS_PSD_CALL_TIME_BP))
-#define ERTS_PROC_SET_CALL_TIME(P, L, PBT) \
- ((process_breakpoint_time_t *) erts_psd_set((P), (L), ERTS_PSD_CALL_TIME_BP, (void *) (PBT)))
+#define ERTS_PROC_SET_CALL_TIME(P, PBT) \
+ ((process_breakpoint_time_t *) erts_psd_set((P), ERTS_PSD_CALL_TIME_BP, (void *) (PBT)))
#define ERTS_PROC_GET_DELAYED_GC_TASK_QS(P) \
((ErtsProcSysTaskQs *) erts_psd_get((P), ERTS_PSD_DELAYED_GC_TASK_QS))
-#define ERTS_PROC_SET_DELAYED_GC_TASK_QS(P, L, PBT) \
- ((ErtsProcSysTaskQs *) erts_psd_set((P), (L), ERTS_PSD_DELAYED_GC_TASK_QS, (void *) (PBT)))
+#define ERTS_PROC_SET_DELAYED_GC_TASK_QS(P, PBT) \
+ ((ErtsProcSysTaskQs *) erts_psd_set((P), ERTS_PSD_DELAYED_GC_TASK_QS, (void *) (PBT)))
-#ifdef ERTS_DIRTY_SCHEDULERS
-#define ERTS_PROC_GET_DIRTY_SCHED_TRAP_EXPORT(P) \
- ((Export *) erts_psd_get((P), ERTS_PSD_DIRTY_SCHED_TRAP_EXPORT))
-#define ERTS_PROC_SET_DIRTY_SCHED_TRAP_EXPORT(P, L, DSTE) \
- ((Export *) erts_psd_set((P), (L), ERTS_PSD_DIRTY_SCHED_TRAP_EXPORT, (void *) (DSTE)))
-#endif
+#define ERTS_PROC_GET_NIF_TRAP_EXPORT(P) \
+ erts_psd_get((P), ERTS_PSD_NIF_TRAP_EXPORT)
+#define ERTS_PROC_SET_NIF_TRAP_EXPORT(P, NTE) \
+ erts_psd_set((P), ERTS_PSD_NIF_TRAP_EXPORT, (void *) (NTE))
+#ifdef HIPE
+#define ERTS_PROC_GET_SUSPENDED_SAVED_CALLS_BUF(P) \
+ ((struct saved_calls *) erts_psd_get((P), ERTS_PSD_SUSPENDED_SAVED_CALLS_BUF))
+#define ERTS_PROC_SET_SUSPENDED_SAVED_CALLS_BUF(P, SCB) \
+ ((struct saved_calls *) erts_psd_set((P), ERTS_PSD_SUSPENDED_SAVED_CALLS_BUF, (void *) (SCB)))
+#endif
ERTS_GLB_INLINE Eterm erts_proc_get_error_handler(Process *p);
-ERTS_GLB_INLINE Eterm erts_proc_set_error_handler(Process *p,
- ErtsProcLocks plocks,
- Eterm handler);
+ERTS_GLB_INLINE Eterm erts_proc_set_error_handler(Process *p, Eterm handler);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
ERTS_GLB_INLINE Eterm
@@ -1844,13 +2128,13 @@ erts_proc_get_error_handler(Process *p)
}
ERTS_GLB_INLINE Eterm
-erts_proc_set_error_handler(Process *p, ErtsProcLocks plocks, Eterm handler)
+erts_proc_set_error_handler(Process *p, Eterm handler)
{
void *old_val;
void *new_val;
ASSERT(is_atom(handler));
new_val = (handler == am_error_handler) ? NULL : (void *) (UWord) handler;
- old_val = erts_psd_set(p, plocks, ERTS_PSD_ERROR_HANDLER, new_val);
+ old_val = erts_psd_set(p, ERTS_PSD_ERROR_HANDLER, new_val);
if (!old_val)
return am_error_handler;
else {
@@ -1969,27 +2253,65 @@ erts_check_emigration_need(ErtsRunQueue *c_rq, int prio)
#endif
+ERTS_GLB_INLINE ErtsSchedulerData *erts_proc_sched_data(Process *c_p);
ERTS_GLB_INLINE int erts_is_scheduler_bound(ErtsSchedulerData *esdp);
ERTS_GLB_INLINE Process *erts_get_current_process(void);
ERTS_GLB_INLINE Eterm erts_get_current_pid(void);
ERTS_GLB_INLINE Uint erts_get_scheduler_id(void);
ERTS_GLB_INLINE ErtsRunQueue *erts_get_runq_proc(Process *p);
ERTS_GLB_INLINE ErtsRunQueue *erts_get_runq_current(ErtsSchedulerData *esdp);
-#ifndef ERTS_ENABLE_LOCK_COUNT
ERTS_GLB_INLINE void erts_smp_runq_lock(ErtsRunQueue *rq);
-#endif
ERTS_GLB_INLINE int erts_smp_runq_trylock(ErtsRunQueue *rq);
ERTS_GLB_INLINE void erts_smp_runq_unlock(ErtsRunQueue *rq);
-#ifndef ERTS_ENABLE_LOCK_COUNT
ERTS_GLB_INLINE void erts_smp_xrunq_lock(ErtsRunQueue *rq, ErtsRunQueue *xrq);
-#endif
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
+ErtsSchedulerData *erts_proc_sched_data(Process *c_p)
+{
+ ErtsSchedulerData *esdp;
+ ASSERT(c_p);
+#if !defined(ERTS_SMP)
+ esdp = erts_get_scheduler_data();
+#else
+ esdp = c_p->scheduler_data;
+# if defined(ERTS_DIRTY_SCHEDULERS)
+ if (esdp) {
+ ASSERT(esdp == erts_get_scheduler_data());
+ ASSERT(!ERTS_SCHEDULER_IS_DIRTY(esdp));
+ }
+ else {
+ esdp = erts_get_scheduler_data();
+ ASSERT(esdp);
+ ASSERT(ERTS_SCHEDULER_IS_DIRTY(esdp));
+ }
+# endif
+#endif
+ ASSERT(esdp);
+ return esdp;
+}
+
+ERTS_GLB_INLINE
int erts_is_scheduler_bound(ErtsSchedulerData *esdp)
{
if (!esdp)
@@ -2060,12 +2382,6 @@ erts_smp_runq_lock(ErtsRunQueue *rq)
#endif
}
-#ifdef ERTS_ENABLE_LOCK_COUNT
-
-#define erts_smp_runq_lock(rq) erts_smp_mtx_lock_x(&(rq)->mtx, __FILE__, __LINE__)
-
-#endif
-
ERTS_GLB_INLINE int
erts_smp_runq_trylock(ErtsRunQueue *rq)
{
@@ -2084,31 +2400,6 @@ erts_smp_runq_unlock(ErtsRunQueue *rq)
#endif
}
-#ifdef ERTS_ENABLE_LOCK_COUNT
-
-#define erts_smp_xrunq_lock(rq, xrq) erts_smp_xrunq_lock_x((rq), (xrq), __FILE__, __LINE__)
-
-ERTS_GLB_INLINE void
-erts_smp_xrunq_lock_x(ErtsRunQueue *rq, ErtsRunQueue *xrq, char* file, int line)
-{
-#ifdef ERTS_SMP
- ERTS_SMP_LC_ASSERT(erts_smp_lc_mtx_is_locked(&rq->mtx));
- if (xrq != rq) {
- if (erts_smp_mtx_trylock(&xrq->mtx) == EBUSY) {
- if (rq < xrq)
- erts_smp_mtx_lock_x(&xrq->mtx, file, line);
- else {
- erts_smp_mtx_unlock(&rq->mtx);
- erts_smp_mtx_lock_x(&xrq->mtx, file, line);
- erts_smp_mtx_lock_x(&rq->mtx, file, line);
- }
- }
- }
-#endif
-}
-
-#else
-
ERTS_GLB_INLINE void
erts_smp_xrunq_lock(ErtsRunQueue *rq, ErtsRunQueue *xrq)
{
@@ -2128,8 +2419,6 @@ erts_smp_xrunq_lock(ErtsRunQueue *rq, ErtsRunQueue *xrq)
#endif
}
-#endif
-
ERTS_GLB_INLINE void
erts_smp_xrunq_unlock(ErtsRunQueue *rq, ErtsRunQueue *xrq)
{
@@ -2168,6 +2457,66 @@ 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;
+ ErtsMessage *mp;
+
+ if ((*psp) & ERTS_PSFLG_OFF_HEAP_MSGQ) {
+ mp = erts_alloc_message(sz, hpp);
+ *ohpp = sz == 0 ? NULL : &mp->hfrag.off_heap;
+ return mp;
+ }
+
+ mp = erts_try_alloc_message_on_heap(pp, psp, plp, sz, hpp, ohpp, &on_heap);
+ ASSERT(pp || !on_heap);
+ return mp;
+}
+
+ERTS_GLB_INLINE ErtsMessage *
+erts_alloc_message_heap(Process *pp,
+ ErtsProcLocks *plp,
+ Uint sz,
+ Eterm **hpp,
+ ErlOffHeap **ohpp)
+{
+ erts_aint32_t state = pp ? erts_smp_atomic32_read_nob(&pp->state) : 0;
+ 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);
@@ -2177,17 +2526,42 @@ ERTS_GLB_INLINE ErtsAtomCacheMap *
erts_get_atom_cache_map(Process *c_p)
{
ErtsSchedulerData *esdp = (c_p
- ? ERTS_PROC_GET_SCHDATA(c_p)
+ ? erts_proc_sched_data(c_p)
: erts_get_scheduler_data());
ASSERT(esdp);
return &esdp->atom_cache_map;
}
#endif
-Process *erts_pid2proc_suspend(Process *,
- ErtsProcLocks,
- Eterm,
- ErtsProcLocks);
+#ifdef __WIN32__
+/*
+ * Don't want erts_time2reds() inlined in beam_emu.c on windows since
+ * it is compiled with gcc which fails on it. Implementation is in
+ * erl_process.c on windows.
+ */
+# define ERTS_TIME2REDS_IMPL__ erts_time2reds__
+#else
+# define ERTS_TIME2REDS_IMPL__ erts_time2reds
+#endif
+
+ERTS_GLB_INLINE Sint64 ERTS_TIME2REDS_IMPL__(ErtsMonotonicTime start,
+ ErtsMonotonicTime end);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+ERTS_GLB_INLINE Sint64
+ERTS_TIME2REDS_IMPL__(ErtsMonotonicTime start, ErtsMonotonicTime end)
+{
+ ErtsMonotonicTime time = end - start;
+ ASSERT(time >= 0);
+ time = ERTS_MONOTONIC_TO_USEC(time);
+ if (time == 0)
+ return (Sint64) 1; /* At least one reduction */
+ /* Currently two reductions per micro second */
+ time *= (CONTEXT_REDS-1)/1000 + 1;
+ return (Sint64) time;
+}
+#endif
+
#ifdef ERTS_SMP
Process *erts_pid2proc_not_running(Process *,
@@ -2259,6 +2633,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 23e5bf737f..3c80f0e0f6 100644
--- a/erts/emulator/beam/erl_process_dict.c
+++ b/erts/emulator/beam/erl_process_dict.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1999-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1999-2017. 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.
+ * 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%
*/
@@ -47,19 +48,22 @@
/* Hash constant macros */
#define MAX_HASH 1342177280UL
-#define INITIAL_SIZE 10
+#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)) ? (Uint32) unsigned_val(Term) : \
+ ((is_atom(Term)) ? \
+ (Uint32) atom_val(Term) : \
+ make_internal_hash(Term, 0)))
#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))
@@ -73,15 +77,21 @@
#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);
static Eterm pd_hash_put(Process *p, Eterm id, Eterm value);
@@ -89,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);
/*
@@ -132,11 +142,21 @@ 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
*/
void
-erts_dictionary_dump(int to, void *to_arg, ProcDict *pd)
+erts_dictionary_dump(fmtfn_t to, void *to_arg, ProcDict *pd)
{
unsigned int i;
#ifdef DEBUG
@@ -144,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));
@@ -176,8 +196,8 @@ erts_dictionary_dump(int to, void *to_arg, ProcDict *pd)
}
void
-erts_deep_dictionary_dump(int to, void *to_arg,
- ProcDict* pd, void (*cb)(int, void *, Eterm))
+erts_deep_dictionary_dump(fmtfn_t to, void *to_arg,
+ ProcDict* pd, void (*cb)(fmtfn_t, void *, Eterm))
{
unsigned int i;
Eterm t;
@@ -201,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;
}
@@ -275,6 +295,16 @@ BIF_RETTYPE get_1(BIF_ALIST_1)
BIF_RET(ret);
}
+BIF_RETTYPE get_keys_0(BIF_ALIST_0)
+{
+ Eterm ret;
+
+ PD_CHECK(BIF_P->dictionary);
+ ret = pd_hash_get_all_keys(BIF_P,BIF_P->dictionary);
+ PD_CHECK(BIF_P->dictionary);
+ BIF_RET(ret);
+}
+
BIF_RETTYPE get_keys_1(BIF_ALIST_1)
{
Eterm ret;
@@ -333,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];
}
@@ -353,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
@@ -362,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)) {
@@ -378,40 +408,102 @@ static void pd_hash_erase_all(Process *p)
}
}
+Uint32 erts_pd_make_hx(Eterm key)
+{
+ return MAKE_HASH(key);
+}
+
+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))); \
+ ASSERT(arityval(*((Eterm*)tuple_val((Src)))) == 2); \
+ (Dst) = ((Eterm*)tuple_val((Src)))[1]; \
+} while(0)
+
+static Eterm pd_hash_get_all_keys(Process *p, ProcDict *pd) {
+ Eterm* hp;
+ Eterm res = NIL;
+ Eterm tmp, tmp2;
+ unsigned int i;
+ unsigned int num;
+
+ if (pd == NULL) {
+ return res;
+ }
+
+ num = HASH_RANGE(pd);
+ hp = HAlloc(p, pd->numElements * 2);
+
+ for (i = 0; i < num; ++i) {
+ tmp = ARRAY_GET(pd, i);
+ if (is_boxed(tmp)) {
+ PD_GET_TKEY(tmp,tmp);
+ res = CONS(hp, tmp, res);
+ hp += 2;
+ } else if (is_list(tmp)) {
+ while (tmp != NIL) {
+ tmp2 = TCAR(tmp);
+ PD_GET_TKEY(tmp2,tmp2);
+ res = CONS(hp, tmp2, res);
+ hp += 2;
+ tmp = TCDR(tmp);
+ }
+ }
+ }
+ return res;
+}
+#undef PD_GET_TKEY
+
static Eterm pd_hash_get_keys(Process *p, Eterm value)
{
Eterm *hp;
@@ -496,8 +588,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);
@@ -530,7 +625,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];
@@ -549,19 +644,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);
}
@@ -571,7 +666,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);
@@ -606,7 +701,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 {
@@ -617,7 +712,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);
@@ -631,6 +726,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;
@@ -645,25 +741,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
@@ -674,13 +771,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);
@@ -688,7 +785,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);
@@ -700,14 +797,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);
}
}
@@ -715,14 +813,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
@@ -731,18 +829,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;
@@ -758,7 +858,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;
@@ -767,21 +867,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;
@@ -803,10 +904,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);
}
}
@@ -823,73 +922,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[] =
@@ -949,35 +1040,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 8fad2a67ab..ab58f3c239 100644
--- a/erts/emulator/beam/erl_process_dict.h
+++ b/erts/emulator/beam/erl_process_dict.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1999-2009. All Rights Reserved.
+ * Copyright Ericsson AB 1999-2016. 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.
+ * 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%
*/
@@ -22,21 +23,27 @@
#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);
-void erts_deep_dictionary_dump(int to, void *to_arg,
- ProcDict* pd, void (*cb)(int, void *, Eterm obj));
+void erts_dictionary_dump(fmtfn_t to, void *to_arg, ProcDict *pd);
+void erts_deep_dictionary_dump(fmtfn_t to, void *to_arg,
+ ProcDict* pd, void (*cb)(fmtfn_t, void *, Eterm obj));
Eterm erts_dictionary_copy(struct process *p, ProcDict *pd);
Eterm erts_pd_hash_get(struct process *p, Eterm id);
+Uint32 erts_pd_make_hx(Eterm key);
+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 2f3cf23b00..5641195458 100644
--- a/erts/emulator/beam/erl_process_dump.c
+++ b/erts/emulator/beam/erl_process_dump.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2003-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2003-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -31,6 +32,7 @@
#include "dist.h"
#include "beam_catches.h"
#include "erl_binary.h"
+#include "erl_map.h"
#define ERTS_WANT_EXTERNAL_TAGS
#include "external.h"
@@ -39,16 +41,22 @@
#define OUR_NIL _make_header(0,_TAG_HEADER_FLOAT)
-static void dump_process_info(int to, void *to_arg, Process *p);
-static void dump_element(int to, void *to_arg, Eterm x);
-static void dump_dist_ext(int to, void *to_arg, ErtsDistExternal *edep);
-static void dump_element_nl(int to, void *to_arg, Eterm x);
-static int stack_element_dump(int to, void *to_arg, Process* p, Eterm* sp,
+static void dump_process_info(fmtfn_t to, void *to_arg, Process *p);
+static void dump_element(fmtfn_t to, void *to_arg, Eterm x);
+static void dump_dist_ext(fmtfn_t to, void *to_arg, ErtsDistExternal *edep);
+static void dump_element_nl(fmtfn_t to, void *to_arg, Eterm x);
+static int stack_element_dump(fmtfn_t to, void *to_arg, Eterm* sp,
int yreg);
-static void print_function_from_pc(int to, void *to_arg, BeamInstr* x);
-static void heap_dump(int to, void *to_arg, Eterm x);
-static void dump_binaries(int to, void *to_arg, Binary* root);
-static void dump_externally(int to, void *to_arg, Eterm term);
+static void stack_trace_dump(fmtfn_t to, void *to_arg, Eterm* sp);
+static void print_function_from_pc(fmtfn_t to, void *to_arg, BeamInstr* x);
+static void heap_dump(fmtfn_t to, void *to_arg, Eterm x);
+static void dump_binaries(fmtfn_t to, void *to_arg, Binary* root);
+static void dump_externally(fmtfn_t to, void *to_arg, Eterm term);
+static void mark_literal(Eterm* ptr);
+static void init_literal_areas(void);
+static void dump_literals(fmtfn_t to, void *to_arg);
+static void dump_module_literals(fmtfn_t to, void *to_arg,
+ ErtsLiteralArea* lit_area);
static Binary* all_binaries;
@@ -56,14 +64,14 @@ extern BeamInstr beam_apply[];
extern BeamInstr beam_exit[];
extern BeamInstr beam_continue_exit[];
-
void
-erts_deep_process_dump(int to, void *to_arg)
+erts_deep_process_dump(fmtfn_t to, void *to_arg)
{
int i, max = erts_ptab_max(&erts_proc);
all_binaries = NULL;
-
+ init_literal_areas();
+
for (i = 0; i < max; i++) {
Process *p = erts_pix2proc(i);
if (p && p->i != ENULL) {
@@ -73,24 +81,29 @@ erts_deep_process_dump(int to, void *to_arg)
}
}
+ dump_literals(to, 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);
size += (p->heap_sz + p->mbuf_sz) * sizeof(Eterm);
+ if (p->abandoned_heap)
+ size += (p->hend - p->heap) * sizeof(Eterm);
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)
@@ -100,7 +113,7 @@ Uint erts_process_memory(Process *p) {
size += p->arity * sizeof(p->arg_reg[0]);
}
- if (p->psd)
+ if (erts_smp_atomic_read_nob(&p->psd) != (erts_aint_t) NULL)
size += sizeof(ErtsPSD);
scb = ERTS_PROC_GET_SAVED_CALLS_BUF(p);
@@ -114,10 +127,10 @@ Uint erts_process_memory(Process *p) {
}
static void
-dump_process_info(int to, void *to_arg, Process *p)
+dump_process_info(fmtfn_t to, void *to_arg, Process *p)
{
Eterm* sp;
- ErlMessage* mp;
+ ErtsMessage* mp;
int yreg = -1;
ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p);
@@ -148,7 +161,7 @@ dump_process_info(int to, void *to_arg, Process *p)
if ((ERTS_TRACE_FLAGS(p) & F_SENSITIVE) == 0) {
erts_print(to, to_arg, "=proc_stack:%T\n", p->common.id);
for (sp = p->stop; sp < STACK_START(p); sp++) {
- yreg = stack_element_dump(to, to_arg, p, sp, yreg);
+ yreg = stack_element_dump(to, to_arg, sp, yreg);
}
erts_print(to, to_arg, "=proc_heap:%T\n", p->common.id);
@@ -173,7 +186,7 @@ dump_process_info(int to, void *to_arg, Process *p)
}
static void
-dump_dist_ext(int to, void *to_arg, ErtsDistExternal *edep)
+dump_dist_ext(fmtfn_t to, void *to_arg, ErtsDistExternal *edep)
{
if (!edep)
erts_print(to, to_arg, "D0:E0:");
@@ -207,7 +220,7 @@ dump_dist_ext(int to, void *to_arg, ErtsDistExternal *edep)
}
static void
-dump_element(int to, void *to_arg, Eterm x)
+dump_element(fmtfn_t to, void *to_arg, Eterm x)
{
if (is_list(x)) {
erts_print(to, to_arg, "H" PTR_FMT, list_val(x));
@@ -237,15 +250,71 @@ dump_element(int to, void *to_arg, Eterm x)
}
static void
-dump_element_nl(int to, void *to_arg, Eterm x)
+dump_element_nl(fmtfn_t to, void *to_arg, Eterm x)
{
dump_element(to, to_arg, x);
erts_putc(to, to_arg, '\n');
}
+static void
+stack_trace_dump(fmtfn_t to, void *to_arg, Eterm *sp) {
+ Eterm x = *sp;
+ if (is_CP(x)) {
+ erts_print(to, to_arg, "%p:", sp);
+ erts_print(to, to_arg, "SReturn addr 0x%X (", cp_val(x));
+ print_function_from_pc(to, to_arg, cp_val(x));
+ erts_print(to, to_arg, ")\n");
+ }
+}
+
+void
+erts_limited_stack_trace(fmtfn_t to, void *to_arg, Process *p)
+{
+ Eterm* sp;
+
+
+ if (ERTS_TRACE_FLAGS(p) & F_SENSITIVE) {
+ return;
+ }
+
+ if (STACK_START(p) < STACK_TOP(p)) {
+ return;
+ }
+
+ if ((STACK_START(p) - STACK_TOP(p)) < 512) {
+ if (erts_sys_is_area_readable((char*)STACK_TOP(p),
+ (char*)STACK_START(p)))
+ for (sp = STACK_TOP(p); sp < STACK_START(p); sp++)
+ stack_trace_dump(to, to_arg, sp);
+ else
+ erts_print(to, to_arg, "Could not read from stack memory: %p - %p\n",
+ STACK_TOP(p), STACK_START(p));
+ } else {
+ sp = STACK_TOP(p);
+ if (erts_sys_is_area_readable((char*)STACK_TOP(p),
+ (char*)(STACK_TOP(p) + 25)))
+ for (; sp < (STACK_TOP(p) + 256); sp++)
+ stack_trace_dump(to, to_arg, sp);
+ else
+ erts_print(to, to_arg, "Could not read from stack memory: %p - %p\n",
+ STACK_TOP(p), STACK_TOP(p) + 256);
+
+ erts_print(to, to_arg, "%p: skipping %d frames\n",
+ sp, STACK_START(p) - STACK_TOP(p) - 512);
+
+ if (erts_sys_is_area_readable((char*)(STACK_START(p) - 256),
+ (char*)STACK_START(p)))
+ for (sp = STACK_START(p) - 256; sp < STACK_START(p); sp++)
+ stack_trace_dump(to, to_arg, sp);
+ else
+ erts_print(to, to_arg, "Could not read from stack memory: %p - %p\n",
+ STACK_START(p) - 256, STACK_START(p));
+ }
+
+}
static int
-stack_element_dump(int to, void *to_arg, Process* p, Eterm* sp, int yreg)
+stack_element_dump(fmtfn_t to, void *to_arg, Eterm* sp, int yreg)
{
Eterm x = *sp;
@@ -273,10 +342,10 @@ stack_element_dump(int to, void *to_arg, Process* p, Eterm* sp, int yreg)
}
static void
-print_function_from_pc(int to, void *to_arg, BeamInstr* x)
+print_function_from_pc(fmtfn_t to, void *to_arg, BeamInstr* x)
{
- BeamInstr* addr = find_function_from_pc(x);
- if (addr == NULL) {
+ ErtsCodeMFA* cmfa = find_function_from_pc(x);
+ if (cmfa == NULL) {
if (x == beam_exit) {
erts_print(to, to_arg, "<terminate process>");
} else if (x == beam_continue_exit) {
@@ -288,12 +357,13 @@ print_function_from_pc(int to, void *to_arg, BeamInstr* x)
}
} else {
erts_print(to, to_arg, "%T:%T/%bpu + %bpu",
- addr[0], addr[1], addr[2], ((x-addr)-2) * sizeof(Eterm));
+ cmfa->module, cmfa->function, cmfa->arity,
+ (x-(BeamInstr*)cmfa) * sizeof(Eterm));
}
}
static void
-heap_dump(int to, void *to_arg, Eterm x)
+heap_dump(fmtfn_t to, void *to_arg, Eterm x)
{
DeclareTmpHeapNoproc(last,1);
Eterm* next = last;
@@ -307,10 +377,12 @@ 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) {
+ if (erts_is_literal(x, ptr)) {
+ mark_literal(ptr);
+ } else if (ptr[0] != OUR_NIL) {
erts_print(to, to_arg, PTR_FMT ":l", ptr);
dump_element(to, to_arg, ptr[0]);
erts_putc(to, to_arg, '|');
@@ -320,7 +392,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;
}
@@ -329,7 +401,9 @@ heap_dump(int to, void *to_arg, Eterm x)
ptr = boxed_val(x);
hdr = *ptr;
- if (hdr != OUR_NIL) { /* If not visited */
+ if (erts_is_literal(x, ptr)) {
+ mark_literal(ptr);
+ } else if (hdr != OUR_NIL) {
erts_print(to, to_arg, PTR_FMT ":", ptr);
if (is_arity_value(hdr)) {
Uint i;
@@ -350,7 +424,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;
}
@@ -384,8 +458,8 @@ heap_dump(int to, void *to_arg, Eterm x)
ProcBin* pb = (ProcBin *) binary_val(x);
Binary* val = pb->val;
- if (erts_smp_atomic_xchg_nob(&val->refc, 0) != 0) {
- val->flags = (UWord) all_binaries;
+ if (erts_atomic_xchg_nob(&val->intern.refc, 0) != 0) {
+ val->intern.flags = (UWord) all_binaries;
all_binaries = val;
}
erts_print(to, to_arg,
@@ -435,11 +509,77 @@ heap_dump(int to, void *to_arg, Eterm x)
erts_print(to, to_arg, "p<%beu.%beu>\n",
port_channel_no(x), port_number(x));
*ptr = OUR_NIL;
+ } else if (is_map_header(hdr)) {
+ if (is_flatmap_header(hdr)) {
+ flatmap_t* fmp = (flatmap_t *) flatmap_val(x);
+ Eterm* values = ptr + sizeof(flatmap_t) / sizeof(Eterm);
+ Uint map_size = fmp->size;
+ int i;
+
+ erts_print(to, to_arg, "Mf" ETERM_FMT ":", map_size);
+ dump_element(to, to_arg, fmp->keys);
+ erts_putc(to, to_arg, ':');
+ for (i = 0; i < map_size; i++) {
+ dump_element(to, to_arg, values[i]);
+ if (is_immed(values[i])) {
+ values[i] = make_small(0);
+ }
+ if (i < map_size-1) {
+ erts_putc(to, to_arg, ',');
+ }
+ }
+ erts_putc(to, to_arg, '\n');
+ *ptr = OUR_NIL;
+ x = fmp->keys;
+ if (map_size) {
+ fmp->keys = (Eterm) next;
+ next = &values[map_size-1];
+ }
+ continue;
+ } else {
+ Uint i;
+ Uint sz = 0;
+ Eterm* nodes = ptr + 1;
+
+ switch (MAP_HEADER_TYPE(hdr)) {
+ case MAP_HEADER_TAG_HAMT_HEAD_ARRAY:
+ nodes++;
+ sz = 16;
+ erts_print(to, to_arg, "Mh" ETERM_FMT ":" ETERM_FMT ":",
+ hashmap_size(x), sz);
+ break;
+ case MAP_HEADER_TAG_HAMT_HEAD_BITMAP:
+ nodes++;
+ sz = hashmap_bitcount(MAP_HEADER_VAL(hdr));
+ erts_print(to, to_arg, "Mh" ETERM_FMT ":" ETERM_FMT ":",
+ hashmap_size(x), sz);
+ break;
+ case MAP_HEADER_TAG_HAMT_NODE_BITMAP:
+ sz = hashmap_bitcount(MAP_HEADER_VAL(hdr));
+ erts_print(to, to_arg, "Mn" ETERM_FMT ":", sz);
+ break;
+ }
+ *ptr = OUR_NIL;
+ for (i = 0; i < sz; i++) {
+ dump_element(to, to_arg, nodes[i]);
+ if (is_immed(nodes[i])) {
+ nodes[i] = make_small(0);
+ }
+ if (i < sz-1) {
+ erts_putc(to, to_arg, ',');
+ }
+ }
+ erts_putc(to, to_arg, '\n');
+ x = nodes[0];
+ nodes[0] = (Eterm) next;
+ next = &nodes[sz-1];
+ continue;
+ }
} else {
/*
* All other we dump in the external term format.
*/
- dump_externally(to, to_arg, x);
+ dump_externally(to, to_arg, x);
erts_putc(to, to_arg, '\n');
*ptr = OUR_NIL;
}
@@ -453,7 +593,7 @@ heap_dump(int to, void *to_arg, Eterm x)
}
static void
-dump_binaries(int to, void *to_arg, Binary* current)
+dump_binaries(fmtfn_t to, void *to_arg, Binary* current)
{
while (current) {
long i;
@@ -466,12 +606,12 @@ dump_binaries(int to, void *to_arg, Binary* current)
erts_print(to, to_arg, "%02X", bytes[i]);
}
erts_putc(to, to_arg, '\n');
- current = (Binary *) current->flags;
+ current = (Binary *) current->intern.flags;
}
}
static void
-dump_externally(int to, void *to_arg, Eterm term)
+dump_externally(fmtfn_t to, void *to_arg, Eterm term)
{
byte sbuf[1024]; /* encode and hope for the best ... */
byte* s;
@@ -508,3 +648,394 @@ dump_externally(int to, void *to_arg, Eterm term)
erts_print(to, to_arg, "%02X", *s++);
}
}
+
+/*
+ * Handle dumping of literal areas.
+ */
+
+static ErtsLiteralArea** lit_areas;
+static Uint num_lit_areas;
+
+static int compare_areas(const void * a, const void * b)
+{
+ ErtsLiteralArea** a_p = (ErtsLiteralArea **) a;
+ ErtsLiteralArea** b_p = (ErtsLiteralArea **) b;
+
+ if (*a_p < *b_p) {
+ return -1;
+ } else if (*b_p < *a_p) {
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+
+static void
+init_literal_areas(void)
+{
+ int i;
+ Module* modp;
+ ErtsCodeIndex code_ix;
+ ErtsLiteralArea** area_p;
+
+ code_ix = erts_active_code_ix();
+ erts_rlock_old_code(code_ix);
+
+ lit_areas = area_p = erts_dump_lit_areas;
+ num_lit_areas = 0;
+ for (i = 0; i < module_code_size(code_ix); i++) {
+ modp = module_code(i, code_ix);
+ if (modp == NULL) {
+ continue;
+ }
+ if (modp->curr.code_length > 0 &&
+ modp->curr.code_hdr->literal_area) {
+ *area_p++ = modp->curr.code_hdr->literal_area;
+ }
+ if (modp->old.code_length > 0 && modp->old.code_hdr->literal_area) {
+ *area_p++ = modp->old.code_hdr->literal_area;
+ }
+ }
+
+ num_lit_areas = area_p - lit_areas;
+ ASSERT(num_lit_areas <= erts_dump_num_lit_areas);
+ for (i = 0; i < num_lit_areas; i++) {
+ lit_areas[i]->off_heap = 0;
+ }
+
+ qsort(lit_areas, num_lit_areas, sizeof(ErtsLiteralArea *),
+ compare_areas);
+
+ erts_runlock_old_code(code_ix);
+}
+
+static int search_areas(const void * a, const void * b) {
+ Eterm* key = (Eterm *) a;
+ ErtsLiteralArea** b_p = (ErtsLiteralArea **) b;
+ if (key < b_p[0]->start) {
+ return -1;
+ } else if (b_p[0]->end <= key) {
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+static void mark_literal(Eterm* ptr)
+{
+ ErtsLiteralArea** ap;
+
+ ap = bsearch(ptr, lit_areas, num_lit_areas, sizeof(ErtsLiteralArea*),
+ search_areas);
+
+ /*
+ * If the literal was created by native code, this search will not
+ * find it and ap will be NULL.
+ */
+
+ if (ap) {
+ ap[0]->off_heap = (struct erl_off_heap_header *) 1;
+ }
+}
+
+
+static void
+dump_literals(fmtfn_t to, void *to_arg)
+{
+ ErtsCodeIndex code_ix;
+ int i;
+
+ code_ix = erts_active_code_ix();
+ erts_rlock_old_code(code_ix);
+
+ erts_print(to, to_arg, "=literals\n");
+ for (i = 0; i < num_lit_areas; i++) {
+ if (lit_areas[i]->off_heap) {
+ dump_module_literals(to, to_arg, lit_areas[i]);
+ }
+ }
+
+ erts_runlock_old_code(code_ix);
+}
+
+static void
+dump_module_literals(fmtfn_t to, void *to_arg, ErtsLiteralArea* lit_area)
+{
+ Eterm* htop;
+ Eterm* hend;
+
+ htop = lit_area->start;
+ hend = lit_area->end;
+ while (htop < hend) {
+ Eterm w = *htop;
+ Eterm term;
+ Uint size;
+
+ switch (primary_tag(w)) {
+ case TAG_PRIMARY_HEADER:
+ term = make_boxed(htop);
+ erts_print(to, to_arg, PTR_FMT ":", htop);
+ if (is_arity_value(w)) {
+ Uint i;
+ Uint arity = arityval(w);
+
+ erts_print(to, to_arg, "t" ETERM_FMT ":", arity);
+ for (i = 1; i <= arity; i++) {
+ dump_element(to, to_arg, htop[i]);
+ if (i < arity) {
+ erts_putc(to, to_arg, ',');
+ }
+ }
+ erts_putc(to, to_arg, '\n');
+ } else if (w == HEADER_FLONUM) {
+ FloatDef f;
+ char sbuf[31];
+ int i;
+
+ GET_DOUBLE_DATA((htop+1), f);
+ i = sys_double_to_chars(f.fd, sbuf, sizeof(sbuf));
+ sys_memset(sbuf+i, 0, 31-i);
+ erts_print(to, to_arg, "F%X:%s\n", i, sbuf);
+ } else if (_is_bignum_header(w)) {
+ erts_print(to, to_arg, "B%T\n", term);
+ } else if (is_binary_header(w)) {
+ Uint tag = thing_subtag(w);
+ Uint size = binary_size(term);
+ Uint i;
+
+ if (tag == HEAP_BINARY_SUBTAG) {
+ byte* p;
+
+ erts_print(to, to_arg, "Yh%X:", size);
+ p = binary_bytes(term);
+ for (i = 0; i < size; i++) {
+ erts_print(to, to_arg, "%02X", p[i]);
+ }
+ } else if (tag == REFC_BINARY_SUBTAG) {
+ ProcBin* pb = (ProcBin *) binary_val(term);
+ Binary* val = pb->val;
+
+ if (erts_atomic_xchg_nob(&val->intern.refc, 0) != 0) {
+ val->intern.flags = (UWord) all_binaries;
+ all_binaries = val;
+ }
+ erts_print(to, to_arg,
+ "Yc" PTR_FMT ":" PTR_FMT ":" PTR_FMT,
+ val,
+ pb->bytes - (byte *)val->orig_bytes,
+ size);
+ } else if (tag == SUB_BINARY_SUBTAG) {
+ ErlSubBin* Sb = (ErlSubBin *) binary_val(term);
+ Eterm* real_bin;
+ void* val;
+
+ real_bin = boxed_val(Sb->orig);
+ if (thing_subtag(*real_bin) == REFC_BINARY_SUBTAG) {
+ /*
+ * Unvisited REFC_BINARY: Point directly to
+ * the binary.
+ */
+ ProcBin* pb = (ProcBin *) real_bin;
+ val = pb->val;
+ } else {
+ /*
+ * Heap binary or visited REFC binary: Point
+ * to heap binary or ProcBin on the heap.
+ */
+ val = real_bin;
+ }
+ erts_print(to, to_arg,
+ "Ys" PTR_FMT ":" PTR_FMT ":" PTR_FMT,
+ val, Sb->offs, size);
+ }
+ erts_putc(to, to_arg, '\n');
+ } else if (is_map_header(w)) {
+ if (is_flatmap_header(w)) {
+ flatmap_t* fmp = (flatmap_t *) flatmap_val(term);
+ Eterm* values = htop + sizeof(flatmap_t) / sizeof(Eterm);
+ Uint map_size = fmp->size;
+ int i;
+
+ erts_print(to, to_arg, "Mf" ETERM_FMT ":", map_size);
+ dump_element(to, to_arg, fmp->keys);
+ erts_putc(to, to_arg, ':');
+ for (i = 0; i < map_size; i++) {
+ dump_element(to, to_arg, values[i]);
+ if (i < map_size-1) {
+ erts_putc(to, to_arg, ',');
+ }
+ }
+ erts_putc(to, to_arg, '\n');
+ } else {
+ Uint i;
+ Uint sz = 0;
+ Eterm* nodes = htop + 1;
+
+ switch (MAP_HEADER_TYPE(w)) {
+ case MAP_HEADER_TAG_HAMT_HEAD_ARRAY:
+ nodes++;
+ sz = 16;
+ erts_print(to, to_arg, "Mh" ETERM_FMT ":" ETERM_FMT ":",
+ hashmap_size(term), sz);
+ break;
+ case MAP_HEADER_TAG_HAMT_HEAD_BITMAP:
+ nodes++;
+ sz = hashmap_bitcount(MAP_HEADER_VAL(w));
+ erts_print(to, to_arg, "Mh" ETERM_FMT ":" ETERM_FMT ":",
+ hashmap_size(term), sz);
+ break;
+ case MAP_HEADER_TAG_HAMT_NODE_BITMAP:
+ sz = hashmap_bitcount(MAP_HEADER_VAL(w));
+ erts_print(to, to_arg, "Mn" ETERM_FMT ":", sz);
+ break;
+ }
+ for (i = 0; i < sz; i++) {
+ dump_element(to, to_arg, nodes[i]);
+ if (i < sz-1) {
+ erts_putc(to, to_arg, ',');
+ }
+ }
+ erts_putc(to, to_arg, '\n');
+ }
+ }
+ size = 1 + header_arity(w);
+ switch (w & _HEADER_SUBTAG_MASK) {
+ case MAP_SUBTAG:
+ if (is_flatmap_header(w)) {
+ size += 1 + flatmap_get_size(htop);
+ } else {
+ size += hashmap_bitcount(MAP_HEADER_VAL(w));
+ }
+ break;
+ case SUB_BINARY_SUBTAG:
+ size += 1;
+ break;
+ }
+ break;
+ default:
+ ASSERT(!is_header(htop[1]));
+ erts_print(to, to_arg, PTR_FMT ":l", htop);
+ dump_element(to, to_arg, htop[0]);
+ erts_putc(to, to_arg, '|');
+ dump_element(to, to_arg, htop[1]);
+ erts_putc(to, to_arg, '\n');
+ size = 2;
+ break;
+ }
+ htop += size;
+ }
+}
+
+void erts_dump_process_state(fmtfn_t to, void *to_arg, erts_aint32_t psflg)
+{
+ char *s;
+ switch (erts_process_state2status(psflg)) {
+ case am_free: s = "Non Existing"; break; /* Should never happen */
+ case am_exiting: s = "Exiting"; break;
+ case am_garbage_collecting: s = "Garbing"; break;
+ case am_suspended: s = "Suspended"; break;
+ case am_running: s = "Running"; break;
+ case am_runnable: s = "Scheduled"; break;
+ case am_waiting: s = "Waiting"; break;
+ default: s = "Undefined"; break; /* Should never happen */
+ }
+
+ erts_print(to, to_arg, "%s\n", s);
+}
+
+void
+erts_dump_extended_process_state(fmtfn_t to, void *to_arg, erts_aint32_t psflg) {
+
+ int i;
+
+ switch (ERTS_PSFLGS_GET_ACT_PRIO(psflg)) {
+ case PRIORITY_MAX: erts_print(to, to_arg, "ACT_PRIO_MAX | "); break;
+ case PRIORITY_HIGH: erts_print(to, to_arg, "ACT_PRIO_HIGH | "); break;
+ case PRIORITY_NORMAL: erts_print(to, to_arg, "ACT_PRIO_NORMAL | "); break;
+ case PRIORITY_LOW: erts_print(to, to_arg, "ACT_PRIO_LOW | "); break;
+ }
+ switch (ERTS_PSFLGS_GET_USR_PRIO(psflg)) {
+ case PRIORITY_MAX: erts_print(to, to_arg, "USR_PRIO_MAX | "); break;
+ case PRIORITY_HIGH: erts_print(to, to_arg, "USR_PRIO_HIGH | "); break;
+ case PRIORITY_NORMAL: erts_print(to, to_arg, "USR_PRIO_NORMAL | "); break;
+ case PRIORITY_LOW: erts_print(to, to_arg, "USR_PRIO_LOW | "); break;
+ }
+ switch (ERTS_PSFLGS_GET_PRQ_PRIO(psflg)) {
+ case PRIORITY_MAX: erts_print(to, to_arg, "PRQ_PRIO_MAX"); break;
+ case PRIORITY_HIGH: erts_print(to, to_arg, "PRQ_PRIO_HIGH"); break;
+ case PRIORITY_NORMAL: erts_print(to, to_arg, "PRQ_PRIO_NORMAL"); break;
+ case PRIORITY_LOW: erts_print(to, to_arg, "PRQ_PRIO_LOW"); break;
+ }
+
+ psflg &= ~(ERTS_PSFLGS_ACT_PRIO_MASK |
+ ERTS_PSFLGS_USR_PRIO_MASK |
+ ERTS_PSFLGS_PRQ_PRIO_MASK);
+
+ if (psflg)
+ erts_print(to, to_arg, " | ");
+
+ for (i = 0; i <= ERTS_PSFLG_MAX && psflg; i++) {
+ erts_aint32_t chk = (1 << i);
+ if (psflg & chk) {
+ switch (chk) {
+ case ERTS_PSFLG_IN_PRQ_MAX:
+ erts_print(to, to_arg, "IN_PRQ_MAX"); break;
+ case ERTS_PSFLG_IN_PRQ_HIGH:
+ erts_print(to, to_arg, "IN_PRQ_HIGH"); break;
+ case ERTS_PSFLG_IN_PRQ_NORMAL:
+ erts_print(to, to_arg, "IN_PRQ_NORMAL"); break;
+ case ERTS_PSFLG_IN_PRQ_LOW:
+ erts_print(to, to_arg, "IN_PRQ_LOW"); break;
+ case ERTS_PSFLG_FREE:
+ erts_print(to, to_arg, "FREE"); break;
+ case ERTS_PSFLG_EXITING:
+ erts_print(to, to_arg, "EXITING"); break;
+ case ERTS_PSFLG_PENDING_EXIT:
+ erts_print(to, to_arg, "PENDING_EXIT"); break;
+ case ERTS_PSFLG_ACTIVE:
+ erts_print(to, to_arg, "ACTIVE"); break;
+ case ERTS_PSFLG_IN_RUNQ:
+ erts_print(to, to_arg, "IN_RUNQ"); break;
+ case ERTS_PSFLG_RUNNING:
+ erts_print(to, to_arg, "RUNNING"); break;
+ case ERTS_PSFLG_SUSPENDED:
+ erts_print(to, to_arg, "SUSPENDED"); break;
+ case ERTS_PSFLG_GC:
+ erts_print(to, to_arg, "GC"); break;
+ case ERTS_PSFLG_BOUND:
+ erts_print(to, to_arg, "BOUND"); break;
+ case ERTS_PSFLG_TRAP_EXIT:
+ erts_print(to, to_arg, "TRAP_EXIT"); break;
+ case ERTS_PSFLG_ACTIVE_SYS:
+ erts_print(to, to_arg, "ACTIVE_SYS"); break;
+ case ERTS_PSFLG_RUNNING_SYS:
+ erts_print(to, to_arg, "RUNNING_SYS"); break;
+ case ERTS_PSFLG_PROXY:
+ erts_print(to, to_arg, "PROXY"); break;
+ case ERTS_PSFLG_DELAYED_SYS:
+ erts_print(to, to_arg, "DELAYED_SYS"); break;
+ 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_ACTIVE_SYS:
+ erts_print(to, to_arg, "DIRTY_ACTIVE_SYS"); break;
+ case ERTS_PSFLG_DIRTY_RUNNING:
+ erts_print(to, to_arg, "DIRTY_RUNNING"); break;
+ case ERTS_PSFLG_DIRTY_RUNNING_SYS:
+ erts_print(to, to_arg, "DIRTY_RUNNING_SYS"); break;
+ default:
+ erts_print(to, to_arg, "UNKNOWN(%d)", chk); break;
+ }
+ if (psflg > chk)
+ erts_print(to, to_arg, " | ");
+ psflg -= chk;
+ }
+ }
+ erts_print(to, to_arg, "\n");
+}
diff --git a/erts/emulator/beam/erl_process_lock.c b/erts/emulator/beam/erl_process_lock.c
index 82cc68222d..ff124d5ba7 100644
--- a/erts/emulator/beam/erl_process_lock.c
+++ b/erts/emulator/beam/erl_process_lock.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2007-2012. All Rights Reserved.
+ * Copyright Ericsson AB 2007-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -103,24 +104,21 @@ static struct {
Sint16 proc_lock_main;
Sint16 proc_lock_link;
Sint16 proc_lock_msgq;
+ Sint16 proc_lock_btm;
Sint16 proc_lock_status;
+ Sint16 proc_lock_trace;
} lc_id;
#endif
erts_pix_lock_t erts_pix_locks[ERTS_NO_OF_PIX_LOCKS];
-
void
erts_init_proc_lock(int cpus)
{
int i;
for (i = 0; i < ERTS_NO_OF_PIX_LOCKS; i++) {
-#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_mtx_init_x(&erts_pix_locks[i].u.mtx,
- "pix_lock", make_small(i), 1);
-#else
- erts_mtx_init(&erts_pix_locks[i].u.mtx, "pix_lock");
-#endif
+ erts_mtx_init(&erts_pix_locks[i].u.mtx, "pix_lock", make_small(i),
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_PROCESS);
}
#if ERTS_PROC_LOCK_OWN_IMPL
erts_thr_install_exit_handler(cleanup_tse);
@@ -145,7 +143,9 @@ erts_init_proc_lock(int cpus)
lc_id.proc_lock_main = erts_lc_get_lock_order_id("proc_main");
lc_id.proc_lock_link = erts_lc_get_lock_order_id("proc_link");
lc_id.proc_lock_msgq = erts_lc_get_lock_order_id("proc_msgq");
+ lc_id.proc_lock_btm = erts_lc_get_lock_order_id("proc_btm");
lc_id.proc_lock_status = erts_lc_get_lock_order_id("proc_status");
+ lc_id.proc_lock_trace = erts_lc_get_lock_order_id("proc_trace");
#endif
}
@@ -707,7 +707,7 @@ proc_safelock(int is_managed,
need_locks1 |= unlock_locks;
if (!is_managed && !have_locks1) {
refc1 = 1;
- erts_smp_proc_inc_refc(p1);
+ erts_proc_inc_refc(p1);
}
erts_smp_proc_unlock(p1, unlock_locks);
}
@@ -717,7 +717,7 @@ proc_safelock(int is_managed,
need_locks2 |= unlock_locks;
if (!is_managed && !have_locks2) {
refc2 = 1;
- erts_smp_proc_inc_refc(p2);
+ erts_proc_inc_refc(p2);
}
erts_smp_proc_unlock(p2, unlock_locks);
}
@@ -798,9 +798,9 @@ proc_safelock(int is_managed,
if (!is_managed) {
if (refc1)
- erts_smp_proc_dec_refc(p1);
+ erts_proc_dec_refc(p1);
if (refc2)
- erts_smp_proc_dec_refc(p2);
+ erts_proc_dec_refc(p2);
}
}
@@ -861,8 +861,8 @@ erts_pid2proc_opt(Process *c_p,
return NULL;
need_locks &= ~c_p_have_locks;
if (!need_locks) {
- if (flags & ERTS_P2P_FLG_SMP_INC_REFC)
- erts_smp_proc_inc_refc(c_p);
+ if (flags & ERTS_P2P_FLG_INC_REFC)
+ erts_proc_inc_refc(c_p);
return c_p;
}
}
@@ -875,8 +875,8 @@ erts_pid2proc_opt(Process *c_p,
if (proc->common.id != pid)
proc = NULL;
else if (!need_locks) {
- if (flags & ERTS_P2P_FLG_SMP_INC_REFC)
- erts_smp_proc_inc_refc(proc);
+ if (flags & ERTS_P2P_FLG_INC_REFC)
+ erts_proc_inc_refc(proc);
}
else {
int busy;
@@ -916,8 +916,8 @@ erts_pid2proc_opt(Process *c_p,
#endif
if (!busy) {
- if (flags & ERTS_P2P_FLG_SMP_INC_REFC)
- erts_smp_proc_inc_refc(proc);
+ if (flags & ERTS_P2P_FLG_INC_REFC)
+ erts_proc_inc_refc(proc);
#if ERTS_PROC_LOCK_OWN_IMPL && defined(ERTS_ENABLE_LOCK_COUNT)
/* all is great */
@@ -932,16 +932,16 @@ erts_pid2proc_opt(Process *c_p,
proc = ERTS_PROC_LOCK_BUSY;
else {
int managed;
- if (flags & ERTS_P2P_FLG_SMP_INC_REFC)
- erts_smp_proc_inc_refc(proc);
+ if (flags & ERTS_P2P_FLG_INC_REFC)
+ erts_proc_inc_refc(proc);
#if ERTS_PROC_LOCK_OWN_IMPL && defined(ERTS_ENABLE_LOCK_COUNT)
- erts_lcnt_proc_lock_unaquire(&proc->lock, lcnt_locks);
+ erts_lcnt_proc_lock_unacquire(&proc->lock, lcnt_locks);
#endif
managed = dhndl == ERTS_THR_PRGR_DHANDLE_MANAGED;
if (!managed) {
- erts_smp_proc_inc_refc(proc);
+ erts_proc_inc_refc(proc);
erts_thr_progress_unmanaged_continue(dhndl);
dec_refc_proc = proc;
@@ -978,14 +978,14 @@ erts_pid2proc_opt(Process *c_p,
erts_smp_proc_unlock(proc, need_locks);
- if (flags & ERTS_P2P_FLG_SMP_INC_REFC)
+ if (flags & ERTS_P2P_FLG_INC_REFC)
dec_refc_proc = proc;
proc = NULL;
}
if (dec_refc_proc)
- erts_smp_proc_dec_refc(dec_refc_proc);
+ erts_proc_dec_refc(dec_refc_proc);
#if ERTS_PROC_LOCK_OWN_IMPL && defined(ERTS_PROC_LOCK_DEBUG)
ERTS_LC_ASSERT(!proc
@@ -998,10 +998,47 @@ erts_pid2proc_opt(Process *c_p,
return proc;
}
+static ERTS_INLINE
+Process *proc_lookup_inc_refc(Eterm pid, int allow_exit)
+{
+ Process *proc;
+#ifdef ERTS_SMP
+ ErtsThrPrgrDelayHandle dhndl;
+
+ dhndl = erts_thr_progress_unmanaged_delay();
+#endif
+
+ proc = erts_proc_lookup_raw(pid);
+ if (proc) {
+ if (!allow_exit && ERTS_PROC_IS_EXITING(proc))
+ proc = NULL;
+ else
+ erts_proc_inc_refc(proc);
+ }
+
+#ifdef ERTS_SMP
+ erts_thr_progress_unmanaged_continue(dhndl);
+#endif
+
+ return proc;
+}
+
+Process *erts_proc_lookup_inc_refc(Eterm pid)
+{
+ return proc_lookup_inc_refc(pid, 0);
+}
+
+Process *erts_proc_lookup_raw_inc_refc(Eterm pid)
+{
+ return proc_lookup_inc_refc(pid, 1);
+}
+
void
erts_proc_lock_init(Process *p)
{
+#if ERTS_PROC_LOCK_OWN_IMPL || defined(ERTS_PROC_LOCK_DEBUG)
int i;
+#endif
#if ERTS_PROC_LOCK_OWN_IMPL
/* We always start with all locks locked */
#if ERTS_PROC_LOCK_ATOMIC_IMPL
@@ -1017,35 +1054,43 @@ erts_proc_lock_init(Process *p)
#endif
#elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL
-#ifdef ERTS_ENABLE_LOCK_COUNT
- int do_lock_count = 1;
-#else
- int do_lock_count = 0;
-#endif
-
- erts_mtx_init_x(&p->lock.main, "proc_main", p->common.id, do_lock_count);
+ erts_mtx_init(&p->lock.main, "proc_main", p->common.id,
+ ERTS_LOCK_FLAGS_CATEGORY_PROCESS);
ethr_mutex_lock(&p->lock.main.mtx);
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_trylock(1, &p->lock.main.lc);
#endif
- erts_mtx_init_x(&p->lock.link, "proc_link", p->common.id, do_lock_count);
+ erts_mtx_init(&p->lock.link, "proc_link", p->common.id,
+ ERTS_LOCK_FLAGS_CATEGORY_PROCESS);
ethr_mutex_lock(&p->lock.link.mtx);
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_trylock(1, &p->lock.link.lc);
#endif
- erts_mtx_init_x(&p->lock.msgq, "proc_msgq", p->common.id, do_lock_count);
+ erts_mtx_init(&p->lock.msgq, "proc_msgq", p->common.id,
+ ERTS_LOCK_FLAGS_CATEGORY_PROCESS);
ethr_mutex_lock(&p->lock.msgq.mtx);
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_trylock(1, &p->lock.msgq.lc);
#endif
- erts_mtx_init_x(&p->lock.status, "proc_status", p->common.id,
- do_lock_count);
+ erts_mtx_init(&p->lock.btm, "proc_btm", p->common.id,
+ ERTS_LOCK_FLAGS_CATEGORY_PROCESS);
+ ethr_mutex_lock(&p->lock.btm.mtx);
+#ifdef ERTS_ENABLE_LOCK_CHECK
+ erts_lc_trylock(1, &p->lock.btm.lc);
+#endif
+ erts_mtx_init(&p->lock.status, "proc_status", p->common.id,
+ ERTS_LOCK_FLAGS_CATEGORY_PROCESS);
ethr_mutex_lock(&p->lock.status.mtx);
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_trylock(1, &p->lock.status.lc);
#endif
+ erts_mtx_init(&p->lock.trace, "proc_trace", p->common.id,
+ ERTS_LOCK_FLAGS_CATEGORY_PROCESS);
+ ethr_mutex_lock(&p->lock.trace.mtx);
+#ifdef ERTS_ENABLE_LOCK_CHECK
+ erts_lc_trylock(1, &p->lock.trace.lc);
+#endif
#endif
- erts_atomic32_init_nob(&p->lock.refc, 1);
#ifdef ERTS_PROC_LOCK_DEBUG
for (i = 0; i <= ERTS_PROC_LOCK_MAX_BIT; i++)
erts_smp_atomic32_init_nob(&p->lock.locked[i], (erts_aint32_t) 1);
@@ -1064,7 +1109,9 @@ erts_proc_lock_fin(Process *p)
erts_mtx_destroy(&p->lock.main);
erts_mtx_destroy(&p->lock.link);
erts_mtx_destroy(&p->lock.msgq);
+ erts_mtx_destroy(&p->lock.btm);
erts_mtx_destroy(&p->lock.status);
+ erts_mtx_destroy(&p->lock.trace);
#endif
#if defined(ERTS_ENABLE_LOCK_COUNT) && defined(ERTS_SMP)
erts_lcnt_proc_lock_destroy(p);
@@ -1074,141 +1121,72 @@ erts_proc_lock_fin(Process *p)
/* --- Process lock counting ----------------------------------------------- */
#if ERTS_PROC_LOCK_OWN_IMPL && defined(ERTS_ENABLE_LOCK_COUNT)
+
void erts_lcnt_proc_lock_init(Process *p) {
- if (erts_lcnt_rt_options & ERTS_LCNT_OPT_PROCLOCK) {
- if (p->common.id != ERTS_INVALID_PID) {
- erts_lcnt_init_lock_x(&(p->lock.lcnt_main), "proc_main", ERTS_LCNT_LT_PROCLOCK, p->common.id);
- erts_lcnt_init_lock_x(&(p->lock.lcnt_msgq), "proc_msgq", ERTS_LCNT_LT_PROCLOCK, p->common.id);
- erts_lcnt_init_lock_x(&(p->lock.lcnt_link), "proc_link", ERTS_LCNT_LT_PROCLOCK, p->common.id);
- erts_lcnt_init_lock_x(&(p->lock.lcnt_status), "proc_status", ERTS_LCNT_LT_PROCLOCK, p->common.id);
- } else {
- erts_lcnt_init_lock(&(p->lock.lcnt_main), "proc_main", ERTS_LCNT_LT_PROCLOCK);
- erts_lcnt_init_lock(&(p->lock.lcnt_msgq), "proc_msgq", ERTS_LCNT_LT_PROCLOCK);
- erts_lcnt_init_lock(&(p->lock.lcnt_link), "proc_link", ERTS_LCNT_LT_PROCLOCK);
- erts_lcnt_init_lock(&(p->lock.lcnt_status), "proc_status", ERTS_LCNT_LT_PROCLOCK);
- }
- } else {
- sys_memzero(&(p->lock.lcnt_main), sizeof(p->lock.lcnt_main));
- sys_memzero(&(p->lock.lcnt_msgq), sizeof(p->lock.lcnt_msgq));
- sys_memzero(&(p->lock.lcnt_link), sizeof(p->lock.lcnt_link));
- sys_memzero(&(p->lock.lcnt_status), sizeof(p->lock.lcnt_status));
+ erts_lcnt_init_ref(&p->lock.lcnt_carrier);
+
+ if(erts_lcnt_check_enabled(ERTS_LOCK_FLAGS_CATEGORY_PROCESS)) {
+ erts_lcnt_enable_proc_lock_count(p, 1);
}
-}
-
+} /* logic reversed */
void erts_lcnt_proc_lock_destroy(Process *p) {
- erts_lcnt_destroy_lock(&(p->lock.lcnt_main));
- erts_lcnt_destroy_lock(&(p->lock.lcnt_msgq));
- erts_lcnt_destroy_lock(&(p->lock.lcnt_link));
- erts_lcnt_destroy_lock(&(p->lock.lcnt_status));
+ erts_lcnt_uninstall(&p->lock.lcnt_carrier);
}
-void erts_lcnt_proc_lock(erts_proc_lock_t *lock, ErtsProcLocks locks) {
- if (erts_lcnt_rt_options & ERTS_LCNT_OPT_PROCLOCK) {
- if (locks & ERTS_PROC_LOCK_MAIN) {
- erts_lcnt_lock(&(lock->lcnt_main));
- }
- if (locks & ERTS_PROC_LOCK_MSGQ) {
- erts_lcnt_lock(&(lock->lcnt_msgq));
- }
- if (locks & ERTS_PROC_LOCK_LINK) {
- erts_lcnt_lock(&(lock->lcnt_link));
- }
- if (locks & ERTS_PROC_LOCK_STATUS) {
- erts_lcnt_lock(&(lock->lcnt_status));
- }
+void erts_lcnt_enable_proc_lock_count(Process *proc, int enable) {
+ if(proc->common.id == ERTS_INVALID_PID) {
+ /* Locks without an id are more trouble than they're worth; there's no
+ * way to look them up and we can't track them with _STATIC since it's
+ * too early to tell whether we're a system process (proc->static_flags
+ * hasn't been not set yet). */
+ } else if(!enable) {
+ erts_lcnt_proc_lock_destroy(proc);
+ } else if(!erts_lcnt_check_ref_installed(&proc->lock.lcnt_carrier)) {
+ erts_lcnt_lock_info_carrier_t *carrier;
+
+ carrier = erts_lcnt_create_lock_info_carrier(ERTS_LCNT_PROCLOCK_COUNT);
+
+ erts_lcnt_init_lock_info_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MAIN,
+ "proc_main", proc->common.id, ERTS_LOCK_TYPE_PROCLOCK);
+ erts_lcnt_init_lock_info_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_LINK,
+ "proc_link", proc->common.id, ERTS_LOCK_TYPE_PROCLOCK);
+ erts_lcnt_init_lock_info_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MSGQ,
+ "proc_msgq", proc->common.id, ERTS_LOCK_TYPE_PROCLOCK);
+ erts_lcnt_init_lock_info_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_BTM,
+ "proc_btm", proc->common.id, ERTS_LOCK_TYPE_PROCLOCK);
+ erts_lcnt_init_lock_info_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_STATUS,
+ "proc_status",proc->common.id, ERTS_LOCK_TYPE_PROCLOCK);
+ erts_lcnt_init_lock_info_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_TRACE,
+ "proc_trace", proc->common.id, ERTS_LOCK_TYPE_PROCLOCK);
+
+ erts_lcnt_install(&proc->lock.lcnt_carrier, carrier);
}
}
-void erts_lcnt_proc_lock_post_x(erts_proc_lock_t *lock, ErtsProcLocks locks, char *file, unsigned int line) {
- if (erts_lcnt_rt_options & ERTS_LCNT_OPT_PROCLOCK) {
- if (locks & ERTS_PROC_LOCK_MAIN) {
- erts_lcnt_lock_post_x(&(lock->lcnt_main), file, line);
- }
- if (locks & ERTS_PROC_LOCK_MSGQ) {
- erts_lcnt_lock_post_x(&(lock->lcnt_msgq), file, line);
- }
- if (locks & ERTS_PROC_LOCK_LINK) {
- erts_lcnt_lock_post_x(&(lock->lcnt_link), file, line);
- }
- if (locks & ERTS_PROC_LOCK_STATUS) {
- erts_lcnt_lock_post_x(&(lock->lcnt_status), file, line);
- }
- }
-}
+void erts_lcnt_update_process_locks(int enable) {
+ int i, max;
-void erts_lcnt_proc_lock_unaquire(erts_proc_lock_t *lock, ErtsProcLocks locks) {
- if (erts_lcnt_rt_options & ERTS_LCNT_OPT_PROCLOCK) {
- if (locks & ERTS_PROC_LOCK_MAIN) {
- erts_lcnt_lock_unaquire(&(lock->lcnt_main));
- }
- if (locks & ERTS_PROC_LOCK_MSGQ) {
- erts_lcnt_lock_unaquire(&(lock->lcnt_msgq));
- }
- if (locks & ERTS_PROC_LOCK_LINK) {
- erts_lcnt_lock_unaquire(&(lock->lcnt_link));
- }
- if (locks & ERTS_PROC_LOCK_STATUS) {
- erts_lcnt_lock_unaquire(&(lock->lcnt_status));
- }
- }
-}
+ max = erts_ptab_max(&erts_proc);
-void erts_lcnt_proc_unlock(erts_proc_lock_t *lock, ErtsProcLocks locks) {
- if (erts_lcnt_rt_options & ERTS_LCNT_OPT_PROCLOCK) {
- if (locks & ERTS_PROC_LOCK_MAIN) {
- erts_lcnt_unlock(&(lock->lcnt_main));
- }
- if (locks & ERTS_PROC_LOCK_MSGQ) {
- erts_lcnt_unlock(&(lock->lcnt_msgq));
- }
- if (locks & ERTS_PROC_LOCK_LINK) {
- erts_lcnt_unlock(&(lock->lcnt_link));
- }
- if (locks & ERTS_PROC_LOCK_STATUS) {
- erts_lcnt_unlock(&(lock->lcnt_status));
- }
- }
-}
-void erts_lcnt_proc_trylock(erts_proc_lock_t *lock, ErtsProcLocks locks, int res) {
- if (erts_lcnt_rt_options & ERTS_LCNT_OPT_PROCLOCK) {
- if (locks & ERTS_PROC_LOCK_MAIN) {
- erts_lcnt_trylock(&(lock->lcnt_main), res);
- }
- if (locks & ERTS_PROC_LOCK_MSGQ) {
- erts_lcnt_trylock(&(lock->lcnt_msgq), res);
- }
- if (locks & ERTS_PROC_LOCK_LINK) {
- erts_lcnt_trylock(&(lock->lcnt_link), res);
- }
- if (locks & ERTS_PROC_LOCK_STATUS) {
- erts_lcnt_trylock(&(lock->lcnt_status), res);
- }
- }
-}
+ for(i = 0; i < max; i++) {
+ int delay_handle;
+ Process *proc;
+ delay_handle = erts_thr_progress_unmanaged_delay();
+ proc = erts_pix2proc(i);
-void erts_lcnt_enable_proc_lock_count(int enable)
-{
- int i, max = erts_ptab_max(&erts_proc);
-
- for (i = 0; i < max; ++i) {
- Process* p = erts_pix2proc(i);
- if (p) {
- if (enable) {
- if (!ERTS_LCNT_LOCK_TYPE(&(p->lock.lcnt_main))) {
- erts_lcnt_proc_lock_init(p);
- }
- } else {
- if (ERTS_LCNT_LOCK_TYPE(&(p->lock.lcnt_main))) {
- erts_lcnt_proc_lock_destroy(p);
- }
- }
- }
+ if(proc != NULL) {
+ erts_lcnt_enable_proc_lock_count(proc, enable);
+ }
+
+ if(delay_handle != ERTS_THR_PRGR_DHANDLE_MANAGED) {
+ erts_thr_progress_unmanaged_continue(delay_handle);
+ }
}
}
-#endif /* ifdef ERTS_ENABLE_LOCK_COUNT */
+#endif /* ERTS_ENABLE_LOCK_COUNT */
/* --- Process lock checking ----------------------------------------------- */
@@ -1222,7 +1200,7 @@ erts_proc_lc_lock(Process *p, ErtsProcLocks locks, char *file, unsigned int line
{
erts_lc_lock_t lck = ERTS_LC_LOCK_INIT(-1,
p->common.id,
- ERTS_LC_FLG_LT_PROCLOCK);
+ ERTS_LOCK_TYPE_PROCLOCK);
if (locks & ERTS_PROC_LOCK_MAIN) {
lck.id = lc_id.proc_lock_main;
erts_lc_lock_x(&lck,file,line);
@@ -1235,10 +1213,18 @@ erts_proc_lc_lock(Process *p, ErtsProcLocks locks, char *file, unsigned int line
lck.id = lc_id.proc_lock_msgq;
erts_lc_lock_x(&lck,file,line);
}
+ if (locks & ERTS_PROC_LOCK_BTM) {
+ lck.id = lc_id.proc_lock_btm;
+ erts_lc_lock_x(&lck,file,line);
+ }
if (locks & ERTS_PROC_LOCK_STATUS) {
lck.id = lc_id.proc_lock_status;
erts_lc_lock_x(&lck,file,line);
}
+ if (locks & ERTS_PROC_LOCK_TRACE) {
+ lck.id = lc_id.proc_lock_trace;
+ erts_lc_lock_x(&lck,file,line);
+ }
}
void
@@ -1247,7 +1233,7 @@ erts_proc_lc_trylock(Process *p, ErtsProcLocks locks, int locked,
{
erts_lc_lock_t lck = ERTS_LC_LOCK_INIT(-1,
p->common.id,
- ERTS_LC_FLG_LT_PROCLOCK);
+ ERTS_LOCK_TYPE_PROCLOCK);
if (locks & ERTS_PROC_LOCK_MAIN) {
lck.id = lc_id.proc_lock_main;
erts_lc_trylock_x(locked, &lck, file, line);
@@ -1260,10 +1246,18 @@ erts_proc_lc_trylock(Process *p, ErtsProcLocks locks, int locked,
lck.id = lc_id.proc_lock_msgq;
erts_lc_trylock_x(locked, &lck, file, line);
}
+ if (locks & ERTS_PROC_LOCK_BTM) {
+ lck.id = lc_id.proc_lock_btm;
+ erts_lc_trylock_x(locked, &lck, file, line);
+ }
if (locks & ERTS_PROC_LOCK_STATUS) {
lck.id = lc_id.proc_lock_status;
erts_lc_trylock_x(locked, &lck, file, line);
}
+ if (locks & ERTS_PROC_LOCK_TRACE) {
+ lck.id = lc_id.proc_lock_trace;
+ erts_lc_trylock_x(locked, &lck, file, line);
+ }
}
void
@@ -1271,11 +1265,19 @@ erts_proc_lc_unlock(Process *p, ErtsProcLocks locks)
{
erts_lc_lock_t lck = ERTS_LC_LOCK_INIT(-1,
p->common.id,
- ERTS_LC_FLG_LT_PROCLOCK);
+ ERTS_LOCK_TYPE_PROCLOCK);
+ if (locks & ERTS_PROC_LOCK_TRACE) {
+ lck.id = lc_id.proc_lock_trace;
+ erts_lc_unlock(&lck);
+ }
if (locks & ERTS_PROC_LOCK_STATUS) {
lck.id = lc_id.proc_lock_status;
erts_lc_unlock(&lck);
}
+ if (locks & ERTS_PROC_LOCK_BTM) {
+ lck.id = lc_id.proc_lock_btm;
+ erts_lc_unlock(&lck);
+ }
if (locks & ERTS_PROC_LOCK_MSGQ) {
lck.id = lc_id.proc_lock_msgq;
erts_lc_unlock(&lck);
@@ -1298,11 +1300,19 @@ erts_proc_lc_might_unlock(Process *p, ErtsProcLocks locks)
#if ERTS_PROC_LOCK_OWN_IMPL
erts_lc_lock_t lck = ERTS_LC_LOCK_INIT(-1,
p->common.id,
- ERTS_LC_FLG_LT_PROCLOCK);
+ ERTS_LOCK_TYPE_PROCLOCK);
+ if (locks & ERTS_PROC_LOCK_TRACE) {
+ lck.id = lc_id.proc_lock_trace;
+ erts_lc_might_unlock(&lck);
+ }
if (locks & ERTS_PROC_LOCK_STATUS) {
lck.id = lc_id.proc_lock_status;
erts_lc_might_unlock(&lck);
}
+ if (locks & ERTS_PROC_LOCK_BTM) {
+ lck.id = lc_id.proc_lock_btm;
+ erts_lc_might_unlock(&lck);
+ }
if (locks & ERTS_PROC_LOCK_MSGQ) {
lck.id = lc_id.proc_lock_msgq;
erts_lc_might_unlock(&lck);
@@ -1322,8 +1332,12 @@ erts_proc_lc_might_unlock(Process *p, ErtsProcLocks locks)
erts_lc_might_unlock(&p->lock.link.lc);
if (locks & ERTS_PROC_LOCK_MSGQ)
erts_lc_might_unlock(&p->lock.msgq.lc);
+ if (locks & ERTS_PROC_LOCK_BTM)
+ erts_lc_might_unlock(&p->lock.btm.lc);
if (locks & ERTS_PROC_LOCK_STATUS)
erts_lc_might_unlock(&p->lock.status.lc);
+ if (locks & ERTS_PROC_LOCK_TRACE)
+ erts_lc_might_unlock(&p->lock.trace.lc);
#endif
}
@@ -1334,7 +1348,7 @@ erts_proc_lc_require_lock(Process *p, ErtsProcLocks locks, char *file,
#if ERTS_PROC_LOCK_OWN_IMPL
erts_lc_lock_t lck = ERTS_LC_LOCK_INIT(-1,
p->common.id,
- ERTS_LC_FLG_LT_PROCLOCK);
+ ERTS_LOCK_TYPE_PROCLOCK);
if (locks & ERTS_PROC_LOCK_MAIN) {
lck.id = lc_id.proc_lock_main;
erts_lc_require_lock(&lck, file, line);
@@ -1347,10 +1361,18 @@ erts_proc_lc_require_lock(Process *p, ErtsProcLocks locks, char *file,
lck.id = lc_id.proc_lock_msgq;
erts_lc_require_lock(&lck, file, line);
}
+ if (locks & ERTS_PROC_LOCK_BTM) {
+ lck.id = lc_id.proc_lock_btm;
+ erts_lc_require_lock(&lck, file, line);
+ }
if (locks & ERTS_PROC_LOCK_STATUS) {
lck.id = lc_id.proc_lock_status;
erts_lc_require_lock(&lck, file, line);
}
+ if (locks & ERTS_PROC_LOCK_TRACE) {
+ lck.id = lc_id.proc_lock_trace;
+ erts_lc_require_lock(&lck, file, line);
+ }
#elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL
if (locks & ERTS_PROC_LOCK_MAIN)
erts_lc_require_lock(&p->lock.main.lc, file, line);
@@ -1358,8 +1380,12 @@ erts_proc_lc_require_lock(Process *p, ErtsProcLocks locks, char *file,
erts_lc_require_lock(&p->lock.link.lc, file, line);
if (locks & ERTS_PROC_LOCK_MSGQ)
erts_lc_require_lock(&p->lock.msgq.lc, file, line);
+ if (locks & ERTS_PROC_LOCK_BTM)
+ erts_lc_require_lock(&p->lock.btm.lc, file, line);
if (locks & ERTS_PROC_LOCK_STATUS)
erts_lc_require_lock(&p->lock.status.lc, file, line);
+ if (locks & ERTS_PROC_LOCK_TRACE)
+ erts_lc_require_lock(&p->lock.trace.lc, file, line);
#endif
}
@@ -1369,11 +1395,19 @@ erts_proc_lc_unrequire_lock(Process *p, ErtsProcLocks locks)
#if ERTS_PROC_LOCK_OWN_IMPL
erts_lc_lock_t lck = ERTS_LC_LOCK_INIT(-1,
p->common.id,
- ERTS_LC_FLG_LT_PROCLOCK);
+ ERTS_LOCK_TYPE_PROCLOCK);
+ if (locks & ERTS_PROC_LOCK_TRACE) {
+ lck.id = lc_id.proc_lock_trace;
+ erts_lc_unrequire_lock(&lck);
+ }
if (locks & ERTS_PROC_LOCK_STATUS) {
lck.id = lc_id.proc_lock_status;
erts_lc_unrequire_lock(&lck);
}
+ if (locks & ERTS_PROC_LOCK_BTM) {
+ lck.id = lc_id.proc_lock_btm;
+ erts_lc_unrequire_lock(&lck);
+ }
if (locks & ERTS_PROC_LOCK_MSGQ) {
lck.id = lc_id.proc_lock_msgq;
erts_lc_unrequire_lock(&lck);
@@ -1393,8 +1427,12 @@ erts_proc_lc_unrequire_lock(Process *p, ErtsProcLocks locks)
erts_lc_unrequire_lock(&p->lock.link.lc);
if (locks & ERTS_PROC_LOCK_MSGQ)
erts_lc_unrequire_lock(&p->lock.msgq.lc);
+ if (locks & ERTS_PROC_LOCK_BTM)
+ erts_lc_unrequire_lock(&p->lock.btm.lc);
if (locks & ERTS_PROC_LOCK_STATUS)
erts_lc_unrequire_lock(&p->lock.status.lc);
+ if (locks & ERTS_PROC_LOCK_TRACE)
+ erts_lc_unrequire_lock(&p->lock.trace.lc);
#endif
}
@@ -1406,7 +1444,7 @@ erts_proc_lc_trylock_force_busy(Process *p, ErtsProcLocks locks)
if (locks & ERTS_PROC_LOCKS_ALL) {
erts_lc_lock_t lck = ERTS_LC_LOCK_INIT(-1,
p->common.id,
- ERTS_LC_FLG_LT_PROCLOCK);
+ ERTS_LOCK_TYPE_PROCLOCK);
if (locks & ERTS_PROC_LOCK_MAIN)
lck.id = lc_id.proc_lock_main;
@@ -1414,8 +1452,12 @@ erts_proc_lc_trylock_force_busy(Process *p, ErtsProcLocks locks)
lck.id = lc_id.proc_lock_link;
else if (locks & ERTS_PROC_LOCK_MSGQ)
lck.id = lc_id.proc_lock_msgq;
+ else if (locks & ERTS_PROC_LOCK_BTM)
+ lck.id = lc_id.proc_lock_btm;
else if (locks & ERTS_PROC_LOCK_STATUS)
lck.id = lc_id.proc_lock_status;
+ else if (locks & ERTS_PROC_LOCK_TRACE)
+ lck.id = lc_id.proc_lock_trace;
else
erts_lc_fail("Unknown proc lock found");
@@ -1428,29 +1470,76 @@ erts_proc_lc_trylock_force_busy(Process *p, ErtsProcLocks locks)
void erts_proc_lc_chk_only_proc_main(Process *p)
{
-#if ERTS_PROC_LOCK_OWN_IMPL
- erts_lc_lock_t proc_main = ERTS_LC_LOCK_INIT(lc_id.proc_lock_main,
- p->common.id,
- ERTS_LC_FLG_LT_PROCLOCK);
- erts_lc_check_exact(&proc_main, 1);
-#elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL
- erts_lc_check_exact(&p->lock.main.lc, 1);
-#endif
+ erts_proc_lc_chk_only_proc(p, ERTS_PROC_LOCK_MAIN);
}
#if ERTS_PROC_LOCK_OWN_IMPL
#define ERTS_PROC_LC_EMPTY_LOCK_INIT \
- ERTS_LC_LOCK_INIT(-1, THE_NON_VALUE, ERTS_LC_FLG_LT_PROCLOCK)
+ ERTS_LC_LOCK_INIT(-1, THE_NON_VALUE, ERTS_LOCK_TYPE_PROCLOCK)
#endif /* ERTS_PROC_LOCK_OWN_IMPL */
+void erts_proc_lc_chk_only_proc(Process *p, ErtsProcLocks locks)
+{
+ int have_locks_len = 0;
+#if ERTS_PROC_LOCK_OWN_IMPL
+ erts_lc_lock_t have_locks[6] = {ERTS_PROC_LC_EMPTY_LOCK_INIT,
+ ERTS_PROC_LC_EMPTY_LOCK_INIT,
+ ERTS_PROC_LC_EMPTY_LOCK_INIT,
+ ERTS_PROC_LC_EMPTY_LOCK_INIT,
+ ERTS_PROC_LC_EMPTY_LOCK_INIT,
+ ERTS_PROC_LC_EMPTY_LOCK_INIT};
+ if (locks & ERTS_PROC_LOCK_MAIN) {
+ have_locks[have_locks_len].id = lc_id.proc_lock_main;
+ have_locks[have_locks_len++].extra = p->common.id;
+ }
+ if (locks & ERTS_PROC_LOCK_LINK) {
+ have_locks[have_locks_len].id = lc_id.proc_lock_link;
+ have_locks[have_locks_len++].extra = p->common.id;
+ }
+ if (locks & ERTS_PROC_LOCK_MSGQ) {
+ have_locks[have_locks_len].id = lc_id.proc_lock_msgq;
+ have_locks[have_locks_len++].extra = p->common.id;
+ }
+ if (locks & ERTS_PROC_LOCK_BTM) {
+ have_locks[have_locks_len].id = lc_id.proc_lock_btm;
+ have_locks[have_locks_len++].extra = p->common.id;
+ }
+ if (locks & ERTS_PROC_LOCK_STATUS) {
+ have_locks[have_locks_len].id = lc_id.proc_lock_status;
+ have_locks[have_locks_len++].extra = p->common.id;
+ }
+ if (locks & ERTS_PROC_LOCK_TRACE) {
+ have_locks[have_locks_len].id = lc_id.proc_lock_trace;
+ have_locks[have_locks_len++].extra = p->common.id;
+ }
+#elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL
+ erts_lc_lock_t have_locks[6];
+ if (locks & ERTS_PROC_LOCK_MAIN)
+ have_locks[have_locks_len++] = p->lock.main.lc;
+ if (locks & ERTS_PROC_LOCK_LINK)
+ have_locks[have_locks_len++] = p->lock.link.lc;
+ if (locks & ERTS_PROC_LOCK_MSGQ)
+ have_locks[have_locks_len++] = p->lock.msgq.lc;
+ if (locks & ERTS_PROC_LOCK_BTM)
+ have_locks[have_locks_len++] = p->lock.btm.lc;
+ if (locks & ERTS_PROC_LOCK_STATUS)
+ have_locks[have_locks_len++] = p->lock.status.lc;
+ if (locks & ERTS_PROC_LOCK_TRACE)
+ have_locks[have_locks_len++] = p->lock.trace.lc;
+#endif
+ erts_lc_check_exact(have_locks, have_locks_len);
+}
+
void
erts_proc_lc_chk_have_proc_locks(Process *p, ErtsProcLocks locks)
{
int have_locks_len = 0;
#if ERTS_PROC_LOCK_OWN_IMPL
- erts_lc_lock_t have_locks[4] = {ERTS_PROC_LC_EMPTY_LOCK_INIT,
+ erts_lc_lock_t have_locks[6] = {ERTS_PROC_LC_EMPTY_LOCK_INIT,
ERTS_PROC_LC_EMPTY_LOCK_INIT,
ERTS_PROC_LC_EMPTY_LOCK_INIT,
+ ERTS_PROC_LC_EMPTY_LOCK_INIT,
+ ERTS_PROC_LC_EMPTY_LOCK_INIT,
ERTS_PROC_LC_EMPTY_LOCK_INIT};
if (locks & ERTS_PROC_LOCK_MAIN) {
have_locks[have_locks_len].id = lc_id.proc_lock_main;
@@ -1464,20 +1553,32 @@ erts_proc_lc_chk_have_proc_locks(Process *p, ErtsProcLocks locks)
have_locks[have_locks_len].id = lc_id.proc_lock_msgq;
have_locks[have_locks_len++].extra = p->common.id;
}
+ if (locks & ERTS_PROC_LOCK_BTM) {
+ have_locks[have_locks_len].id = lc_id.proc_lock_btm;
+ have_locks[have_locks_len++].extra = p->common.id;
+ }
if (locks & ERTS_PROC_LOCK_STATUS) {
have_locks[have_locks_len].id = lc_id.proc_lock_status;
have_locks[have_locks_len++].extra = p->common.id;
}
+ if (locks & ERTS_PROC_LOCK_TRACE) {
+ have_locks[have_locks_len].id = lc_id.proc_lock_trace;
+ have_locks[have_locks_len++].extra = p->common.id;
+ }
#elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL
- erts_lc_lock_t have_locks[4];
+ erts_lc_lock_t have_locks[6];
if (locks & ERTS_PROC_LOCK_MAIN)
have_locks[have_locks_len++] = p->lock.main.lc;
if (locks & ERTS_PROC_LOCK_LINK)
have_locks[have_locks_len++] = p->lock.link.lc;
if (locks & ERTS_PROC_LOCK_MSGQ)
have_locks[have_locks_len++] = p->lock.msgq.lc;
+ if (locks & ERTS_PROC_LOCK_BTM)
+ have_locks[have_locks_len++] = p->lock.btm.lc;
if (locks & ERTS_PROC_LOCK_STATUS)
have_locks[have_locks_len++] = p->lock.status.lc;
+ if (locks & ERTS_PROC_LOCK_TRACE)
+ have_locks[have_locks_len++] = p->lock.trace.lc;
#endif
erts_lc_check(have_locks, have_locks_len, NULL, 0);
}
@@ -1488,12 +1589,14 @@ erts_proc_lc_chk_proc_locks(Process *p, ErtsProcLocks locks)
int have_locks_len = 0;
int have_not_locks_len = 0;
#if ERTS_PROC_LOCK_OWN_IMPL
- erts_lc_lock_t have_locks[4] = {ERTS_PROC_LC_EMPTY_LOCK_INIT,
+ erts_lc_lock_t have_locks[6] = {ERTS_PROC_LC_EMPTY_LOCK_INIT,
ERTS_PROC_LC_EMPTY_LOCK_INIT,
+ ERTS_PROC_LC_EMPTY_LOCK_INIT,
ERTS_PROC_LC_EMPTY_LOCK_INIT,
ERTS_PROC_LC_EMPTY_LOCK_INIT};
- erts_lc_lock_t have_not_locks[4] = {ERTS_PROC_LC_EMPTY_LOCK_INIT,
+ erts_lc_lock_t have_not_locks[6] = {ERTS_PROC_LC_EMPTY_LOCK_INIT,
ERTS_PROC_LC_EMPTY_LOCK_INIT,
+ ERTS_PROC_LC_EMPTY_LOCK_INIT,
ERTS_PROC_LC_EMPTY_LOCK_INIT,
ERTS_PROC_LC_EMPTY_LOCK_INIT};
@@ -1521,6 +1624,14 @@ erts_proc_lc_chk_proc_locks(Process *p, ErtsProcLocks locks)
have_not_locks[have_not_locks_len].id = lc_id.proc_lock_msgq;
have_not_locks[have_not_locks_len++].extra = p->common.id;
}
+ if (locks & ERTS_PROC_LOCK_BTM) {
+ have_locks[have_locks_len].id = lc_id.proc_lock_btm;
+ have_locks[have_locks_len++].extra = p->common.id;
+ }
+ else {
+ have_not_locks[have_not_locks_len].id = lc_id.proc_lock_btm;
+ have_not_locks[have_not_locks_len++].extra = p->common.id;
+ }
if (locks & ERTS_PROC_LOCK_STATUS) {
have_locks[have_locks_len].id = lc_id.proc_lock_status;
have_locks[have_locks_len++].extra = p->common.id;
@@ -1529,9 +1640,17 @@ erts_proc_lc_chk_proc_locks(Process *p, ErtsProcLocks locks)
have_not_locks[have_not_locks_len].id = lc_id.proc_lock_status;
have_not_locks[have_not_locks_len++].extra = p->common.id;
}
+ if (locks & ERTS_PROC_LOCK_TRACE) {
+ have_locks[have_locks_len].id = lc_id.proc_lock_trace;
+ have_locks[have_locks_len++].extra = p->common.id;
+ }
+ else {
+ have_not_locks[have_not_locks_len].id = lc_id.proc_lock_trace;
+ have_not_locks[have_not_locks_len++].extra = p->common.id;
+ }
#elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL
- erts_lc_lock_t have_locks[4];
- erts_lc_lock_t have_not_locks[4];
+ erts_lc_lock_t have_locks[6];
+ erts_lc_lock_t have_not_locks[6];
if (locks & ERTS_PROC_LOCK_MAIN)
have_locks[have_locks_len++] = p->lock.main.lc;
@@ -1545,10 +1664,18 @@ erts_proc_lc_chk_proc_locks(Process *p, ErtsProcLocks locks)
have_locks[have_locks_len++] = p->lock.msgq.lc;
else
have_not_locks[have_not_locks_len++] = p->lock.msgq.lc;
+ if (locks & ERTS_PROC_LOCK_BTM)
+ have_locks[have_locks_len++] = p->lock.btm.lc;
+ else
+ have_not_locks[have_not_locks_len++] = p->lock.btm.lc;
if (locks & ERTS_PROC_LOCK_STATUS)
have_locks[have_locks_len++] = p->lock.status.lc;
else
have_not_locks[have_not_locks_len++] = p->lock.status.lc;
+ if (locks & ERTS_PROC_LOCK_TRACE)
+ have_locks[have_locks_len++] = p->lock.trace.lc;
+ else
+ have_not_locks[have_not_locks_len++] = p->lock.trace.lc;
#endif
erts_lc_check(have_locks, have_locks_len,
@@ -1558,29 +1685,37 @@ erts_proc_lc_chk_proc_locks(Process *p, ErtsProcLocks locks)
ErtsProcLocks
erts_proc_lc_my_proc_locks(Process *p)
{
- int resv[4];
+ int resv[6];
ErtsProcLocks res = 0;
#if ERTS_PROC_LOCK_OWN_IMPL
- erts_lc_lock_t locks[4] = {ERTS_LC_LOCK_INIT(lc_id.proc_lock_main,
+ erts_lc_lock_t locks[6] = {ERTS_LC_LOCK_INIT(lc_id.proc_lock_main,
p->common.id,
- ERTS_LC_FLG_LT_PROCLOCK),
+ ERTS_LOCK_TYPE_PROCLOCK),
ERTS_LC_LOCK_INIT(lc_id.proc_lock_link,
p->common.id,
- ERTS_LC_FLG_LT_PROCLOCK),
+ ERTS_LOCK_TYPE_PROCLOCK),
ERTS_LC_LOCK_INIT(lc_id.proc_lock_msgq,
p->common.id,
- ERTS_LC_FLG_LT_PROCLOCK),
+ ERTS_LOCK_TYPE_PROCLOCK),
+ ERTS_LC_LOCK_INIT(lc_id.proc_lock_btm,
+ p->common.id,
+ ERTS_LOCK_TYPE_PROCLOCK),
ERTS_LC_LOCK_INIT(lc_id.proc_lock_status,
p->common.id,
- ERTS_LC_FLG_LT_PROCLOCK)};
+ ERTS_LOCK_TYPE_PROCLOCK),
+ ERTS_LC_LOCK_INIT(lc_id.proc_lock_trace,
+ p->common.id,
+ ERTS_LOCK_TYPE_PROCLOCK)};
#elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL
- erts_lc_lock_t locks[4] = {p->lock.main.lc,
+ erts_lc_lock_t locks[6] = {p->lock.main.lc,
p->lock.link.lc,
p->lock.msgq.lc,
- p->lock.status.lc};
+ p->lock.btm.lc,
+ p->lock.status.lc,
+ p->lock.trace.lc};
#endif
- erts_lc_have_locks(resv, locks, 4);
+ erts_lc_have_locks(resv, locks, 6);
if (resv[0])
res |= ERTS_PROC_LOCK_MAIN;
if (resv[1])
@@ -1588,7 +1723,11 @@ erts_proc_lc_my_proc_locks(Process *p)
if (resv[2])
res |= ERTS_PROC_LOCK_MSGQ;
if (resv[3])
+ res |= ERTS_PROC_LOCK_BTM;
+ if (resv[4])
res |= ERTS_PROC_LOCK_STATUS;
+ if (resv[5])
+ res |= ERTS_PROC_LOCK_TRACE;
return res;
}
@@ -1596,13 +1735,15 @@ erts_proc_lc_my_proc_locks(Process *p)
void
erts_proc_lc_chk_no_proc_locks(char *file, int line)
{
- int resv[4];
- int ids[4] = {lc_id.proc_lock_main,
+ int resv[6];
+ int ids[6] = {lc_id.proc_lock_main,
lc_id.proc_lock_link,
lc_id.proc_lock_msgq,
- lc_id.proc_lock_status};
- erts_lc_have_lock_ids(resv, ids, 4);
- if (!ERTS_IS_CRASH_DUMPING && (resv[0] || resv[1] || resv[2] || resv[3])) {
+ lc_id.proc_lock_btm,
+ lc_id.proc_lock_status,
+ lc_id.proc_lock_trace};
+ erts_lc_have_lock_ids(resv, ids, 6);
+ if (!ERTS_IS_CRASH_DUMPING && (resv[0] || resv[1] || resv[2] || resv[3] || resv[4] || resv[5])) {
erts_lc_fail("%s:%d: Thread has process locks locked when expected "
"not to have any process locks locked",
file, line);
diff --git a/erts/emulator/beam/erl_process_lock.h b/erts/emulator/beam/erl_process_lock.h
index 052d992d3f..023ba4d4ae 100644
--- a/erts/emulator/beam/erl_process_lock.h
+++ b/erts/emulator/beam/erl_process_lock.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2007-2012. All Rights Reserved.
+ * Copyright Ericsson AB 2007-2017. 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.
+ * 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%
*/
@@ -65,7 +66,7 @@
#endif
-#define ERTS_PROC_LOCK_MAX_BIT 3
+#define ERTS_PROC_LOCK_MAX_BIT 5
typedef erts_aint32_t ErtsProcLocks;
@@ -77,21 +78,30 @@ typedef struct erts_proc_lock_t_ {
ErtsProcLocks flags;
#endif
erts_tse_t *queue[ERTS_PROC_LOCK_MAX_BIT+1];
-#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_lock_t lcnt_main;
- erts_lcnt_lock_t lcnt_link;
- erts_lcnt_lock_t lcnt_msgq;
- erts_lcnt_lock_t lcnt_status;
+#if defined(ERTS_ENABLE_LOCK_COUNT) && !ERTS_PROC_LOCK_RAW_MUTEX_IMPL
+ /* Each erts_mtx_t has its own lock counter ^ */
+
+ #define ERTS_LCNT_PROCLOCK_IDX_MAIN 0
+ #define ERTS_LCNT_PROCLOCK_IDX_LINK 1
+ #define ERTS_LCNT_PROCLOCK_IDX_MSGQ 2
+ #define ERTS_LCNT_PROCLOCK_IDX_BTM 3
+ #define ERTS_LCNT_PROCLOCK_IDX_STATUS 4
+ #define ERTS_LCNT_PROCLOCK_IDX_TRACE 5
+
+ #define ERTS_LCNT_PROCLOCK_COUNT 6
+
+ erts_lcnt_ref_t lcnt_carrier;
#endif
#elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL
erts_mtx_t main;
erts_mtx_t link;
erts_mtx_t msgq;
+ erts_mtx_t btm;
erts_mtx_t status;
+ erts_mtx_t trace;
#else
# error "no implementation"
#endif
- erts_atomic32_t refc;
#ifdef ERTS_PROC_LOCK_DEBUG
erts_smp_atomic32_t locked[ERTS_PROC_LOCK_MAX_BIT+1];
#endif
@@ -120,18 +130,33 @@ typedef struct erts_proc_lock_t_ {
* Message queue lock:
* Protects the following fields in the process structure:
* * msg_inq
- * * bif_timers
*/
#define ERTS_PROC_LOCK_MSGQ (((ErtsProcLocks) 1) << 2)
/*
+ * Bif timer lock:
+ * Protects the following fields in the process structure:
+ * * bif_timers
+ */
+#define ERTS_PROC_LOCK_BTM (((ErtsProcLocks) 1) << 3)
+
+/*
* Status lock:
* Protects the following fields in the process structure:
* * pending_suspenders
* * suspendee
+ * * sys_tasks
* * ...
*/
-#define ERTS_PROC_LOCK_STATUS (((ErtsProcLocks) 1) << ERTS_PROC_LOCK_MAX_BIT)
+#define ERTS_PROC_LOCK_STATUS (((ErtsProcLocks) 1) << 4)
+
+/*
+ * Trace message lock:
+ * Protects the order in which messages are sent
+ * from trace nifs. This lock is taken inside enif_send.
+ *
+ */
+#define ERTS_PROC_LOCK_TRACE (((ErtsProcLocks) 1) << ERTS_PROC_LOCK_MAX_BIT)
/*
* Special fields:
@@ -146,8 +171,8 @@ typedef struct erts_proc_lock_t_ {
* all process locks are held, and are allowed to be read if
* at least one process lock (whichever one doesn't matter)
* is held:
- * * tracer_proc
- * * tracer_flags
+ * * common.tracer
+ * * common.trace_flags
*
* The following fields are only allowed to be accessed if
* both the schedule queue lock and at least one process lock
@@ -190,17 +215,19 @@ typedef struct erts_proc_lock_t_ {
/* ERTS_PROC_LOCKS_* are combinations of process locks */
-#define ERTS_PROC_LOCKS_MSG_RECEIVE (ERTS_PROC_LOCK_MSGQ \
- | ERTS_PROC_LOCK_STATUS)
-#define ERTS_PROC_LOCKS_MSG_SEND (ERTS_PROC_LOCK_MSGQ \
- | ERTS_PROC_LOCK_STATUS)
+#define ERTS_PROC_LOCKS_MSG_RECEIVE ERTS_PROC_LOCK_MSGQ
+#define ERTS_PROC_LOCKS_MSG_SEND ERTS_PROC_LOCK_MSGQ
#define ERTS_PROC_LOCKS_XSIG_SEND ERTS_PROC_LOCK_STATUS
#define ERTS_PROC_LOCKS_ALL \
((((ErtsProcLocks) 1) << (ERTS_PROC_LOCK_MAX_BIT + 1)) - 1)
#define ERTS_PROC_LOCKS_ALL_MINOR (ERTS_PROC_LOCKS_ALL \
- & ~ERTS_PROC_LOCK_MAIN)
+ & ~ERTS_PROC_LOCK_MAIN)
+
+/* All locks we first must unlock to lock L */
+#define ERTS_PROC_LOCKS_HIGHER_THAN(L) \
+ (ERTS_PROC_LOCKS_ALL & (~(L) & ~((L)-1)))
#define ERTS_PIX_LOCKS_BITS 10
@@ -224,14 +251,170 @@ typedef struct erts_proc_lock_t_ {
void erts_lcnt_proc_lock_init(Process *p);
void erts_lcnt_proc_lock_destroy(Process *p);
+
+ERTS_GLB_INLINE
void erts_lcnt_proc_lock(erts_proc_lock_t *lock, ErtsProcLocks locks);
+ERTS_GLB_INLINE
void erts_lcnt_proc_lock_post_x(erts_proc_lock_t *lock, ErtsProcLocks locks, char *file, unsigned int line);
-void erts_lcnt_proc_lock_unaquire(erts_proc_lock_t *lock, ErtsProcLocks locks);
+ERTS_GLB_INLINE
+void erts_lcnt_proc_lock_unacquire(erts_proc_lock_t *lock, ErtsProcLocks locks);
+ERTS_GLB_INLINE
void erts_lcnt_proc_unlock(erts_proc_lock_t *lock, ErtsProcLocks locks);
+ERTS_GLB_INLINE
void erts_lcnt_proc_trylock(erts_proc_lock_t *lock, ErtsProcLocks locks, int res);
-void erts_lcnt_enable_proc_lock_count(int enable);
+void erts_lcnt_enable_proc_lock_count(Process *proc, int enable);
+void erts_lcnt_update_process_locks(int enable);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_INLINE
+void erts_lcnt_proc_lock(erts_proc_lock_t *lock, ErtsProcLocks locks) {
+ erts_lcnt_lock_info_carrier_t *carrier;
+ int handle;
+
+ if(erts_lcnt_open_ref(&lock->lcnt_carrier, &handle, &carrier)) {
+ if (locks & ERTS_PROC_LOCK_MAIN) {
+ erts_lcnt_lock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MAIN);
+ }
+ if (locks & ERTS_PROC_LOCK_LINK) {
+ erts_lcnt_lock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_LINK);
+ }
+ if (locks & ERTS_PROC_LOCK_MSGQ) {
+ erts_lcnt_lock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MSGQ);
+ }
+ if (locks & ERTS_PROC_LOCK_BTM) {
+ erts_lcnt_lock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_BTM);
+ }
+ if (locks & ERTS_PROC_LOCK_STATUS) {
+ erts_lcnt_lock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_STATUS);
+ }
+ if (locks & ERTS_PROC_LOCK_TRACE) {
+ erts_lcnt_lock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_TRACE);
+ }
+
+ erts_lcnt_close_ref(handle, carrier);
+ }
+}
+ERTS_GLB_INLINE
+void erts_lcnt_proc_lock_post_x(erts_proc_lock_t *lock, ErtsProcLocks locks,
+ char *file, unsigned int line) {
+ erts_lcnt_lock_info_carrier_t *carrier;
+ int handle;
+
+ if(erts_lcnt_open_ref(&lock->lcnt_carrier, &handle, &carrier)) {
+ if (locks & ERTS_PROC_LOCK_MAIN) {
+ erts_lcnt_lock_post_x_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MAIN, file, line);
+ }
+ if (locks & ERTS_PROC_LOCK_LINK) {
+ erts_lcnt_lock_post_x_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_LINK, file, line);
+ }
+ if (locks & ERTS_PROC_LOCK_MSGQ) {
+ erts_lcnt_lock_post_x_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MSGQ, file, line);
+ }
+ if (locks & ERTS_PROC_LOCK_BTM) {
+ erts_lcnt_lock_post_x_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_BTM, file, line);
+ }
+ if (locks & ERTS_PROC_LOCK_STATUS) {
+ erts_lcnt_lock_post_x_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_STATUS, file, line);
+ }
+ if (locks & ERTS_PROC_LOCK_TRACE) {
+ erts_lcnt_lock_post_x_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_TRACE, file, line);
+ }
+
+ erts_lcnt_close_ref(handle, carrier);
+ }
+}
+
+ERTS_GLB_INLINE
+void erts_lcnt_proc_lock_unacquire(erts_proc_lock_t *lock, ErtsProcLocks locks) {
+ erts_lcnt_lock_info_carrier_t *carrier;
+ int handle;
+
+ if(erts_lcnt_open_ref(&lock->lcnt_carrier, &handle, &carrier)) {
+ if (locks & ERTS_PROC_LOCK_MAIN) {
+ erts_lcnt_lock_unacquire_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MAIN);
+ }
+ if (locks & ERTS_PROC_LOCK_LINK) {
+ erts_lcnt_lock_unacquire_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_LINK);
+ }
+ if (locks & ERTS_PROC_LOCK_MSGQ) {
+ erts_lcnt_lock_unacquire_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MSGQ);
+ }
+ if (locks & ERTS_PROC_LOCK_BTM) {
+ erts_lcnt_lock_unacquire_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_BTM);
+ }
+ if (locks & ERTS_PROC_LOCK_STATUS) {
+ erts_lcnt_lock_unacquire_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_STATUS);
+ }
+ if (locks & ERTS_PROC_LOCK_TRACE) {
+ erts_lcnt_lock_unacquire_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_TRACE);
+ }
+
+ erts_lcnt_close_ref(handle, carrier);
+ }
+}
+
+ERTS_GLB_INLINE
+void erts_lcnt_proc_unlock(erts_proc_lock_t *lock, ErtsProcLocks locks) {
+ erts_lcnt_lock_info_carrier_t *carrier;
+ int handle;
+
+ if(erts_lcnt_open_ref(&lock->lcnt_carrier, &handle, &carrier)) {
+ if (locks & ERTS_PROC_LOCK_MAIN) {
+ erts_lcnt_unlock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MAIN);
+ }
+ if (locks & ERTS_PROC_LOCK_LINK) {
+ erts_lcnt_unlock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_LINK);
+ }
+ if (locks & ERTS_PROC_LOCK_MSGQ) {
+ erts_lcnt_unlock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MSGQ);
+ }
+ if (locks & ERTS_PROC_LOCK_BTM) {
+ erts_lcnt_unlock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_BTM);
+ }
+ if (locks & ERTS_PROC_LOCK_STATUS) {
+ erts_lcnt_unlock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_STATUS);
+ }
+ if (locks & ERTS_PROC_LOCK_TRACE) {
+ erts_lcnt_unlock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_TRACE);
+ }
+
+ erts_lcnt_close_ref(handle, carrier);
+ }
+}
+
+ERTS_GLB_INLINE
+void erts_lcnt_proc_trylock(erts_proc_lock_t *lock, ErtsProcLocks locks, int res) {
+ erts_lcnt_lock_info_carrier_t *carrier;
+ int handle;
+
+ if(erts_lcnt_open_ref(&lock->lcnt_carrier, &handle, &carrier)) {
+ if (locks & ERTS_PROC_LOCK_MAIN) {
+ erts_lcnt_trylock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MAIN, res);
+ }
+ if (locks & ERTS_PROC_LOCK_LINK) {
+ erts_lcnt_trylock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_LINK, res);
+ }
+ if (locks & ERTS_PROC_LOCK_MSGQ) {
+ erts_lcnt_trylock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MSGQ, res);
+ }
+ if (locks & ERTS_PROC_LOCK_BTM) {
+ erts_lcnt_trylock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_BTM, res);
+ }
+ if (locks & ERTS_PROC_LOCK_STATUS) {
+ erts_lcnt_trylock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_STATUS, res);
+ }
+ if (locks & ERTS_PROC_LOCK_TRACE) {
+ erts_lcnt_trylock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_TRACE, res);
+ }
+
+ erts_lcnt_close_ref(handle, carrier);
+ }
+} /* reversed logic */
+
+#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
#endif /* ERTS_ENABLE_LOCK_COUNT*/
@@ -252,6 +435,7 @@ void erts_proc_lc_might_unlock(Process *p, ErtsProcLocks locks);
void erts_proc_lc_chk_have_proc_locks(Process *p, ErtsProcLocks locks);
void erts_proc_lc_chk_proc_locks(Process *p, ErtsProcLocks locks);
void erts_proc_lc_chk_only_proc_main(Process *p);
+void erts_proc_lc_chk_only_proc(Process *p, ErtsProcLocks locks);
void erts_proc_lc_chk_no_proc_locks(char *file, int line);
ErtsProcLocks erts_proc_lc_my_proc_locks(Process *p);
int erts_proc_lc_trylock_force_busy(Process *p, ErtsProcLocks locks);
@@ -463,13 +647,25 @@ erts_smp_proc_raw_trylock__(Process *p, ErtsProcLocks locks)
if (locks & ERTS_PROC_LOCK_MSGQ)
if (erts_mtx_trylock(&p->lock.msgq) == EBUSY)
goto busy_msgq;
+ if (locks & ERTS_PROC_LOCK_BTM)
+ if (erts_mtx_trylock(&p->lock.btm) == EBUSY)
+ goto busy_btm;
if (locks & ERTS_PROC_LOCK_STATUS)
if (erts_mtx_trylock(&p->lock.status) == EBUSY)
goto busy_status;
+ if (locks & ERTS_PROC_LOCK_TRACE)
+ if (erts_mtx_trylock(&p->lock.trace) == EBUSY)
+ goto busy_trace;
return 0;
+busy_trace:
+ if (locks & ERTS_PROC_LOCK_TRACE)
+ erts_mtx_unlock(&p->lock.trace);
busy_status:
+ if (locks & ERTS_PROC_LOCK_BTM)
+ erts_mtx_unlock(&p->lock.btm);
+busy_btm:
if (locks & ERTS_PROC_LOCK_MSGQ)
erts_mtx_unlock(&p->lock.msgq);
busy_msgq:
@@ -509,6 +705,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) {
@@ -530,9 +730,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);
@@ -549,8 +746,12 @@ erts_smp_proc_lock__(Process *p,
erts_mtx_lock(&p->lock.link);
if (locks & ERTS_PROC_LOCK_MSGQ)
erts_mtx_lock(&p->lock.msgq);
+ if (locks & ERTS_PROC_LOCK_BTM)
+ erts_mtx_lock(&p->lock.btm);
if (locks & ERTS_PROC_LOCK_STATUS)
erts_mtx_lock(&p->lock.status);
+ if (locks & ERTS_PROC_LOCK_TRACE)
+ erts_mtx_lock(&p->lock.trace);
#ifdef ERTS_PROC_LOCK_DEBUG
erts_proc_lock_op_debug(p, locks, 1);
@@ -636,8 +837,12 @@ erts_smp_proc_unlock__(Process *p,
erts_proc_lock_op_debug(p, locks, 0);
#endif
+ if (locks & ERTS_PROC_LOCK_TRACE)
+ erts_mtx_unlock(&p->lock.trace);
if (locks & ERTS_PROC_LOCK_STATUS)
erts_mtx_unlock(&p->lock.status);
+ if (locks & ERTS_PROC_LOCK_BTM)
+ erts_mtx_unlock(&p->lock.btm);
if (locks & ERTS_PROC_LOCK_MSGQ)
erts_mtx_unlock(&p->lock.msgq);
if (locks & ERTS_PROC_LOCK_LINK)
@@ -752,9 +957,10 @@ ERTS_GLB_INLINE void erts_smp_proc_lock(Process *, ErtsProcLocks);
ERTS_GLB_INLINE void erts_smp_proc_unlock(Process *, ErtsProcLocks);
ERTS_GLB_INLINE int erts_smp_proc_trylock(Process *, ErtsProcLocks);
-ERTS_GLB_INLINE void erts_smp_proc_inc_refc(Process *);
-ERTS_GLB_INLINE void erts_smp_proc_dec_refc(Process *);
-ERTS_GLB_INLINE void erts_smp_proc_add_refc(Process *, Sint32);
+ERTS_GLB_INLINE void erts_proc_inc_refc(Process *);
+ERTS_GLB_INLINE void erts_proc_dec_refc(Process *);
+ERTS_GLB_INLINE void erts_proc_add_refc(Process *, Sint);
+ERTS_GLB_INLINE Sint erts_proc_read_refc(Process *);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
@@ -814,28 +1020,53 @@ erts_smp_proc_trylock(Process *p, ErtsProcLocks locks)
#endif
}
-ERTS_GLB_INLINE void erts_smp_proc_inc_refc(Process *p)
+ERTS_GLB_INLINE void erts_proc_inc_refc(Process *p)
{
+ ASSERT(!(erts_smp_atomic32_read_nob(&p->state) & ERTS_PSFLG_PROXY));
#ifdef ERTS_SMP
+ erts_ptab_atmc_inc_refc(&p->common);
+#else
erts_ptab_inc_refc(&p->common);
#endif
}
-ERTS_GLB_INLINE void erts_smp_proc_dec_refc(Process *p)
+ERTS_GLB_INLINE void erts_proc_dec_refc(Process *p)
{
+ Sint referred;
+ ASSERT(!(erts_smp_atomic32_read_nob(&p->state) & ERTS_PSFLG_PROXY));
#ifdef ERTS_SMP
- int referred = erts_ptab_dec_test_refc(&p->common);
- if (!referred)
- erts_free_proc(p);
+ referred = erts_ptab_atmc_dec_test_refc(&p->common);
+#else
+ referred = erts_ptab_dec_test_refc(&p->common);
#endif
+ if (!referred) {
+ ASSERT(ERTS_PROC_IS_EXITING(p));
+ erts_free_proc(p);
+ }
}
-ERTS_GLB_INLINE void erts_smp_proc_add_refc(Process *p, Sint32 add_refc)
+ERTS_GLB_INLINE void erts_proc_add_refc(Process *p, Sint add_refc)
{
+ Sint referred;
+ ASSERT(!(erts_smp_atomic32_read_nob(&p->state) & ERTS_PSFLG_PROXY));
#ifdef ERTS_SMP
- int referred = erts_ptab_add_test_refc(&p->common, add_refc);
- if (!referred)
+ referred = erts_ptab_atmc_add_test_refc(&p->common, add_refc);
+#else
+ referred = erts_ptab_add_test_refc(&p->common, add_refc);
+#endif
+ if (!referred) {
+ ASSERT(ERTS_PROC_IS_EXITING(p));
erts_free_proc(p);
+ }
+}
+
+ERTS_GLB_INLINE Sint erts_proc_read_refc(Process *p)
+{
+ ASSERT(!(erts_smp_atomic32_read_nob(&p->state) & ERTS_PSFLG_PROXY));
+#ifdef ERTS_SMP
+ return erts_ptab_atmc_read_refc(&p->common);
+#else
+ return erts_ptab_read_refc(&p->common);
#endif
}
@@ -868,13 +1099,15 @@ void erts_proc_safelock(Process *a_proc,
#define ERTS_P2P_FLG_ALLOW_OTHER_X (1 << 0)
#define ERTS_P2P_FLG_TRY_LOCK (1 << 1)
-#define ERTS_P2P_FLG_SMP_INC_REFC (1 << 2)
+#define ERTS_P2P_FLG_INC_REFC (1 << 2)
#define ERTS_PROC_LOCK_BUSY ((Process *) &erts_invalid_process)
#define erts_pid2proc(PROC, HL, PID, NL) \
erts_pid2proc_opt((PROC), (HL), (PID), (NL), 0)
+Process *erts_proc_lookup_inc_refc(Eterm pid);
+Process *erts_proc_lookup_raw_inc_refc(Eterm pid);
ERTS_GLB_INLINE Process *erts_pix2proc(int ix);
ERTS_GLB_INLINE Process *erts_proc_lookup_raw(Eterm pid);
@@ -928,11 +1161,14 @@ erts_pid2proc_opt(Process *c_p_unused,
int flags)
{
Process *proc = erts_proc_lookup_raw(pid);
- return ((!(flags & ERTS_P2P_FLG_ALLOW_OTHER_X)
- && proc
- && ERTS_PROC_IS_EXITING(proc))
- ? NULL
- : proc);
+ if (!proc)
+ return NULL;
+ if (!(flags & ERTS_P2P_FLG_ALLOW_OTHER_X)
+ && ERTS_PROC_IS_EXITING(proc))
+ return NULL;
+ if (flags & ERTS_P2P_FLG_INC_REFC)
+ erts_proc_inc_refc(proc);
+ return proc;
}
#endif /* !ERTS_SMP */
diff --git a/erts/emulator/beam/erl_ptab.c b/erts/emulator/beam/erl_ptab.c
index eabf016081..b3bcb3af3f 100644
--- a/erts/emulator/beam/erl_ptab.c
+++ b/erts/emulator/beam/erl_ptab.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2012-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2012-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -280,124 +281,38 @@ struct ErtsPTabListBifData_ {
};
-#ifdef ARCH_32
-
-static ERTS_INLINE Uint64
-dw_aint_to_uint64(erts_dw_aint_t *dw)
-{
-#ifdef ETHR_SU_DW_NAINT_T__
- return (Uint64) dw->dw_sint;
-#else
- Uint64 res;
- res = (Uint64) ((Uint32) dw->sint[ERTS_DW_AINT_HIGH_WORD]);
- res <<= 32;
- res |= (Uint64) ((Uint32) dw->sint[ERTS_DW_AINT_LOW_WORD]);
- return res;
-#endif
-}
-
-static void
-unint64_to_dw_aint(erts_dw_aint_t *dw, Uint64 val)
-{
-#ifdef ETHR_SU_DW_NAINT_T__
- dw->dw_sint = (ETHR_SU_DW_NAINT_T__) val;
-#else
- dw->sint[ERTS_DW_AINT_LOW_WORD] = (erts_aint_t) (val & 0xffffffff);
- dw->sint[ERTS_DW_AINT_HIGH_WORD] = (erts_aint_t) ((val >> 32) & 0xffffffff);
-#endif
-}
-
-static ERTS_INLINE void
-last_data_init_nob(ErtsPTab *ptab, Uint64 val)
-{
- erts_dw_aint_t dw;
- unint64_to_dw_aint(&dw, val);
- erts_smp_dw_atomic_init_nob(&ptab->vola.tile.last_data, &dw);
-}
-
-static ERTS_INLINE void
-last_data_set_relb(ErtsPTab *ptab, Uint64 val)
-{
- erts_dw_aint_t dw;
- unint64_to_dw_aint(&dw, val);
- erts_smp_dw_atomic_set_relb(&ptab->vola.tile.last_data, &dw);
-}
-
-static ERTS_INLINE Uint64
-last_data_read_nob(ErtsPTab *ptab)
-{
- erts_dw_aint_t dw;
- erts_smp_dw_atomic_read_nob(&ptab->vola.tile.last_data, &dw);
- return dw_aint_to_uint64(&dw);
-}
-
-static ERTS_INLINE Uint64
-last_data_read_acqb(ErtsPTab *ptab)
-{
- erts_dw_aint_t dw;
- erts_smp_dw_atomic_read_acqb(&ptab->vola.tile.last_data, &dw);
- return dw_aint_to_uint64(&dw);
-}
-
-static ERTS_INLINE Uint64
-last_data_cmpxchg_relb(ErtsPTab *ptab, Uint64 new, Uint64 exp)
-{
- erts_dw_aint_t dw_new, dw_xchg;
-
- unint64_to_dw_aint(&dw_new, new);
- unint64_to_dw_aint(&dw_xchg, exp);
-
- if (erts_smp_dw_atomic_cmpxchg_relb(&ptab->vola.tile.last_data,
- &dw_new,
- &dw_xchg))
- return exp;
- else
- return dw_aint_to_uint64(&dw_xchg);
-}
-
-#elif defined(ARCH_64)
-
-union {
- erts_smp_atomic_t pid_data;
- char align[ERTS_CACHE_LINE_SIZE];
-} last erts_align_attribute(ERTS_CACHE_LINE_SIZE);
-
static ERTS_INLINE void
last_data_init_nob(ErtsPTab *ptab, Uint64 val)
{
- erts_smp_atomic_init_nob(&ptab->vola.tile.last_data, (erts_aint_t) val);
+ erts_smp_atomic64_init_nob(&ptab->vola.tile.last_data, (erts_aint64_t) val);
}
static ERTS_INLINE void
last_data_set_relb(ErtsPTab *ptab, Uint64 val)
{
- erts_smp_atomic_set_relb(&ptab->vola.tile.last_data, (erts_aint_t) val);
+ erts_smp_atomic64_set_relb(&ptab->vola.tile.last_data, (erts_aint64_t) val);
}
static ERTS_INLINE Uint64
last_data_read_nob(ErtsPTab *ptab)
{
- return (Uint64) erts_smp_atomic_read_nob(&ptab->vola.tile.last_data);
+ return (Uint64) erts_smp_atomic64_read_nob(&ptab->vola.tile.last_data);
}
static ERTS_INLINE Uint64
last_data_read_acqb(ErtsPTab *ptab)
{
- return (Uint64) erts_smp_atomic_read_acqb(&ptab->vola.tile.last_data);
+ return (Uint64) erts_smp_atomic64_read_acqb(&ptab->vola.tile.last_data);
}
static ERTS_INLINE Uint64
last_data_cmpxchg_relb(ErtsPTab *ptab, Uint64 new, Uint64 exp)
{
- return (Uint64) erts_smp_atomic_cmpxchg_relb(&ptab->vola.tile.last_data,
- (erts_aint_t) new,
- (erts_aint_t) exp);
+ return (Uint64) erts_smp_atomic64_cmpxchg_relb(&ptab->vola.tile.last_data,
+ (erts_aint64_t) new,
+ (erts_aint64_t) exp);
}
-#else
-# error "Not 64-bit, nor 32-bit architecture..."
-#endif
-
static ERTS_INLINE int
last_data_cmp(Uint64 ld1, Uint64 ld2)
{
@@ -446,7 +361,8 @@ erts_ptab_init_table(ErtsPTab *ptab,
int size,
UWord element_size,
char *name,
- int legacy)
+ int legacy,
+ int atomic_refc)
{
size_t tab_sz, alloc_sz;
Uint32 bits, cl, cli, ix, ix_per_cache_line, tab_cache_lines;
@@ -456,7 +372,8 @@ erts_ptab_init_table(ErtsPTab *ptab,
rwmtx_opts.type = ERTS_SMP_RWMTX_TYPE_EXTREMELY_FREQUENT_READ;
rwmtx_opts.lived = ERTS_SMP_RWMTX_LONG_LIVED;
- erts_smp_rwmtx_init_opt(&ptab->list.data.rwmtx, &rwmtx_opts, name);
+ erts_smp_rwmtx_init_opt(&ptab->list.data.rwmtx, &rwmtx_opts, name, NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
erts_smp_atomic32_init_nob(&ptab->vola.tile.count, 0);
last_data_init_nob(ptab, ~((Uint64) 0));
@@ -501,6 +418,8 @@ erts_ptab_init_table(ErtsPTab *ptab,
ptab->r.o.invalid_data = erts_ptab_id2data(ptab, invalid_element->id);
ptab->r.o.release_element = release_element;
+ ptab->r.o.atomic_refc = atomic_refc;
+
if (legacy) {
ptab->r.o.free_id_data = NULL;
ptab->r.o.dix_cl_mask = 0;
@@ -556,7 +475,7 @@ erts_ptab_init_table(ErtsPTab *ptab,
* we don't want to shrink the size to ERTS_PTAB_MAX_SIZE/2.
*
* In order to fix this, we insert a pointer from the table
- * to the invalid_element, wich will be interpreted as a
+ * to the invalid_element, which will be interpreted as a
* slot currently being modified. This way we will be able to
* have ERTS_PTAB_MAX_SIZE-1 valid elements in the table while
* still having a table size of the power of 2.
@@ -619,9 +538,10 @@ erts_ptab_new_element(ErtsPTab *ptab,
init_ptab_el(init_arg, (Eterm) data);
-#ifdef ERTS_SMP
- erts_smp_atomic32_init_nob(&ptab_el->refc, 1);
-#endif
+ if (ptab->r.o.atomic_refc)
+ erts_atomic_init_nob(&ptab_el->refc.atmc, 1);
+ else
+ ptab_el->refc.sint = 1;
pix = erts_ptab_data2pix(ptab, (Eterm) data);
@@ -694,9 +614,10 @@ erts_ptab_new_element(ErtsPTab *ptab,
init_ptab_el(init_arg, data);
-#ifdef ERTS_SMP
- erts_smp_atomic32_init_nob(&ptab_el->refc, 1);
-#endif
+ if (ptab->r.o.atomic_refc)
+ erts_atomic_init_nob(&ptab_el->refc.atmc, 1);
+ else
+ ptab_el->refc.sint = 1;
/* Move into slot reserved */
#ifdef DEBUG
@@ -813,7 +734,7 @@ erts_ptab_delete_element(ErtsPTab *ptab,
* erts_ptab_list() implements BIFs listing the content of the table,
* e.g. erlang:processes/0.
*/
-static void cleanup_ptab_list_bif_data(Binary *bp);
+static int cleanup_ptab_list_bif_data(Binary *bp);
static int ptab_list_bif_engine(Process *c_p, Eterm *res_accp, Binary *mbp);
@@ -851,23 +772,23 @@ erts_ptab_list(Process *c_p, ErtsPTab *ptab)
}
else {
Eterm *hp;
- Eterm magic_bin;
+ Eterm magic_ref;
ERTS_PTAB_LIST_DBG_CHK_RESLIST(res_acc);
- hp = HAlloc(c_p, PROC_BIN_SIZE);
- ERTS_PTAB_LIST_DBG_SAVE_HEAP_ALLOC(ptlbdp, hp, PROC_BIN_SIZE);
- magic_bin = erts_mk_magic_binary_term(&hp, &MSO(c_p), mbp);
+ hp = HAlloc(c_p, ERTS_MAGIC_REF_THING_SIZE);
+ ERTS_PTAB_LIST_DBG_SAVE_HEAP_ALLOC(ptlbdp, hp, ERTS_MAGIC_REF_THING_SIZE);
+ magic_ref = erts_mk_magic_ref(&hp, &MSO(c_p), mbp);
ERTS_PTAB_LIST_DBG_VERIFY_HEAP_ALLOC_USED(ptlbdp, hp);
ERTS_PTAB_LIST_DBG_TRACE(c_p->common.id, trap);
ERTS_BIF_PREP_YIELD2(ret_val,
&ptab_list_continue_export,
c_p,
res_acc,
- magic_bin);
+ magic_ref);
}
return ret_val;
}
-static void
+static int
cleanup_ptab_list_bif_data(Binary *bp)
{
ErtsPTabListBifData *ptlbdp = ERTS_MAGIC_BIN_DATA(bp);
@@ -955,6 +876,8 @@ cleanup_ptab_list_bif_data(Binary *bp)
ERTS_PTAB_LIST_DBG_TRACE(ptlbdp->debug.caller, return);
ERTS_PTAB_LIST_DBG_CLEANUP(ptlbdp);
+
+ return 1;
}
static int
@@ -1335,7 +1258,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);
}
@@ -1367,9 +1290,7 @@ static BIF_RETTYPE ptab_list_continue(BIF_ALIST_2)
res_acc = BIF_ARG_1;
- ERTS_PTAB_LIST_ASSERT(ERTS_TERM_IS_MAGIC_BINARY(BIF_ARG_2));
-
- mbp = ((ProcBin *) binary_val(BIF_ARG_2))->val;
+ mbp = erts_magic_ref2bin(BIF_ARG_2);
ERTS_PTAB_LIST_ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(mbp)
== cleanup_ptab_list_bif_data);
diff --git a/erts/emulator/beam/erl_ptab.h b/erts/emulator/beam/erl_ptab.h
index e3e05f14af..fecfd96ab0 100644
--- a/erts/emulator/beam/erl_ptab.h
+++ b/erts/emulator/beam/erl_ptab.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2012-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2012-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -36,14 +37,16 @@
#include "erl_alloc.h"
#include "erl_monitors.h"
-#define ERTS_TRACER_PROC(P) ((P)->common.tracer_proc)
+#define ERTS_TRACER(P) ((P)->common.tracer)
+#define ERTS_TRACER_MODULE(T) (CAR(list_val(T)))
+#define ERTS_TRACER_STATE(T) (CDR(list_val(T)))
#define ERTS_TRACE_FLAGS(P) ((P)->common.trace_flags)
#define ERTS_P_LINKS(P) ((P)->common.u.alive.links)
#define ERTS_P_MONITORS(P) ((P)->common.u.alive.monitors)
#define IS_TRACED(p) \
- (ERTS_TRACER_PROC((p)) != NIL)
+ (ERTS_TRACER(p) != NIL)
#define ARE_TRACE_FLAGS_ON(p,tf) \
((ERTS_TRACE_FLAGS((p)) & (tf|F_SENSITIVE)) == (tf))
#define IS_TRACED_FL(p,tf) \
@@ -51,11 +54,13 @@
typedef struct {
Eterm id;
-#ifdef ERTS_SMP
- erts_atomic32_t refc;
-#endif
- Eterm tracer_proc;
+ union {
+ erts_atomic_t atmc;
+ Sint sint;
+ } refc;
+ ErtsTracer tracer;
Uint trace_flags;
+ erts_smp_atomic_t timer;
union {
/* --- While being alive --- */
struct {
@@ -63,11 +68,6 @@ typedef struct {
struct reg_proc *reg;
ErtsLink *links;
ErtsMonitor *monitors;
-#ifdef ERTS_SMP
- ErtsSmpPTimer *ptimer;
-#else
- ErlTimer tm;
-#endif
} alive;
/* --- While being released --- */
@@ -88,11 +88,7 @@ typedef struct {
} ErtsPTabListData;
typedef struct {
-#ifdef ARCH_32
- erts_smp_dw_atomic_t last_data;
-#else
- erts_smp_atomic_t last_data;
-#endif
+ erts_smp_atomic64_t last_data;
erts_smp_atomic32_t count;
erts_smp_atomic32_t aid_ix;
erts_smp_atomic32_t fid_ix;
@@ -115,6 +111,7 @@ typedef struct {
Eterm invalid_data;
void (*release_element)(void *);
UWord element_size;
+ int atomic_refc;
} ErtsPTabReadOnlyData;
typedef struct {
@@ -171,7 +168,7 @@ typedef struct {
#define ERTS_PTAB_INVALID_ID(TAG) \
((Eterm) \
- ((((1 << ERTS_PTAB_ID_DATA_SIZE) - 1) << ERTS_PTAB_ID_DATA_SHIFT) \
+ ((((1U << ERTS_PTAB_ID_DATA_SIZE) - 1) << ERTS_PTAB_ID_DATA_SHIFT) \
| (TAG)))
#define erts_ptab_is_valid_id(ID) \
@@ -185,7 +182,8 @@ void erts_ptab_init_table(ErtsPTab *ptab,
int size,
UWord element_size,
char *name,
- int legacy);
+ int legacy,
+ int atomic_refc);
int erts_ptab_new_element(ErtsPTab *ptab,
ErtsPTabElementCommon *ptab_el,
void *init_arg,
@@ -210,9 +208,15 @@ ERTS_GLB_INLINE erts_aint_t erts_ptab_pix2intptr_ddrb(ErtsPTab *ptab, int ix);
ERTS_GLB_INLINE erts_aint_t erts_ptab_pix2intptr_rb(ErtsPTab *ptab, int ix);
ERTS_GLB_INLINE erts_aint_t erts_ptab_pix2intptr_acqb(ErtsPTab *ptab, int ix);
ERTS_GLB_INLINE void erts_ptab_inc_refc(ErtsPTabElementCommon *ptab_el);
-ERTS_GLB_INLINE int erts_ptab_dec_test_refc(ErtsPTabElementCommon *ptab_el);
-ERTS_GLB_INLINE int erts_ptab_add_test_refc(ErtsPTabElementCommon *ptab_el,
- Sint32 add_refc);
+ERTS_GLB_INLINE Sint erts_ptab_dec_test_refc(ErtsPTabElementCommon *ptab_el);
+ERTS_GLB_INLINE Sint erts_ptab_add_test_refc(ErtsPTabElementCommon *ptab_el,
+ Sint add_refc);
+ERTS_GLB_INLINE Sint erts_ptab_read_refc(ErtsPTabElementCommon *ptab_el);
+ERTS_GLB_INLINE void erts_ptab_atmc_inc_refc(ErtsPTabElementCommon *ptab_el);
+ERTS_GLB_INLINE Sint erts_ptab_atmc_dec_test_refc(ErtsPTabElementCommon *ptab_el);
+ERTS_GLB_INLINE Sint erts_ptab_atmc_add_test_refc(ErtsPTabElementCommon *ptab_el,
+ Sint add_refc);
+ERTS_GLB_INLINE Sint erts_ptab_atmc_read_refc(ErtsPTabElementCommon *ptab_el);
ERTS_GLB_INLINE void erts_ptab_rlock(ErtsPTab *ptab);
ERTS_GLB_INLINE int erts_ptab_tryrlock(ErtsPTab *ptab);
ERTS_GLB_INLINE void erts_ptab_runlock(ErtsPTab *ptab);
@@ -369,50 +373,65 @@ ERTS_GLB_INLINE erts_aint_t erts_ptab_pix2intptr_acqb(ErtsPTab *ptab, int ix)
return erts_smp_atomic_read_acqb(&ptab->r.o.tab[ix]);
}
-ERTS_GLB_INLINE void erts_ptab_inc_refc(ErtsPTabElementCommon *ptab_el)
+ERTS_GLB_INLINE void erts_ptab_atmc_inc_refc(ErtsPTabElementCommon *ptab_el)
{
-#ifdef ERTS_SMP
#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_aint32_t refc = erts_atomic32_inc_read_nob(&ptab_el->refc);
- ERTS_SMP_LC_ASSERT(refc > 1);
+ erts_aint_t refc = erts_atomic_inc_read_nob(&ptab_el->refc.atmc);
+ ERTS_LC_ASSERT(refc > 1);
#else
- erts_atomic32_inc_nob(&ptab_el->refc);
-#endif
+ erts_atomic_inc_nob(&ptab_el->refc.atmc);
#endif
}
-ERTS_GLB_INLINE int erts_ptab_dec_test_refc(ErtsPTabElementCommon *ptab_el)
+ERTS_GLB_INLINE Sint erts_ptab_atmc_dec_test_refc(ErtsPTabElementCommon *ptab_el)
{
-#ifdef ERTS_SMP
- erts_aint32_t refc = erts_atomic32_dec_read_nob(&ptab_el->refc);
+ erts_aint_t refc = erts_atomic_dec_read_relb(&ptab_el->refc.atmc);
ERTS_SMP_LC_ASSERT(refc >= 0);
- return (int) refc;
-#else
- return 0;
+#ifdef ERTS_SMP
+ if (refc == 0)
+ ETHR_MEMBAR(ETHR_LoadLoad|ETHR_LoadStore);
#endif
+ return (Sint) refc;
}
-ERTS_GLB_INLINE int erts_ptab_add_test_refc(ErtsPTabElementCommon *ptab_el,
- Sint32 add_refc)
+ERTS_GLB_INLINE Sint erts_ptab_atmc_add_test_refc(ErtsPTabElementCommon *ptab_el,
+ Sint add_refc)
{
-#ifdef ERTS_SMP
- erts_aint32_t refc;
+ erts_aint_t refc = erts_atomic_add_read_mb(&ptab_el->refc.atmc,
+ (erts_aint_t) add_refc);
+ ERTS_SMP_LC_ASSERT(refc >= 0);
+ return (Sint) refc;
+}
-#ifndef ERTS_ENABLE_LOCK_CHECK
- if (add_refc >= 0) {
- erts_atomic32_add_nob(&ptab_el->refc,
- (erts_aint32_t) add_refc);
- return 1;
- }
-#endif
+ERTS_GLB_INLINE Sint erts_ptab_atmc_read_refc(ErtsPTabElementCommon *ptab_el)
+{
+ return (Sint) erts_atomic_read_nob(&ptab_el->refc.atmc);
+}
- refc = erts_atomic32_add_read_nob(&ptab_el->refc,
- (erts_aint32_t) add_refc);
+ERTS_GLB_INLINE void erts_ptab_inc_refc(ErtsPTabElementCommon *ptab_el)
+{
+ ptab_el->refc.sint++;
+ ASSERT(ptab_el->refc.sint > 1);
+}
+
+ERTS_GLB_INLINE Sint erts_ptab_dec_test_refc(ErtsPTabElementCommon *ptab_el)
+{
+ Sint refc = --ptab_el->refc.sint;
ERTS_SMP_LC_ASSERT(refc >= 0);
- return (int) refc;
-#else
- return 0;
-#endif
+ return refc;
+}
+
+ERTS_GLB_INLINE Sint erts_ptab_add_test_refc(ErtsPTabElementCommon *ptab_el,
+ Sint add_refc)
+{
+ ptab_el->refc.sint += add_refc;
+ ERTS_SMP_LC_ASSERT(ptab_el->refc.sint >= 0);
+ return (Sint) ptab_el->refc.sint;
+}
+
+ERTS_GLB_INLINE Sint erts_ptab_read_refc(ErtsPTabElementCommon *ptab_el)
+{
+ return ptab_el->refc.sint;
}
ERTS_GLB_INLINE void erts_ptab_rlock(ErtsPTab *ptab)
diff --git a/erts/emulator/beam/erl_rbtree.h b/erts/emulator/beam/erl_rbtree.h
new file mode 100644
index 0000000000..e59d6900b0
--- /dev/null
+++ b/erts/emulator/beam/erl_rbtree.h
@@ -0,0 +1,1757 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2015-2017. 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: A Red-Black (binary search) Tree implementation. The search,
+ * insert, and delete operations are all O(log n) operations
+ * on a Red-Black Tree. Red-Black Trees are described in
+ * "Introduction to Algorithms", by Thomas H. Cormen, Charles
+ * E. Leiserson, and Ronald L. Riverest.
+ *
+ * Use by defining mandatory defines as well as defines for
+ * API functions wanted, and include this header.
+ *
+ * Author: Rickard Green
+ *
+ *
+ * Mandatory defines:
+ * - ERTS_RBT_PREFIX - Prefix to use on functions.
+ * - ERTS_RBT_T - Type of a tree node.
+ * - ERTS_RBT_KEY_T - Type of key for a tree node.
+ * - ERTS_RBT_FLAGS_T - Type of flags for a tree node.
+ * - ERTS_RBT_INIT_EMPTY_TNODE(T) -Initialize an empty tree node.
+ * - ERTS_RBT_IS_RED(T) - Is tree node red?
+ * - ERTS_RBT_SET_RED(T) - Set tree node red.
+ * - ERTS_RBT_IS_BLACK(T) - Is tree node back?
+ * - ERTS_RBT_SET_BLACK(T) - Set tree node black.
+ * - ERTS_RBT_GET_FLAGS(T) - Get flags of tree node (incl colors).
+ * - ERTS_RBT_SET_FLAGS(T, F) - Set flags of tree note.
+ * - ERTS_RBT_GET_PARENT(T) - Get parent node.
+ * - ERTS_RBT_SET_PARENT(T, P) - Set parent node.
+ * - ERTS_RBT_GET_RIGHT(T) - Get right child node.
+ * - ERTS_RBT_SET_RIGHT(T, R) - Set right child node.
+ * - ERTS_RBT_GET_LEFT(T) - Get left child node.
+ * - ERTS_RBT_SET_LEFT(T, L) - Set left child node.
+ * - ERTS_RBT_GET_KEY(T) - Get key of node.
+ * - ERTS_RBT_IS_LT(KX, KY) - Is key KX less than key KY?
+ * - ERTS_RBT_IS_EQ(KX, KY) - Is key KX equal to key KY?
+ *
+ * Optional defines:
+ *
+ * - ERTS_RBT_UNDEF - Undefine all user defined ERTS_RBT_*
+ * defines after use.
+ *
+ * - ERTS_RBT_NO_API_INLINE - Do not inline API functions.
+ *
+ * Attached data management:
+ * - ERTS_RBT_UPDATE_ATTACHED_DATA_ROTATE(L, OP, NP) - Called
+ * when a rotate operation has been performed. If L (in int)
+ * is a non zero, a left rotation was performed; otherwise,
+ * a right rotation was performed. OR points to the old
+ * parent node and NP points to the new parent node.
+ * - ERTS_RBT_UPDATE_ATTACHED_DATA_DMOD(F, T) - Called when
+ * a delete operation modifies a tree node. A delete
+ * modification is either a removal or replacement of a
+ * node. F points to the parent of the tree node that was
+ * modified. T points to the next ancestor that will be
+ * modified. If T is NULL, no more removal and/or
+ * replacements will be made. One typically wants to update
+ * the attached data of each node between F and T. If T is
+ * NULL all the way up to the root.
+ * - ERTS_RBT_UPDATE_ATTACHED_DATA_CHGROOT(OR, NR) - Called
+ * when the root node changes. OR points to the old
+ * root node and NP points to the new root node.
+ *
+ * Request implementation of API functions:
+ * - ERTS_RBT_WANT_DELETE
+ * - ERTS_RBT_WANT_INSERT
+ * - ERTS_RBT_WANT_LOOKUP_INSERT
+ * - ERTS_RBT_WANT_REPLACE
+ * - ERTS_RBT_WANT_LOOKUP
+ * - ERTS_RBT_WANT_SMALLEST
+ * - ERTS_RBT_WANT_LARGEST
+ * - ERTS_RBT_WANT_FOREACH
+ * - ERTS_RBT_WANT_FOREACH_DESTROY
+ * - ERTS_RBT_WANT_FOREACH_YIELDING
+ * - ERTS_RBT_WANT_FOREACH_DESTROY_YIELDING
+ * - ERTS_RBT_WANT_FOREACH_SMALL
+ * - ERTS_RBT_WANT_FOREACH_LARGE
+ * - ERTS_RBT_WANT_FOREACH_SMALL_DESTROY
+ * - ERTS_RBT_WANT_FOREACH_LARGE_DESTROY
+ * - ERTS_RBT_WANT_FOREACH_SMALL_YIELDING
+ * - ERTS_RBT_WANT_FOREACH_LARGE_YIELDING
+ * - ERTS_RBT_WANT_FOREACH_SMALL_DESTROY_YIELDING
+ * - ERTS_RBT_WANT_FOREACH_LARGE_DESTROY_YIELDING
+ * - ERTS_RBT_WANT_DEBUG_PRINT
+ *
+ * The yield state data type will equal
+ * <ERTS_RBT_PREFIX>_rbt_yield_state_t.
+ *
+ * The yield state should be statically initialized by
+ * ERTS_RBT_YIELD_STAT_INITER
+ *
+ * or dynamically initialized with
+ * ERTS_RBT_YIELD_STAT_INIT(<ERTS_RBT_PREFIX>_rbt_yield_state_t *ystate)
+ *
+ *
+ * The following API functions are implemented if corresponding
+ * ERTS_RBT_WANT_<OPERATION> is defined:
+ *
+ * - void <ERTS_RBT_PREFIX>_rbt_delete(
+ * ERTS_RBT_T **tree,
+ * ERTS_RBT_T *element);
+ * Delete element from tree.
+ *
+ * - void <ERTS_RBT_PREFIX>_rbt_insert(
+ * ERTS_RBT_T **tree,
+ * ERTS_RBT_T *element);
+ * Insert element into tree.
+ *
+ * - ERTS_RBT_T * <ERTS_RBT_PREFIX>_rbt_lookup_insert(
+ * ERTS_RBT_T **tree,
+ * ERTS_RBT_T *element);
+ * Look up an element in the tree that compares as equal to the
+ * element passed as argument, and return the looked up element.
+ * If no element compared as equal, insert the element passed as
+ * argument into the tree, and return NULL.
+ *
+ * - void <ERTS_RBT_PREFIX>_rbt_replace(
+ * ERTS_RBT_T **tree,
+ * ERTS_RBT_T *old_element,
+ * ERTS_RBT_T *new_element);
+ * Replace old_element in the tree with new_element. Both elements
+ * *should* compare as equal.
+ *
+ * - ERTS_RBT_T * <ERTS_RBT_PREFIX>_rbt_lookup(
+ * ERTS_RBT_T *tree,
+ * ERTS_RBT_KEY_T key);
+ * Look up an element with a key that compares as equal to
+ * the key passed as argument.
+ *
+ * - ERTS_RBT_T * <ERTS_RBT_PREFIX>_rbt_smallest(
+ * ERTS_RBT_T *tree);
+ * Look up the element with the smallest key.
+ *
+ * - ERTS_RBT_T * <ERTS_RBT_PREFIX>_rbt_largest(
+ * ERTS_RBT_T *tree);
+ * Look up the element with the largest key.
+ *
+ * - void <ERTS_RBT_PREFIX>_rbt_foreach(
+ * ERTS_RBT_T *tree,
+ * void (*op)(ERTS_RBT_T *, void *),
+ * void *arg);
+ * Operate by calling the operator 'op' on each element.
+ * Order is undefined.
+ *
+ * 'arg' is passed as argument to 'op'.
+ *
+ * - void <ERTS_RBT_PREFIX>_rbt_foreach_destroy(
+ * ERTS_RBT_T *tree,
+ * void (*op)(ERTS_RBT_T *, void *),
+ * void *arg);
+ * Operate by calling the operator 'op' on each element.
+ * Order is undefined. Each element should be destroyed
+ * by 'op'.
+ *
+ * 'arg' is passed as argument to 'op'.
+ *
+ * - int <ERTS_RBT_PREFIX>_rbt_foreach_yielding(
+ * ERTS_RBT_T *tree,
+ * void (*op)(ERTS_RBT_T *, void *),
+ * void *arg,
+ * <ERTS_RBT_PREFIX>_rbt_yield_state_t *ystate,
+ * Sint ylimit);
+ * Operate by calling the operator 'op' on each element.
+ * Order is undefined.
+ *
+ * Yield when 'ylimit' elements has been processed. True is
+ * returned when yielding, and false is returned when
+ * the whole tree has been processed. The tree should not be
+ * modified until all of it has been processed.
+ *
+ * 'arg' is passed as argument to 'op'.
+ *
+ * - int <ERTS_RBT_PREFIX>_rbt_foreach_destroy_yielding(
+ * ERTS_RBT_T *tree,
+ * void (*op)(ERTS_RBT_T *, void *),
+ * void *arg,
+ * <ERTS_RBT_PREFIX>_rbt_yield_state_t *ystate,
+ * Sint ylimit);
+ * Operate by calling the operator 'op' on each element.
+ * Order is undefined. Each element should be destroyed
+ * by 'op'.
+ *
+ * Yield when 'ylimit' elements has been processed. True is
+ * returned when yielding, and false is returned when
+ * the whole tree has been processed.
+ *
+ * 'arg' is passed as argument to 'op'.
+ *
+ * - void <ERTS_RBT_PREFIX>_rbt_foreach_small(
+ * ERTS_RBT_T *tree,
+ * void (*op)(ERTS_RBT_T *, void *),
+ * void *arg);
+ * Operate by calling the operator 'op' on each element from
+ * smallest towards larger elements.
+ *
+ * 'arg' is passed as argument to 'op'.
+ *
+ * - void <ERTS_RBT_PREFIX>_rbt_foreach_large(
+ * ERTS_RBT_T *tree,
+ * void (*op)(ERTS_RBT_T *, void *),
+ * void *arg);
+ * Operate by calling the operator 'op' on each element from
+ * largest towards smaller elements.
+ *
+ * 'arg' is passed as argument to 'op'.
+ *
+ * - int <ERTS_RBT_PREFIX>_rbt_foreach_small_yielding(
+ * ERTS_RBT_T *tree,
+ * void (*op)(ERTS_RBT_T *, void *),
+ * void *arg,
+ * <ERTS_RBT_PREFIX>_rbt_yield_state_t *ystate,
+ * Sint ylimit);
+ * Operate by calling the operator 'op' on each element from
+ * smallest towards larger elements.
+ *
+ * Yield when 'ylimit' elements has been processed. True is
+ * returned when yielding, and false is returned when
+ * the whole tree has been processed. The tree should not be
+ * modified until all of it has been processed.
+ *
+ * 'arg' is passed as argument to 'op'.
+ *
+ * - int <ERTS_RBT_PREFIX>_rbt_foreach_large_yielding(
+ * ERTS_RBT_T *tree,
+ * void (*op)(ERTS_RBT_T *, void *),
+ * void *arg,
+ * <ERTS_RBT_PREFIX>_rbt_yield_state_t *ystate,
+ * Sint ylimit);
+ * Operate by calling the operator 'op' on each element from
+ * largest towards smaller elements.
+ *
+ * Yield when 'ylimit' elements has been processed. True is
+ * returned when yielding, and false is returned when
+ * the whole tree has been processed. The tree should not be
+ * modified until all of it has been processed.
+ *
+ * 'arg' is passed as argument to 'op'.
+ *
+ * - void <ERTS_RBT_PREFIX>_rbt_foreach_small_destroy(
+ * ERTS_RBT_T **tree,
+ * void (*op)(ERTS_RBT_T *, void *),
+ * void (*destr)(ERTS_RBT_T *, void *),
+ * void *arg);
+ * Operate by calling the operator 'op' on each element from
+ * smallest towards larger elements.
+ *
+ * Destroy elements by calling the destructor 'destr'. Elements
+ * are destroyed when not needed by the tree structure anymore.
+ * Note that elements are often *not* destroyed in another order
+ * than the order that the elements are operated on.
+ *
+ * 'arg' is passed as argument to 'op' and 'destroy'.
+ *
+ * - void <ERTS_RBT_PREFIX>_rbt_foreach_large_destroy(
+ * ERTS_RBT_T **tree,
+ * void (*op)(ERTS_RBT_T *, void *),
+ * void (*destr)(ERTS_RBT_T *, void *),
+ * void *arg);
+ * Operate by calling the operator 'op' on each element from
+ * largest towards smaller elements.
+ *
+ * Destroy elements by calling the destructor 'destr'. Elements
+ * are destroyed when not needed by the tree structure anymore.
+ * Note that elements are often destroyed in another order
+ * than the order that the elements are operated on.
+ *
+ * 'arg' is passed as argument to 'op' and 'destroy'.
+ *
+ * - int <ERTS_RBT_PREFIX>_rbt_foreach_small_destroy_yielding(
+ * ERTS_RBT_T **tree,
+ * void (*op)(ERTS_RBT_T *, void *),
+ * void (*destr)(ERTS_RBT_T *, void *),
+ * void *arg,
+ * <ERTS_RBT_PREFIX>_rbt_yield_state_t *ystate,
+ * Sint ylimit);
+ * Operate by calling the operator 'op' on each element from
+ * smallest towards larger elements.
+ *
+ * Destroy elements by calling the destructor 'destr'. Elements
+ * are destroyed when not needed by the tree structure anymore.
+ * Note that elements are often destroyed in another order
+ * than the order that the elements are operated on.
+ *
+ * Yield when 'ylimit' elements has been processed. True is
+ * returned when yielding, and false is returned when
+ * the whole tree has been processed. The tree should not be
+ * modified until all of it has been processed.
+ *
+ * 'arg' is passed as argument to 'op' and 'destroy'.
+ *
+ * - int <ERTS_RBT_PREFIX>_rbt_foreach_large_destroy_yielding(
+ * ERTS_RBT_T **tree,
+ * void (*op)(ERTS_RBT_T *, void *),
+ * void (*destr)(ERTS_RBT_T *, void *),
+ * void *arg,
+ * <ERTS_RBT_PREFIX>_rbt_yield_state_t *ystate,
+ * Sint ylimit);
+ * Operate by calling the operator 'op' on each element from
+ * largest towards smaller elements.
+ *
+ * Destroy elements by calling the destructor 'destr'. Elements
+ * are destroyed when not needed by the tree structure anymore.
+ * Note that elements are often destroyed in another order
+ * than the order that the elements are operated on.
+ *
+ * Yield when 'ylimit' elements has been processed. True is
+ * returned when yielding, and false is returned when
+ * the whole tree has been processed. The tree should not be
+ * modified until all of it has been processed.
+ *
+ * 'arg' is passed as argument to 'op' and 'destroy'.
+ *
+ * - void <ERTS_RBT_PREFIX>_rbt_debug_print(
+ * FILE *filep,
+ * ERTS_RBT_T *x,
+ * int indent,
+ * (void)(*print_node)(ERTS_RBT_T *));
+ * Prints the tree. Note that this function is recursive.
+ * Should only be used for debuging.
+ */
+
+
+/*
+ * Check that we have all mandatory defines
+ */
+#ifndef ERTS_RBT_PREFIX
+# error Missing definition of ERTS_RBT_PREFIX
+#endif
+#ifndef ERTS_RBT_T
+# error Missing definition of ERTS_RBT_T
+#endif
+#ifndef ERTS_RBT_KEY_T
+# error Missing definition of ERTS_RBT_KEY_T
+#endif
+#ifndef ERTS_RBT_FLAGS_T
+# error Missing definition of ERTS_RBT_FLAGS_T
+#endif
+#ifndef ERTS_RBT_INIT_EMPTY_TNODE
+# error Missing definition of ERTS_RBT_INIT_EMPTY_TNODE
+#endif
+#ifndef ERTS_RBT_IS_RED
+# error Missing definition of ERTS_RBT_IS_RED
+#endif
+#ifndef ERTS_RBT_SET_RED
+# error Missing definition of ERTS_RBT_SET_RED
+#endif
+#ifndef ERTS_RBT_IS_BLACK
+# error Missing definition of ERTS_RBT_IS_BLACK
+#endif
+#ifndef ERTS_RBT_SET_BLACK
+# error Missing definition of ERTS_RBT_SET_BLACK
+#endif
+#ifndef ERTS_RBT_GET_FLAGS
+# error Missing definition of ERTS_RBT_GET_FLAGS
+#endif
+#ifndef ERTS_RBT_SET_FLAGS
+# error Missing definition of ERTS_RBT_SET_FLAGS
+#endif
+#ifndef ERTS_RBT_GET_PARENT
+# error Missing definition of ERTS_RBT_GET_PARENT
+#endif
+#ifndef ERTS_RBT_SET_PARENT
+# error Missing definition of ERTS_RBT_SET_PARENT
+#endif
+#ifndef ERTS_RBT_GET_RIGHT
+# error Missing definition of ERTS_RBT_GET_RIGHT
+#endif
+#ifndef ERTS_RBT_GET_LEFT
+# error Missing definition of ERTS_RBT_GET_LEFT
+#endif
+#ifndef ERTS_RBT_IS_LT
+# error Missing definition of ERTS_RBT_IS_LT
+#endif
+#ifndef ERTS_RBT_GET_KEY
+# error Missing definition of ERTS_RBT_GET_KEY
+#endif
+#ifndef ERTS_RBT_IS_EQ
+# error Missing definition of ERTS_RBT_IS_EQ
+#endif
+
+#if defined(ERTS_RBT_HARD_DEBUG) || defined(DEBUG)
+# ifndef ERTS_RBT_DEBUG
+# define ERTS_RBT_DEBUG 1
+# endif
+#endif
+
+#if defined(ERTS_RBT_HARD_DEBUG) && defined(__GNUC__)
+#warning "* * * * * * * * * * * * * * * * * *"
+#warning "* ERTS_RBT_HARD_DEBUG IS ENABLED! *"
+#warning "* * * * * * * * * * * * * * * * * *"
+#endif
+
+#undef ERTS_RBT_ASSERT
+#if defined(ERTS_RBT_DEBUG)
+#define ERTS_RBT_ASSERT(E) ERTS_ASSERT(E)
+#else
+#define ERTS_RBT_ASSERT(E) ((void) 1)
+#endif
+
+#undef ERTS_RBT_API_INLINE__
+#if defined(ERTS_RBT_NO_API_INLINE) || defined(ERTS_RBT_DEBUG)
+# define ERTS_RBT_API_INLINE__
+#else
+# define ERTS_RBT_API_INLINE__ ERTS_INLINE
+#endif
+
+#ifndef ERTS_RBT_YIELD_STAT_INITER
+# define ERTS_RBT_YIELD_STAT_INITER {NULL, 0}
+#endif
+#ifndef ERTS_RBT_YIELD_STAT_INIT
+# define ERTS_RBT_YIELD_STAT_INIT(YS) \
+ do { \
+ (YS)->x = NULL; \
+ (YS)->up = 0; \
+ } while (0)
+#endif
+
+#define ERTS_RBT_CONCAT_MACRO_VALUES___(X, Y) \
+ X ## Y
+#define ERTS_RBT_CONCAT_MACRO_VALUES__(X, Y) \
+ ERTS_RBT_CONCAT_MACRO_VALUES___(X, Y)
+
+#undef ERTS_RBT_YIELD_STATE_T__
+#define ERTS_RBT_YIELD_STATE_T__ \
+ ERTS_RBT_CONCAT_MACRO_VALUES__(ERTS_RBT_PREFIX, _rbt_yield_state_t)
+
+typedef struct {
+ ERTS_RBT_T *x;
+ int up;
+} ERTS_RBT_YIELD_STATE_T__;
+
+#define ERTS_RBT_FUNC__(Name) \
+ ERTS_RBT_CONCAT_MACRO_VALUES__(ERTS_RBT_PREFIX, _rbt_ ## Name)
+
+#undef ERTS_RBT_NEED_REPLACE__
+#undef ERTS_RBT_NEED_INSERT__
+#undef ERTS_RBT_NEED_ROTATE__
+#undef ERTS_RBT_NEED_FOREACH_UNORDERED__
+#undef ERTS_RBT_NEED_FOREACH_ORDERED__
+#undef ERTS_RBT_NEED_HDBG_CHECK_TREE__
+#undef ERTS_RBT_HDBG_CHECK_TREE__
+
+#if defined(ERTS_RBT_WANT_REPLACE) || defined(ERTS_RBT_WANT_DELETE)
+# define ERTS_RBT_NEED_REPLACE__
+#endif
+#if defined(ERTS_RBT_WANT_INSERT) || defined(ERTS_RBT_WANT_LOOKUP_INSERT)
+# define ERTS_RBT_NEED_INSERT__
+#endif
+#if defined(ERTS_RBT_WANT_DELETE) || defined(ERTS_RBT_NEED_INSERT__)
+# define ERTS_RBT_NEED_ROTATE__
+#endif
+#if defined(ERTS_RBT_WANT_FOREACH) \
+ || defined(ERTS_RBT_WANT_FOREACH_YIELDING) \
+ || defined(ERTS_RBT_WANT_FOREACH_DESTROY) \
+ || defined(ERTS_RBT_WANT_FOREACH_DESTROY_YIELDING)
+# define ERTS_RBT_NEED_FOREACH_UNORDERED__
+#endif
+#if defined(ERTS_RBT_WANT_FOREACH_SMALL) \
+ || defined(ERTS_RBT_WANT_FOREACH_LARGE) \
+ || defined(ERTS_RBT_WANT_FOREACH_SMALL_YIELDING) \
+ || defined(ERTS_RBT_WANT_FOREACH_LARGE_YIELDING) \
+ || defined(ERTS_RBT_WANT_FOREACH_SMALL_DESTROY) \
+ || defined(ERTS_RBT_WANT_FOREACH_LARGE_DESTROY) \
+ || defined(ERTS_RBT_WANT_FOREACH_SMALL_DESTROY_YIELDING) \
+ || defined(ERTS_RBT_WANT_FOREACH_LARGE_DESTROY_YIELDING)
+# define ERTS_RBT_NEED_FOREACH_ORDERED__
+#endif
+#if defined(ERTS_RBT_HARD_DEBUG) \
+ && (defined(ERTS_RBT_WANT_DELETE) \
+ || defined(ERTS_RBT_NEED_INSERT__))
+static void ERTS_RBT_FUNC__(hdbg_check_tree)(ERTS_RBT_T *root, ERTS_RBT_T *node);
+# define ERTS_RBT_NEED_HDBG_CHECK_TREE__
+# define ERTS_RBT_HDBG_CHECK_TREE__(R,N) \
+ ERTS_RBT_FUNC__(hdbg_check_tree)((R),(N))
+#else
+# define ERTS_RBT_HDBG_CHECK_TREE__(R,N) ((void) 1)
+#endif
+
+#ifdef ERTS_RBT_NEED_ROTATE__
+
+static ERTS_INLINE void
+ERTS_RBT_FUNC__(left_rotate__)(ERTS_RBT_T **root, ERTS_RBT_T *x)
+{
+ ERTS_RBT_T *y, *l, *p;
+
+ y = ERTS_RBT_GET_RIGHT(x);
+ l = ERTS_RBT_GET_LEFT(y);
+ ERTS_RBT_SET_RIGHT(x, l);
+
+ if (l)
+ ERTS_RBT_SET_PARENT(l, x);
+
+ p = ERTS_RBT_GET_PARENT(x);
+ ERTS_RBT_SET_PARENT(y, p);
+
+ if (!p) {
+ ERTS_RBT_ASSERT(*root == x);
+ *root = y;
+#ifdef ERTS_RBT_UPDATE_ATTACHED_DATA_CHGROOT
+ ERTS_RBT_UPDATE_ATTACHED_DATA_CHGROOT(x, y);
+#endif
+ }
+ else if (x == ERTS_RBT_GET_LEFT(p))
+ ERTS_RBT_SET_LEFT(p, y);
+ else {
+ ERTS_RBT_ASSERT(x == ERTS_RBT_GET_RIGHT(p));
+ ERTS_RBT_SET_RIGHT(p, y);
+ }
+ ERTS_RBT_SET_LEFT(y, x);
+ ERTS_RBT_SET_PARENT(x, y);
+
+#ifdef ERTS_RBT_UPDATE_ATTACHED_DATA_ROTATE
+ ERTS_RBT_UPDATE_ATTACHED_DATA_ROTATE(!0, x, y);
+#endif
+
+}
+
+static ERTS_INLINE void
+ERTS_RBT_FUNC__(right_rotate__)(ERTS_RBT_T **root, ERTS_RBT_T *x)
+{
+ ERTS_RBT_T *y, *r, *p;
+
+ y = ERTS_RBT_GET_LEFT(x);
+ r = ERTS_RBT_GET_RIGHT(y);
+ ERTS_RBT_SET_LEFT(x, r);
+
+ if (r)
+ ERTS_RBT_SET_PARENT(r, x);
+
+ p = ERTS_RBT_GET_PARENT(x);
+ ERTS_RBT_SET_PARENT(y, p);
+
+ if (!p) {
+ ERTS_RBT_ASSERT(*root == x);
+ *root = y;
+#ifdef ERTS_RBT_UPDATE_ATTACHED_DATA_CHGROOT
+ ERTS_RBT_UPDATE_ATTACHED_DATA_CHGROOT(x, y);
+#endif
+ }
+ else if (x == ERTS_RBT_GET_RIGHT(p))
+ ERTS_RBT_SET_RIGHT(p, y);
+ else {
+ ERTS_RBT_ASSERT(x == ERTS_RBT_GET_LEFT(p));
+ ERTS_RBT_SET_LEFT(p, y);
+ }
+
+ ERTS_RBT_SET_RIGHT(y, x);
+ ERTS_RBT_SET_PARENT(x, y);
+
+#ifdef ERTS_RBT_UPDATE_ATTACHED_DATA_ROTATE
+ ERTS_RBT_UPDATE_ATTACHED_DATA_ROTATE(0, x, y);
+#endif
+
+}
+
+#endif /* ERTS_RBT_NEED_ROTATE__ */
+
+#ifdef ERTS_RBT_NEED_REPLACE__
+
+/*
+ * Replace node x with node y
+ */
+static ERTS_INLINE void
+ERTS_RBT_FUNC__(replace__)(ERTS_RBT_T **root, ERTS_RBT_T *x, ERTS_RBT_T *y)
+{
+ ERTS_RBT_T *p, *r, *l;
+ ERTS_RBT_FLAGS_T f;
+
+ p = ERTS_RBT_GET_PARENT(x);
+ if (!p) {
+ ERTS_RBT_ASSERT(*root == x);
+ *root = y;
+#ifdef ERTS_RBT_UPDATE_ATTACHED_DATA_CHGROOT
+ ERTS_RBT_UPDATE_ATTACHED_DATA_CHGROOT(x, y);
+#endif
+ }
+ else if (x == ERTS_RBT_GET_LEFT(p))
+ ERTS_RBT_SET_LEFT(p, y);
+ else {
+ ERTS_RBT_ASSERT(x == ERTS_RBT_GET_RIGHT(p));
+ ERTS_RBT_SET_RIGHT(p, y);
+ }
+ l = ERTS_RBT_GET_LEFT(x);
+ if (l) {
+ ERTS_RBT_ASSERT(ERTS_RBT_GET_PARENT(l) == x);
+ ERTS_RBT_SET_PARENT(l, y);
+ }
+ r = ERTS_RBT_GET_RIGHT(x);
+ if (r) {
+ ERTS_RBT_ASSERT(ERTS_RBT_GET_PARENT(r) == x);
+ ERTS_RBT_SET_PARENT(r, y);
+ }
+
+ f = ERTS_RBT_GET_FLAGS(x);
+ ERTS_RBT_SET_FLAGS(y, f);
+ ERTS_RBT_SET_PARENT(y, p);
+ ERTS_RBT_SET_RIGHT(y, r);
+ ERTS_RBT_SET_LEFT(y, l);
+}
+
+#endif /* ERTS_RBT_NEED_REPLACE__ */
+
+#ifdef ERTS_RBT_WANT_REPLACE
+
+static ERTS_RBT_API_INLINE__ void
+ERTS_RBT_FUNC__(replace)(ERTS_RBT_T **root, ERTS_RBT_T *x, ERTS_RBT_T *y)
+{
+ ERTS_RBT_ASSERT(ERTS_RBT_IS_EQ(ERTS_RBT_GET_KEY(x),
+ ERTS_RBT_GET_KEY(y)));
+
+ ERTS_RBT_FUNC__(replace__)(root, x, y);
+}
+
+#endif /* ERTS_RBT_WANT_REPLACE */
+
+#ifdef ERTS_RBT_WANT_DELETE
+
+/*
+ * Delete a node.
+ */
+static ERTS_RBT_API_INLINE__ void
+ERTS_RBT_FUNC__(delete)(ERTS_RBT_T **root, ERTS_RBT_T *n)
+{
+ int spliced_is_black;
+ ERTS_RBT_T *p, *x, *y, *z = n;
+ ERTS_RBT_T null_x; /* null_x is used to get the fixup started when we
+ splice out a node without children. */
+
+ ERTS_RBT_HDBG_CHECK_TREE__(*root, n);
+
+ ERTS_RBT_INIT_EMPTY_TNODE(&null_x);
+
+ /* Remove node from tree... */
+
+ /* Find node to splice out */
+ if (!ERTS_RBT_GET_LEFT(z) || !ERTS_RBT_GET_RIGHT(z))
+ y = z;
+ else {
+ /* Set y to z:s successor */
+ y = ERTS_RBT_GET_RIGHT(z);
+ while (1) {
+ ERTS_RBT_T *t = ERTS_RBT_GET_LEFT(y);
+ if (!t)
+ break;
+ y = t;
+ }
+ }
+ /* splice out y */
+ x = ERTS_RBT_GET_LEFT(y);
+ if (!x)
+ x = ERTS_RBT_GET_RIGHT(y);
+ spliced_is_black = ERTS_RBT_IS_BLACK(y);
+ p = ERTS_RBT_GET_PARENT(y);
+ if (x)
+ ERTS_RBT_SET_PARENT(x, p);
+ else if (spliced_is_black) {
+ x = &null_x;
+ ERTS_RBT_SET_BLACK(x);
+ ERTS_RBT_SET_PARENT(x, p);
+ ERTS_RBT_SET_LEFT(y, x);
+ }
+
+ if (!p) {
+ ERTS_RBT_ASSERT(*root == y);
+ *root = x;
+#ifdef ERTS_RBT_UPDATE_ATTACHED_DATA_CHGROOT
+ ERTS_RBT_UPDATE_ATTACHED_DATA_CHGROOT(y, x);
+#endif
+ }
+ else {
+ if (y == ERTS_RBT_GET_LEFT(p))
+ ERTS_RBT_SET_LEFT(p, x);
+ else {
+ ERTS_RBT_ASSERT(y == ERTS_RBT_GET_RIGHT(p));
+ ERTS_RBT_SET_RIGHT(p, x);
+ }
+#ifdef ERTS_RBT_UPDATE_ATTACHED_DATA_DMOD
+ if (p != z)
+ ERTS_RBT_UPDATE_ATTACHED_DATA_DMOD(p, y == z ? NULL : z);
+#endif
+ }
+ if (y != z) {
+ /* We spliced out the successor of z; replace z by the successor */
+ ERTS_RBT_FUNC__(replace__)(root, z, y);
+#ifdef ERTS_RBT_UPDATE_ATTACHED_DATA_DMOD
+ ERTS_RBT_UPDATE_ATTACHED_DATA_DMOD(y, NULL);
+#endif
+ }
+
+ if (spliced_is_black) {
+ /* We removed a black node which makes the resulting tree
+ violate the Red-Black Tree properties. Fixup tree... */
+
+ p = ERTS_RBT_GET_PARENT(x);
+ while (ERTS_RBT_IS_BLACK(x) && p) {
+ ERTS_RBT_T *r, *l;
+
+ /*
+ * x has an "extra black" which we move up the tree
+ * until we reach the root or until we can get rid of it.
+ *
+ * y is the sibbling of x, and p is their parent
+ */
+
+ if (x == ERTS_RBT_GET_LEFT(p)) {
+ y = ERTS_RBT_GET_RIGHT(p);
+
+ ERTS_RBT_ASSERT(y);
+
+ if (ERTS_RBT_IS_RED(y)) {
+ ERTS_RBT_ASSERT(ERTS_RBT_GET_RIGHT(y));
+ ERTS_RBT_ASSERT(ERTS_RBT_GET_LEFT(y));
+
+ ERTS_RBT_SET_BLACK(y);
+
+ ERTS_RBT_ASSERT(ERTS_RBT_IS_BLACK(p));
+
+ ERTS_RBT_SET_RED(p);
+ ERTS_RBT_FUNC__(left_rotate__)(root, p);
+ p = ERTS_RBT_GET_PARENT(x);
+ y = ERTS_RBT_GET_RIGHT(p);
+ }
+
+ ERTS_RBT_ASSERT(y);
+ ERTS_RBT_ASSERT(ERTS_RBT_IS_BLACK(y));
+
+ l = ERTS_RBT_GET_LEFT(y);
+ r = ERTS_RBT_GET_RIGHT(y);
+ if ((!l || ERTS_RBT_IS_BLACK(l))
+ && (!r || ERTS_RBT_IS_BLACK(r))) {
+ ERTS_RBT_SET_RED(y);
+ x = p;
+ p = ERTS_RBT_GET_PARENT(x);
+ }
+ else {
+ if (!r || ERTS_RBT_IS_BLACK(r)) {
+ ERTS_RBT_SET_BLACK(l);
+ ERTS_RBT_SET_RED(y);
+ ERTS_RBT_FUNC__(right_rotate__)(root, y);
+ p = ERTS_RBT_GET_PARENT(x);
+ y = ERTS_RBT_GET_RIGHT(p);
+ }
+
+ ERTS_RBT_ASSERT(y);
+
+ if (p && ERTS_RBT_IS_RED(p)) {
+
+ ERTS_RBT_SET_BLACK(p);
+ ERTS_RBT_SET_RED(y);
+ }
+
+ ERTS_RBT_ASSERT(ERTS_RBT_GET_RIGHT(y));
+
+ ERTS_RBT_SET_BLACK(ERTS_RBT_GET_RIGHT(y));
+ ERTS_RBT_FUNC__(left_rotate__)(root, p);
+ x = *root;
+ break;
+ }
+ }
+ else {
+ ERTS_RBT_ASSERT(x == ERTS_RBT_GET_RIGHT(p));
+
+ y = ERTS_RBT_GET_LEFT(p);
+
+ ERTS_RBT_ASSERT(y);
+
+ if (ERTS_RBT_IS_RED(y)) {
+ ERTS_RBT_ASSERT(ERTS_RBT_GET_RIGHT(y));
+ ERTS_RBT_ASSERT(ERTS_RBT_GET_LEFT(y));
+
+ ERTS_RBT_SET_BLACK(y);
+ ERTS_RBT_ASSERT(ERTS_RBT_IS_BLACK(p));
+ ERTS_RBT_SET_RED(p);
+ ERTS_RBT_FUNC__(right_rotate__)(root, p);
+
+ p = ERTS_RBT_GET_PARENT(x);
+ y = ERTS_RBT_GET_LEFT(p);
+ }
+
+ ERTS_RBT_ASSERT(y);
+ ERTS_RBT_ASSERT(ERTS_RBT_IS_BLACK(y));
+
+ l = ERTS_RBT_GET_LEFT(y);
+ r = ERTS_RBT_GET_RIGHT(y);
+
+ if ((!r || ERTS_RBT_IS_BLACK(r))
+ && (!l || ERTS_RBT_IS_BLACK(l))) {
+ ERTS_RBT_SET_RED(y);
+ x = p;
+ p = ERTS_RBT_GET_PARENT(x);
+ }
+ else {
+ if (!l || ERTS_RBT_IS_BLACK(l)) {
+ ERTS_RBT_SET_BLACK(r);
+ ERTS_RBT_SET_RED(y);
+ ERTS_RBT_FUNC__(left_rotate__)(root, y);
+
+ p = ERTS_RBT_GET_PARENT(x);
+ y = ERTS_RBT_GET_LEFT(p);
+ }
+
+ ERTS_RBT_ASSERT(y);
+
+ if (p && ERTS_RBT_IS_RED(p)) {
+ ERTS_RBT_SET_BLACK(p);
+ ERTS_RBT_SET_RED(y);
+ }
+
+ ERTS_RBT_ASSERT(ERTS_RBT_GET_LEFT(y));
+
+ ERTS_RBT_SET_BLACK(ERTS_RBT_GET_LEFT(y));
+ ERTS_RBT_FUNC__(right_rotate__)(root, p);
+ x = *root;
+ break;
+ }
+ }
+ }
+
+ ERTS_RBT_SET_BLACK(x);
+
+ x = &null_x;
+ p = ERTS_RBT_GET_PARENT(x);
+
+ if (p) {
+ if (ERTS_RBT_GET_LEFT(p) == x)
+ ERTS_RBT_SET_LEFT(p, NULL);
+ else {
+ ERTS_RBT_ASSERT(ERTS_RBT_GET_RIGHT(p) == x);
+ ERTS_RBT_SET_RIGHT(p, NULL);
+ }
+
+ ERTS_RBT_ASSERT(!ERTS_RBT_GET_LEFT(x));
+ ERTS_RBT_ASSERT(!ERTS_RBT_GET_RIGHT(x));
+ }
+ else if (*root == x) {
+ *root = NULL;
+
+#ifdef ERTS_RBT_UPDATE_ATTACHED_DATA_CHGROOT
+ ERTS_RBT_UPDATE_ATTACHED_DATA_CHGROOT(x, NULL);
+#endif
+
+ ERTS_RBT_ASSERT(!ERTS_RBT_GET_LEFT(x));
+ ERTS_RBT_ASSERT(!ERTS_RBT_GET_RIGHT(x));
+ }
+ }
+
+ ERTS_RBT_HDBG_CHECK_TREE__(*root, NULL);
+
+}
+
+#endif /* ERTS_RBT_WANT_DELETE */
+
+#ifdef ERTS_RBT_NEED_INSERT__
+
+static void
+ERTS_RBT_FUNC__(insert_fixup__)(ERTS_RBT_T **root, ERTS_RBT_T *n)
+{
+ ERTS_RBT_T *x, *y;
+
+ x = n;
+
+ /*
+ * Rearrange the tree so that it satisfies the Red-Black Tree properties
+ */
+
+ ERTS_RBT_ASSERT(x != *root && ERTS_RBT_IS_RED(ERTS_RBT_GET_PARENT(x)));
+ do {
+ ERTS_RBT_T *p, *pp;
+
+ /*
+ * x and its parent are both red. Move the red pair up the tree
+ * until we get to the root or until we can separate them.
+ */
+
+ p = ERTS_RBT_GET_PARENT(x);
+ pp = ERTS_RBT_GET_PARENT(p);
+
+ ERTS_RBT_ASSERT(p && pp);
+ ERTS_RBT_ASSERT(ERTS_RBT_IS_RED(x));
+ ERTS_RBT_ASSERT(ERTS_RBT_IS_BLACK(pp));
+
+ if (p == ERTS_RBT_GET_LEFT(pp)) {
+ y = ERTS_RBT_GET_RIGHT(pp);
+ if (y && ERTS_RBT_IS_RED(y)) {
+ ERTS_RBT_SET_BLACK(y);
+ ERTS_RBT_SET_BLACK(p);
+ ERTS_RBT_SET_RED(pp);
+ x = pp;
+ }
+ else {
+
+ if (x == ERTS_RBT_GET_RIGHT(p)) {
+ x = p;
+ ERTS_RBT_FUNC__(left_rotate__)(root, x);
+ p = ERTS_RBT_GET_PARENT(x);
+ pp = ERTS_RBT_GET_PARENT(p);
+
+ ERTS_RBT_ASSERT(p && pp);
+ }
+
+ ERTS_RBT_ASSERT(x == ERTS_RBT_GET_LEFT(ERTS_RBT_GET_LEFT(pp)));
+ ERTS_RBT_ASSERT(ERTS_RBT_IS_RED(x));
+ ERTS_RBT_ASSERT(ERTS_RBT_IS_RED(p));
+ ERTS_RBT_ASSERT(ERTS_RBT_IS_BLACK(pp));
+ ERTS_RBT_ASSERT(!y || ERTS_RBT_IS_BLACK(y));
+
+
+ ERTS_RBT_SET_BLACK(p);
+ ERTS_RBT_SET_RED(pp);
+ ERTS_RBT_FUNC__(right_rotate__)(root, pp);
+
+
+ ERTS_RBT_ASSERT(ERTS_RBT_GET_LEFT(ERTS_RBT_GET_PARENT(x)) == x);
+ ERTS_RBT_ASSERT(ERTS_RBT_IS_RED(x));
+ ERTS_RBT_ASSERT(ERTS_RBT_IS_RED(
+ ERTS_RBT_GET_RIGHT(
+ ERTS_RBT_GET_PARENT(x))));
+ ERTS_RBT_ASSERT(!ERTS_RBT_GET_PARENT(x)
+ || ERTS_RBT_IS_BLACK(ERTS_RBT_GET_PARENT(x)));
+ break;
+ }
+ }
+ else {
+ ERTS_RBT_ASSERT(p == ERTS_RBT_GET_RIGHT(pp));
+
+ y = ERTS_RBT_GET_LEFT(pp);
+ if (y && ERTS_RBT_IS_RED(y)) {
+ ERTS_RBT_SET_BLACK(y);
+ ERTS_RBT_SET_BLACK(p);
+ ERTS_RBT_SET_RED(pp);
+ x = pp;
+ }
+ else {
+
+ if (x == ERTS_RBT_GET_LEFT(p)) {
+ x = p;
+ ERTS_RBT_FUNC__(right_rotate__)(root, x);
+ p = ERTS_RBT_GET_PARENT(x);
+ pp = ERTS_RBT_GET_PARENT(p);
+
+ ERTS_RBT_ASSERT(p && pp);
+ }
+
+ ERTS_RBT_ASSERT(x == ERTS_RBT_GET_RIGHT(ERTS_RBT_GET_RIGHT(pp)));
+ ERTS_RBT_ASSERT(ERTS_RBT_IS_RED(x));
+ ERTS_RBT_ASSERT(ERTS_RBT_IS_RED(p));
+ ERTS_RBT_ASSERT(ERTS_RBT_IS_BLACK(pp));
+ ERTS_RBT_ASSERT(!y || ERTS_RBT_IS_BLACK(y));
+
+
+ ERTS_RBT_SET_BLACK(p);
+ ERTS_RBT_SET_RED(pp);
+ ERTS_RBT_FUNC__(left_rotate__)(root, pp);
+
+
+ ERTS_RBT_ASSERT(ERTS_RBT_GET_RIGHT(ERTS_RBT_GET_PARENT(x)) == x);
+ ERTS_RBT_ASSERT(ERTS_RBT_IS_RED(x));
+ ERTS_RBT_ASSERT(ERTS_RBT_IS_RED(
+ ERTS_RBT_GET_LEFT(
+ ERTS_RBT_GET_PARENT(x))));
+ ERTS_RBT_ASSERT(!ERTS_RBT_GET_PARENT(x)
+ || ERTS_RBT_IS_BLACK(ERTS_RBT_GET_PARENT(x)));
+ break;
+ }
+ }
+ } while (x != *root && ERTS_RBT_IS_RED(ERTS_RBT_GET_PARENT(x)));
+
+ ERTS_RBT_SET_BLACK(*root);
+
+}
+
+static ERTS_INLINE ERTS_RBT_T *
+ERTS_RBT_FUNC__(insert_aux__)(ERTS_RBT_T **root, ERTS_RBT_T *n, int lookup)
+{
+ ERTS_RBT_KEY_T kn = ERTS_RBT_GET_KEY(n);
+
+ ERTS_RBT_HDBG_CHECK_TREE__(*root, NULL);
+
+ ERTS_RBT_INIT_EMPTY_TNODE(n);
+
+ if (!*root) {
+ ERTS_RBT_SET_BLACK(n);
+ *root = n;
+#ifdef ERTS_RBT_UPDATE_ATTACHED_DATA_CHGROOT
+ ERTS_RBT_UPDATE_ATTACHED_DATA_CHGROOT(NULL, n);
+#endif
+ }
+ else {
+ ERTS_RBT_T *p, *x = *root;
+
+ while (1) {
+ ERTS_RBT_KEY_T kx;
+ ERTS_RBT_T *c;
+
+ kx = ERTS_RBT_GET_KEY(x);
+
+ if (lookup && ERTS_RBT_IS_EQ(kn, kx)) {
+
+ ERTS_RBT_HDBG_CHECK_TREE__(*root, NULL);
+
+ return x;
+ }
+
+ if (ERTS_RBT_IS_LT(kn, kx)) {
+ c = ERTS_RBT_GET_LEFT(x);
+ if (!c) {
+ ERTS_RBT_SET_PARENT(n, x);
+ ERTS_RBT_SET_LEFT(x, n);
+ p = x;
+ break;
+ }
+ }
+ else {
+ c = ERTS_RBT_GET_RIGHT(x);
+ if (!c) {
+ ERTS_RBT_SET_PARENT(n, x);
+ ERTS_RBT_SET_RIGHT(x, n);
+ p = x;
+ break;
+ }
+ }
+
+ x = c;
+ }
+
+ ERTS_RBT_ASSERT(p);
+
+ ERTS_RBT_SET_RED(n);
+ if (ERTS_RBT_IS_RED(p))
+ ERTS_RBT_FUNC__(insert_fixup__)(root, n);
+ }
+
+ ERTS_RBT_HDBG_CHECK_TREE__(*root, n);
+
+ return NULL;
+}
+
+#endif /* ERTS_RBT_NEED_INSERT__ */
+
+#ifdef ERTS_RBT_WANT_LOOKUP_INSERT
+
+static ERTS_RBT_API_INLINE__ ERTS_RBT_T *
+ERTS_RBT_FUNC__(lookup_insert)(ERTS_RBT_T **root, ERTS_RBT_T *n)
+{
+ return ERTS_RBT_FUNC__(insert_aux__)(root, n, !0);
+}
+
+#endif /* ERTS_RBT_WANT_LOOKUP_INSERT */
+
+#ifdef ERTS_RBT_WANT_INSERT
+
+static ERTS_RBT_API_INLINE__ void
+ERTS_RBT_FUNC__(insert)(ERTS_RBT_T **root, ERTS_RBT_T *n)
+{
+ (void) ERTS_RBT_FUNC__(insert_aux__)(root, n, 0);
+}
+
+#endif /* ERTS_RBT_WANT_INSERT */
+
+#ifdef ERTS_RBT_WANT_LOOKUP
+
+static ERTS_RBT_API_INLINE__ ERTS_RBT_T *
+ERTS_RBT_FUNC__(lookup)(ERTS_RBT_T *root, ERTS_RBT_KEY_T key)
+{
+ ERTS_RBT_T *x = root;
+
+ if (!x)
+ return NULL;
+
+ while (1) {
+ ERTS_RBT_KEY_T kx = ERTS_RBT_GET_KEY(x);
+ ERTS_RBT_T *c;
+
+ if (ERTS_RBT_IS_EQ(key, kx))
+ return x;
+
+ if (ERTS_RBT_IS_LT(key, kx)) {
+ c = ERTS_RBT_GET_LEFT(x);
+ if (!c)
+ return NULL;
+ }
+ else {
+ c = ERTS_RBT_GET_RIGHT(x);
+ if (!c)
+ return NULL;
+ }
+
+ x = c;
+ }
+}
+
+#endif /* ERTS_RBT_WANT_LOOKUP */
+
+#ifdef ERTS_RBT_WANT_SMALLEST
+
+static ERTS_RBT_API_INLINE__ ERTS_RBT_T *
+ERTS_RBT_FUNC__(smallest)(ERTS_RBT_T *root)
+{
+ ERTS_RBT_T *x = root;
+
+ if (!x)
+ return NULL;
+
+ while (1) {
+ ERTS_RBT_T *c = ERTS_RBT_GET_LEFT(x);
+ if (!c)
+ break;
+ x = c;
+ }
+
+ return x;
+}
+
+#endif /* ERTS_RBT_WANT_SMALLEST */
+
+#ifdef ERTS_RBT_WANT_LARGEST
+
+static ERTS_RBT_API_INLINE__ ERTS_RBT_T *
+ERTS_RBT_FUNC__(largest)(ERTS_RBT_T *root)
+{
+ ERTS_RBT_T *x = root;
+
+ if (!x)
+ return NULL;
+
+ while (1) {
+ ERTS_RBT_T *c = ERTS_RBT_GET_RIGHT(x);
+ if (!c)
+ break;
+ x = c;
+ }
+
+ return x;
+}
+
+#endif /* ERTS_RBT_WANT_LARGEST */
+
+#ifdef ERTS_RBT_NEED_FOREACH_UNORDERED__
+
+static ERTS_INLINE int
+ERTS_RBT_FUNC__(foreach_unordered__)(ERTS_RBT_T **root,
+ int destroying,
+ void (*op)(ERTS_RBT_T *, void *),
+ void *arg,
+ int yielding,
+ ERTS_RBT_YIELD_STATE_T__ *ystate,
+ Sint ylimit)
+{
+ ERTS_RBT_T *c, *p, *x;
+
+ ERTS_RBT_ASSERT(!yielding || ystate);
+
+ if (yielding && ystate->x) {
+ x = ystate->x;
+ ERTS_RBT_ASSERT(ystate->up);
+ goto restart_up;
+ }
+ else {
+ x = *root;
+ if (!x)
+ return 0;
+ if (destroying)
+ *root = NULL;
+ }
+
+ while (1) {
+
+ while (1) {
+
+ while (1) {
+ c = ERTS_RBT_GET_LEFT(x);
+ if (!c)
+ break;
+ x = c;
+ }
+
+ c = ERTS_RBT_GET_RIGHT(x);
+ if (!c)
+ break;
+ x = c;
+ }
+
+ while (1) {
+#ifdef ERTS_RBT_DEBUG
+ int cdir;
+#endif
+ if (yielding && ylimit-- <= 0) {
+ ystate->x = x;
+ ystate->up = 1;
+ return 1;
+ }
+
+ restart_up:
+
+ p = ERTS_RBT_GET_PARENT(x);
+
+#ifdef ERTS_RBT_DEBUG
+ ERTS_RBT_ASSERT(!destroying || !ERTS_RBT_GET_LEFT(x));
+ ERTS_RBT_ASSERT(!destroying || !ERTS_RBT_GET_RIGHT(x));
+
+ if (p) {
+ if (x == ERTS_RBT_GET_LEFT(p)) {
+ cdir = -1;
+ if (destroying)
+ ERTS_RBT_SET_LEFT(p, NULL);
+ }
+ else {
+ ERTS_RBT_ASSERT(x == ERTS_RBT_GET_RIGHT(p));
+ cdir = 1;
+ if (destroying)
+ ERTS_RBT_SET_RIGHT(p, NULL);
+ }
+ }
+#endif
+
+ (*op)(x, arg);
+
+ if (!p) {
+ if (yielding) {
+ ystate->x = NULL;
+ ystate->up = 0;
+ }
+ return 0; /* Done */
+ }
+
+ c = ERTS_RBT_GET_RIGHT(p);
+ if (c && c != x) {
+ ERTS_RBT_ASSERT(cdir < 0);
+
+ /* Go down tree of x's sibling... */
+ x = c;
+ break;
+ }
+
+ x = p;
+ }
+ }
+}
+
+#endif /* ERTS_RBT_NEED_FOREACH_UNORDERED__ */
+
+#ifdef ERTS_RBT_NEED_FOREACH_ORDERED__
+
+static ERTS_INLINE int
+ERTS_RBT_FUNC__(foreach_ordered__)(ERTS_RBT_T **root,
+ int from_small,
+ int destroying,
+ void (*op)(ERTS_RBT_T *, void *),
+ void (*destroy)(ERTS_RBT_T *, void *),
+ void *arg,
+ int yielding,
+ ERTS_RBT_YIELD_STATE_T__ *ystate,
+ Sint ylimit)
+{
+ ERTS_RBT_T *c, *p, *x;
+
+ ERTS_RBT_ASSERT(!yielding || ystate);
+ ERTS_RBT_ASSERT(!destroying || destroy);
+
+ if (yielding && ystate->x) {
+ x = ystate->x;
+ if (ystate->up)
+ goto restart_up;
+ else
+ goto restart_down;
+ }
+ else {
+ x = *root;
+ if (!x)
+ return 0;
+ if (destroying)
+ *root = NULL;
+ }
+
+ while (1) {
+
+ while (1) {
+
+ while (1) {
+ c = from_small ? ERTS_RBT_GET_LEFT(x) : ERTS_RBT_GET_RIGHT(x);
+ if (!c)
+ break;
+ x = c;
+ }
+
+ (*op)(x, arg);
+
+ if (yielding && --ylimit <= 0) {
+ ystate->x = x;
+ ystate->up = 0;
+ return 1;
+ }
+
+ restart_down:
+
+ c = from_small ? ERTS_RBT_GET_RIGHT(x) : ERTS_RBT_GET_LEFT(x);
+ if (!c)
+ break;
+ x = c;
+ }
+
+ while (1) {
+ p = ERTS_RBT_GET_PARENT(x);
+
+ if (p) {
+
+ c = from_small ? ERTS_RBT_GET_RIGHT(p) : ERTS_RBT_GET_LEFT(p);
+ if (!c || c != x) {
+ ERTS_RBT_ASSERT((from_small
+ ? ERTS_RBT_GET_LEFT(p)
+ : ERTS_RBT_GET_RIGHT(p)) == x);
+
+ (*op)(p, arg);
+
+ if (yielding && --ylimit <= 0) {
+ ystate->x = x;
+ ystate->up = 1;
+ return 1;
+ restart_up:
+ p = ERTS_RBT_GET_PARENT(x);
+ }
+ }
+
+ if (c && c != x) {
+ ERTS_RBT_ASSERT((from_small
+ ? ERTS_RBT_GET_LEFT(p)
+ : ERTS_RBT_GET_RIGHT(p)) == x);
+
+ /* Go down tree of x's sibling... */
+ x = c;
+ break;
+ }
+ }
+
+ if (destroying) {
+
+#ifdef ERTS_RBT_DEBUG
+ ERTS_RBT_ASSERT(!ERTS_RBT_GET_LEFT(x)
+ && !ERTS_RBT_GET_RIGHT(x));
+
+ if (p) {
+ if (x == ERTS_RBT_GET_LEFT(p))
+ ERTS_RBT_SET_LEFT(p, NULL);
+ else {
+ ERTS_RBT_ASSERT(x == ERTS_RBT_GET_RIGHT(p));
+ ERTS_RBT_SET_RIGHT(p, NULL);
+ }
+ }
+#endif
+
+ (*destroy)(x, arg);
+ }
+
+ if (!p) {
+ if (yielding) {
+ ystate->x = NULL;
+ ystate->up = 0;
+ }
+ return 0; /* Done */
+ }
+ x = p;
+ }
+ }
+}
+
+#endif /* ERTS_RBT_NEED_FOREACH_ORDERED__ */
+
+#ifdef ERTS_RBT_WANT_FOREACH
+
+static ERTS_RBT_API_INLINE__ void
+ERTS_RBT_FUNC__(foreach)(ERTS_RBT_T *root,
+ void (*op)(ERTS_RBT_T *, void *),
+ void *arg)
+{
+ (void) ERTS_RBT_FUNC__(foreach_unordered__)(&root, 0, op, arg,
+ 0, NULL, 0);
+}
+
+#endif /* ERTS_RBT_WANT_FOREACH */
+
+#ifdef ERTS_RBT_WANT_FOREACH_SMALL
+
+static ERTS_RBT_API_INLINE__ void
+ERTS_RBT_FUNC__(foreach_small)(ERTS_RBT_T *root,
+ void (*op)(ERTS_RBT_T *, void *),
+ void *arg)
+{
+ (void) ERTS_RBT_FUNC__(foreach_ordered__)(&root, 1, 0,
+ op, NULL, arg,
+ 0, NULL, 0);
+}
+
+#endif /* ERTS_RBT_WANT_FOREACH_SMALL */
+
+#ifdef ERTS_RBT_WANT_FOREACH_LARGE
+
+static ERTS_RBT_API_INLINE__ void
+ERTS_RBT_FUNC__(foreach_large)(ERTS_RBT_T *root,
+ void (*op)(ERTS_RBT_T *, void *),
+ void *arg)
+{
+ (void) ERTS_RBT_FUNC__(foreach_ordered__)(&root, 0, 0,
+ op, NULL, arg,
+ 0, NULL, 0);
+}
+
+#endif /* ERTS_RBT_WANT_FOREACH_LARGE */
+
+#ifdef ERTS_RBT_WANT_FOREACH_YIELDING
+
+static ERTS_RBT_API_INLINE__ void
+ERTS_RBT_FUNC__(foreach_yielding)(ERTS_RBT_T *root,
+ void (*op)(ERTS_RBT_T *, void *),
+ void *arg,
+ ERTS_RBT_YIELD_STATE_T__ *ystate,
+ Sint ylimit)
+{
+ (void) ERTS_RBT_FUNC__(foreach_unordered__)(*root, 0, op, arg,
+ 1, ystate, ylimit);
+}
+
+#endif /* ERTS_RBT_WANT_FOREACH_YIELDING */
+
+#ifdef ERTS_RBT_WANT_FOREACH_SMALL_YIELDING
+
+static ERTS_RBT_API_INLINE__ int
+ERTS_RBT_FUNC__(foreach_small_yielding)(ERTS_RBT_T *root,
+ void (*op)(ERTS_RBT_T *, void *),
+ void *arg,
+ ERTS_RBT_YIELD_STATE_T__ *ystate,
+ Sint ylimit)
+{
+ return ERTS_RBT_FUNC__(foreach_ordered__)(&root, 1, 0,
+ op, NULL, arg,
+ 1, ystate, ylimit);
+}
+
+#endif /* ERTS_RBT_WANT_FOREACH_SMALL_YIELDING */
+
+#ifdef ERTS_RBT_WANT_FOREACH_LARGE_YIELDING
+
+static ERTS_RBT_API_INLINE__ int
+ERTS_RBT_FUNC__(foreach_large_yielding)(ERTS_RBT_T *root,
+ void (*op)(ERTS_RBT_T *, void *),
+ void *arg,
+ ERTS_RBT_YIELD_STATE_T__ *ystate,
+ Sint ylimit)
+{
+ return ERTS_RBT_FUNC__(foreach_ordered__)(&root, 0, 0,
+ op, NULL, arg,
+ 1, ystate, ylimit);
+}
+
+#endif /* ERTS_RBT_WANT_FOREACH_LARGE_YIELDING */
+
+#ifdef ERTS_RBT_WANT_FOREACH_DESTROY
+
+static ERTS_RBT_API_INLINE__ void
+ERTS_RBT_FUNC__(foreach_destroy)(ERTS_RBT_T **root,
+ void (*op)(ERTS_RBT_T *, void *),
+ void *arg)
+{
+ (void) ERTS_RBT_FUNC__(foreach_unordered__)(root, 1, op, arg,
+ 0, NULL, 0);
+}
+
+#endif /* ERTS_RBT_WANT_FOREACH_DESTROY */
+
+#ifdef ERTS_RBT_WANT_FOREACH_SMALL_DESTROY
+
+static ERTS_RBT_API_INLINE__ void
+ERTS_RBT_FUNC__(foreach_small_destroy)(ERTS_RBT_T **root,
+ void (*op)(ERTS_RBT_T *, void *),
+ void (*destr)(ERTS_RBT_T *, void *),
+ void *arg)
+{
+ (void) ERTS_RBT_FUNC__(foreach_ordered__)(root, 1, 1,
+ op, destr, arg,
+ 0, NULL, 0);
+}
+
+#endif /* ERTS_RBT_WANT_FOREACH_SMALL_DESTROY */
+
+#ifdef ERTS_RBT_WANT_FOREACH_LARGE_DESTROY
+
+static ERTS_RBT_API_INLINE__ void
+ERTS_RBT_FUNC__(foreach_large_destroy)(ERTS_RBT_T **root,
+ void (*op)(ERTS_RBT_T *, void *),
+ void (*destr)(ERTS_RBT_T *, void *),
+ void *arg)
+{
+ (void) ERTS_RBT_FUNC__(foreach_ordered__)(root, 0, 1,
+ op, destr, arg,
+ 0, NULL, 0);
+}
+
+#endif /* ERTS_RBT_WANT_FOREACH_LARGE_DESTROY */
+
+#ifdef ERTS_RBT_WANT_FOREACH_DESTROY_YIELDING
+
+static ERTS_RBT_API_INLINE__ int
+ERTS_RBT_FUNC__(foreach_destroy_yielding)(ERTS_RBT_T **root,
+ void (*op)(ERTS_RBT_T *, void *),
+ void *arg,
+ ERTS_RBT_YIELD_STATE_T__ *ystate,
+ Sint ylimit)
+{
+ return ERTS_RBT_FUNC__(foreach_unordered__)(root, 1, op, arg,
+ 1, ystate, ylimit);
+}
+
+#endif /* ERTS_RBT_WANT_FOREACH_DESTROY_YIELDING */
+
+#ifdef ERTS_RBT_WANT_FOREACH_SMALL_DESTROY_YIELDING
+
+static ERTS_RBT_API_INLINE__ int
+ERTS_RBT_FUNC__(foreach_small_destroy_yielding)(ERTS_RBT_T **root,
+ void (*op)(ERTS_RBT_T *, void *),
+ void (*destr)(ERTS_RBT_T *, void *),
+ void *arg,
+ ERTS_RBT_YIELD_STATE_T__ *ystate,
+ Sint ylimit)
+{
+ return ERTS_RBT_FUNC__(foreach_ordered__)(root, 1, 1,
+ op, destr, arg,
+ 1, ystate, ylimit);
+}
+
+#endif /* ERTS_RBT_WANT_FOREACH_SMALL_DESTROY_YIELDING */
+
+#ifdef ERTS_RBT_WANT_FOREACH_LARGE_DESTROY_YIELDING
+
+static ERTS_RBT_API_INLINE__ int
+ERTS_RBT_FUNC__(foreach_large_destroy_yielding)(ERTS_RBT_T **root,
+ void (*op)(ERTS_RBT_T *, void *),
+ void (*destr)(ERTS_RBT_T *, void *),
+ void *arg,
+ ERTS_RBT_YIELD_STATE_T__ *ystate,
+ Sint ylimit)
+{
+ return ERTS_RBT_FUNC__(foreach_ordered__)(root, 0, 1,
+ op, destr, arg,
+ 1, ystate, ylimit);
+}
+
+#endif /* ERTS_RBT_WANT_FOREACH_LARGE_DESTROY_YIELDING */
+
+#ifdef ERTS_RBT_WANT_DEBUG_PRINT
+
+static void
+ERTS_RBT_FUNC__(debug_print)(FILE *filep, ERTS_RBT_T *x, int indent,
+ void (*print_node)(ERTS_RBT_T *))
+{
+ if (x) {
+ ERTS_RBT_FUNC__(debug_print)(filep, ERTS_RBT_GET_RIGHT(x),
+ indent+2, print_node);
+ erts_fprintf(filep,
+ "%*s[%s:%p:",
+ indent, "",
+ ERTS_RBT_IS_BLACK(x) ? "Black" : "Red",
+ x);
+ (*print_node)(x);
+ erts_fprintf(filep, "]\n");
+ ERTS_RBT_FUNC__(debug_print)(filep, ERTS_RBT_GET_LEFT(x),
+ indent+2, print_node);
+ }
+}
+
+#endif /* ERTS_RBT_WANT_DEBUG_PRINT */
+
+#ifdef ERTS_RBT_NEED_HDBG_CHECK_TREE__
+
+static void
+ERTS_RBT_FUNC__(hdbg_check_tree)(ERTS_RBT_T *root, ERTS_RBT_T *n)
+{
+ int black_depth = -1, no_black = 0;
+ ERTS_RBT_T *c, *p, *x = root;
+ ERTS_RBT_KEY_T kx;
+ ERTS_RBT_KEY_T kc;
+
+ if (!x) {
+ ERTS_RBT_ASSERT(!n);
+ return;
+ }
+
+ ERTS_RBT_ASSERT(!ERTS_RBT_GET_PARENT(x));
+
+ while (1) {
+
+ while (1) {
+
+ while (1) {
+
+ if (x == n)
+ n = NULL;
+
+ if (ERTS_RBT_IS_BLACK(x))
+ no_black++;
+ else {
+ c = ERTS_RBT_GET_RIGHT(x);
+ ERTS_RBT_ASSERT(!c || ERTS_RBT_IS_BLACK(c));
+ c = ERTS_RBT_GET_LEFT(x);
+ ERTS_RBT_ASSERT(!c || ERTS_RBT_IS_BLACK(c));
+ }
+
+ c = ERTS_RBT_GET_LEFT(x);
+ if (!c)
+ break;
+
+ ERTS_RBT_ASSERT(x == ERTS_RBT_GET_PARENT(c));
+
+ kx = ERTS_RBT_GET_KEY(x);
+ kc = ERTS_RBT_GET_KEY(c);
+
+ ERTS_RBT_ASSERT(ERTS_RBT_IS_LT(kc, kx)
+ || ERTS_RBT_IS_EQ(kc, kx));
+
+ x = c;
+ }
+
+ c = ERTS_RBT_GET_RIGHT(x);
+ if (!c) {
+ if (black_depth < 0)
+ black_depth = no_black;
+ ERTS_RBT_ASSERT(black_depth == no_black);
+ break;
+ }
+
+ ERTS_RBT_ASSERT(x == ERTS_RBT_GET_PARENT(c));
+
+ kx = ERTS_RBT_GET_KEY(x);
+ kc = ERTS_RBT_GET_KEY(c);
+
+ ERTS_RBT_ASSERT(ERTS_RBT_IS_LT(kx, kc)
+ || ERTS_RBT_IS_EQ(kx, kc));
+ x = c;
+ }
+
+ while (1) {
+ p = ERTS_RBT_GET_PARENT(x);
+
+ if (ERTS_RBT_IS_BLACK(x))
+ no_black--;
+
+ if (p) {
+
+ ERTS_RBT_ASSERT(x == ERTS_RBT_GET_LEFT(p)
+ || x == ERTS_RBT_GET_RIGHT(p));
+
+ c = ERTS_RBT_GET_RIGHT(p);
+ if (c && c != x) {
+ ERTS_RBT_ASSERT(ERTS_RBT_GET_LEFT(p) == x);
+
+ kx = ERTS_RBT_GET_KEY(x);
+ kc = ERTS_RBT_GET_KEY(c);
+
+ ERTS_RBT_ASSERT(ERTS_RBT_IS_LT(kx, kc)
+ || ERTS_RBT_IS_EQ(kx, kc));
+ /* Go down tree of x's sibling... */
+ x = c;
+ break;
+ }
+ }
+
+ if (!p) {
+ ERTS_RBT_ASSERT(root == x);
+ ERTS_RBT_ASSERT(no_black == 0);
+ ERTS_RBT_ASSERT(!n);
+ return; /* Done */
+ }
+
+ x = p;
+ }
+ }
+}
+
+#undef ERTS_RBT_PRINT_TREE__
+
+#endif /* ERTS_RBT_NEED_HDBG_CHECK_TREE__ */
+
+#undef ERTS_RBT_ASSERT
+#undef ERTS_RBT_DEBUG
+#undef ERTS_RBT_API_INLINE__
+#undef ERTS_RBT_YIELD_STATE_T__
+#undef ERTS_RBT_NEED_REPLACE__
+#undef ERTS_RBT_NEED_INSERT__
+#undef ERTS_RBT_NEED_ROTATE__
+#undef ERTS_RBT_NEED_FOREACH_UNORDERED__
+#undef ERTS_RBT_NEED_FOREACH_ORDERED__
+#undef ERTS_RBT_NEED_HDBG_CHECK_TREE__
+#undef ERTS_RBT_HDBG_CHECK_TREE__
+
+#ifdef ERTS_RBT_UNDEF
+# undef ERTS_RBT_PREFIX
+# undef ERTS_RBT_T
+# undef ERTS_RBT_KEY_T
+# undef ERTS_RBT_FLAGS_T
+# undef ERTS_RBT_INIT_EMPTY_TNODE
+# undef ERTS_RBT_IS_RED
+# undef ERTS_RBT_SET_RED
+# undef ERTS_RBT_IS_BLACK
+# undef ERTS_RBT_SET_BLACK
+# undef ERTS_RBT_GET_FLAGS
+# undef ERTS_RBT_SET_FLAGS
+# undef ERTS_RBT_GET_PARENT
+# undef ERTS_RBT_SET_PARENT
+# undef ERTS_RBT_GET_RIGHT
+# undef ERTS_RBT_SET_RIGHT
+# undef ERTS_RBT_GET_LEFT
+# undef ERTS_RBT_SET_LEFT
+# undef ERTS_RBT_GET_KEY
+# undef ERTS_RBT_IS_LT
+# undef ERTS_RBT_IS_EQ
+# undef ERTS_RBT_UNDEF
+# undef ERTS_RBT_NO_API_INLINE
+# undef ERTS_RBT_UPDATE_ATTACHED_DATA_ROTATE
+# undef ERTS_RBT_UPDATE_ATTACHED_DATA_DMOD
+# undef ERTS_RBT_UPDATE_ATTACHED_DATA_CHGROOT
+# undef ERTS_RBT_WANT_DELETE
+# undef ERTS_RBT_WANT_INSERT
+# undef ERTS_RBT_WANT_LOOKUP_INSERT
+# undef ERTS_RBT_WANT_REPLACE
+# undef ERTS_RBT_WANT_LOOKUP
+# undef ERTS_RBT_WANT_SMALLEST
+# undef ERTS_RBT_WANT_LARGEST
+# undef ERTS_RBT_WANT_FOREACH
+# undef ERTS_RBT_WANT_FOREACH_DESTROY
+# undef ERTS_RBT_WANT_FOREACH_YIELDING
+# undef ERTS_RBT_WANT_FOREACH_DESTROY_YIELDING
+# undef ERTS_RBT_WANT_FOREACH_SMALL
+# undef ERTS_RBT_WANT_FOREACH_LARGE
+# undef ERTS_RBT_WANT_FOREACH_SMALL_DESTROY
+# undef ERTS_RBT_WANT_FOREACH_LARGE_DESTROY
+# undef ERTS_RBT_WANT_FOREACH_SMALL_YIELDING
+# undef ERTS_RBT_WANT_FOREACH_LARGE_YIELDING
+# undef ERTS_RBT_WANT_FOREACH_SMALL_DESTROY_YIELDING
+# undef ERTS_RBT_WANT_FOREACH_LARGE_DESTROY_YIELDING
+# undef ERTS_RBT_WANT_DEBUG_PRINT
+#endif
diff --git a/erts/emulator/beam/erl_sched_spec_pre_alloc.c b/erts/emulator/beam/erl_sched_spec_pre_alloc.c
index a490aec734..96238318c9 100644
--- a/erts/emulator/beam/erl_sched_spec_pre_alloc.c
+++ b/erts/emulator/beam/erl_sched_spec_pre_alloc.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2011-2012. All Rights Reserved.
+ * Copyright Ericsson AB 2011-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -160,7 +161,7 @@ enqueue_remote_managed_thread(erts_sspa_chunk_header_t *chdr,
if ((i & 1) == 0)
itmp = itmp2;
else {
- enq = (erts_sspa_blk_t *) itmp;
+ enq = (erts_sspa_blk_t *) itmp2;
itmp = erts_atomic_read_acqb(&enq->next_atmc);
ASSERT(itmp != ERTS_AINT_NULL);
}
diff --git a/erts/emulator/beam/erl_sched_spec_pre_alloc.h b/erts/emulator/beam/erl_sched_spec_pre_alloc.h
index 9144c73acd..7808d7d438 100644
--- a/erts/emulator/beam/erl_sched_spec_pre_alloc.h
+++ b/erts/emulator/beam/erl_sched_spec_pre_alloc.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2011-2012. All Rights Reserved.
+ * Copyright Ericsson AB 2011-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/beam/erl_smp.h b/erts/emulator/beam/erl_smp.h
index c38ef47d87..696bdbdaf1 100644
--- a/erts/emulator/beam/erl_smp.h
+++ b/erts/emulator/beam/erl_smp.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2005-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2005-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -60,6 +61,7 @@ typedef erts_tsd_key_t erts_smp_tsd_key_t;
#define erts_smp_dw_atomic_t erts_dw_atomic_t
#define erts_smp_atomic_t erts_atomic_t
#define erts_smp_atomic32_t erts_atomic32_t
+#define erts_smp_atomic64_t erts_atomic64_t
typedef erts_spinlock_t erts_smp_spinlock_t;
typedef erts_rwlock_t erts_smp_rwlock_t;
void erts_thr_fatal_error(int, char *); /* implemented in erl_init.c */
@@ -95,6 +97,7 @@ typedef int erts_smp_tsd_key_t;
#define erts_smp_dw_atomic_t erts_no_dw_atomic_t
#define erts_smp_atomic_t erts_no_atomic_t
#define erts_smp_atomic32_t erts_no_atomic32_t
+#define erts_smp_atomic64_t erts_no_atomic64_t
#if __GNUC__ > 2
typedef struct { } erts_smp_spinlock_t;
typedef struct { } erts_smp_rwlock_t;
@@ -125,14 +128,14 @@ ERTS_GLB_INLINE int erts_smp_equal_tids(erts_smp_tid_t x, erts_smp_tid_t y);
#define ERTS_SMP_HAVE_REC_MTX_INIT 1
ERTS_GLB_INLINE void erts_smp_rec_mtx_init(erts_smp_mtx_t *mtx);
#endif
-ERTS_GLB_INLINE void erts_smp_mtx_init_x(erts_smp_mtx_t *mtx,
- char *name,
- Eterm extra);
-ERTS_GLB_INLINE void erts_smp_mtx_init_locked_x(erts_smp_mtx_t *mtx,
- char *name,
- Eterm extra);
-ERTS_GLB_INLINE void erts_smp_mtx_init(erts_smp_mtx_t *mtx, char *name);
-ERTS_GLB_INLINE void erts_smp_mtx_init_locked(erts_smp_mtx_t *mtx, char *name);
+ERTS_GLB_INLINE void erts_smp_mtx_init(erts_smp_mtx_t *mtx,
+ char *name,
+ Eterm extra,
+ erts_lock_flags_t flags);
+ERTS_GLB_INLINE void erts_smp_mtx_init_locked(erts_smp_mtx_t *mtx,
+ char *name,
+ Eterm extra,
+ erts_lock_flags_t flags);
ERTS_GLB_INLINE void erts_smp_mtx_destroy(erts_smp_mtx_t *mtx);
#ifdef ERTS_ENABLE_LOCK_POSITION
ERTS_GLB_INLINE int erts_smp_mtx_trylock_x(erts_smp_mtx_t *mtx, char *file, unsigned int line);
@@ -150,18 +153,15 @@ ERTS_GLB_INLINE void erts_smp_cnd_wait(erts_smp_cnd_t *cnd,
ERTS_GLB_INLINE void erts_smp_cnd_signal(erts_smp_cnd_t *cnd);
ERTS_GLB_INLINE void erts_smp_cnd_broadcast(erts_smp_cnd_t *cnd);
ERTS_GLB_INLINE void erts_smp_rwmtx_set_reader_group(int no);
-ERTS_GLB_INLINE void erts_smp_rwmtx_init_opt_x(erts_smp_rwmtx_t *rwmtx,
- erts_smp_rwmtx_opt_t *opt,
- char *name,
- Eterm extra);
-ERTS_GLB_INLINE void erts_smp_rwmtx_init_x(erts_smp_rwmtx_t *rwmtx,
- char *name,
- Eterm extra);
ERTS_GLB_INLINE void erts_smp_rwmtx_init_opt(erts_smp_rwmtx_t *rwmtx,
- erts_smp_rwmtx_opt_t *opt,
- char *name);
+ erts_smp_rwmtx_opt_t *opt,
+ char *name,
+ Eterm extra,
+ erts_lock_flags_t flags);
ERTS_GLB_INLINE void erts_smp_rwmtx_init(erts_smp_rwmtx_t *rwmtx,
- char *name);
+ char *name,
+ Eterm extra,
+ erts_lock_flags_t flags);
ERTS_GLB_INLINE void erts_smp_rwmtx_destroy(erts_smp_rwmtx_t *rwmtx);
#ifdef ERTS_ENABLE_LOCK_POSITION
ERTS_GLB_INLINE int erts_smp_rwmtx_tryrlock_x(erts_smp_rwmtx_t *rwmtx, char *file, unsigned int line);
@@ -178,11 +178,10 @@ ERTS_GLB_INLINE void erts_smp_rwmtx_runlock(erts_smp_rwmtx_t *rwmtx);
ERTS_GLB_INLINE void erts_smp_rwmtx_rwunlock(erts_smp_rwmtx_t *rwmtx);
ERTS_GLB_INLINE int erts_smp_lc_rwmtx_is_rlocked(erts_smp_rwmtx_t *mtx);
ERTS_GLB_INLINE int erts_smp_lc_rwmtx_is_rwlocked(erts_smp_rwmtx_t *mtx);
-ERTS_GLB_INLINE void erts_smp_spinlock_init_x(erts_smp_spinlock_t *lock,
- char *name,
- Eterm extra);
ERTS_GLB_INLINE void erts_smp_spinlock_init(erts_smp_spinlock_t *lock,
- char *name);
+ char *name,
+ Eterm extra,
+ erts_lock_flags_t flags);
ERTS_GLB_INLINE void erts_smp_spinlock_destroy(erts_smp_spinlock_t *lock);
ERTS_GLB_INLINE void erts_smp_spin_unlock(erts_smp_spinlock_t *lock);
#ifdef ERTS_ENABLE_LOCK_POSITION
@@ -191,11 +190,10 @@ ERTS_GLB_INLINE void erts_smp_spin_lock_x(erts_smp_spinlock_t *lock, char *file,
ERTS_GLB_INLINE void erts_smp_spin_lock(erts_smp_spinlock_t *lock);
#endif
ERTS_GLB_INLINE int erts_smp_lc_spinlock_is_locked(erts_smp_spinlock_t *lock);
-ERTS_GLB_INLINE void erts_smp_rwlock_init_x(erts_smp_rwlock_t *lock,
- char *name,
- Eterm extra);
ERTS_GLB_INLINE void erts_smp_rwlock_init(erts_smp_rwlock_t *lock,
- char *name);
+ char *name,
+ Eterm extra,
+ erts_lock_flags_t flags);
ERTS_GLB_INLINE void erts_smp_rwlock_destroy(erts_smp_rwlock_t *lock);
ERTS_GLB_INLINE void erts_smp_read_unlock(erts_smp_rwlock_t *lock);
#ifdef ERTS_ENABLE_LOCK_POSITION
@@ -489,6 +487,116 @@ ERTS_GLB_INLINE void erts_smp_thr_sigwait(const sigset_t *set, int *sig);
#define erts_smp_atomic32_set_dirty erts_atomic32_set_dirty
#define erts_smp_atomic32_read_dirty erts_atomic32_read_dirty
+/* 64-bit atomics */
+
+#define erts_smp_atomic64_init_nob erts_atomic64_init_nob
+#define erts_smp_atomic64_set_nob erts_atomic64_set_nob
+#define erts_smp_atomic64_read_nob erts_atomic64_read_nob
+#define erts_smp_atomic64_inc_read_nob erts_atomic64_inc_read_nob
+#define erts_smp_atomic64_dec_read_nob erts_atomic64_dec_read_nob
+#define erts_smp_atomic64_inc_nob erts_atomic64_inc_nob
+#define erts_smp_atomic64_dec_nob erts_atomic64_dec_nob
+#define erts_smp_atomic64_add_read_nob erts_atomic64_add_read_nob
+#define erts_smp_atomic64_add_nob erts_atomic64_add_nob
+#define erts_smp_atomic64_read_bor_nob erts_atomic64_read_bor_nob
+#define erts_smp_atomic64_read_band_nob erts_atomic64_read_band_nob
+#define erts_smp_atomic64_xchg_nob erts_atomic64_xchg_nob
+#define erts_smp_atomic64_cmpxchg_nob erts_atomic64_cmpxchg_nob
+#define erts_smp_atomic64_read_bset_nob erts_atomic64_read_bset_nob
+
+#define erts_smp_atomic64_init_mb erts_atomic64_init_mb
+#define erts_smp_atomic64_set_mb erts_atomic64_set_mb
+#define erts_smp_atomic64_read_mb erts_atomic64_read_mb
+#define erts_smp_atomic64_inc_read_mb erts_atomic64_inc_read_mb
+#define erts_smp_atomic64_dec_read_mb erts_atomic64_dec_read_mb
+#define erts_smp_atomic64_inc_mb erts_atomic64_inc_mb
+#define erts_smp_atomic64_dec_mb erts_atomic64_dec_mb
+#define erts_smp_atomic64_add_read_mb erts_atomic64_add_read_mb
+#define erts_smp_atomic64_add_mb erts_atomic64_add_mb
+#define erts_smp_atomic64_read_bor_mb erts_atomic64_read_bor_mb
+#define erts_smp_atomic64_read_band_mb erts_atomic64_read_band_mb
+#define erts_smp_atomic64_xchg_mb erts_atomic64_xchg_mb
+#define erts_smp_atomic64_cmpxchg_mb erts_atomic64_cmpxchg_mb
+#define erts_smp_atomic64_read_bset_mb erts_atomic64_read_bset_mb
+
+#define erts_smp_atomic64_init_acqb erts_atomic64_init_acqb
+#define erts_smp_atomic64_set_acqb erts_atomic64_set_acqb
+#define erts_smp_atomic64_read_acqb erts_atomic64_read_acqb
+#define erts_smp_atomic64_inc_read_acqb erts_atomic64_inc_read_acqb
+#define erts_smp_atomic64_dec_read_acqb erts_atomic64_dec_read_acqb
+#define erts_smp_atomic64_inc_acqb erts_atomic64_inc_acqb
+#define erts_smp_atomic64_dec_acqb erts_atomic64_dec_acqb
+#define erts_smp_atomic64_add_read_acqb erts_atomic64_add_read_acqb
+#define erts_smp_atomic64_add_acqb erts_atomic64_add_acqb
+#define erts_smp_atomic64_read_bor_acqb erts_atomic64_read_bor_acqb
+#define erts_smp_atomic64_read_band_acqb erts_atomic64_read_band_acqb
+#define erts_smp_atomic64_xchg_acqb erts_atomic64_xchg_acqb
+#define erts_smp_atomic64_cmpxchg_acqb erts_atomic64_cmpxchg_acqb
+#define erts_smp_atomic64_read_bset_acqb erts_atomic64_read_bset_acqb
+
+#define erts_smp_atomic64_init_relb erts_atomic64_init_relb
+#define erts_smp_atomic64_set_relb erts_atomic64_set_relb
+#define erts_smp_atomic64_read_relb erts_atomic64_read_relb
+#define erts_smp_atomic64_inc_read_relb erts_atomic64_inc_read_relb
+#define erts_smp_atomic64_dec_read_relb erts_atomic64_dec_read_relb
+#define erts_smp_atomic64_inc_relb erts_atomic64_inc_relb
+#define erts_smp_atomic64_dec_relb erts_atomic64_dec_relb
+#define erts_smp_atomic64_add_read_relb erts_atomic64_add_read_relb
+#define erts_smp_atomic64_add_relb erts_atomic64_add_relb
+#define erts_smp_atomic64_read_bor_relb erts_atomic64_read_bor_relb
+#define erts_smp_atomic64_read_band_relb erts_atomic64_read_band_relb
+#define erts_smp_atomic64_xchg_relb erts_atomic64_xchg_relb
+#define erts_smp_atomic64_cmpxchg_relb erts_atomic64_cmpxchg_relb
+#define erts_smp_atomic64_read_bset_relb erts_atomic64_read_bset_relb
+
+#define erts_smp_atomic64_init_ddrb erts_atomic64_init_ddrb
+#define erts_smp_atomic64_set_ddrb erts_atomic64_set_ddrb
+#define erts_smp_atomic64_read_ddrb erts_atomic64_read_ddrb
+#define erts_smp_atomic64_inc_read_ddrb erts_atomic64_inc_read_ddrb
+#define erts_smp_atomic64_dec_read_ddrb erts_atomic64_dec_read_ddrb
+#define erts_smp_atomic64_inc_ddrb erts_atomic64_inc_ddrb
+#define erts_smp_atomic64_dec_ddrb erts_atomic64_dec_ddrb
+#define erts_smp_atomic64_add_read_ddrb erts_atomic64_add_read_ddrb
+#define erts_smp_atomic64_add_ddrb erts_atomic64_add_ddrb
+#define erts_smp_atomic64_read_bor_ddrb erts_atomic64_read_bor_ddrb
+#define erts_smp_atomic64_read_band_ddrb erts_atomic64_read_band_ddrb
+#define erts_smp_atomic64_xchg_ddrb erts_atomic64_xchg_ddrb
+#define erts_smp_atomic64_cmpxchg_ddrb erts_atomic64_cmpxchg_ddrb
+#define erts_smp_atomic64_read_bset_ddrb erts_atomic64_read_bset_ddrb
+
+#define erts_smp_atomic64_init_rb erts_atomic64_init_rb
+#define erts_smp_atomic64_set_rb erts_atomic64_set_rb
+#define erts_smp_atomic64_read_rb erts_atomic64_read_rb
+#define erts_smp_atomic64_inc_read_rb erts_atomic64_inc_read_rb
+#define erts_smp_atomic64_dec_read_rb erts_atomic64_dec_read_rb
+#define erts_smp_atomic64_inc_rb erts_atomic64_inc_rb
+#define erts_smp_atomic64_dec_rb erts_atomic64_dec_rb
+#define erts_smp_atomic64_add_read_rb erts_atomic64_add_read_rb
+#define erts_smp_atomic64_add_rb erts_atomic64_add_rb
+#define erts_smp_atomic64_read_bor_rb erts_atomic64_read_bor_rb
+#define erts_smp_atomic64_read_band_rb erts_atomic64_read_band_rb
+#define erts_smp_atomic64_xchg_rb erts_atomic64_xchg_rb
+#define erts_smp_atomic64_cmpxchg_rb erts_atomic64_cmpxchg_rb
+#define erts_smp_atomic64_read_bset_rb erts_atomic64_read_bset_rb
+
+#define erts_smp_atomic64_init_wb erts_atomic64_init_wb
+#define erts_smp_atomic64_set_wb erts_atomic64_set_wb
+#define erts_smp_atomic64_read_wb erts_atomic64_read_wb
+#define erts_smp_atomic64_inc_read_wb erts_atomic64_inc_read_wb
+#define erts_smp_atomic64_dec_read_wb erts_atomic64_dec_read_wb
+#define erts_smp_atomic64_inc_wb erts_atomic64_inc_wb
+#define erts_smp_atomic64_dec_wb erts_atomic64_dec_wb
+#define erts_smp_atomic64_add_read_wb erts_atomic64_add_read_wb
+#define erts_smp_atomic64_add_wb erts_atomic64_add_wb
+#define erts_smp_atomic64_read_bor_wb erts_atomic64_read_bor_wb
+#define erts_smp_atomic64_read_band_wb erts_atomic64_read_band_wb
+#define erts_smp_atomic64_xchg_wb erts_atomic64_xchg_wb
+#define erts_smp_atomic64_cmpxchg_wb erts_atomic64_cmpxchg_wb
+#define erts_smp_atomic64_read_bset_wb erts_atomic64_read_bset_wb
+
+#define erts_smp_atomic64_set_dirty erts_atomic64_set_dirty
+#define erts_smp_atomic64_read_dirty erts_atomic64_read_dirty
+
#else /* !ERTS_SMP */
/* Double word size atomics */
@@ -751,6 +859,116 @@ ERTS_GLB_INLINE void erts_smp_thr_sigwait(const sigset_t *set, int *sig);
#define erts_smp_atomic32_set_dirty erts_no_atomic32_set
#define erts_smp_atomic32_read_dirty erts_no_atomic32_read
+/* 64-bit atomics */
+
+#define erts_smp_atomic64_init_nob erts_no_atomic64_set
+#define erts_smp_atomic64_set_nob erts_no_atomic64_set
+#define erts_smp_atomic64_read_nob erts_no_atomic64_read
+#define erts_smp_atomic64_inc_read_nob erts_no_atomic64_inc_read
+#define erts_smp_atomic64_dec_read_nob erts_no_atomic64_dec_read
+#define erts_smp_atomic64_inc_nob erts_no_atomic64_inc
+#define erts_smp_atomic64_dec_nob erts_no_atomic64_dec
+#define erts_smp_atomic64_add_read_nob erts_no_atomic64_add_read
+#define erts_smp_atomic64_add_nob erts_no_atomic64_add
+#define erts_smp_atomic64_read_bor_nob erts_no_atomic64_read_bor
+#define erts_smp_atomic64_read_band_nob erts_no_atomic64_read_band
+#define erts_smp_atomic64_xchg_nob erts_no_atomic64_xchg
+#define erts_smp_atomic64_cmpxchg_nob erts_no_atomic64_cmpxchg
+#define erts_smp_atomic64_read_bset_nob erts_no_atomic64_read_bset
+
+#define erts_smp_atomic64_init_mb erts_no_atomic64_set
+#define erts_smp_atomic64_set_mb erts_no_atomic64_set
+#define erts_smp_atomic64_read_mb erts_no_atomic64_read
+#define erts_smp_atomic64_inc_read_mb erts_no_atomic64_inc_read
+#define erts_smp_atomic64_dec_read_mb erts_no_atomic64_dec_read
+#define erts_smp_atomic64_inc_mb erts_no_atomic64_inc
+#define erts_smp_atomic64_dec_mb erts_no_atomic64_dec
+#define erts_smp_atomic64_add_read_mb erts_no_atomic64_add_read
+#define erts_smp_atomic64_add_mb erts_no_atomic64_add
+#define erts_smp_atomic64_read_bor_mb erts_no_atomic64_read_bor
+#define erts_smp_atomic64_read_band_mb erts_no_atomic64_read_band
+#define erts_smp_atomic64_xchg_mb erts_no_atomic64_xchg
+#define erts_smp_atomic64_cmpxchg_mb erts_no_atomic64_cmpxchg
+#define erts_smp_atomic64_read_bset_mb erts_no_atomic64_read_bset
+
+#define erts_smp_atomic64_init_acqb erts_no_atomic64_set
+#define erts_smp_atomic64_set_acqb erts_no_atomic64_set
+#define erts_smp_atomic64_read_acqb erts_no_atomic64_read
+#define erts_smp_atomic64_inc_read_acqb erts_no_atomic64_inc_read
+#define erts_smp_atomic64_dec_read_acqb erts_no_atomic64_dec_read
+#define erts_smp_atomic64_inc_acqb erts_no_atomic64_inc
+#define erts_smp_atomic64_dec_acqb erts_no_atomic64_dec
+#define erts_smp_atomic64_add_read_acqb erts_no_atomic64_add_read
+#define erts_smp_atomic64_add_acqb erts_no_atomic64_add
+#define erts_smp_atomic64_read_bor_acqb erts_no_atomic64_read_bor
+#define erts_smp_atomic64_read_band_acqb erts_no_atomic64_read_band
+#define erts_smp_atomic64_xchg_acqb erts_no_atomic64_xchg
+#define erts_smp_atomic64_cmpxchg_acqb erts_no_atomic64_cmpxchg
+#define erts_smp_atomic64_read_bset_acqb erts_no_atomic64_read_bset
+
+#define erts_smp_atomic64_init_relb erts_no_atomic64_set
+#define erts_smp_atomic64_set_relb erts_no_atomic64_set
+#define erts_smp_atomic64_read_relb erts_no_atomic64_read
+#define erts_smp_atomic64_inc_read_relb erts_no_atomic64_inc_read
+#define erts_smp_atomic64_dec_read_relb erts_no_atomic64_dec_read
+#define erts_smp_atomic64_inc_relb erts_no_atomic64_inc
+#define erts_smp_atomic64_dec_relb erts_no_atomic64_dec
+#define erts_smp_atomic64_add_read_relb erts_no_atomic64_add_read
+#define erts_smp_atomic64_add_relb erts_no_atomic64_add
+#define erts_smp_atomic64_read_bor_relb erts_no_atomic64_read_bor
+#define erts_smp_atomic64_read_band_relb erts_no_atomic64_read_band
+#define erts_smp_atomic64_xchg_relb erts_no_atomic64_xchg
+#define erts_smp_atomic64_cmpxchg_relb erts_no_atomic64_cmpxchg
+#define erts_smp_atomic64_read_bset_relb erts_no_atomic64_read_bset
+
+#define erts_smp_atomic64_init_ddrb erts_no_atomic64_set
+#define erts_smp_atomic64_set_ddrb erts_no_atomic64_set
+#define erts_smp_atomic64_read_ddrb erts_no_atomic64_read
+#define erts_smp_atomic64_inc_read_ddrb erts_no_atomic64_inc_read
+#define erts_smp_atomic64_dec_read_ddrb erts_no_atomic64_dec_read
+#define erts_smp_atomic64_inc_ddrb erts_no_atomic64_inc
+#define erts_smp_atomic64_dec_ddrb erts_no_atomic64_dec
+#define erts_smp_atomic64_add_read_ddrb erts_no_atomic64_add_read
+#define erts_smp_atomic64_add_ddrb erts_no_atomic64_add
+#define erts_smp_atomic64_read_bor_ddrb erts_no_atomic64_read_bor
+#define erts_smp_atomic64_read_band_ddrb erts_no_atomic64_read_band
+#define erts_smp_atomic64_xchg_ddrb erts_no_atomic64_xchg
+#define erts_smp_atomic64_cmpxchg_ddrb erts_no_atomic64_cmpxchg
+#define erts_smp_atomic64_read_bset_ddrb erts_no_atomic64_read_bset
+
+#define erts_smp_atomic64_init_rb erts_no_atomic64_set
+#define erts_smp_atomic64_set_rb erts_no_atomic64_set
+#define erts_smp_atomic64_read_rb erts_no_atomic64_read
+#define erts_smp_atomic64_inc_read_rb erts_no_atomic64_inc_read
+#define erts_smp_atomic64_dec_read_rb erts_no_atomic64_dec_read
+#define erts_smp_atomic64_inc_rb erts_no_atomic64_inc
+#define erts_smp_atomic64_dec_rb erts_no_atomic64_dec
+#define erts_smp_atomic64_add_read_rb erts_no_atomic64_add_read
+#define erts_smp_atomic64_add_rb erts_no_atomic64_add
+#define erts_smp_atomic64_read_bor_rb erts_no_atomic64_read_bor
+#define erts_smp_atomic64_read_band_rb erts_no_atomic64_read_band
+#define erts_smp_atomic64_xchg_rb erts_no_atomic64_xchg
+#define erts_smp_atomic64_cmpxchg_rb erts_no_atomic64_cmpxchg
+#define erts_smp_atomic64_read_bset_rb erts_no_atomic64_read_bset
+
+#define erts_smp_atomic64_init_wb erts_no_atomic64_set
+#define erts_smp_atomic64_set_wb erts_no_atomic64_set
+#define erts_smp_atomic64_read_wb erts_no_atomic64_read
+#define erts_smp_atomic64_inc_read_wb erts_no_atomic64_inc_read
+#define erts_smp_atomic64_dec_read_wb erts_no_atomic64_dec_read
+#define erts_smp_atomic64_inc_wb erts_no_atomic64_inc
+#define erts_smp_atomic64_dec_wb erts_no_atomic64_dec
+#define erts_smp_atomic64_add_read_wb erts_no_atomic64_add_read
+#define erts_smp_atomic64_add_wb erts_no_atomic64_add
+#define erts_smp_atomic64_read_bor_wb erts_no_atomic64_read_bor
+#define erts_smp_atomic64_read_band_wb erts_no_atomic64_read_band
+#define erts_smp_atomic64_xchg_wb erts_no_atomic64_xchg
+#define erts_smp_atomic64_cmpxchg_wb erts_no_atomic64_cmpxchg
+#define erts_smp_atomic64_read_bset_wb erts_no_atomic64_read_bset
+
+#define erts_smp_atomic64_set_dirty erts_no_atomic64_set
+#define erts_smp_atomic64_read_dirty erts_no_atomic64_read
+
#endif /* !ERTS_SMP */
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
@@ -839,34 +1057,18 @@ erts_smp_rec_mtx_init(erts_smp_mtx_t *mtx)
#endif
ERTS_GLB_INLINE void
-erts_smp_mtx_init_x(erts_smp_mtx_t *mtx, char *name, Eterm extra)
-{
-#ifdef ERTS_SMP
- erts_mtx_init_x(mtx, name, extra, 1);
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_mtx_init_locked_x(erts_smp_mtx_t *mtx, char *name, Eterm extra)
-{
-#ifdef ERTS_SMP
- erts_mtx_init_locked_x(mtx, name, extra, 1);
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_mtx_init(erts_smp_mtx_t *mtx, char *name)
+erts_smp_mtx_init(erts_smp_mtx_t *mtx, char *name, Eterm extra, erts_lock_flags_t flags)
{
#ifdef ERTS_SMP
- erts_mtx_init(mtx, name);
+ erts_mtx_init(mtx, name, extra, flags);
#endif
}
ERTS_GLB_INLINE void
-erts_smp_mtx_init_locked(erts_smp_mtx_t *mtx, char *name)
+erts_smp_mtx_init_locked(erts_smp_mtx_t *mtx, char *name, Eterm extra, erts_lock_flags_t flags)
{
#ifdef ERTS_SMP
- erts_mtx_init_locked(mtx, name);
+ erts_mtx_init_locked(mtx, name, extra, flags);
#endif
}
@@ -988,39 +1190,25 @@ erts_smp_rwmtx_set_reader_group(int no)
}
ERTS_GLB_INLINE void
-erts_smp_rwmtx_init_opt_x(erts_smp_rwmtx_t *rwmtx,
- erts_smp_rwmtx_opt_t *opt,
- char *name,
- Eterm extra)
+erts_smp_rwmtx_init(erts_smp_rwmtx_t *rwmtx,
+ char *name,
+ Eterm extra,
+ erts_lock_flags_t flags)
{
#ifdef ERTS_SMP
- erts_rwmtx_init_opt_x(rwmtx, opt, name, extra);
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_rwmtx_init_x(erts_smp_rwmtx_t *rwmtx, char *name, Eterm extra)
-{
-#ifdef ERTS_SMP
- erts_rwmtx_init_x(rwmtx, name, extra);
+ erts_smp_rwmtx_init_opt(rwmtx, NULL, name, extra, flags);
#endif
}
ERTS_GLB_INLINE void
erts_smp_rwmtx_init_opt(erts_smp_rwmtx_t *rwmtx,
- erts_smp_rwmtx_opt_t *opt,
- char *name)
+ erts_smp_rwmtx_opt_t *opt,
+ char *name,
+ Eterm extra,
+ erts_lock_flags_t flags)
{
#ifdef ERTS_SMP
- erts_rwmtx_init_opt(rwmtx, opt, name);
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_rwmtx_init(erts_smp_rwmtx_t *rwmtx, char *name)
-{
-#ifdef ERTS_SMP
- erts_rwmtx_init(rwmtx, name);
+ erts_rwmtx_init_opt(rwmtx, opt, name, extra, flags);
#endif
}
@@ -1156,20 +1344,10 @@ erts_smp_lc_rwmtx_is_rwlocked(erts_smp_rwmtx_t *mtx)
}
ERTS_GLB_INLINE void
-erts_smp_spinlock_init_x(erts_smp_spinlock_t *lock, char *name, Eterm extra)
+erts_smp_spinlock_init(erts_smp_spinlock_t *lock, char *name, Eterm extra, erts_lock_flags_t flags)
{
#ifdef ERTS_SMP
- erts_spinlock_init_x(lock, name, extra);
-#else
- (void)lock;
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_spinlock_init(erts_smp_spinlock_t *lock, char *name)
-{
-#ifdef ERTS_SMP
- erts_spinlock_init(lock, name);
+ erts_spinlock_init(lock, name, extra, flags);
#else
(void)lock;
#endif
@@ -1222,20 +1400,10 @@ erts_smp_lc_spinlock_is_locked(erts_smp_spinlock_t *lock)
}
ERTS_GLB_INLINE void
-erts_smp_rwlock_init_x(erts_smp_rwlock_t *lock, char *name, Eterm extra)
-{
-#ifdef ERTS_SMP
- erts_rwlock_init_x(lock, name, extra);
-#else
- (void)lock;
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_rwlock_init(erts_smp_rwlock_t *lock, char *name)
+erts_smp_rwlock_init(erts_smp_rwlock_t *lock, char *name, Eterm extra, erts_lock_flags_t flags)
{
#ifdef ERTS_SMP
- erts_rwlock_init(lock, name);
+ erts_rwlock_init(lock, name, extra, flags);
#else
(void)lock;
#endif
diff --git a/erts/emulator/beam/erl_sock.h b/erts/emulator/beam/erl_sock.h
index 7ae6116dc5..3429a52d7e 100644
--- a/erts/emulator/beam/erl_sock.h
+++ b/erts/emulator/beam/erl_sock.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2003-2009. All Rights Reserved.
+ * Copyright Ericsson AB 2003-2016. 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.
+ * 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%
*/
diff --git a/erts/emulator/beam/erl_sys_driver.h b/erts/emulator/beam/erl_sys_driver.h
index dab4a94a9b..d46e88cb05 100644
--- a/erts/emulator/beam/erl_sys_driver.h
+++ b/erts/emulator/beam/erl_sys_driver.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2016. 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.
+ * 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%
*/
diff --git a/erts/emulator/beam/erl_term.c b/erts/emulator/beam/erl_term.c
index 28cbe7004f..d904e35e40 100644
--- a/erts/emulator/beam/erl_term.c
+++ b/erts/emulator/beam/erl_term.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2000-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2000-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -27,92 +28,71 @@
#include <stdlib.h>
#include <stdio.h>
-__decl_noreturn static void __noreturn
-et_abort(const char *expr, const char *file, unsigned line)
+void
+erts_set_literal_tag(Eterm *term, Eterm *hp_start, Eterm hsz)
{
-#ifdef EXIT_ON_ET_ABORT
- static int have_been_called = 0;
-
- if (have_been_called) {
- abort();
- } else {
- /*
- * Prevent infinite loop.
- */
- have_been_called = 1;
- erl_exit(1, "TYPE ASSERTION FAILED, file %s, line %u: %s\n", file, line, expr);
+#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++;
}
-#else
- erts_fprintf(stderr, "TYPE ASSERTION FAILED, file %s, line %u: %s\n", file, line, expr);
- abort();
+ if (is_boxed(*term) || is_list(*term))
+ *term |= TAG_LITERAL_PTR;
#endif
}
-#if ET_DEBUG
-#define ET_ASSERT(expr,file,line) \
-do { \
- if (!(expr)) \
- et_abort(#expr, file, line); \
-} while(0)
-#else
-#define ET_ASSERT(expr,file,line) do { } while(0)
-#endif
+void
+erts_term_init(void)
+{
+#ifdef ERTS_ORDINARY_REF_MARKER
+ /* Ordinary and magic references of same size... */
+
+ ErtsRefThing ref_thing;
+
+ ERTS_CT_ASSERT(ERTS_ORDINARY_REF_MARKER == ~((Uint32)0));
+ ref_thing.m.header = ERTS_REF_THING_HEADER;
+ ref_thing.m.mb = (ErtsMagicBinary *) ~((UWord) 3);
+ ref_thing.m.next = (struct erl_off_heap_header *) ~((UWord) 3);
+ if (ref_thing.o.marker == ERTS_ORDINARY_REF_MARKER)
+ ERTS_INTERNAL_ERROR("Cannot differentiate between magic and ordinary references");
+
+ ERTS_CT_ASSERT(offsetof(ErtsORefThing,marker) != 0);
+ ERTS_CT_ASSERT(sizeof(ErtsORefThing) == sizeof(ErtsMRefThing));
+# ifdef ERTS_MAGIC_REF_THING_HEADER
+# error Magic ref thing header should not have been defined...
+# endif
-#if ET_DEBUG
-unsigned tag_val_def_debug(Wterm x, const char *file, unsigned line)
#else
-unsigned tag_val_def(Wterm x)
-#define file __FILE__
-#define line __LINE__
+ /* Ordinary and magic references of different sizes... */
+
+# ifndef ERTS_MAGIC_REF_THING_HEADER
+# error Magic ref thing header should have been defined...
+# endif
+ ERTS_CT_ASSERT(sizeof(ErtsORefThing) != sizeof(ErtsMRefThing));
+
#endif
-{
- static char msg[32];
-
- switch (x & _TAG_PRIMARY_MASK) {
- case TAG_PRIMARY_LIST:
- ET_ASSERT(_list_precond(x),file,line);
- return LIST_DEF;
- case TAG_PRIMARY_BOXED: {
- Eterm hdr = *boxed_val(x);
- ET_ASSERT(is_header(hdr),file,line);
- switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_HEADER_ARITYVAL >> _TAG_PRIMARY_SIZE): return TUPLE_DEF;
- case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): return BIG_DEF;
- case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): return BIG_DEF;
- case (_TAG_HEADER_REF >> _TAG_PRIMARY_SIZE): return REF_DEF;
- case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): return FLOAT_DEF;
- case (_TAG_HEADER_EXPORT >> _TAG_PRIMARY_SIZE): return EXPORT_DEF;
- case (_TAG_HEADER_FUN >> _TAG_PRIMARY_SIZE): return FUN_DEF;
- case (_TAG_HEADER_EXTERNAL_PID >> _TAG_PRIMARY_SIZE): return EXTERNAL_PID_DEF;
- case (_TAG_HEADER_EXTERNAL_PORT >> _TAG_PRIMARY_SIZE): return EXTERNAL_PORT_DEF;
- case (_TAG_HEADER_EXTERNAL_REF >> _TAG_PRIMARY_SIZE): return EXTERNAL_REF_DEF;
- case (_TAG_HEADER_REFC_BIN >> _TAG_PRIMARY_SIZE): return BINARY_DEF;
- case (_TAG_HEADER_HEAP_BIN >> _TAG_PRIMARY_SIZE): return BINARY_DEF;
- case (_TAG_HEADER_SUB_BIN >> _TAG_PRIMARY_SIZE): return BINARY_DEF;
- case (_TAG_HEADER_MAP >> _TAG_PRIMARY_SIZE): return MAP_DEF;
- }
- break;
- }
- case TAG_PRIMARY_IMMED1: {
- switch ((x & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_IMMED1_PID >> _TAG_PRIMARY_SIZE): return PID_DEF;
- case (_TAG_IMMED1_PORT >> _TAG_PRIMARY_SIZE): return PORT_DEF;
- case (_TAG_IMMED1_IMMED2 >> _TAG_PRIMARY_SIZE): {
- switch ((x & _TAG_IMMED2_MASK) >> _TAG_IMMED1_SIZE) {
- case (_TAG_IMMED2_ATOM >> _TAG_IMMED1_SIZE): return ATOM_DEF;
- case (_TAG_IMMED2_NIL >> _TAG_IMMED1_SIZE): return NIL_DEF;
- }
- break;
- }
- case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): return SMALL_DEF;
- }
- break;
- }
- }
- erts_snprintf(msg, sizeof(msg), "tag_val_def: %#lx", (unsigned long) x);
- et_abort(msg, file, line);
-#undef file
-#undef line
+
+ ERTS_CT_ASSERT(ERTS_REF_THING_SIZE*sizeof(Eterm) == sizeof(ErtsORefThing));
+ ERTS_CT_ASSERT(ERTS_MAGIC_REF_THING_SIZE*sizeof(Eterm) == sizeof(ErtsMRefThing));
+
}
/*
@@ -127,10 +107,10 @@ FUNTY checked_##FUN(ARGTY x, const char *file, unsigned line) \
return _unchecked_##FUN(x); \
}
-ET_DEFINE_CHECKED(Eterm,make_boxed,Eterm*,_is_taggable_pointer);
+ET_DEFINE_CHECKED(Eterm,make_boxed,const Eterm*,_is_taggable_pointer);
ET_DEFINE_CHECKED(int,is_boxed,Eterm,!is_header);
ET_DEFINE_CHECKED(Eterm*,boxed_val,Wterm,_boxed_precond);
-ET_DEFINE_CHECKED(Eterm,make_list,Eterm*,_is_taggable_pointer);
+ET_DEFINE_CHECKED(Eterm,make_list,const Eterm*,_is_taggable_pointer);
ET_DEFINE_CHECKED(int,is_not_list,Eterm,!is_header);
ET_DEFINE_CHECKED(Eterm*,list_val,Wterm,_list_precond);
ET_DEFINE_CHECKED(Uint,unsigned_val,Eterm,is_small);
@@ -151,8 +131,8 @@ ET_DEFINE_CHECKED(Eterm*,tuple_val,Wterm,is_tuple);
ET_DEFINE_CHECKED(struct erl_node_*,internal_pid_node,Eterm,is_internal_pid);
ET_DEFINE_CHECKED(struct erl_node_*,internal_port_node,Eterm,is_internal_port);
ET_DEFINE_CHECKED(Eterm*,internal_ref_val,Wterm,is_internal_ref);
-ET_DEFINE_CHECKED(Uint,internal_ref_data_words,Wterm,is_internal_ref);
-ET_DEFINE_CHECKED(Uint32*,internal_ref_data,Wterm,is_internal_ref);
+ET_DEFINE_CHECKED(Uint32*,internal_magic_ref_numbers,Wterm,is_internal_magic_ref);
+ET_DEFINE_CHECKED(Uint32*,internal_ordinary_ref_numbers,Wterm,is_internal_ordinary_ref);
ET_DEFINE_CHECKED(struct erl_node_*,internal_ref_node,Eterm,is_internal_ref);
ET_DEFINE_CHECKED(Eterm*,external_val,Wterm,is_external);
ET_DEFINE_CHECKED(Uint,external_data_words,Wterm,is_external);
@@ -171,9 +151,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 37014ccf94..842802f8d9 100644
--- a/erts/emulator/beam/erl_term.h
+++ b/erts/emulator/beam/erl_term.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2000-2014. All Rights Reserved.
+ * Copyright Ericsson AB 2000-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -20,33 +21,11 @@
#ifndef __ERL_TERM_H
#define __ERL_TERM_H
-#include "sys.h" /* defines HALFWORD_HEAP */
+#include "erl_mmap.h"
-typedef UWord Wterm; /* Full word terms */
+void erts_term_init(void);
-#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
+typedef UWord Wterm; /* Full word terms */
struct erl_node_; /* Declared in erl_node_tables.h */
@@ -73,6 +52,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
@@ -147,21 +144,21 @@ struct erl_node_; /* Declared in erl_node_tables.h */
#define MAP_SUBTAG (0xF << _TAG_PRIMARY_SIZE) /* MAP */
-#define _TAG_HEADER_ARITYVAL (TAG_PRIMARY_HEADER|ARITYVAL_SUBTAG)
-#define _TAG_HEADER_FUN (TAG_PRIMARY_HEADER|FUN_SUBTAG)
-#define _TAG_HEADER_POS_BIG (TAG_PRIMARY_HEADER|POS_BIG_SUBTAG)
-#define _TAG_HEADER_NEG_BIG (TAG_PRIMARY_HEADER|NEG_BIG_SUBTAG)
-#define _TAG_HEADER_FLOAT (TAG_PRIMARY_HEADER|FLOAT_SUBTAG)
-#define _TAG_HEADER_EXPORT (TAG_PRIMARY_HEADER|EXPORT_SUBTAG)
-#define _TAG_HEADER_REF (TAG_PRIMARY_HEADER|REF_SUBTAG)
-#define _TAG_HEADER_REFC_BIN (TAG_PRIMARY_HEADER|REFC_BINARY_SUBTAG)
-#define _TAG_HEADER_HEAP_BIN (TAG_PRIMARY_HEADER|HEAP_BINARY_SUBTAG)
-#define _TAG_HEADER_SUB_BIN (TAG_PRIMARY_HEADER|SUB_BINARY_SUBTAG)
-#define _TAG_HEADER_EXTERNAL_PID (TAG_PRIMARY_HEADER|EXTERNAL_PID_SUBTAG)
-#define _TAG_HEADER_EXTERNAL_PORT (TAG_PRIMARY_HEADER|EXTERNAL_PORT_SUBTAG)
-#define _TAG_HEADER_EXTERNAL_REF (TAG_PRIMARY_HEADER|EXTERNAL_REF_SUBTAG)
+#define _TAG_HEADER_ARITYVAL (TAG_PRIMARY_HEADER|ARITYVAL_SUBTAG)
+#define _TAG_HEADER_FUN (TAG_PRIMARY_HEADER|FUN_SUBTAG)
+#define _TAG_HEADER_POS_BIG (TAG_PRIMARY_HEADER|POS_BIG_SUBTAG)
+#define _TAG_HEADER_NEG_BIG (TAG_PRIMARY_HEADER|NEG_BIG_SUBTAG)
+#define _TAG_HEADER_FLOAT (TAG_PRIMARY_HEADER|FLOAT_SUBTAG)
+#define _TAG_HEADER_EXPORT (TAG_PRIMARY_HEADER|EXPORT_SUBTAG)
+#define _TAG_HEADER_REF (TAG_PRIMARY_HEADER|REF_SUBTAG)
+#define _TAG_HEADER_REFC_BIN (TAG_PRIMARY_HEADER|REFC_BINARY_SUBTAG)
+#define _TAG_HEADER_HEAP_BIN (TAG_PRIMARY_HEADER|HEAP_BINARY_SUBTAG)
+#define _TAG_HEADER_SUB_BIN (TAG_PRIMARY_HEADER|SUB_BINARY_SUBTAG)
+#define _TAG_HEADER_EXTERNAL_PID (TAG_PRIMARY_HEADER|EXTERNAL_PID_SUBTAG)
+#define _TAG_HEADER_EXTERNAL_PORT (TAG_PRIMARY_HEADER|EXTERNAL_PORT_SUBTAG)
+#define _TAG_HEADER_EXTERNAL_REF (TAG_PRIMARY_HEADER|EXTERNAL_REF_SUBTAG)
#define _TAG_HEADER_BIN_MATCHSTATE (TAG_PRIMARY_HEADER|BIN_MATCHSTATE_SUBTAG)
-#define _TAG_HEADER_MAP (TAG_PRIMARY_HEADER|MAP_SUBTAG)
+#define _TAG_HEADER_MAP (TAG_PRIMARY_HEADER|MAP_SUBTAG)
#define _TAG_HEADER_MASK 0x3F
@@ -189,16 +186,14 @@ 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)
-_ET_DECLARE_CHECKED(Eterm,make_boxed,Eterm*)
+
+#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
#define _is_not_boxed(x) ((x) & (_TAG_PRIMARY_MASK-TAG_PRIMARY_BOXED))
@@ -208,13 +203,17 @@ _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)
-_ET_DECLARE_CHECKED(Eterm,make_list,Eterm*)
+#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
#define _unchecked_is_not_list(x) ((x) & (_TAG_PRIMARY_MASK-TAG_PRIMARY_LIST))
@@ -225,12 +224,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))
@@ -241,15 +240,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
@@ -296,9 +302,10 @@ _ET_DECLARE_CHECKED(Uint,atom_val,Eterm)
#define atom_val(x) _ET_APPLY(atom_val,(x))
/* header (arityval or thing) access methods */
-#define _make_header(sz,tag) ((Uint)(((sz) << _HEADER_ARITY_OFFS) + (tag)))
+#define _make_header(sz,tag) ((Uint)(((Uint)(sz) << _HEADER_ARITY_OFFS) + (tag)))
#define is_header(x) (((x) & _TAG_PRIMARY_MASK) == TAG_PRIMARY_HEADER)
-#define _unchecked_header_arity(x) ((x) >> _HEADER_ARITY_OFFS)
+#define _unchecked_header_arity(x) \
+ (is_map_header(x) ? MAP_HEADER_ARITY(x) : ((x) >> _HEADER_ARITY_OFFS))
_ET_DECLARE_CHECKED(Uint,header_arity,Eterm)
#define header_arity(x) _ET_APPLY(header_arity,(x))
@@ -361,6 +368,7 @@ _ET_DECLARE_CHECKED(Uint,thing_subtag,Eterm)
((((x) & (_TAG_HEADER_MASK)) == _TAG_HEADER_REFC_BIN) || \
(((x) & (_TAG_HEADER_MASK)) == _TAG_HEADER_HEAP_BIN) || \
(((x) & (_TAG_HEADER_MASK)) == _TAG_HEADER_SUB_BIN))
+
#define make_binary(x) make_boxed((Eterm*)(x))
#define is_binary(x) (is_boxed((x)) && is_binary_header(*boxed_val((x))))
#define is_not_binary(x) (!is_binary((x)))
@@ -393,11 +401,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)
@@ -421,7 +425,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)
@@ -442,12 +446,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)
@@ -556,14 +560,6 @@ _ET_DECLARE_CHECKED(Eterm*,tuple_val,Wterm)
#define _GETBITS(X,Pos,Size) (((X) >> (Pos)) & ~(~((Uint) 0) << (Size)))
-/*
- * Creation in node specific data (pids, ports, refs)
- */
-
-#define _CRE_SIZE 2
-
-/* MAX value for the creation field in pid, port and reference */
-#define MAX_CREATION (1 << _CRE_SIZE)
/*
* PID layout (internal pids):
@@ -577,7 +573,7 @@ _ET_DECLARE_CHECKED(Eterm*,tuple_val,Wterm)
*
* n : number
*
- * Old pid layout:
+ * Very old pid layout:
*
* |3 3 2 2 2 2 2 2|2 2 2 2 1 1 1 1|1 1 1 1 1 1 | |
* |1 0 9 8 7 6 5 4|3 2 1 0 9 8 7 6|5 4 3 2 1 0 9 8|7 6 5 4 3 2 1 0|
@@ -724,73 +720,235 @@ _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
-# define ERTS_REF_WORDS (ERTS_REF_NUMBERS/2 + 1)
-# define ERTS_REF_32BIT_WORDS (ERTS_REF_NUMBERS+1)
-#else
-# define ERTS_REF_WORDS ERTS_REF_NUMBERS
-# define ERTS_REF_32BIT_WORDS ERTS_REF_NUMBERS
+#ifndef ERTS_ENDIANNESS
+# error ERTS_ENDIANNESS not defined...
#endif
-typedef struct {
- Eterm header;
- union {
- Uint32 ui32[ERTS_REF_32BIT_WORDS];
- Uint ui[ERTS_REF_WORDS];
- } data;
-} RefThing;
+#if ERTS_REF_NUMBERS != 3
+# error "A new reference layout for 64-bit needs to be implemented..."
+#endif
-#define REF_THING_SIZE (sizeof(RefThing)/sizeof(Uint))
-#define REF_THING_HEAD_SIZE (sizeof(Eterm)/sizeof(Uint))
+struct magic_binary;
-#define make_ref_thing_header(DW) \
- _make_header((DW)+REF_THING_HEAD_SIZE-1,_TAG_HEADER_REF)
+#if defined(ARCH_64)
-#if defined(ARCH_64) && !HALFWORD_HEAP
+# define ERTS_ORDINARY_REF_MARKER (~((Uint32) 0))
+
+typedef struct {
+ Eterm header;
+#if ERTS_ENDIANNESS <= 0
+ Uint32 marker;
+#endif
+ Uint32 num[ERTS_REF_NUMBERS];
+#if ERTS_ENDIANNESS > 0
+ Uint32 marker;
+#endif
+} ErtsORefThing;
+
+typedef struct {
+ Eterm header;
+ struct magic_binary *mb;
+ struct erl_off_heap_header* next;
+#if !ERTS_ENDIANNESS
+ Uint32 num[ERTS_REF_NUMBERS];
+ Uint32 marker;
+#endif
+} ErtsMRefThing;
/*
- * Ref layout on a 64-bit little endian machine:
+ * Ordinary ref layout on a 64-bit little endian machine:
*
* 63 31 0
* +--------------+--------------+
* | Thing word |
* +--------------+--------------+
- * | Data 0 | 32-bit arity |
+ * | Data 0 | 0xffffffff |
* +--------------+--------------+
* | Data 2 | Data 1 |
* +--------------+--------------+
*
- * Data is stored as an Uint32 array with 32-bit arity as first number.
+ * Ordinary ref layout on a 64-bit big endian machine:
+ *
+ * 63 31 0
+ * +--------------+--------------+
+ * | Thing word |
+ * +--------------+--------------+
+ * | Data 0 | Data 1 |
+ * +--------------+--------------+
+ * | Data 2 | 0xffffffff |
+ * +--------------+--------------+
+ *
+ * Magic Ref layout on a 64-bit machine:
+ *
+ * 63 31 0
+ * +--------------+--------------+
+ * | Thing word |
+ * +--------------+--------------+
+ * | Magic Binary Pointer |
+ * +--------------+--------------+
+ * | Next Off Heap Pointer |
+ * +--------------+--------------+
+ *
+ * Both pointers in the magic ref are 64-bit aligned. That is,
+ * least significant bits are zero. The marker 32-bit word is
+ * placed over the least significant bits of one of the pointers.
+ * That is, we can distinguish between magic and ordinary ref
+ * by looking at the marker field.
+ *
*/
#define write_ref_thing(Hp, R0, R1, R2) \
do { \
- ((RefThing *) (Hp))->header = make_ref_thing_header(ERTS_REF_WORDS); \
- ((RefThing *) (Hp))->data.ui32[0] = ERTS_REF_NUMBERS; \
- ((RefThing *) (Hp))->data.ui32[1] = (R0); \
- ((RefThing *) (Hp))->data.ui32[2] = (R1); \
- ((RefThing *) (Hp))->data.ui32[3] = (R2); \
+ ((ErtsORefThing *) (Hp))->header = ERTS_REF_THING_HEADER; \
+ ((ErtsORefThing *) (Hp))->marker = ERTS_ORDINARY_REF_MARKER; \
+ ((ErtsORefThing *) (Hp))->num[0] = (R0); \
+ ((ErtsORefThing *) (Hp))->num[1] = (R1); \
+ ((ErtsORefThing *) (Hp))->num[2] = (R2); \
} while (0)
-#else
+#if ERTS_ENDIANNESS
+/* Known big or little endian */
+
+#define write_magic_ref_thing(Hp, Ohp, Binp) \
+do { \
+ ((ErtsMRefThing *) (Hp))->header = ERTS_REF_THING_HEADER; \
+ ((ErtsMRefThing *) (Hp))->mb = (Binp); \
+ ((ErtsMRefThing *) (Hp))->next = (Ohp)->first; \
+ (Ohp)->first = (struct erl_off_heap_header*) (Hp); \
+ ASSERT(erts_is_ref_numbers_magic((Binp)->refn)); \
+} while (0)
+
+#else /* !ERTS_ENDIANNESS */
+
+#define write_magic_ref_thing(Hp, Ohp, Binp) \
+do { \
+ ((ErtsMRefThing *) (Hp))->header = ERTS_MAGIC_REF_THING_HEADER; \
+ ((ErtsMRefThing *) (Hp))->mb = (Binp); \
+ ((ErtsMRefThing *) (Hp))->next = (Ohp)->first; \
+ (Ohp)->first = (struct erl_off_heap_header*) (Hp); \
+ ((ErtsMRefThing *) (Hp))->marker = 0; \
+ ((ErtsMRefThing *) (Hp))->num[0] = (Binp)->refn[0]; \
+ ((ErtsMRefThing *) (Hp))->num[1] = (Binp)->refn[1]; \
+ ((ErtsMRefThing *) (Hp))->num[2] = (Binp)->refn[2]; \
+ ASSERT(erts_is_ref_numbers_magic((Binp)->refn)); \
+} while (0)
+
+#endif /* !ERTS_ENDIANNESS */
+
+#else /* ARCH_32 */
+
+typedef struct {
+ Eterm header;
+ Uint32 num[ERTS_REF_NUMBERS];
+} ErtsORefThing;
+
+typedef struct {
+ Eterm header;
+ struct magic_binary *mb;
+ struct erl_off_heap_header* next;
+} ErtsMRefThing;
+
#define write_ref_thing(Hp, R0, R1, R2) \
do { \
- ((RefThing *) (Hp))->header = make_ref_thing_header(ERTS_REF_WORDS); \
- ((RefThing *) (Hp))->data.ui32[0] = (R0); \
- ((RefThing *) (Hp))->data.ui32[1] = (R1); \
- ((RefThing *) (Hp))->data.ui32[2] = (R2); \
+ ((ErtsORefThing *) (Hp))->header = ERTS_REF_THING_HEADER; \
+ ((ErtsORefThing *) (Hp))->num[0] = (R0); \
+ ((ErtsORefThing *) (Hp))->num[1] = (R1); \
+ ((ErtsORefThing *) (Hp))->num[2] = (R2); \
+} while (0)
+
+#define write_magic_ref_thing(Hp, Ohp, Binp) \
+do { \
+ ((ErtsMRefThing *) (Hp))->header = ERTS_MAGIC_REF_THING_HEADER; \
+ ((ErtsMRefThing *) (Hp))->mb = (Binp); \
+ ((ErtsMRefThing *) (Hp))->next = (Ohp)->first; \
+ (Ohp)->first = (struct erl_off_heap_header*) (Hp); \
+ ASSERT(erts_is_ref_numbers_magic(&(Binp)->refn)); \
} while (0)
+#endif /* ARCH_32 */
+
+typedef union {
+ ErtsMRefThing m;
+ ErtsORefThing o;
+} ErtsRefThing;
+
+/* for copy sharing */
+#define BOXED_VISITED_MASK ((Eterm) 3)
+#define BOXED_VISITED ((Eterm) 1)
+#define BOXED_SHARED_UNPROCESSED ((Eterm) 2)
+#define BOXED_SHARED_PROCESSED ((Eterm) 3)
+
+#define ERTS_REF_THING_SIZE (sizeof(ErtsORefThing)/sizeof(Uint))
+#define ERTS_MAGIC_REF_THING_SIZE (sizeof(ErtsMRefThing)/sizeof(Uint))
+#define ERTS_MAX_INTERNAL_REF_SIZE (sizeof(ErtsRefThing)/sizeof(Uint))
+
+#define make_ref_thing_header(Words) \
+ _make_header((Words)-1,_TAG_HEADER_REF)
+
+#define ERTS_REF_THING_HEADER _make_header(ERTS_REF_THING_SIZE-1,_TAG_HEADER_REF)
+
+#if defined(ARCH_64) && ERTS_ENDIANNESS /* All internal refs of same size... */
+
+# undef ERTS_MAGIC_REF_THING_HEADER
+
+# define is_ref_thing_header(x) ((x) == ERTS_REF_THING_HEADER)
+
+#ifdef SHCOPY
+#define is_ordinary_ref_thing(x) \
+ (((ErtsRefThing *) (x))->o.marker == ERTS_ORDINARY_REF_MARKER)
+#else
+#define is_ordinary_ref_thing(x) \
+ (ASSERT(is_ref_thing_header((*((Eterm *)(x))) & ~BOXED_VISITED_MASK)), \
+ ((ErtsRefThing *) (x))->o.marker == ERTS_ORDINARY_REF_MARKER)
+#endif
+
+#define is_magic_ref_thing(x) \
+ (!is_ordinary_ref_thing((x)))
+
+#define is_internal_magic_ref(x) \
+ ((_unchecked_is_boxed((x)) && *boxed_val((x)) == ERTS_REF_THING_HEADER) \
+ && is_magic_ref_thing(boxed_val((x))))
+
+#define is_internal_ordinary_ref(x) \
+ ((_unchecked_is_boxed((x)) && *boxed_val((x)) == ERTS_REF_THING_HEADER) \
+ && is_ordinary_ref_thing(boxed_val((x))))
+
+#else /* Ordinary and magic references of different sizes... */
+
+# define ERTS_MAGIC_REF_THING_HEADER \
+ _make_header(ERTS_MAGIC_REF_THING_SIZE-1,_TAG_HEADER_REF)
+
+# define is_ref_thing_header(x) \
+ (((x) & _TAG_HEADER_MASK) == _TAG_HEADER_REF)
+
+#define is_ordinary_ref_thing(x) \
+ (ASSERT(is_ref_thing_header(*((Eterm *)(x)))), \
+ *((Eterm *)(x)) == ERTS_REF_THING_HEADER)
+
+#define is_magic_ref_thing(x) \
+ (ASSERT(is_ref_thing_header(*((Eterm *)(x)))), \
+ *((Eterm *)(x)) == ERTS_MAGIC_REF_THING_HEADER)
+
+#define is_internal_magic_ref(x) \
+ (_unchecked_is_boxed((x)) && *boxed_val((x)) == ERTS_MAGIC_REF_THING_HEADER)
+
+#define is_internal_ordinary_ref(x) \
+ (_unchecked_is_boxed((x)) && *boxed_val((x)) == ERTS_REF_THING_HEADER)
+
#endif
-#define is_ref_thing_header(x) (((x) & _TAG_HEADER_MASK) == _TAG_HEADER_REF)
#define make_internal_ref(x) make_boxed((Eterm*)(x))
-#define _unchecked_ref_thing_ptr(x) \
- ((RefThing*) _unchecked_internal_ref_val(x))
-#define ref_thing_ptr(x) \
- ((RefThing*) internal_ref_val(x))
+#define _unchecked_ordinary_ref_thing_ptr(x) \
+ ((ErtsORefThing*) _unchecked_internal_ref_val(x))
+#define ordinary_ref_thing_ptr(x) \
+ ((ErtsORefThing*) internal_ref_val(x))
+
+#define _unchecked_magic_ref_thing_ptr(x) \
+ ((ErtsMRefThing*) _unchecked_internal_ref_val(x))
+#define magic_ref_thing_ptr(x) \
+ ((ErtsMRefThing*) internal_ref_val(x))
#define is_internal_ref(x) \
(_unchecked_is_boxed((x)) && is_ref_thing_header(*boxed_val((x))))
@@ -802,16 +960,21 @@ do { \
_ET_DECLARE_CHECKED(Eterm*,internal_ref_val,Wterm)
#define internal_ref_val(x) _ET_APPLY(internal_ref_val,(x))
-#define internal_thing_ref_data_words(t) (thing_arityval(*(Eterm*)(t)))
-#define _unchecked_internal_ref_data_words(x) \
- (_unchecked_thing_arityval(*_unchecked_internal_ref_val(x)))
-_ET_DECLARE_CHECKED(Uint,internal_ref_data_words,Wterm)
-#define internal_ref_data_words(x) _ET_APPLY(internal_ref_data_words,(x))
+#define internal_ordinary_thing_ref_numbers(ort) (((ErtsORefThing *)(ort))->num)
+#define _unchecked_internal_ordinary_ref_numbers(x) (internal_ordinary_thing_ref_numbers(_unchecked_ordinary_ref_thing_ptr(x)))
+_ET_DECLARE_CHECKED(Uint32*,internal_ordinary_ref_numbers,Wterm)
+#define internal_ordinary_ref_numbers(x) _ET_APPLY(internal_ordinary_ref_numbers,(x))
+
+#if defined(ARCH_64) && !ERTS_ENDIANNESS
+#define internal_magic_thing_ref_numbers(mrt) (((ErtsMRefThing *)(mrt))->num)
+#else
+#define internal_magic_thing_ref_numbers(mrt) (((ErtsMRefThing *)(mrt))->mb->refn)
+#endif
+
+#define _unchecked_internal_magic_ref_numbers(x) (internal_magic_thing_ref_numbers(_unchecked_magic_ref_thing_ptr(x)))
+_ET_DECLARE_CHECKED(Uint32*,internal_magic_ref_numbers,Wterm)
+#define internal_magic_ref_numbers(x) _ET_APPLY(internal_magic_ref_numbers,(x))
-#define internal_thing_ref_data(thing) ((thing)->data.ui32)
-#define _unchecked_internal_ref_data(x) (internal_thing_ref_data(_unchecked_ref_thing_ptr(x)))
-_ET_DECLARE_CHECKED(Uint32*,internal_ref_data,Wterm)
-#define internal_ref_data(x) _ET_APPLY(internal_ref_data,(x))
#define _unchecked_internal_ref_node(x) erts_this_node
_ET_DECLARE_CHECKED(struct erl_node_*,internal_ref_node,Eterm)
@@ -990,6 +1153,37 @@ _ET_DECLARE_CHECKED(Uint32*,external_ref_data,Wterm)
_ET_DECLARE_CHECKED(struct erl_node_*,external_ref_node,Eterm)
#define external_ref_node(x) _ET_APPLY(external_ref_node,(x))
+/* maps */
+
+#define MAP_HEADER_TAG_SZ (2)
+#define MAP_HEADER_ARITY_SZ (8)
+#define MAP_HEADER_VAL_SZ (16)
+
+#define MAP_HEADER_TAG_FLATMAP_HEAD (0x0)
+#define MAP_HEADER_TAG_HAMT_NODE_BITMAP (0x1)
+#define MAP_HEADER_TAG_HAMT_HEAD_ARRAY (0x2)
+#define MAP_HEADER_TAG_HAMT_HEAD_BITMAP (0x3)
+
+#define MAP_HEADER_TYPE(Hdr) (((Hdr) >> (_HEADER_ARITY_OFFS)) & (0x3))
+#define MAP_HEADER_ARITY(Hdr) (((Hdr) >> (_HEADER_ARITY_OFFS + MAP_HEADER_TAG_SZ)) & (0xff))
+#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 is_hashmap(x) (is_boxed((x)) && is_hashmap_header(*boxed_val((x))))
+#define is_not_hashmap(x) (!is_hashmap(x))
+#define is_hashmap_header(x) (((x) & (_HEADER_MAP_HASHMAP_HEAD_MASK)) == HAMT_SUBTAG_HEAD_ARRAY)
+#define hashmap_val(x) _unchecked_boxed_val((x))
+
+#define make_flatmap(x) make_boxed((Eterm*)(x))
+#define is_flatmap(x) (is_boxed((x)) && is_flatmap_header(*boxed_val((x))))
+#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 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))
+
/* number tests */
#define is_integer(x) (is_small(x) || is_big(x))
@@ -1007,14 +1201,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))
@@ -1030,44 +1224,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 beam_reg_tag(x) ((x) & 3)
+#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 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 LOADER_X_REG _LOADER_TAG_XREG
+#define LOADER_Y_REG _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 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 _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_reg_index(R) ((R) >> _LOADER_TAG_SIZE)
-#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 loader_tag(T) ((T) & _LOADER_MASK)
-#define reg_index(R) ((R) / sizeof(Eterm))
+#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 _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_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_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:
@@ -1095,13 +1285,16 @@ _ET_DECLARE_CHECKED(Uint,y_reg_index,Uint)
#define FLOAT_DEF 0xe
#define BIG_DEF 0xf
#define SMALL_DEF 0x10
+#define MATCHSTATE_DEF 0x11 /* not a "real" term */
+
+#define FIRST_VACANT_TAG_DEF 0x12
#if ET_DEBUG
-extern unsigned tag_val_def_debug(Wterm, const char*, unsigned);
-#define tag_val_def(x) tag_val_def_debug((x),__FILE__,__LINE__)
+ERTS_GLB_INLINE unsigned tag_val_def(Wterm, const char*, unsigned);
#else
-extern unsigned tag_val_def(Wterm);
+ERTS_GLB_INLINE unsigned tag_val_def(Wterm);
#endif
+
#define not_eq_tags(X,Y) (tag_val_def((X)) ^ tag_val_def((Y)))
#define NUMBER_CODE(x,y) ((tag_val_def(x) << 5) | tag_val_def(y))
@@ -1116,81 +1309,83 @@ 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 is_same(A,B) ((A)==(B))
-#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))
+void erts_set_literal_tag(Eterm *term, Eterm *hp_start, Eterm hsz);
-#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_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 ET_DEBUG
+#define ET_ASSERT(expr,file,line) \
+do { \
+ if (!(expr)) \
+ erl_assert_error("TYPE ASSERTION: " #expr, __FUNCTION__, file, line); \
+} while(0)
+#else
+#define ET_ASSERT(expr,file,line) do { } while(0)
+#endif
#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));
+#if ET_DEBUG
+ERTS_GLB_INLINE unsigned tag_val_def(Wterm x, const char *file, unsigned line)
+#else
+ERTS_GLB_INLINE unsigned tag_val_def(Wterm x)
+#define file __FILE__
+#define line __LINE__
+#endif
+{
+ static char *msg = "tag_val_def error";
+
+ switch (x & _TAG_PRIMARY_MASK) {
+ case TAG_PRIMARY_LIST:
+ ET_ASSERT(_list_precond(x),file,line);
+ return LIST_DEF;
+ case TAG_PRIMARY_BOXED: {
+ Eterm hdr = *boxed_val(x);
+ ET_ASSERT(is_header(hdr),file,line);
+ switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
+ case (_TAG_HEADER_ARITYVAL >> _TAG_PRIMARY_SIZE): return TUPLE_DEF;
+ case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): return BIG_DEF;
+ case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): return BIG_DEF;
+ case (_TAG_HEADER_REF >> _TAG_PRIMARY_SIZE): return REF_DEF;
+ case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): return FLOAT_DEF;
+ case (_TAG_HEADER_EXPORT >> _TAG_PRIMARY_SIZE): return EXPORT_DEF;
+ case (_TAG_HEADER_FUN >> _TAG_PRIMARY_SIZE): return FUN_DEF;
+ case (_TAG_HEADER_EXTERNAL_PID >> _TAG_PRIMARY_SIZE): return EXTERNAL_PID_DEF;
+ case (_TAG_HEADER_EXTERNAL_PORT >> _TAG_PRIMARY_SIZE): return EXTERNAL_PORT_DEF;
+ case (_TAG_HEADER_EXTERNAL_REF >> _TAG_PRIMARY_SIZE): return EXTERNAL_REF_DEF;
+ case (_TAG_HEADER_MAP >> _TAG_PRIMARY_SIZE): return MAP_DEF;
+ case (_TAG_HEADER_REFC_BIN >> _TAG_PRIMARY_SIZE): return BINARY_DEF;
+ case (_TAG_HEADER_HEAP_BIN >> _TAG_PRIMARY_SIZE): return BINARY_DEF;
+ case (_TAG_HEADER_SUB_BIN >> _TAG_PRIMARY_SIZE): return BINARY_DEF;
+ case (_TAG_HEADER_BIN_MATCHSTATE >> _TAG_PRIMARY_SIZE): return MATCHSTATE_DEF;
+ }
+
+ break;
+ }
+ case TAG_PRIMARY_IMMED1: {
+ switch ((x & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
+ case (_TAG_IMMED1_PID >> _TAG_PRIMARY_SIZE): return PID_DEF;
+ case (_TAG_IMMED1_PORT >> _TAG_PRIMARY_SIZE): return PORT_DEF;
+ case (_TAG_IMMED1_IMMED2 >> _TAG_PRIMARY_SIZE): {
+ switch ((x & _TAG_IMMED2_MASK) >> _TAG_IMMED1_SIZE) {
+ case (_TAG_IMMED2_ATOM >> _TAG_IMMED1_SIZE): return ATOM_DEF;
+ case (_TAG_IMMED2_NIL >> _TAG_IMMED1_SIZE): return NIL_DEF;
+ }
+ break;
+ }
+ case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): return SMALL_DEF;
+ }
+ break;
+ }
+ }
+ erl_assert_error(msg, __FUNCTION__, file, line);
+#undef file
+#undef line
}
#endif
-#else /* !HALFWORD_HEAP */
-#define is_same(A,A_BASE,B,B_BASE) ((A)==(B))
+#if ET_DEBUG
+#define tag_val_def(X) tag_val_def(X, __FILE__, __LINE__)
#endif
#endif /* __ERL_TERM_H */
diff --git a/erts/emulator/beam/erl_thr_progress.c b/erts/emulator/beam/erl_thr_progress.c
index 545a0343d0..2a9f276e02 100644
--- a/erts/emulator/beam/erl_thr_progress.c
+++ b/erts/emulator/beam/erl_thr_progress.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2011-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2011-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -94,9 +95,9 @@
#define ERTS_THR_PRGR_FTL_ERR_BLCK_POLL_INTERVAL 100
-#define ERTS_THR_PRGR_LFLG_BLOCK (((erts_aint32_t) 1) << 31)
-#define ERTS_THR_PRGR_LFLG_NO_LEADER (((erts_aint32_t) 1) << 30)
-#define ERTS_THR_PRGR_LFLG_WAITING_UM (((erts_aint32_t) 1) << 29)
+#define ERTS_THR_PRGR_LFLG_BLOCK ((erts_aint32_t) (1U << 31))
+#define ERTS_THR_PRGR_LFLG_NO_LEADER ((erts_aint32_t) (1U << 30))
+#define ERTS_THR_PRGR_LFLG_WAITING_UM ((erts_aint32_t) (1U << 29))
#define ERTS_THR_PRGR_LFLG_ACTIVE_MASK (~(ERTS_THR_PRGR_LFLG_NO_LEADER \
| ERTS_THR_PRGR_LFLG_BLOCK \
| ERTS_THR_PRGR_LFLG_WAITING_UM))
@@ -115,70 +116,24 @@
#undef read_nob
#define read_nob erts_thr_prgr_read_nob__
-#ifdef ARCH_64
-
-static ERTS_INLINE void
-set_mb(ERTS_THR_PRGR_ATOMIC *atmc, ErtsThrPrgrVal val)
-{
- erts_atomic_set_mb(atmc, val);
-}
-
-static ERTS_INLINE void
-set_nob(ERTS_THR_PRGR_ATOMIC *atmc, ErtsThrPrgrVal val)
-{
- erts_atomic_set_nob(atmc, val);
-}
-
-static ERTS_INLINE void
-init_nob(ERTS_THR_PRGR_ATOMIC *atmc, ErtsThrPrgrVal val)
-{
- erts_atomic_init_nob(atmc, val);
-}
-
-#else
-
-#undef dw_aint_to_val
-#define dw_aint_to_val erts_thr_prgr_dw_aint_to_val__
-
-static void
-val_to_dw_aint(erts_dw_aint_t *dw_aint, ErtsThrPrgrVal val)
-{
-#ifdef ETHR_SU_DW_NAINT_T__
- dw_aint->dw_sint = (ETHR_SU_DW_NAINT_T__) val;
-#else
- dw_aint->sint[ERTS_DW_AINT_LOW_WORD]
- = (erts_aint_t) (val & 0xffffffff);
- dw_aint->sint[ERTS_DW_AINT_HIGH_WORD]
- = (erts_aint_t) ((val >> 32) & 0xffffffff);
-#endif
-}
-
static ERTS_INLINE void
set_mb(ERTS_THR_PRGR_ATOMIC *atmc, ErtsThrPrgrVal val)
{
- erts_dw_aint_t dw_aint;
- val_to_dw_aint(&dw_aint, val);
- erts_dw_atomic_set_mb(atmc, &dw_aint);
+ erts_atomic64_set_mb(atmc, (erts_aint64_t) val);
}
static ERTS_INLINE void
set_nob(ERTS_THR_PRGR_ATOMIC *atmc, ErtsThrPrgrVal val)
{
- erts_dw_aint_t dw_aint;
- val_to_dw_aint(&dw_aint, val);
- erts_dw_atomic_set_nob(atmc, &dw_aint);
+ erts_atomic64_set_nob(atmc, (erts_aint64_t) val);
}
static ERTS_INLINE void
init_nob(ERTS_THR_PRGR_ATOMIC *atmc, ErtsThrPrgrVal val)
{
- erts_dw_aint_t dw_aint;
- val_to_dw_aint(&dw_aint, val);
- erts_dw_atomic_init_nob(atmc, &dw_aint);
+ erts_atomic64_init_nob(atmc, (erts_aint64_t) val);
}
-#endif
-
/* #define ERTS_THR_PROGRESS_STATE_DEBUG */
#ifdef ERTS_THR_PROGRESS_STATE_DEBUG
@@ -187,8 +142,8 @@ init_nob(ERTS_THR_PRGR_ATOMIC *atmc, ErtsThrPrgrVal val)
#warning "Thread progress state debug is on"
#endif
-#define ERTS_THR_PROGRESS_STATE_DEBUG_LEADER (((erts_aint32_t) 1) << 0)
-#define ERTS_THR_PROGRESS_STATE_DEBUG_ACTIVE (((erts_aint32_t) 1) << 1)
+#define ERTS_THR_PROGRESS_STATE_DEBUG_LEADER ((erts_aint32_t) (1U << 0))
+#define ERTS_THR_PROGRESS_STATE_DEBUG_ACTIVE ((erts_aint32_t) (1U << 1))
#define ERTS_THR_PROGRESS_STATE_DEBUG_INIT(ID) \
erts_atomic32_init_nob(&intrnl->thr[(ID)].data.state_debug, \
@@ -224,10 +179,10 @@ do { \
#endif /* ERTS_THR_PROGRESS_STATE_DEBUG */
-#define ERTS_THR_PRGR_BLCKR_INVALID (~((erts_aint32_t) 0))
-#define ERTS_THR_PRGR_BLCKR_UNMANAGED (((erts_aint32_t) 1) << 31)
+#define ERTS_THR_PRGR_BLCKR_INVALID ((erts_aint32_t) (~0U))
+#define ERTS_THR_PRGR_BLCKR_UNMANAGED ((erts_aint32_t) (1U << 31))
-#define ERTS_THR_PRGR_BC_FLG_NOT_BLOCKING (((erts_aint32_t) 1) << 31)
+#define ERTS_THR_PRGR_BC_FLG_NOT_BLOCKING ((erts_aint32_t) (1U << 31))
#define ERTS_THR_PRGR_BM_BITS 32
#define ERTS_THR_PRGR_BM_SHIFT 5
@@ -366,13 +321,23 @@ tmp_thr_prgr_data(ErtsSchedulerData *esdp)
ErtsThrPrgrData *tpd = perhaps_thr_prgr_data(esdp);
if (!tpd) {
- /*
- * We only allocate the part up to the wakeup_request field
- * which is the first field only used by registered threads
- */
- tpd = erts_alloc(ERTS_ALC_T_T_THR_PRGR_DATA,
- offsetof(ErtsThrPrgrData, wakeup_request));
- init_tmp_thr_prgr_data(tpd);
+ /*
+ * We only allocate the part up to the wakeup_request field which is
+ * the first field only used by registered threads
+ */
+ size_t alloc_size = offsetof(ErtsThrPrgrData, wakeup_request);
+
+ /* We may land here as a result of unmanaged_delay being called from
+ * the lock counting module, which in turn might be called from within
+ * the allocator, so we use plain malloc to avoid deadlocks. */
+ tpd =
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ malloc(alloc_size);
+#else
+ erts_alloc(ERTS_ALC_T_T_THR_PRGR_DATA, alloc_size);
+#endif
+
+ init_tmp_thr_prgr_data(tpd);
}
return tpd;
@@ -382,8 +347,13 @@ static ERTS_INLINE void
return_tmp_thr_prgr_data(ErtsThrPrgrData *tpd)
{
if (tpd->is_temporary) {
- erts_tsd_set(erts_thr_prgr_data_key__, NULL);
- erts_free(ERTS_ALC_T_T_THR_PRGR_DATA, tpd);
+ erts_tsd_set(erts_thr_prgr_data_key__, NULL);
+
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ free(tpd);
+#else
+ erts_free(ERTS_ALC_T_T_THR_PRGR_DATA, tpd);
+#endif
}
}
@@ -547,7 +517,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;
@@ -569,7 +539,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__);
@@ -592,7 +562,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;
@@ -613,7 +583,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__);
@@ -745,6 +715,7 @@ leader_update(ErtsThrPrgrData *tpd)
tpd->leader_state.chk_next_ix = no_managed;
erts_atomic32_set_nob(&intrnl->misc.data.umrefc_ix.current,
(erts_aint32_t) new_umrefc_ix);
+ tpd->leader_state.umrefc_ix.current = new_umrefc_ix;
ETHR_MEMBAR(ETHR_StoreLoad);
refc = erts_atomic_read_nob(&intrnl->umrefc[umrefc_ix].refc);
ASSERT(refc >= 0);
@@ -1014,8 +985,10 @@ erts_thr_progress_unmanaged_continue__(ErtsThrPrgrDelayHandle handle)
#ifdef ERTS_ENABLE_LOCK_CHECK
ErtsThrPrgrData *tpd = perhaps_thr_prgr_data(NULL);
ERTS_LC_ASSERT(tpd && tpd->is_delaying);
- tpd->is_delaying = 0;
- return_tmp_thr_prgr_data(tpd);
+ tpd->is_delaying--;
+ ASSERT(tpd->is_delaying >= 0);
+ if (!tpd->is_delaying)
+ return_tmp_thr_prgr_data(tpd);
#endif
ASSERT(!erts_thr_progress_is_managed_thread());
@@ -1040,7 +1013,7 @@ erts_thr_progress_unmanaged_delay__(void)
#ifdef ERTS_ENABLE_LOCK_CHECK
{
ErtsThrPrgrData *tpd = tmp_thr_prgr_data(NULL);
- tpd->is_delaying = 1;
+ tpd->is_delaying++;
}
#endif
return (ErtsThrPrgrDelayHandle) umrefc_ix;
@@ -1078,7 +1051,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);
@@ -1147,7 +1120,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;
@@ -1231,7 +1204,7 @@ wakeup_unmanaged_threads(ErtsThrPrgrUnmanagedWakeupData *umwd)
int hbase = hix << ERTS_THR_PRGR_BM_SHIFT;
int hbit;
for (hbit = 0; hbit < ERTS_THR_PRGR_BM_BITS; hbit++) {
- if (hmask & (1 << hbit)) {
+ if (hmask & (1U << hbit)) {
erts_aint_t lmask;
int lix = hbase + hbit;
ASSERT(0 <= lix && lix < umwd->low_sz);
@@ -1240,7 +1213,7 @@ wakeup_unmanaged_threads(ErtsThrPrgrUnmanagedWakeupData *umwd)
int lbase = lix << ERTS_THR_PRGR_BM_SHIFT;
int lbit;
for (lbit = 0; lbit < ERTS_THR_PRGR_BM_BITS; lbit++) {
- if (lmask & (1 << lbit)) {
+ if (lmask & (1U << lbit)) {
int id = lbase + lbit;
wakeup_unmanaged(id);
}
@@ -1381,25 +1354,10 @@ erts_thr_progress_block(void)
thr_progress_block(tmp_thr_prgr_data(NULL), 1);
}
-void
-erts_thr_progress_fatal_error_block(SWord timeout,
- ErtsThrPrgrData *tmp_tpd_bufp)
+int
+erts_thr_progress_fatal_error_block(ErtsThrPrgrData *tmp_tpd_bufp)
{
ErtsThrPrgrData *tpd = perhaps_thr_prgr_data(NULL);
- erts_aint32_t bc;
- SWord time_left = timeout;
- SysTimeval to;
-
- /*
- * Counting poll intervals may give us a too long timeout
- * if cpu is busy. If we got tolerant time of day we use it
- * to prevent this.
- */
- if (!erts_disable_tolerant_timeofday) {
- erts_get_timeval(&to);
- to.tv_sec += timeout / 1000;
- to.tv_sec += timeout % 1000;
- }
if (!tpd) {
/*
@@ -1412,9 +1370,25 @@ erts_thr_progress_fatal_error_block(SWord timeout,
init_tmp_thr_prgr_data(tpd);
}
- bc = thr_progress_block(tpd, 0);
- if (bc == 0)
- return; /* Succefully blocked all managed threads */
+ /* Returns number of threads that have not yes been blocked */
+ return thr_progress_block(tpd, 0);
+}
+
+void
+erts_thr_progress_fatal_error_wait(SWord timeout) {
+ erts_aint32_t bc;
+ SWord time_left = timeout;
+ ErtsMonotonicTime timeout_time;
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
+
+ /*
+ * Counting poll intervals may give us a too long timeout
+ * if cpu is busy. We use timeout time to try to prevent
+ * this. In case we havn't got time correction this may
+ * however fail too...
+ */
+ timeout_time = erts_get_monotonic_time(esdp);
+ timeout_time += ERTS_MSEC_TO_MONOTONIC((ErtsMonotonicTime) timeout);
while (1) {
if (erts_milli_sleep(ERTS_THR_PRGR_FTL_ERR_BLCK_POLL_INTERVAL) == 0)
@@ -1424,14 +1398,8 @@ erts_thr_progress_fatal_error_block(SWord timeout,
break; /* Succefully blocked all managed threads */
if (time_left <= 0)
break; /* Timeout */
- if (!erts_disable_tolerant_timeofday) {
- SysTimeval now;
- erts_get_timeval(&now);
- if (now.tv_sec > to.tv_sec)
- break; /* Timeout */
- if (now.tv_sec == to.tv_sec && now.tv_usec >= to.tv_usec)
- break; /* Timeout */
- }
+ if (timeout_time <= erts_get_monotonic_time(esdp))
+ break; /* Timeout */
}
}
diff --git a/erts/emulator/beam/erl_thr_progress.h b/erts/emulator/beam/erl_thr_progress.h
index 5f392944c2..b2894ba1fe 100644
--- a/erts/emulator/beam/erl_thr_progress.h
+++ b/erts/emulator/beam/erl_thr_progress.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2011-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2011-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -83,8 +84,8 @@ typedef struct {
ErtsThrPrgrLeaderState leader_state;
} ErtsThrPrgrData;
-void erts_thr_progress_fatal_error_block(SWord timeout,
- ErtsThrPrgrData *tmp_tpd_bufp);
+int erts_thr_progress_fatal_error_block(ErtsThrPrgrData *tmp_tpd_bufp);
+void erts_thr_progress_fatal_error_wait(SWord timeout);
#endif /* ERTS_SMP */
@@ -115,11 +116,7 @@ struct ErtsThrPrgrLaterOp_ {
extern erts_tsd_key_t erts_thr_prgr_data_key__;
-#ifdef ARCH_64
-# define ERTS_THR_PRGR_ATOMIC erts_atomic_t
-#else /* ARCH_32 */
-# define ERTS_THR_PRGR_ATOMIC erts_dw_atomic_t
-#endif
+#define ERTS_THR_PRGR_ATOMIC erts_atomic64_t
typedef struct {
void *arg;
@@ -158,10 +155,6 @@ void erts_thr_progress_unmanaged_continue__(int umrefc_ix);
void erts_thr_progress_dbg_print_state(void);
-#ifdef ARCH_32
-#define ERTS_THR_PRGR_ATOMIC erts_dw_atomic_t
-ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_prgr_dw_aint_to_val__(erts_dw_aint_t *dw_aint);
-#endif
ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_prgr_read_nob__(ERTS_THR_PRGR_ATOMIC *atmc);
ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_prgr_read_acqb__(ERTS_THR_PRGR_ATOMIC *atmc);
ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_prgr_read_mb__(ERTS_THR_PRGR_ATOMIC *atmc);
@@ -184,68 +177,24 @@ ERTS_GLB_INLINE int erts_thr_progress_has_reached(ErtsThrPrgrVal val);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
-#ifdef ARCH_64
-
ERTS_GLB_INLINE ErtsThrPrgrVal
erts_thr_prgr_read_nob__(ERTS_THR_PRGR_ATOMIC *atmc)
{
- return (ErtsThrPrgrVal) erts_atomic_read_nob(atmc);
+ return (ErtsThrPrgrVal) erts_atomic64_read_nob(atmc);
}
ERTS_GLB_INLINE ErtsThrPrgrVal
erts_thr_prgr_read_acqb__(ERTS_THR_PRGR_ATOMIC *atmc)
{
- return (ErtsThrPrgrVal) erts_atomic_read_acqb(atmc);
+ return (ErtsThrPrgrVal) erts_atomic64_read_acqb(atmc);
}
ERTS_GLB_INLINE ErtsThrPrgrVal
erts_thr_prgr_read_mb__(ERTS_THR_PRGR_ATOMIC *atmc)
{
- return (ErtsThrPrgrVal) erts_atomic_read_mb(atmc);
-}
-
-#else /* ARCH_32 */
-
-ERTS_GLB_INLINE ErtsThrPrgrVal
-erts_thr_prgr_dw_aint_to_val__(erts_dw_aint_t *dw_aint)
-{
-#ifdef ETHR_SU_DW_NAINT_T__
- return (ErtsThrPrgrVal) dw_aint->dw_sint;
-#else
- ErtsThrPrgrVal res;
- res = (ErtsThrPrgrVal) ((Uint32) dw_aint->sint[ERTS_DW_AINT_HIGH_WORD]);
- res <<= 32;
- res |= (ErtsThrPrgrVal) ((Uint32) dw_aint->sint[ERTS_DW_AINT_LOW_WORD]);
- return res;
-#endif
+ return (ErtsThrPrgrVal) erts_atomic64_read_mb(atmc);
}
-ERTS_GLB_INLINE ErtsThrPrgrVal
-erts_thr_prgr_read_nob__(ERTS_THR_PRGR_ATOMIC *atmc)
-{
- erts_dw_aint_t dw_aint;
- erts_dw_atomic_read_nob(atmc, &dw_aint);
- return erts_thr_prgr_dw_aint_to_val__(&dw_aint);
-}
-
-ERTS_GLB_INLINE ErtsThrPrgrVal
-erts_thr_prgr_read_acqb__(ERTS_THR_PRGR_ATOMIC *atmc)
-{
- erts_dw_aint_t dw_aint;
- erts_dw_atomic_read_acqb(atmc, &dw_aint);
- return erts_thr_prgr_dw_aint_to_val__(&dw_aint);
-}
-
-ERTS_GLB_INLINE ErtsThrPrgrVal
-erts_thr_prgr_read_mb__(ERTS_THR_PRGR_ATOMIC *atmc)
-{
- erts_dw_aint_t dw_aint;
- erts_dw_atomic_read_mb(atmc, &dw_aint);
- return erts_thr_prgr_dw_aint_to_val__(&dw_aint);
-}
-
-#endif
-
ERTS_GLB_INLINE int
erts_thr_progress_is_managed_thread(void)
{
diff --git a/erts/emulator/beam/erl_thr_queue.c b/erts/emulator/beam/erl_thr_queue.c
index f8ca87ddcc..f56d0828dd 100644
--- a/erts/emulator/beam/erl_thr_queue.c
+++ b/erts/emulator/beam/erl_thr_queue.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2011-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2011-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -223,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);
}
@@ -588,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);
@@ -770,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
@@ -779,3 +780,35 @@ erts_thr_q_dequeue(ErtsThrQ_t *q)
return res;
#endif
}
+
+#ifdef USE_LTTNG_VM_TRACEPOINTS
+int
+erts_thr_q_length_dirty(ErtsThrQ_t *q)
+{
+ int n = 0;
+#ifndef USE_THREADS
+ void *res;
+ ErtsThrQElement_t *tmp;
+
+ for (tmp = q->first; tmp != NULL; tmp = tmp->next) {
+ n++;
+ }
+#else
+ ErtsThrQElement_t *e;
+ erts_aint_t inext;
+
+ e = ErtsThrQDirtyReadEl(&q->head.head);
+ inext = erts_atomic_read_acqb(&e->next);
+
+ while (inext != ERTS_AINT_NULL) {
+ e = (ErtsThrQElement_t *) inext;
+ if (e != &q->tail.data.marker) {
+ /* don't count marker */
+ n++;
+ }
+ inext = erts_atomic_read_acqb(&e->next);
+ }
+#endif
+ return n;
+}
+#endif
diff --git a/erts/emulator/beam/erl_thr_queue.h b/erts/emulator/beam/erl_thr_queue.h
index 13af758b3f..705a67af4c 100644
--- a/erts/emulator/beam/erl_thr_queue.h
+++ b/erts/emulator/beam/erl_thr_queue.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2011-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2011-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -189,6 +190,10 @@ void erts_thr_q_append_finalize_dequeue_data(ErtsThrQFinDeQ_t *,
int erts_thr_q_finalize_dequeue(ErtsThrQFinDeQ_t *);
void erts_thr_q_finalize_dequeue_state_init(ErtsThrQFinDeQ_t *);
+#ifdef USE_LTTNG_VM_TRACEPOINTS
+int erts_thr_q_length_dirty(ErtsThrQ_t *);
+#endif
+
#ifdef ERTS_SMP
ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_q_need_thr_progress(ErtsThrQ_t *q);
#endif
diff --git a/erts/emulator/beam/erl_threads.h b/erts/emulator/beam/erl_threads.h
index 80026104db..8b5c17d739 100644
--- a/erts/emulator/beam/erl_threads.h
+++ b/erts/emulator/beam/erl_threads.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -258,13 +259,16 @@
#include "sys.h"
+#include "erl_lock_flags.h"
+#include "erl_term.h"
+
#ifdef USE_THREADS
#define ETHR_TRY_INLINE_FUNCS
#include "ethread.h"
+
#include "erl_lock_check.h"
#include "erl_lock_count.h"
-#include "erl_term.h"
#if defined(__GLIBC__) && (__GLIBC__ << 16) + __GLIBC_MINOR__ < (2 << 16) + 4
/*
@@ -306,9 +310,11 @@ typedef struct {
erts_lc_lock_t lc;
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_lock_t lcnt;
+ erts_lcnt_ref_t lcnt;
+#endif
+#ifdef DEBUG
+ erts_lock_flags_t flags;
#endif
-
} erts_mtx_t;
typedef ethr_cond erts_cnd_t;
@@ -319,7 +325,10 @@ typedef struct {
erts_lc_lock_t lc;
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_lock_t lcnt;
+ erts_lcnt_ref_t lcnt;
+#endif
+#ifdef DEBUG
+ erts_lock_flags_t flags;
#endif
} erts_rwmtx_t;
@@ -344,6 +353,16 @@ typedef ethr_ts_event erts_tse_t;
#define erts_aint32_t ethr_sint32_t
#define erts_atomic32_t ethr_atomic32_t
+#if defined(ARCH_32)
+# define erts_atomic64_t ethr_dw_atomic_t
+# define erts_aint64_t ethr_sint64_t
+#elif defined(ARCH_64)
+# define erts_atomic64_t ethr_atomic_t
+# define erts_aint64_t ethr_sint_t
+#else
+# error "Not supported architecture"
+#endif
+
#define ERTS_DW_AINT_HIGH_WORD ETHR_DW_SINT_HIGH_WORD
#define ERTS_DW_AINT_LOW_WORD ETHR_DW_SINT_LOW_WORD
@@ -354,7 +373,10 @@ typedef struct {
erts_lc_lock_t lc;
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_lock_t lcnt;
+ erts_lcnt_ref_t lcnt;
+#endif
+#ifdef DEBUG
+ erts_lock_flags_t flags;
#endif
} erts_spinlock_t;
@@ -365,7 +387,10 @@ typedef struct {
erts_lc_lock_t lc;
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_lock_t lcnt;
+ erts_lcnt_ref_t lcnt;
+#endif
+#ifdef DEBUG
+ erts_lock_flags_t flags;
#endif
} erts_rwlock_t;
@@ -414,10 +439,12 @@ typedef int erts_tse_t;
typedef struct { SWord sint[2]; } erts_dw_aint_t;
typedef SWord erts_aint_t;
typedef Sint32 erts_aint32_t;
+typedef Sint64 erts_aint64_t;
#define erts_dw_atomic_t erts_dw_aint_t
#define erts_atomic_t erts_aint_t
#define erts_atomic32_t erts_aint32_t
+#define erts_atomic64_t erts_aint64_t
#if __GNUC__ > 2
typedef struct { } erts_spinlock_t;
@@ -446,6 +473,7 @@ typedef struct { int gcc_is_buggy; } erts_rwlock_t;
#define erts_no_dw_atomic_t erts_dw_aint_t
#define erts_no_atomic_t erts_aint_t
#define erts_no_atomic32_t erts_aint32_t
+#define erts_no_atomic64_t erts_aint64_t
#define ERTS_AINT_NULL ((erts_aint_t) NULL)
@@ -463,17 +491,16 @@ ERTS_GLB_INLINE void erts_thr_detach(erts_tid_t tid);
ERTS_GLB_INLINE void erts_thr_exit(void *res);
ERTS_GLB_INLINE void erts_thr_install_exit_handler(void (*exit_handler)(void));
ERTS_GLB_INLINE erts_tid_t erts_thr_self(void);
+ERTS_GLB_INLINE int erts_thr_getname(erts_tid_t tid, char *buf, size_t len);
ERTS_GLB_INLINE int erts_equal_tids(erts_tid_t x, erts_tid_t y);
-ERTS_GLB_INLINE void erts_mtx_init_x(erts_mtx_t *mtx, char *name, Eterm extra,
- int enable_lcnt);
-ERTS_GLB_INLINE void erts_mtx_init_x_opt(erts_mtx_t *mtx, char *name, Eterm extra,
- Uint16 opt, int enable_lcnt);
-ERTS_GLB_INLINE void erts_mtx_init_locked_x(erts_mtx_t *mtx,
- char *name,
- Eterm extra,
- int enable_lcnt);
-ERTS_GLB_INLINE void erts_mtx_init(erts_mtx_t *mtx, char *name);
-ERTS_GLB_INLINE void erts_mtx_init_locked(erts_mtx_t *mtx, char *name);
+ERTS_GLB_INLINE void erts_mtx_init(erts_mtx_t *mtx,
+ char *name,
+ Eterm extra,
+ erts_lock_flags_t flags);
+ERTS_GLB_INLINE void erts_mtx_init_locked(erts_mtx_t *mtx,
+ char *name,
+ Eterm extra,
+ erts_lock_flags_t flags);
ERTS_GLB_INLINE void erts_mtx_destroy(erts_mtx_t *mtx);
#ifdef ERTS_ENABLE_LOCK_POSITION
ERTS_GLB_INLINE int erts_mtx_trylock_x(erts_mtx_t *mtx, char *file,
@@ -492,18 +519,15 @@ ERTS_GLB_INLINE void erts_cnd_wait(erts_cnd_t *cnd, erts_mtx_t *mtx);
ERTS_GLB_INLINE void erts_cnd_signal(erts_cnd_t *cnd);
ERTS_GLB_INLINE void erts_cnd_broadcast(erts_cnd_t *cnd);
ERTS_GLB_INLINE void erts_rwmtx_set_reader_group(int no);
-ERTS_GLB_INLINE void erts_rwmtx_init_opt_x(erts_rwmtx_t *rwmtx,
- erts_rwmtx_opt_t *opt,
- char *name,
- Eterm extra);
-ERTS_GLB_INLINE void erts_rwmtx_init_x(erts_rwmtx_t *rwmtx,
- char *name,
- Eterm extra);
ERTS_GLB_INLINE void erts_rwmtx_init_opt(erts_rwmtx_t *rwmtx,
- erts_rwmtx_opt_t *opt,
- char *name);
+ erts_rwmtx_opt_t *opt,
+ char *name,
+ Eterm extra,
+ erts_lock_flags_t flags);
ERTS_GLB_INLINE void erts_rwmtx_init(erts_rwmtx_t *rwmtx,
- char *name);
+ char *name,
+ Eterm extra,
+ erts_lock_flags_t flags);
ERTS_GLB_INLINE void erts_rwmtx_destroy(erts_rwmtx_t *rwmtx);
#ifdef ERTS_ENABLE_LOCK_POSITION
ERTS_GLB_INLINE int erts_rwmtx_tryrlock_x(erts_rwmtx_t *rwmtx, char *file, unsigned int line);
@@ -570,16 +594,33 @@ ERTS_GLB_INLINE erts_aint32_t erts_no_atomic32_cmpxchg(erts_no_atomic32_t *xchgp
ERTS_GLB_INLINE erts_aint32_t erts_no_atomic32_read_bset(erts_no_atomic32_t *var,
erts_aint32_t mask,
erts_aint32_t set);
-
-ERTS_GLB_INLINE void erts_spinlock_init_x_opt(erts_spinlock_t *lock,
- char *name,
- Eterm extra,
- Uint16 opt);
-ERTS_GLB_INLINE void erts_spinlock_init_x(erts_spinlock_t *lock,
- char *name,
- Eterm extra);
+ERTS_GLB_INLINE void erts_no_atomic64_set(erts_no_atomic64_t *var,
+ erts_aint64_t i);
+ERTS_GLB_INLINE erts_aint64_t erts_no_atomic64_read(erts_no_atomic64_t *var);
+ERTS_GLB_INLINE erts_aint64_t erts_no_atomic64_inc_read(erts_no_atomic64_t *incp);
+ERTS_GLB_INLINE erts_aint64_t erts_no_atomic64_dec_read(erts_no_atomic64_t *decp);
+ERTS_GLB_INLINE void erts_no_atomic64_inc(erts_no_atomic64_t *incp);
+ERTS_GLB_INLINE void erts_no_atomic64_dec(erts_no_atomic64_t *decp);
+ERTS_GLB_INLINE erts_aint64_t erts_no_atomic64_add_read(erts_no_atomic64_t *addp,
+ erts_aint64_t i);
+ERTS_GLB_INLINE void erts_no_atomic64_add(erts_no_atomic64_t *addp,
+ erts_aint64_t i);
+ERTS_GLB_INLINE erts_aint64_t erts_no_atomic64_read_bor(erts_no_atomic64_t *var,
+ erts_aint64_t mask);
+ERTS_GLB_INLINE erts_aint64_t erts_no_atomic64_read_band(erts_no_atomic64_t *var,
+ erts_aint64_t mask);
+ERTS_GLB_INLINE erts_aint64_t erts_no_atomic64_xchg(erts_no_atomic64_t *xchgp,
+ erts_aint64_t new);
+ERTS_GLB_INLINE erts_aint64_t erts_no_atomic64_cmpxchg(erts_no_atomic64_t *xchgp,
+ erts_aint64_t new,
+ erts_aint64_t expected);
+ERTS_GLB_INLINE erts_aint64_t erts_no_atomic64_read_bset(erts_no_atomic64_t *var,
+ erts_aint64_t mask,
+ erts_aint64_t set);
ERTS_GLB_INLINE void erts_spinlock_init(erts_spinlock_t *lock,
- char *name);
+ char *name,
+ Eterm extra,
+ erts_lock_flags_t flags);
ERTS_GLB_INLINE void erts_spinlock_destroy(erts_spinlock_t *lock);
ERTS_GLB_INLINE void erts_spin_unlock(erts_spinlock_t *lock);
#ifdef ERTS_ENABLE_LOCK_POSITION
@@ -588,11 +629,10 @@ ERTS_GLB_INLINE void erts_spin_lock_x(erts_spinlock_t *lock, char *file, unsigne
ERTS_GLB_INLINE void erts_spin_lock(erts_spinlock_t *lock);
#endif
ERTS_GLB_INLINE int erts_lc_spinlock_is_locked(erts_spinlock_t *lock);
-ERTS_GLB_INLINE void erts_rwlock_init_x(erts_rwlock_t *lock,
- char *name,
- Eterm extra);
ERTS_GLB_INLINE void erts_rwlock_init(erts_rwlock_t *lock,
- char *name);
+ char *name,
+ Eterm extra,
+ erts_lock_flags_t flags);
ERTS_GLB_INLINE void erts_rwlock_destroy(erts_rwlock_t *lock);
ERTS_GLB_INLINE void erts_read_unlock(erts_rwlock_t *lock);
#ifdef ERTS_ENABLE_LOCK_POSITION
@@ -611,20 +651,29 @@ ERTS_GLB_INLINE void erts_tsd_set(erts_tsd_key_t key, void *value);
ERTS_GLB_INLINE void * erts_tsd_get(erts_tsd_key_t key);
ERTS_GLB_INLINE erts_tse_t *erts_tse_fetch(void);
ERTS_GLB_INLINE void erts_tse_return(erts_tse_t *ep);
+ERTS_GLB_INLINE void erts_tse_prepare_timed(erts_tse_t *ep);
ERTS_GLB_INLINE void erts_tse_set(erts_tse_t *ep);
ERTS_GLB_INLINE void erts_tse_reset(erts_tse_t *ep);
ERTS_GLB_INLINE int erts_tse_wait(erts_tse_t *ep);
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);
+ERTS_GLB_INLINE int erts_tse_stwait(erts_tse_t *ep, int spincount, Sint64 tmo);
ERTS_GLB_INLINE int erts_tse_is_tmp(erts_tse_t *ep);
ERTS_GLB_INLINE void erts_thr_set_main_status(int, int);
ERTS_GLB_INLINE int erts_thr_get_main_status(void);
ERTS_GLB_INLINE void erts_thr_yield(void);
+
#ifdef ETHR_HAVE_ETHR_SIG_FUNCS
#define ERTS_THR_HAVE_SIG_FUNCS 1
ERTS_GLB_INLINE void erts_thr_sigmask(int how, const sigset_t *set,
sigset_t *oset);
ERTS_GLB_INLINE void erts_thr_sigwait(const sigset_t *set, int *sig);
+
+#ifdef USE_THREADS
+ERTS_GLB_INLINE void erts_thr_kill(erts_tid_t tid, int sig);
+#endif
+
#endif /* #ifdef HAVE_ETHR_SIG_FUNCS */
#ifdef USE_THREADS
@@ -1200,6 +1249,441 @@ erts_atomic32_read_dirty(erts_atomic32_t *var)
#endif
+/* 64-bit atomics */
+
+#if defined(ARCH_64)
+
+#define erts_atomic64_init_nob ethr_atomic_init
+#define erts_atomic64_set_nob ethr_atomic_set
+#define erts_atomic64_read_nob ethr_atomic_read
+#define erts_atomic64_inc_read_nob ethr_atomic_inc_read
+#define erts_atomic64_dec_read_nob ethr_atomic_dec_read
+#define erts_atomic64_inc_nob ethr_atomic_inc
+#define erts_atomic64_dec_nob ethr_atomic_dec
+#define erts_atomic64_add_read_nob ethr_atomic_add_read
+#define erts_atomic64_add_nob ethr_atomic_add
+#define erts_atomic64_read_bor_nob ethr_atomic_read_bor
+#define erts_atomic64_read_band_nob ethr_atomic_read_band
+#define erts_atomic64_xchg_nob ethr_atomic_xchg
+#define erts_atomic64_cmpxchg_nob ethr_atomic_cmpxchg
+#define erts_atomic64_read_bset_nob erts_atomic_read_bset_nob
+
+#define erts_atomic64_init_mb ethr_atomic_init_mb
+#define erts_atomic64_set_mb ethr_atomic_set_mb
+#define erts_atomic64_read_mb ethr_atomic_read_mb
+#define erts_atomic64_inc_read_mb ethr_atomic_inc_read_mb
+#define erts_atomic64_dec_read_mb ethr_atomic_dec_read_mb
+#define erts_atomic64_inc_mb ethr_atomic_inc_mb
+#define erts_atomic64_dec_mb ethr_atomic_dec_mb
+#define erts_atomic64_add_read_mb ethr_atomic_add_read_mb
+#define erts_atomic64_add_mb ethr_atomic_add_mb
+#define erts_atomic64_read_bor_mb ethr_atomic_read_bor_mb
+#define erts_atomic64_read_band_mb ethr_atomic_read_band_mb
+#define erts_atomic64_xchg_mb ethr_atomic_xchg_mb
+#define erts_atomic64_cmpxchg_mb ethr_atomic_cmpxchg_mb
+#define erts_atomic64_read_bset_mb erts_atomic_read_bset_mb
+
+#define erts_atomic64_init_acqb ethr_atomic_init_acqb
+#define erts_atomic64_set_acqb ethr_atomic_set_acqb
+#define erts_atomic64_read_acqb ethr_atomic_read_acqb
+#define erts_atomic64_inc_read_acqb ethr_atomic_inc_read_acqb
+#define erts_atomic64_dec_read_acqb ethr_atomic_dec_read_acqb
+#define erts_atomic64_inc_acqb ethr_atomic_inc_acqb
+#define erts_atomic64_dec_acqb ethr_atomic_dec_acqb
+#define erts_atomic64_add_read_acqb ethr_atomic_add_read_acqb
+#define erts_atomic64_add_acqb ethr_atomic_add_acqb
+#define erts_atomic64_read_bor_acqb ethr_atomic_read_bor_acqb
+#define erts_atomic64_read_band_acqb ethr_atomic_read_band_acqb
+#define erts_atomic64_xchg_acqb ethr_atomic_xchg_acqb
+#define erts_atomic64_cmpxchg_acqb ethr_atomic_cmpxchg_acqb
+#define erts_atomic64_read_bset_acqb erts_atomic_read_bset_acqb
+
+#define erts_atomic64_init_relb ethr_atomic_init_relb
+#define erts_atomic64_set_relb ethr_atomic_set_relb
+#define erts_atomic64_read_relb ethr_atomic_read_relb
+#define erts_atomic64_inc_read_relb ethr_atomic_inc_read_relb
+#define erts_atomic64_dec_read_relb ethr_atomic_dec_read_relb
+#define erts_atomic64_inc_relb ethr_atomic_inc_relb
+#define erts_atomic64_dec_relb ethr_atomic_dec_relb
+#define erts_atomic64_add_read_relb ethr_atomic_add_read_relb
+#define erts_atomic64_add_relb ethr_atomic_add_relb
+#define erts_atomic64_read_bor_relb ethr_atomic_read_bor_relb
+#define erts_atomic64_read_band_relb ethr_atomic_read_band_relb
+#define erts_atomic64_xchg_relb ethr_atomic_xchg_relb
+#define erts_atomic64_cmpxchg_relb ethr_atomic_cmpxchg_relb
+#define erts_atomic64_read_bset_relb erts_atomic_read_bset_relb
+
+#define erts_atomic64_init_ddrb ethr_atomic_init_ddrb
+#define erts_atomic64_set_ddrb ethr_atomic_set_ddrb
+#define erts_atomic64_read_ddrb ethr_atomic_read_ddrb
+#define erts_atomic64_inc_read_ddrb ethr_atomic_inc_read_ddrb
+#define erts_atomic64_dec_read_ddrb ethr_atomic_dec_read_ddrb
+#define erts_atomic64_inc_ddrb ethr_atomic_inc_ddrb
+#define erts_atomic64_dec_ddrb ethr_atomic_dec_ddrb
+#define erts_atomic64_add_read_ddrb ethr_atomic_add_read_ddrb
+#define erts_atomic64_add_ddrb ethr_atomic_add_ddrb
+#define erts_atomic64_read_bor_ddrb ethr_atomic_read_bor_ddrb
+#define erts_atomic64_read_band_ddrb ethr_atomic_read_band_ddrb
+#define erts_atomic64_xchg_ddrb ethr_atomic_xchg_ddrb
+#define erts_atomic64_cmpxchg_ddrb ethr_atomic_cmpxchg_ddrb
+#define erts_atomic64_read_bset_ddrb erts_atomic_read_bset_ddrb
+
+#define erts_atomic64_init_rb ethr_atomic_init_rb
+#define erts_atomic64_set_rb ethr_atomic_set_rb
+#define erts_atomic64_read_rb ethr_atomic_read_rb
+#define erts_atomic64_inc_read_rb ethr_atomic_inc_read_rb
+#define erts_atomic64_dec_read_rb ethr_atomic_dec_read_rb
+#define erts_atomic64_inc_rb ethr_atomic_inc_rb
+#define erts_atomic64_dec_rb ethr_atomic_dec_rb
+#define erts_atomic64_add_read_rb ethr_atomic_add_read_rb
+#define erts_atomic64_add_rb ethr_atomic_add_rb
+#define erts_atomic64_read_bor_rb ethr_atomic_read_bor_rb
+#define erts_atomic64_read_band_rb ethr_atomic_read_band_rb
+#define erts_atomic64_xchg_rb ethr_atomic_xchg_rb
+#define erts_atomic64_cmpxchg_rb ethr_atomic_cmpxchg_rb
+#define erts_atomic64_read_bset_rb erts_atomic_read_bset_rb
+
+#define erts_atomic64_init_wb ethr_atomic_init_wb
+#define erts_atomic64_set_wb ethr_atomic_set_wb
+#define erts_atomic64_read_wb ethr_atomic_read_wb
+#define erts_atomic64_inc_read_wb ethr_atomic_inc_read_wb
+#define erts_atomic64_dec_read_wb ethr_atomic_dec_read_wb
+#define erts_atomic64_inc_wb ethr_atomic_inc_wb
+#define erts_atomic64_dec_wb ethr_atomic_dec_wb
+#define erts_atomic64_add_read_wb ethr_atomic_add_read_wb
+#define erts_atomic64_add_wb ethr_atomic_add_wb
+#define erts_atomic64_read_bor_wb ethr_atomic_read_bor_wb
+#define erts_atomic64_read_band_wb ethr_atomic_read_band_wb
+#define erts_atomic64_xchg_wb ethr_atomic_xchg_wb
+#define erts_atomic64_cmpxchg_wb ethr_atomic_cmpxchg_wb
+#define erts_atomic64_read_bset_wb erts_atomic_read_bset_wb
+
+#define erts_atomic64_set_dirty erts_atomic_set_dirty
+#define erts_atomic64_read_dirty erts_atomic_read_dirty
+
+#elif defined(ARCH_32)
+
+#undef ERTS_ATOMIC64_OPS_DECL__
+
+#define ERTS_ATOMIC64_OPS_DECL__(BARRIER) \
+ERTS_GLB_INLINE void \
+erts_atomic64_init_ ## BARRIER(erts_atomic64_t *var, \
+ erts_aint64_t val); \
+ERTS_GLB_INLINE void \
+erts_atomic64_set_ ## BARRIER(erts_atomic64_t *var, \
+ erts_aint64_t val); \
+ERTS_GLB_INLINE erts_aint64_t \
+erts_atomic64_read_ ## BARRIER(erts_atomic64_t *var); \
+ERTS_GLB_INLINE erts_aint64_t \
+erts_atomic64_inc_read_ ## BARRIER(erts_atomic64_t *var); \
+ERTS_GLB_INLINE erts_aint64_t \
+erts_atomic64_dec_read_ ## BARRIER(erts_atomic64_t *var); \
+ERTS_GLB_INLINE void \
+erts_atomic64_inc_ ## BARRIER(erts_atomic64_t *var); \
+ERTS_GLB_INLINE void \
+erts_atomic64_dec_ ## BARRIER(erts_atomic64_t *var); \
+ERTS_GLB_INLINE erts_aint64_t \
+erts_atomic64_add_read_ ## BARRIER(erts_atomic64_t *var, \
+ erts_aint64_t val); \
+ERTS_GLB_INLINE void \
+erts_atomic64_add_ ## BARRIER(erts_atomic64_t *var, \
+ erts_aint64_t val); \
+ERTS_GLB_INLINE erts_aint64_t \
+erts_atomic64_read_bor_ ## BARRIER(erts_atomic64_t *var, \
+ erts_aint64_t val); \
+ERTS_GLB_INLINE erts_aint64_t \
+erts_atomic64_read_band_ ## BARRIER(erts_atomic64_t *var, \
+ erts_aint64_t val); \
+ERTS_GLB_INLINE erts_aint64_t \
+erts_atomic64_xchg_ ## BARRIER(erts_atomic64_t *var, \
+ erts_aint64_t val); \
+ERTS_GLB_INLINE erts_aint64_t \
+erts_atomic64_cmpxchg_ ## BARRIER(erts_atomic64_t *var, \
+ erts_aint64_t new, \
+ erts_aint64_t exp); \
+ERTS_GLB_INLINE erts_aint64_t \
+erts_atomic64_read_bset_ ## BARRIER(erts_atomic64_t *var, \
+ erts_aint64_t mask, \
+ erts_aint64_t set)
+
+ERTS_ATOMIC64_OPS_DECL__(nob);
+ERTS_ATOMIC64_OPS_DECL__(mb);
+ERTS_ATOMIC64_OPS_DECL__(acqb);
+ERTS_ATOMIC64_OPS_DECL__(relb);
+ERTS_ATOMIC64_OPS_DECL__(ddrb);
+ERTS_ATOMIC64_OPS_DECL__(rb);
+ERTS_ATOMIC64_OPS_DECL__(wb);
+
+#undef ERTS_ATOMIC64_OPS_DECL__
+
+ERTS_GLB_INLINE void
+erts_atomic64_set_dirty(erts_atomic64_t *var, erts_aint64_t val);
+ERTS_GLB_INLINE erts_aint64_t
+erts_atomic64_read_dirty(erts_atomic64_t *var);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+/*
+ * The ethr_dw_atomic_*_nob() functions below
+ * are here to make it possible for the
+ * ERTS_ATOMIC64_OPS_IMPL__() to map erts
+ * barriers to ethread barriers...
+ */
+static ERTS_INLINE void
+ethr_dw_atomic_init_nob(ethr_dw_atomic_t *var,
+ ethr_dw_sint_t *val)
+{
+ ethr_dw_atomic_init(var, val);
+}
+
+static ERTS_INLINE void
+ethr_dw_atomic_set_nob(ethr_dw_atomic_t *var,
+ ethr_dw_sint_t *val)
+{
+ ethr_dw_atomic_set(var, val);
+}
+
+static ERTS_INLINE void
+ethr_dw_atomic_read_nob(ethr_dw_atomic_t *var,
+ ethr_dw_sint_t *val)
+{
+ ethr_dw_atomic_read(var, val);
+}
+
+static ERTS_INLINE int
+ethr_dw_atomic_cmpxchg_nob(ethr_dw_atomic_t *var,
+ ethr_dw_sint_t *new,
+ ethr_dw_sint_t *xchg)
+{
+ return ethr_dw_atomic_cmpxchg(var, new, xchg);
+}
+
+#undef ERTS_ATOMIC64_OPS_IMPL__
+#undef ERTS_ATOMIC64_DW_CMPXCHG_IMPL__
+#undef ERTS_DW_SINT_TO_AINT64__
+#undef ERTS_AINT64_TO_DW_SINT__
+
+#ifdef ETHR_SU_DW_NAINT_T__
+#define ERTS_DW_SINT_TO_AINT64__(DW) \
+ ((erts_aint64_t) DW.dw_sint)
+#define ERTS_AINT64_TO_DW_SINT__(DW, AINT64) \
+ (DW.dw_sint = (ETHR_SU_DW_NAINT_T__) AINT64)
+#else /* !ETHR_SU_DW_NAINT_T__ */
+#define ERTS_DW_SINT_TO_AINT64__(DW) \
+ ((((erts_aint64_t) DW.sint[ETHR_DW_SINT_HIGH_WORD]) << 32) \
+ | (((erts_aint64_t) DW.sint[ETHR_DW_SINT_LOW_WORD]) \
+ & ((erts_aint64_t) 0xffffffff)))
+#define ERTS_AINT64_TO_DW_SINT__(DW, AINT64) \
+ do { \
+ DW.sint[ETHR_DW_SINT_LOW_WORD] = \
+ (ethr_sint_t) (AINT64 & 0xffffffff); \
+ DW.sint[ETHR_DW_SINT_HIGH_WORD] = \
+ (ethr_sint_t) ((AINT64 >> 32) & 0xffffffff); \
+ } while (0)
+#endif /* !ETHR_SU_DW_NAINT_T__ */
+
+#define ERTS_ATOMIC64_DW_CMPXCHG_IMPL__(CmpXchgOp, \
+ AVarP, XchgVar, NewVar, \
+ ModificationCode) \
+do { \
+ ethr_dw_sint_t dw_xchg__, dw_new__; \
+ ethr_dw_atomic_read(AVarP, &dw_xchg__); \
+ do { \
+ XchgVar = ERTS_DW_SINT_TO_AINT64__(dw_xchg__); \
+ { \
+ ModificationCode; \
+ } \
+ ERTS_AINT64_TO_DW_SINT__(dw_new__, NewVar); \
+ } while (!CmpXchgOp((AVarP), &dw_new__, &dw_xchg__)); \
+} while (0)
+
+#define ERTS_ATOMIC64_OPS_IMPL__(BARRIER) \
+ \
+ERTS_GLB_INLINE void \
+erts_atomic64_init_ ## BARRIER(erts_atomic64_t *var, \
+ erts_aint64_t val) \
+{ \
+ ethr_dw_sint_t dw; \
+ ERTS_AINT64_TO_DW_SINT__(dw, val); \
+ ethr_dw_atomic_init_ ## BARRIER(var, &dw); \
+} \
+ \
+ERTS_GLB_INLINE void \
+erts_atomic64_set_ ## BARRIER(erts_atomic64_t *var, \
+ erts_aint64_t val) \
+{ \
+ ethr_dw_sint_t dw; \
+ ERTS_AINT64_TO_DW_SINT__(dw, val); \
+ ethr_dw_atomic_set_ ## BARRIER(var, &dw); \
+} \
+ \
+ERTS_GLB_INLINE erts_aint64_t \
+erts_atomic64_read_ ## BARRIER(erts_atomic64_t *var) \
+{ \
+ ethr_dw_sint_t dw; \
+ ethr_dw_atomic_read_ ## BARRIER(var, &dw); \
+ return ERTS_DW_SINT_TO_AINT64__(dw); \
+} \
+ \
+ERTS_GLB_INLINE erts_aint64_t \
+erts_atomic64_inc_read_ ## BARRIER(erts_atomic64_t *var) \
+{ \
+ erts_aint64_t xchg, new; \
+ ERTS_ATOMIC64_DW_CMPXCHG_IMPL__(ethr_dw_atomic_cmpxchg_ ## BARRIER, \
+ var, xchg, new, \
+ new = xchg + 1); \
+ return new; \
+} \
+ \
+ERTS_GLB_INLINE erts_aint64_t \
+erts_atomic64_dec_read_ ## BARRIER(erts_atomic64_t *var) \
+{ \
+ erts_aint64_t xchg, new; \
+ ERTS_ATOMIC64_DW_CMPXCHG_IMPL__(ethr_dw_atomic_cmpxchg_ ## BARRIER, \
+ var, xchg, new, \
+ new = xchg - 1); \
+ return new; \
+} \
+ \
+ERTS_GLB_INLINE void \
+erts_atomic64_inc_ ## BARRIER(erts_atomic64_t *var) \
+{ \
+ erts_aint64_t xchg, new; \
+ ERTS_ATOMIC64_DW_CMPXCHG_IMPL__(ethr_dw_atomic_cmpxchg_ ## BARRIER, \
+ var, xchg, new, \
+ new = xchg + 1); \
+} \
+ \
+ERTS_GLB_INLINE void \
+erts_atomic64_dec_ ## BARRIER(erts_atomic64_t *var) \
+{ \
+ erts_aint64_t xchg, new; \
+ ERTS_ATOMIC64_DW_CMPXCHG_IMPL__(ethr_dw_atomic_cmpxchg_ ## BARRIER, \
+ var, xchg, new, \
+ new = xchg - 1); \
+} \
+ \
+ERTS_GLB_INLINE erts_aint64_t \
+erts_atomic64_add_read_ ## BARRIER(erts_atomic64_t *var, \
+ erts_aint64_t val) \
+{ \
+ erts_aint64_t xchg, new; \
+ ERTS_ATOMIC64_DW_CMPXCHG_IMPL__(ethr_dw_atomic_cmpxchg_ ## BARRIER, \
+ var, xchg, new, \
+ new = xchg + val); \
+ return new; \
+} \
+ \
+ERTS_GLB_INLINE void \
+erts_atomic64_add_ ## BARRIER(erts_atomic64_t *var, \
+ erts_aint64_t val) \
+{ \
+ erts_aint64_t xchg, new; \
+ ERTS_ATOMIC64_DW_CMPXCHG_IMPL__(ethr_dw_atomic_cmpxchg_ ## BARRIER, \
+ var, xchg, new, \
+ new = xchg + val); \
+} \
+ \
+ERTS_GLB_INLINE erts_aint64_t \
+erts_atomic64_read_bor_ ## BARRIER(erts_atomic64_t *var, \
+ erts_aint64_t val) \
+{ \
+ erts_aint64_t xchg, new; \
+ ERTS_ATOMIC64_DW_CMPXCHG_IMPL__(ethr_dw_atomic_cmpxchg_ ## BARRIER, \
+ var, xchg, new, \
+ new = xchg | val); \
+ return xchg; \
+} \
+ \
+ERTS_GLB_INLINE erts_aint64_t \
+erts_atomic64_read_band_ ## BARRIER(erts_atomic64_t *var, \
+ erts_aint64_t val) \
+{ \
+ erts_aint64_t xchg, new; \
+ ERTS_ATOMIC64_DW_CMPXCHG_IMPL__(ethr_dw_atomic_cmpxchg_ ## BARRIER, \
+ var, xchg, new, \
+ new = xchg & val); \
+ return xchg; \
+} \
+ \
+ERTS_GLB_INLINE erts_aint64_t \
+erts_atomic64_xchg_ ## BARRIER(erts_atomic64_t *var, \
+ erts_aint64_t val) \
+{ \
+ erts_aint64_t xchg, new; \
+ ERTS_ATOMIC64_DW_CMPXCHG_IMPL__(ethr_dw_atomic_cmpxchg_ ## BARRIER, \
+ var, xchg, new, \
+ new = val); \
+ return xchg; \
+} \
+ \
+ERTS_GLB_INLINE erts_aint64_t \
+erts_atomic64_cmpxchg_ ## BARRIER(erts_atomic64_t *var, \
+ erts_aint64_t new, \
+ erts_aint64_t exp) \
+{ \
+ ethr_dw_sint_t dw_xchg, dw_new; \
+ ERTS_AINT64_TO_DW_SINT__(dw_xchg, exp); \
+ ERTS_AINT64_TO_DW_SINT__(dw_new, new); \
+ if (ethr_dw_atomic_cmpxchg_ ## BARRIER(var, &dw_new, &dw_xchg)) \
+ return exp; \
+ return ERTS_DW_SINT_TO_AINT64__(dw_xchg); \
+} \
+ \
+ERTS_GLB_INLINE erts_aint64_t \
+erts_atomic64_read_bset_ ## BARRIER(erts_atomic64_t *var, \
+ erts_aint64_t mask, \
+ erts_aint64_t set) \
+{ \
+ erts_aint64_t xchg, new; \
+ ERTS_ATOMIC64_DW_CMPXCHG_IMPL__(ethr_dw_atomic_cmpxchg_ ## BARRIER, \
+ var, xchg, new, \
+ { \
+ new = xchg & ~mask; \
+ new |= mask & set; \
+ }); \
+ return xchg; \
+}
+
+ERTS_ATOMIC64_OPS_IMPL__(nob)
+ERTS_ATOMIC64_OPS_IMPL__(mb)
+ERTS_ATOMIC64_OPS_IMPL__(acqb)
+ERTS_ATOMIC64_OPS_IMPL__(relb)
+ERTS_ATOMIC64_OPS_IMPL__(ddrb)
+ERTS_ATOMIC64_OPS_IMPL__(rb)
+ERTS_ATOMIC64_OPS_IMPL__(wb)
+
+#undef ERTS_ATOMIC64_OPS_IMPL__
+#undef ERTS_ATOMIC64_DW_CMPXCHG_IMPL__
+
+ERTS_GLB_INLINE void
+erts_atomic64_set_dirty(erts_atomic64_t *var, erts_aint64_t val)
+{
+ ethr_sint_t *sint = ethr_dw_atomic_addr(var);
+ ethr_dw_sint_t dw;
+ ERTS_AINT64_TO_DW_SINT__(dw, val);
+ sint[0] = dw.sint[0];
+ sint[1] = dw.sint[1];
+}
+
+ERTS_GLB_INLINE erts_aint64_t
+erts_atomic64_read_dirty(erts_atomic64_t *var)
+{
+ ethr_sint_t *sint;
+ ethr_dw_sint_t dw;
+ sint = ethr_dw_atomic_addr(var);
+ dw.sint[0] = sint[0];
+ dw.sint[1] = sint[1];
+ return ERTS_DW_SINT_TO_AINT64__(dw);
+}
+
+#undef ERTS_DW_SINT_TO_AINT64__
+#undef ERTS_AINT64_TO_DW_SINT__
+
+#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
+
+#endif /* ARCH_32 */
+
#else /* !USE_THREADS */
/* Double word size atomics */
@@ -1462,8 +1946,120 @@ erts_atomic32_read_dirty(erts_atomic32_t *var)
#define erts_atomic32_set_dirty erts_no_atomic32_set
#define erts_atomic32_read_dirty erts_no_atomic32_read
+/* 64-bit atomics */
+
+#define erts_atomic64_init_nob erts_no_atomic64_set
+#define erts_atomic64_set_nob erts_no_atomic64_set
+#define erts_atomic64_read_nob erts_no_atomic64_read
+#define erts_atomic64_inc_read_nob erts_no_atomic64_inc_read
+#define erts_atomic64_dec_read_nob erts_no_atomic64_dec_read
+#define erts_atomic64_inc_nob erts_no_atomic64_inc
+#define erts_atomic64_dec_nob erts_no_atomic64_dec
+#define erts_atomic64_add_read_nob erts_no_atomic64_add_read
+#define erts_atomic64_add_nob erts_no_atomic64_add
+#define erts_atomic64_read_bor_nob erts_no_atomic64_read_bor
+#define erts_atomic64_read_band_nob erts_no_atomic64_read_band
+#define erts_atomic64_xchg_nob erts_no_atomic64_xchg
+#define erts_atomic64_cmpxchg_nob erts_no_atomic64_cmpxchg
+#define erts_atomic64_read_bset_nob erts_no_atomic64_read_bset
+
+#define erts_atomic64_init_mb erts_no_atomic64_set
+#define erts_atomic64_set_mb erts_no_atomic64_set
+#define erts_atomic64_read_mb erts_no_atomic64_read
+#define erts_atomic64_inc_read_mb erts_no_atomic64_inc_read
+#define erts_atomic64_dec_read_mb erts_no_atomic64_dec_read
+#define erts_atomic64_inc_mb erts_no_atomic64_inc
+#define erts_atomic64_dec_mb erts_no_atomic64_dec
+#define erts_atomic64_add_read_mb erts_no_atomic64_add_read
+#define erts_atomic64_add_mb erts_no_atomic64_add
+#define erts_atomic64_read_bor_mb erts_no_atomic64_read_bor
+#define erts_atomic64_read_band_mb erts_no_atomic64_read_band
+#define erts_atomic64_xchg_mb erts_no_atomic64_xchg
+#define erts_atomic64_cmpxchg_mb erts_no_atomic64_cmpxchg
+#define erts_atomic64_read_bset_mb erts_no_atomic64_read_bset
+
+#define erts_atomic64_init_acqb erts_no_atomic64_set
+#define erts_atomic64_set_acqb erts_no_atomic64_set
+#define erts_atomic64_read_acqb erts_no_atomic64_read
+#define erts_atomic64_inc_read_acqb erts_no_atomic64_inc_read
+#define erts_atomic64_dec_read_acqb erts_no_atomic64_dec_read
+#define erts_atomic64_inc_acqb erts_no_atomic64_inc
+#define erts_atomic64_dec_acqb erts_no_atomic64_dec
+#define erts_atomic64_add_read_acqb erts_no_atomic64_add_read
+#define erts_atomic64_add_acqb erts_no_atomic64_add
+#define erts_atomic64_read_bor_acqb erts_no_atomic64_read_bor
+#define erts_atomic64_read_band_acqb erts_no_atomic64_read_band
+#define erts_atomic64_xchg_acqb erts_no_atomic64_xchg
+#define erts_atomic64_cmpxchg_acqb erts_no_atomic64_cmpxchg
+#define erts_atomic64_read_bset_acqb erts_no_atomic64_read_bset
+
+#define erts_atomic64_init_relb erts_no_atomic64_set
+#define erts_atomic64_set_relb erts_no_atomic64_set
+#define erts_atomic64_read_relb erts_no_atomic64_read
+#define erts_atomic64_inc_read_relb erts_no_atomic64_inc_read
+#define erts_atomic64_dec_read_relb erts_no_atomic64_dec_read
+#define erts_atomic64_inc_relb erts_no_atomic64_inc
+#define erts_atomic64_dec_relb erts_no_atomic64_dec
+#define erts_atomic64_add_read_relb erts_no_atomic64_add_read
+#define erts_atomic64_add_relb erts_no_atomic64_add
+#define erts_atomic64_read_bor_relb erts_no_atomic64_read_bor
+#define erts_atomic64_read_band_relb erts_no_atomic64_read_band
+#define erts_atomic64_xchg_relb erts_no_atomic64_xchg
+#define erts_atomic64_cmpxchg_relb erts_no_atomic64_cmpxchg
+#define erts_atomic64_read_bset_relb erts_no_atomic64_read_bset
+
+#define erts_atomic64_init_ddrb erts_no_atomic64_set
+#define erts_atomic64_set_ddrb erts_no_atomic64_set
+#define erts_atomic64_read_ddrb erts_no_atomic64_read
+#define erts_atomic64_inc_read_ddrb erts_no_atomic64_inc_read
+#define erts_atomic64_dec_read_ddrb erts_no_atomic64_dec_read
+#define erts_atomic64_inc_ddrb erts_no_atomic64_inc
+#define erts_atomic64_dec_ddrb erts_no_atomic64_dec
+#define erts_atomic64_add_read_ddrb erts_no_atomic64_add_read
+#define erts_atomic64_add_ddrb erts_no_atomic64_add
+#define erts_atomic64_read_bor_ddrb erts_no_atomic64_read_bor
+#define erts_atomic64_read_band_ddrb erts_no_atomic64_read_band
+#define erts_atomic64_xchg_ddrb erts_no_atomic64_xchg
+#define erts_atomic64_cmpxchg_ddrb erts_no_atomic64_cmpxchg
+#define erts_atomic64_read_bset_ddrb erts_no_atomic64_read_bset
+
+#define erts_atomic64_init_rb erts_no_atomic64_set
+#define erts_atomic64_set_rb erts_no_atomic64_set
+#define erts_atomic64_read_rb erts_no_atomic64_read
+#define erts_atomic64_inc_read_rb erts_no_atomic64_inc_read
+#define erts_atomic64_dec_read_rb erts_no_atomic64_dec_read
+#define erts_atomic64_inc_rb erts_no_atomic64_inc
+#define erts_atomic64_dec_rb erts_no_atomic64_dec
+#define erts_atomic64_add_read_rb erts_no_atomic64_add_read
+#define erts_atomic64_add_rb erts_no_atomic64_add
+#define erts_atomic64_read_bor_rb erts_no_atomic64_read_bor
+#define erts_atomic64_read_band_rb erts_no_atomic64_read_band
+#define erts_atomic64_xchg_rb erts_no_atomic64_xchg
+#define erts_atomic64_cmpxchg_rb erts_no_atomic64_cmpxchg
+#define erts_atomic64_read_bset_rb erts_no_atomic64_read_bset
+
+#define erts_atomic64_init_wb erts_no_atomic64_set
+#define erts_atomic64_set_wb erts_no_atomic64_set
+#define erts_atomic64_read_wb erts_no_atomic64_read
+#define erts_atomic64_inc_read_wb erts_no_atomic64_inc_read
+#define erts_atomic64_dec_read_wb erts_no_atomic64_dec_read
+#define erts_atomic64_inc_wb erts_no_atomic64_inc
+#define erts_atomic64_dec_wb erts_no_atomic64_dec
+#define erts_atomic64_add_read_wb erts_no_atomic64_add_read
+#define erts_atomic64_add_wb erts_no_atomic64_add
+#define erts_atomic64_read_bor_wb erts_no_atomic64_read_bor
+#define erts_atomic64_read_band_wb erts_no_atomic64_read_band
+#define erts_atomic64_xchg_wb erts_no_atomic64_xchg
+#define erts_atomic64_cmpxchg_wb erts_no_atomic64_cmpxchg
+#define erts_atomic64_read_bset_wb erts_no_atomic64_read_bset
+
+#define erts_atomic64_set_dirty erts_no_atomic64_set
+#define erts_atomic64_read_dirty erts_no_atomic64_read
+
#endif /* !USE_THREADS */
+#include "erl_msacc.h"
+
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
ERTS_GLB_INLINE void
@@ -1548,119 +2144,63 @@ erts_thr_self(void)
#endif
}
-
ERTS_GLB_INLINE int
-erts_equal_tids(erts_tid_t x, erts_tid_t y)
+erts_thr_getname(erts_tid_t tid, char *buf, size_t len)
{
#ifdef USE_THREADS
- return ethr_equal_tids(x, y);
+ return ethr_getname(tid, buf, len);
#else
- return 1;
+ return -1;
#endif
}
-ERTS_GLB_INLINE void
-erts_mtx_init_x(erts_mtx_t *mtx, char *name, Eterm extra, int enable_lcnt)
-{
-#ifdef USE_THREADS
- int res = ethr_mutex_init(&mtx->mtx);
- if (res)
- erts_thr_fatal_error(res, "initialize mutex");
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_init_lock_x(&mtx->lc, name, ERTS_LC_FLG_LT_MUTEX, extra);
-#endif
-#ifdef ERTS_ENABLE_LOCK_COUNT
- if (enable_lcnt)
- erts_lcnt_init_lock_x(&mtx->lcnt, name, ERTS_LCNT_LT_MUTEX, extra);
- else
- erts_lcnt_init_lock_x(&mtx->lcnt, NULL, ERTS_LCNT_LT_MUTEX, extra);
-#endif
-#endif
-}
-ERTS_GLB_INLINE void
-erts_mtx_init_x_opt(erts_mtx_t *mtx, char *name, Eterm extra, Uint16 opt,
- int enable_lcnt)
+ERTS_GLB_INLINE int
+erts_equal_tids(erts_tid_t x, erts_tid_t y)
{
#ifdef USE_THREADS
- int res = ethr_mutex_init(&mtx->mtx);
- if (res)
- erts_thr_fatal_error(res, "initialize mutex");
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_init_lock_x(&mtx->lc, name, ERTS_LC_FLG_LT_MUTEX, extra);
-#endif
-#ifdef ERTS_ENABLE_LOCK_COUNT
- if (enable_lcnt)
- erts_lcnt_init_lock_x(&mtx->lcnt, name, ERTS_LCNT_LT_MUTEX | opt, extra);
- else
- erts_lcnt_init_lock_x(&mtx->lcnt, NULL, ERTS_LCNT_LT_MUTEX | opt, extra);
-#endif
+ return ethr_equal_tids(x, y);
+#else
+ return 1;
#endif
}
-
ERTS_GLB_INLINE void
-erts_mtx_init_locked_x(erts_mtx_t *mtx, char *name, Eterm extra, int enable_lcnt)
+erts_mtx_init(erts_mtx_t *mtx, char *name, Eterm extra, erts_lock_flags_t flags)
{
#ifdef USE_THREADS
int res = ethr_mutex_init(&mtx->mtx);
- if (res)
- erts_thr_fatal_error(res, "initialize mutex");
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_init_lock_x(&mtx->lc, name, ERTS_LC_FLG_LT_MUTEX, extra);
-#endif
-#ifdef ERTS_ENABLE_LOCK_COUNT
- if (enable_lcnt)
- erts_lcnt_init_lock_x(&mtx->lcnt, name, ERTS_LCNT_LT_MUTEX, extra);
- else
- erts_lcnt_init_lock_x(&mtx->lcnt, NULL, ERTS_LCNT_LT_MUTEX, extra);
-#endif
- ethr_mutex_lock(&mtx->mtx);
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_trylock(1, &mtx->lc);
-#endif
-#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_trylock(&mtx->lcnt, 1);
-#endif
+ if (res) {
+ erts_thr_fatal_error(res, "initialize mutex");
+ }
+
+ flags |= ERTS_LOCK_TYPE_MUTEX;
+#ifdef DEBUG
+ mtx->flags = flags;
#endif
-}
-ERTS_GLB_INLINE void
-erts_mtx_init(erts_mtx_t *mtx, char *name)
-{
-#ifdef USE_THREADS
- int res = ethr_mutex_init(&mtx->mtx);
- if (res)
- erts_thr_fatal_error(res, "initialize mutex");
#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_init_lock(&mtx->lc, name, ERTS_LC_FLG_LT_MUTEX);
+ erts_lc_init_lock_x(&mtx->lc, name, flags, extra);
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_init_lock(&mtx->lcnt, name, ERTS_LCNT_LT_MUTEX);
-#endif
+ erts_lcnt_init_ref_x(&mtx->lcnt, name, extra, flags);
#endif
+#endif /* USE_THREADS */
}
ERTS_GLB_INLINE void
-erts_mtx_init_locked(erts_mtx_t *mtx, char *name)
+erts_mtx_init_locked(erts_mtx_t *mtx, char *name, Eterm extra, erts_lock_flags_t flags)
{
#ifdef USE_THREADS
- int res = ethr_mutex_init(&mtx->mtx);
- if (res)
- erts_thr_fatal_error(res, "initialize mutex");
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_init_lock(&mtx->lc, name, ERTS_LC_FLG_LT_MUTEX);
-#endif
-#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_init_lock(&mtx->lcnt, name, ERTS_LCNT_LT_MUTEX);
-#endif
+ erts_mtx_init(mtx, name, extra, flags);
+
ethr_mutex_lock(&mtx->mtx);
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_trylock(1, &mtx->lc);
-#endif
-#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_trylock(&mtx->lcnt, 1);
-#endif
+ #ifdef ERTS_ENABLE_LOCK_CHECK
+ erts_lc_trylock(1, &mtx->lc);
+ #endif
+ #ifdef ERTS_ENABLE_LOCK_COUNT
+ erts_lcnt_trylock(&mtx->lcnt, 1);
+ #endif
#endif
}
@@ -1669,11 +2209,14 @@ erts_mtx_destroy(erts_mtx_t *mtx)
{
#ifdef USE_THREADS
int res;
+
+ ASSERT(!(mtx->flags & ERTS_LOCK_FLAGS_PROPERTY_STATIC));
+
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_destroy_lock(&mtx->lc);
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_destroy_lock(&mtx->lcnt);
+ erts_lcnt_uninstall(&mtx->lcnt);
#endif
res = ethr_mutex_destroy(&mtx->mtx);
if (res != 0) {
@@ -1770,7 +2313,8 @@ erts_lc_mtx_is_locked(erts_mtx_t *mtx)
#if defined(USE_THREADS) && defined(ERTS_ENABLE_LOCK_CHECK)
int res;
erts_lc_lock_t lc = mtx->lc;
- lc.flags = 0;
+ lc.flags = ERTS_LOCK_FLAGS_TYPE_MUTEX;
+ lc.taken_options = 0;
erts_lc_have_locks(&res, &lc, 1);
return res;
#else
@@ -1812,6 +2356,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
@@ -1830,6 +2375,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
}
@@ -1868,7 +2414,7 @@ erts_rwmtx_set_reader_group(int no)
#ifdef USE_THREADS
int res;
#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_check_no_locked_of_type(ERTS_LC_FLG_LT_RWMUTEX);
+ erts_lc_check_no_locked_of_type(ERTS_LOCK_TYPE_RWMUTEX);
#endif
res = ethr_rwmutex_set_reader_group(no);
if (res != 0)
@@ -1877,57 +2423,32 @@ erts_rwmtx_set_reader_group(int no)
}
ERTS_GLB_INLINE void
-erts_rwmtx_init_opt_x(erts_rwmtx_t *rwmtx,
- erts_rwmtx_opt_t *opt,
- char *name,
- Eterm extra)
-{
+erts_rwmtx_init_opt(erts_rwmtx_t *rwmtx, erts_rwmtx_opt_t *opt,
+ char *name, Eterm extra, erts_lock_flags_t flags) {
#ifdef USE_THREADS
int res = ethr_rwmutex_init_opt(&rwmtx->rwmtx, opt);
- if (res != 0)
- erts_thr_fatal_error(res, "initialize rwmutex");
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_init_lock_x(&rwmtx->lc, name, ERTS_LC_FLG_LT_RWMUTEX, extra);
-#endif
-#ifdef ERTS_ENABLE_LOCK_COUNT
- if (name && name[0] == '\0')
- erts_lcnt_init_lock_x(&rwmtx->lcnt, NULL, ERTS_LCNT_LT_RWMUTEX, extra);
- else
- erts_lcnt_init_lock_x(&rwmtx->lcnt, name, ERTS_LCNT_LT_RWMUTEX, extra);
-#endif
-#endif
-}
+ if (res != 0) {
+ erts_thr_fatal_error(res, "initialize rwmutex");
+ }
-ERTS_GLB_INLINE void
-erts_rwmtx_init_x(erts_rwmtx_t *rwmtx,
- char *name,
- Eterm extra)
-{
- erts_rwmtx_init_opt_x(rwmtx, NULL, name, extra);
-}
+ flags |= ERTS_LOCK_TYPE_RWMUTEX;
+#ifdef DEBUG
+ rwmtx->flags = flags;
+#endif
-ERTS_GLB_INLINE void
-erts_rwmtx_init_opt(erts_rwmtx_t *rwmtx,
- erts_rwmtx_opt_t *opt,
- char *name)
-{
-#ifdef USE_THREADS
- int res = ethr_rwmutex_init_opt(&rwmtx->rwmtx, opt);
- if (res != 0)
- erts_thr_fatal_error(res, "initialize rwmutex");
#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_init_lock(&rwmtx->lc, name, ERTS_LC_FLG_LT_RWMUTEX);
+ erts_lc_init_lock_x(&rwmtx->lc, name, flags, extra);
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_init_lock(&rwmtx->lcnt, name, ERTS_LCNT_LT_RWMUTEX);
-#endif
+ erts_lcnt_init_ref_x(&rwmtx->lcnt, name, extra, flags);
#endif
+#endif /* USE_THREADS */
}
ERTS_GLB_INLINE void
-erts_rwmtx_init(erts_rwmtx_t *rwmtx, char *name)
-{
- erts_rwmtx_init_opt(rwmtx, NULL, name);
+erts_rwmtx_init(erts_rwmtx_t *rwmtx, char *name, Eterm extra,
+ erts_lock_flags_t flags) {
+ erts_rwmtx_init_opt(rwmtx, NULL, name, extra, flags);
}
ERTS_GLB_INLINE void
@@ -1935,11 +2456,14 @@ erts_rwmtx_destroy(erts_rwmtx_t *rwmtx)
{
#ifdef USE_THREADS
int res;
+
+ ASSERT(!(rwmtx->flags & ERTS_LOCK_FLAGS_PROPERTY_STATIC));
+
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_destroy_lock(&rwmtx->lc);
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_destroy_lock(&rwmtx->lcnt);
+ erts_lcnt_uninstall(&rwmtx->lcnt);
#endif
res = ethr_rwmutex_destroy(&rwmtx->rwmtx);
if (res != 0) {
@@ -1967,7 +2491,7 @@ erts_rwmtx_tryrlock(erts_rwmtx_t *rwmtx)
int res;
#ifdef ERTS_ENABLE_LOCK_CHECK
- if (erts_lc_trylock_force_busy_flg(&rwmtx->lc, ERTS_LC_FLG_LO_READ))
+ if (erts_lc_trylock_force_busy_flg(&rwmtx->lc, ERTS_LOCK_OPTIONS_READ))
return EBUSY; /* Make sure caller can handle the situation without
causing a lock order violation */
#endif
@@ -1976,13 +2500,13 @@ erts_rwmtx_tryrlock(erts_rwmtx_t *rwmtx)
#ifdef ERTS_ENABLE_LOCK_CHECK
#ifdef ERTS_ENABLE_LOCK_POSITION
- erts_lc_trylock_flg_x(res == 0, &rwmtx->lc, ERTS_LC_FLG_LO_READ,file,line);
+ erts_lc_trylock_flg_x(res == 0, &rwmtx->lc, ERTS_LOCK_OPTIONS_READ,file,line);
#else
- erts_lc_trylock_flg(res == 0, &rwmtx->lc, ERTS_LC_FLG_LO_READ);
+ erts_lc_trylock_flg(res == 0, &rwmtx->lc, ERTS_LOCK_OPTIONS_READ);
#endif
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_trylock_opt(&rwmtx->lcnt, res, ERTS_LCNT_LO_READ);
+ erts_lcnt_trylock_opt(&rwmtx->lcnt, res, ERTS_LOCK_OPTIONS_READ);
#endif
return res;
@@ -2001,13 +2525,13 @@ erts_rwmtx_rlock(erts_rwmtx_t *rwmtx)
#ifdef USE_THREADS
#ifdef ERTS_ENABLE_LOCK_CHECK
#ifdef ERTS_ENABLE_LOCK_POSITION
- erts_lc_lock_flg_x(&rwmtx->lc, ERTS_LC_FLG_LO_READ,file,line);
+ erts_lc_lock_flg_x(&rwmtx->lc, ERTS_LOCK_OPTIONS_READ,file,line);
#else
- erts_lc_lock_flg(&rwmtx->lc, ERTS_LC_FLG_LO_READ);
+ erts_lc_lock_flg(&rwmtx->lc, ERTS_LOCK_OPTIONS_READ);
#endif
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_lock_opt(&rwmtx->lcnt, ERTS_LCNT_LO_READ);
+ erts_lcnt_lock_opt(&rwmtx->lcnt, ERTS_LOCK_OPTIONS_READ);
#endif
ethr_rwmutex_rlock(&rwmtx->rwmtx);
#ifdef ERTS_ENABLE_LOCK_COUNT
@@ -2021,10 +2545,10 @@ erts_rwmtx_runlock(erts_rwmtx_t *rwmtx)
{
#ifdef USE_THREADS
#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_unlock_flg(&rwmtx->lc, ERTS_LC_FLG_LO_READ);
+ erts_lc_unlock_flg(&rwmtx->lc, ERTS_LOCK_OPTIONS_READ);
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_unlock_opt(&rwmtx->lcnt, ERTS_LCNT_LO_READ);
+ erts_lcnt_unlock_opt(&rwmtx->lcnt, ERTS_LOCK_OPTIONS_READ);
#endif
ethr_rwmutex_runlock(&rwmtx->rwmtx);
#endif
@@ -2042,7 +2566,7 @@ erts_rwmtx_tryrwlock(erts_rwmtx_t *rwmtx)
int res;
#ifdef ERTS_ENABLE_LOCK_CHECK
- if (erts_lc_trylock_force_busy_flg(&rwmtx->lc, ERTS_LC_FLG_LO_READ_WRITE))
+ if (erts_lc_trylock_force_busy_flg(&rwmtx->lc, ERTS_LOCK_OPTIONS_RDWR))
return EBUSY; /* Make sure caller can handle the situation without
causing a lock order violation */
#endif
@@ -2051,13 +2575,13 @@ erts_rwmtx_tryrwlock(erts_rwmtx_t *rwmtx)
#ifdef ERTS_ENABLE_LOCK_CHECK
#ifdef ERTS_ENABLE_LOCK_POSITION
- erts_lc_trylock_flg_x(res == 0, &rwmtx->lc, ERTS_LC_FLG_LO_READ_WRITE,file,line);
+ erts_lc_trylock_flg_x(res == 0, &rwmtx->lc, ERTS_LOCK_OPTIONS_RDWR,file,line);
#else
- erts_lc_trylock_flg(res == 0, &rwmtx->lc, ERTS_LC_FLG_LO_READ_WRITE);
+ erts_lc_trylock_flg(res == 0, &rwmtx->lc, ERTS_LOCK_OPTIONS_RDWR);
#endif
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_trylock_opt(&rwmtx->lcnt, res, ERTS_LCNT_LO_READ_WRITE);
+ erts_lcnt_trylock_opt(&rwmtx->lcnt, res, ERTS_LOCK_OPTIONS_RDWR);
#endif
return res;
@@ -2076,13 +2600,13 @@ erts_rwmtx_rwlock(erts_rwmtx_t *rwmtx)
#ifdef USE_THREADS
#ifdef ERTS_ENABLE_LOCK_CHECK
#ifdef ERTS_ENABLE_LOCK_POSITION
- erts_lc_lock_flg_x(&rwmtx->lc, ERTS_LC_FLG_LO_READ_WRITE,file,line);
+ erts_lc_lock_flg_x(&rwmtx->lc, ERTS_LOCK_OPTIONS_RDWR,file,line);
#else
- erts_lc_lock_flg(&rwmtx->lc, ERTS_LC_FLG_LO_READ_WRITE);
+ erts_lc_lock_flg(&rwmtx->lc, ERTS_LOCK_OPTIONS_RDWR);
#endif
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_lock_opt(&rwmtx->lcnt, ERTS_LCNT_LO_READ_WRITE);
+ erts_lcnt_lock_opt(&rwmtx->lcnt, ERTS_LOCK_OPTIONS_RDWR);
#endif
ethr_rwmutex_rwlock(&rwmtx->rwmtx);
#ifdef ERTS_ENABLE_LOCK_COUNT
@@ -2096,10 +2620,10 @@ erts_rwmtx_rwunlock(erts_rwmtx_t *rwmtx)
{
#ifdef USE_THREADS
#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_unlock_flg(&rwmtx->lc, ERTS_LC_FLG_LO_READ_WRITE);
+ erts_lc_unlock_flg(&rwmtx->lc, ERTS_LOCK_OPTIONS_RDWR);
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_unlock_opt(&rwmtx->lcnt, ERTS_LCNT_LO_READ_WRITE);
+ erts_lcnt_unlock_opt(&rwmtx->lcnt, ERTS_LOCK_OPTIONS_RDWR);
#endif
ethr_rwmutex_rwunlock(&rwmtx->rwmtx);
#endif
@@ -2137,7 +2661,8 @@ erts_lc_rwmtx_is_rlocked(erts_rwmtx_t *mtx)
#if defined(USE_THREADS) && defined(ERTS_ENABLE_LOCK_CHECK)
int res;
erts_lc_lock_t lc = mtx->lc;
- lc.flags = ERTS_LC_FLG_LO_READ;
+ lc.flags = ERTS_LOCK_TYPE_RWMUTEX;
+ lc.taken_options = ERTS_LOCK_OPTIONS_READ;
erts_lc_have_locks(&res, &lc, 1);
return res;
#else
@@ -2151,7 +2676,8 @@ erts_lc_rwmtx_is_rwlocked(erts_rwmtx_t *mtx)
#if defined(USE_THREADS) && defined(ERTS_ENABLE_LOCK_CHECK)
int res;
erts_lc_lock_t lc = mtx->lc;
- lc.flags = ERTS_LC_FLG_LO_READ|ERTS_LC_FLG_LO_WRITE;
+ lc.flags = ERTS_LOCK_TYPE_RWMUTEX;
+ lc.taken_options = ERTS_LOCK_OPTIONS_RDWR;
erts_lc_have_locks(&res, &lc, 1);
return res;
#else
@@ -2383,62 +2909,127 @@ erts_no_atomic32_read_bset(erts_no_atomic32_t *var,
return old;
}
-/* spinlock */
+/* atomic64 */
ERTS_GLB_INLINE void
-erts_spinlock_init_x(erts_spinlock_t *lock, char *name, Eterm extra)
+erts_no_atomic64_set(erts_no_atomic64_t *var, erts_aint64_t i)
{
-#ifdef USE_THREADS
- int res = ethr_spinlock_init(&lock->slck);
- if (res)
- erts_thr_fatal_error(res, "init spinlock");
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_init_lock_x(&lock->lc, name, ERTS_LC_FLG_LT_SPINLOCK, extra);
-#endif
-#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_init_lock_x(&lock->lcnt, name, ERTS_LCNT_LT_SPINLOCK, extra);
-#endif
-#else
- (void)lock;
-#endif
+ *var = i;
+}
+
+ERTS_GLB_INLINE erts_aint64_t
+erts_no_atomic64_read(erts_no_atomic64_t *var)
+{
+ return *var;
+}
+
+ERTS_GLB_INLINE erts_aint64_t
+erts_no_atomic64_inc_read(erts_no_atomic64_t *incp)
+{
+ return ++(*incp);
+}
+
+ERTS_GLB_INLINE erts_aint64_t
+erts_no_atomic64_dec_read(erts_no_atomic64_t *decp)
+{
+ return --(*decp);
}
ERTS_GLB_INLINE void
-erts_spinlock_init_x_opt(erts_spinlock_t *lock, char *name, Eterm extra,
- Uint16 opt)
+erts_no_atomic64_inc(erts_no_atomic64_t *incp)
{
-#ifdef USE_THREADS
- int res = ethr_spinlock_init(&lock->slck);
- if (res)
- erts_thr_fatal_error(res, "init spinlock");
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_init_lock_x(&lock->lc, name, ERTS_LC_FLG_LT_SPINLOCK, extra);
-#endif
-#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_init_lock_x(&lock->lcnt, name, ERTS_LCNT_LT_SPINLOCK|opt, extra);
-#endif
-#else
- (void)lock;
-#endif
+ ++(*incp);
+}
+
+ERTS_GLB_INLINE void
+erts_no_atomic64_dec(erts_no_atomic64_t *decp)
+{
+ --(*decp);
}
+ERTS_GLB_INLINE erts_aint64_t
+erts_no_atomic64_add_read(erts_no_atomic64_t *addp, erts_aint64_t i)
+{
+ return *addp += i;
+}
ERTS_GLB_INLINE void
-erts_spinlock_init(erts_spinlock_t *lock, char *name)
+erts_no_atomic64_add(erts_no_atomic64_t *addp, erts_aint64_t i)
+{
+ *addp += i;
+}
+
+ERTS_GLB_INLINE erts_aint64_t
+erts_no_atomic64_read_bor(erts_no_atomic64_t *var, erts_aint64_t mask)
+{
+ erts_aint64_t old;
+ old = *var;
+ *var |= mask;
+ return old;
+}
+
+ERTS_GLB_INLINE erts_aint64_t
+erts_no_atomic64_read_band(erts_no_atomic64_t *var, erts_aint64_t mask)
+{
+ erts_aint64_t old;
+ old = *var;
+ *var &= mask;
+ return old;
+}
+
+ERTS_GLB_INLINE erts_aint64_t
+erts_no_atomic64_xchg(erts_no_atomic64_t *xchgp, erts_aint64_t new)
+{
+ erts_aint64_t old = *xchgp;
+ *xchgp = new;
+ return old;
+}
+
+ERTS_GLB_INLINE erts_aint64_t
+erts_no_atomic64_cmpxchg(erts_no_atomic64_t *xchgp,
+ erts_aint64_t new,
+ erts_aint64_t expected)
+{
+ erts_aint64_t old = *xchgp;
+ if (old == expected)
+ *xchgp = new;
+ return old;
+}
+
+ERTS_GLB_INLINE erts_aint64_t
+erts_no_atomic64_read_bset(erts_no_atomic64_t *var,
+ erts_aint64_t mask,
+ erts_aint64_t set)
+{
+ erts_aint64_t old = *var;
+ *var &= ~mask;
+ *var |= (mask & set);
+ return old;
+}
+
+/* spinlock */
+
+ERTS_GLB_INLINE void
+erts_spinlock_init(erts_spinlock_t *lock, char *name, Eterm extra, erts_lock_flags_t flags)
{
#ifdef USE_THREADS
int res = ethr_spinlock_init(&lock->slck);
- if (res)
- erts_thr_fatal_error(res, "init spinlock");
+ if (res) {
+ erts_thr_fatal_error(res, "init spinlock");
+ }
+
+ flags |= ERTS_LOCK_TYPE_SPINLOCK;
+#ifdef DEBUG
+ lock->flags = flags;
+#endif
+
#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_init_lock(&lock->lc, name, ERTS_LC_FLG_LT_SPINLOCK);
+ erts_lc_init_lock_x(&lock->lc, name, flags, extra);
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_init_lock(&lock->lcnt, name, ERTS_LCNT_LT_SPINLOCK);
-#endif
-#else
- (void)lock;
+ erts_lcnt_init_ref_x(&lock->lcnt, name, extra, flags);
#endif
+#endif /* USE_THREADS */
}
ERTS_GLB_INLINE void
@@ -2446,11 +3037,14 @@ erts_spinlock_destroy(erts_spinlock_t *lock)
{
#ifdef USE_THREADS
int res;
+
+ ASSERT(!(lock->flags & ERTS_LOCK_FLAGS_PROPERTY_STATIC));
+
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_destroy_lock(&lock->lc);
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_destroy_lock(&lock->lcnt);
+ erts_lcnt_uninstall(&lock->lcnt);
#endif
res = ethr_spinlock_destroy(&lock->slck);
if (res != 0) {
@@ -2518,7 +3112,8 @@ erts_lc_spinlock_is_locked(erts_spinlock_t *lock)
#if defined(USE_THREADS) && defined(ERTS_ENABLE_LOCK_CHECK)
int res;
erts_lc_lock_t lc = lock->lc;
- lc.flags = 0;
+ lc.flags = ERTS_LOCK_TYPE_SPINLOCK;
+ lc.taken_options = 0;
erts_lc_have_locks(&res, &lc, 1);
return res;
#else
@@ -2529,39 +3124,26 @@ erts_lc_spinlock_is_locked(erts_spinlock_t *lock)
/* rwspinlock */
ERTS_GLB_INLINE void
-erts_rwlock_init_x(erts_rwlock_t *lock, char *name, Eterm extra)
+erts_rwlock_init(erts_rwlock_t *lock, char *name, Eterm extra, erts_lock_flags_t flags)
{
#ifdef USE_THREADS
int res = ethr_rwlock_init(&lock->rwlck);
- if (res)
- erts_thr_fatal_error(res, "init rwlock");
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_init_lock_x(&lock->lc, name, ERTS_LC_FLG_LT_RWSPINLOCK, extra);
-#endif
-#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_init_lock_x(&lock->lcnt, name, ERTS_LCNT_LT_RWSPINLOCK, extra);
-#endif
-#else
- (void)lock;
+ if (res) {
+ erts_thr_fatal_error(res, "init rwlock");
+ }
+
+ flags |= ERTS_LOCK_TYPE_RWSPINLOCK;
+#ifdef DEBUG
+ lock->flags = flags;
#endif
-}
-ERTS_GLB_INLINE void
-erts_rwlock_init(erts_rwlock_t *lock, char *name)
-{
-#ifdef USE_THREADS
- int res = ethr_rwlock_init(&lock->rwlck);
- if (res)
- erts_thr_fatal_error(res, "init rwlock");
#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_init_lock(&lock->lc, name, ERTS_LC_FLG_LT_RWSPINLOCK);
+ erts_lc_init_lock_x(&lock->lc, name, flags, extra);
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_init_lock(&lock->lcnt, name, ERTS_LCNT_LT_RWSPINLOCK);
-#endif
-#else
- (void)lock;
+ erts_lcnt_init_ref_x(&lock->lcnt, name, extra, flags);
#endif
+#endif /* USE_THREADS */
}
ERTS_GLB_INLINE void
@@ -2569,11 +3151,14 @@ erts_rwlock_destroy(erts_rwlock_t *lock)
{
#ifdef USE_THREADS
int res;
+
+ ASSERT(!(lock->flags & ERTS_LOCK_FLAGS_PROPERTY_STATIC));
+
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_destroy_lock(&lock->lc);
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_destroy_lock(&lock->lcnt);
+ erts_lcnt_uninstall(&lock->lcnt);
#endif
res = ethr_rwlock_destroy(&lock->rwlck);
if (res != 0) {
@@ -2597,10 +3182,10 @@ erts_read_unlock(erts_rwlock_t *lock)
{
#ifdef USE_THREADS
#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_unlock_flg(&lock->lc, ERTS_LC_FLG_LO_READ);
+ erts_lc_unlock_flg(&lock->lc, ERTS_LOCK_OPTIONS_READ);
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_unlock_opt(&lock->lcnt, ERTS_LCNT_LO_READ);
+ erts_lcnt_unlock_opt(&lock->lcnt, ERTS_LOCK_OPTIONS_READ);
#endif
ethr_read_unlock(&lock->rwlck);
#else
@@ -2618,13 +3203,13 @@ erts_read_lock(erts_rwlock_t *lock)
#ifdef USE_THREADS
#ifdef ERTS_ENABLE_LOCK_CHECK
#ifdef ERTS_ENABLE_LOCK_POSITION
- erts_lc_lock_flg_x(&lock->lc, ERTS_LC_FLG_LO_READ,file,line);
+ erts_lc_lock_flg_x(&lock->lc, ERTS_LOCK_OPTIONS_READ,file,line);
#else
- erts_lc_lock_flg(&lock->lc, ERTS_LC_FLG_LO_READ);
+ erts_lc_lock_flg(&lock->lc, ERTS_LOCK_OPTIONS_READ);
#endif
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_lock_opt(&lock->lcnt, ERTS_LCNT_LO_READ);
+ erts_lcnt_lock_opt(&lock->lcnt, ERTS_LOCK_OPTIONS_READ);
#endif
ethr_read_lock(&lock->rwlck);
#ifdef ERTS_ENABLE_LOCK_COUNT
@@ -2640,10 +3225,10 @@ erts_write_unlock(erts_rwlock_t *lock)
{
#ifdef USE_THREADS
#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_unlock_flg(&lock->lc, ERTS_LC_FLG_LO_READ_WRITE);
+ erts_lc_unlock_flg(&lock->lc, ERTS_LOCK_OPTIONS_RDWR);
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_unlock_opt(&lock->lcnt, ERTS_LCNT_LO_READ_WRITE);
+ erts_lcnt_unlock_opt(&lock->lcnt, ERTS_LOCK_OPTIONS_RDWR);
#endif
ethr_write_unlock(&lock->rwlck);
#else
@@ -2661,13 +3246,13 @@ erts_write_lock(erts_rwlock_t *lock)
#ifdef USE_THREADS
#ifdef ERTS_ENABLE_LOCK_CHECK
#ifdef ERTS_ENABLE_LOCK_POSITION
- erts_lc_lock_flg_x(&lock->lc, ERTS_LC_FLG_LO_READ_WRITE,file,line);
+ erts_lc_lock_flg_x(&lock->lc, ERTS_LOCK_OPTIONS_RDWR,file,line);
#else
- erts_lc_lock_flg(&lock->lc, ERTS_LC_FLG_LO_READ_WRITE);
+ erts_lc_lock_flg(&lock->lc, ERTS_LOCK_OPTIONS_RDWR);
#endif
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_lock_opt(&lock->lcnt, ERTS_LCNT_LO_READ_WRITE);
+ erts_lcnt_lock_opt(&lock->lcnt, ERTS_LOCK_OPTIONS_RDWR);
#endif
ethr_write_lock(&lock->rwlck);
#ifdef ERTS_ENABLE_LOCK_COUNT
@@ -2684,7 +3269,8 @@ erts_lc_rwlock_is_rlocked(erts_rwlock_t *lock)
#if defined(USE_THREADS) && defined(ERTS_ENABLE_LOCK_CHECK)
int res;
erts_lc_lock_t lc = lock->lc;
- lc.flags = ERTS_LC_FLG_LO_READ;
+ lc.flags = ERTS_LOCK_TYPE_RWSPINLOCK;
+ lc.taken_options = ERTS_LOCK_OPTIONS_READ;
erts_lc_have_locks(&res, &lc, 1);
return res;
#else
@@ -2698,7 +3284,8 @@ erts_lc_rwlock_is_rwlocked(erts_rwlock_t *lock)
#if defined(USE_THREADS) && defined(ERTS_ENABLE_LOCK_CHECK)
int res;
erts_lc_lock_t lc = lock->lc;
- lc.flags = ERTS_LC_FLG_LO_READ|ERTS_LC_FLG_LO_WRITE;
+ lc.flags = ERTS_LOCK_TYPE_RWSPINLOCK;
+ lc.taken_options = ERTS_LOCK_OPTIONS_RDWR;
erts_lc_have_locks(&res, &lc, 1);
return res;
#else
@@ -2762,6 +3349,15 @@ ERTS_GLB_INLINE void erts_tse_return(erts_tse_t *ep)
#endif
}
+ERTS_GLB_INLINE void erts_tse_prepare_timed(erts_tse_t *ep)
+{
+#ifdef USE_THREADS
+ int res = ethr_event_prepare_timed(&((ethr_ts_event *) ep)->event);
+ if (res != 0)
+ erts_thr_fatal_error(res, "prepare timed");
+#endif
+}
+
ERTS_GLB_INLINE void erts_tse_set(erts_tse_t *ep)
{
#ifdef USE_THREADS
@@ -2779,7 +3375,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
@@ -2788,7 +3388,40 @@ 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
+}
+
+ERTS_GLB_INLINE int erts_tse_twait(erts_tse_t *ep, Sint64 tmo)
+{
+#ifdef USE_THREADS
+ 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
+}
+
+ERTS_GLB_INLINE int erts_tse_stwait(erts_tse_t *ep, int spincount, Sint64 tmo)
+{
+#ifdef USE_THREADS
+ 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
@@ -2838,6 +3471,15 @@ ERTS_GLB_INLINE void erts_thr_yield(void)
#ifdef ETHR_HAVE_ETHR_SIG_FUNCS
ERTS_GLB_INLINE void
+erts_thr_kill(erts_tid_t tid, int sig) {
+#ifdef USE_THREADS
+ int res = ethr_kill((ethr_tid)tid, sig);
+ if (res)
+ erts_thr_fatal_error(res, "killing thread");
+#endif
+}
+
+ERTS_GLB_INLINE void
erts_thr_sigmask(int how, const sigset_t *set, sigset_t *oset)
{
#ifdef USE_THREADS
diff --git a/erts/emulator/beam/erl_time.h b/erts/emulator/beam/erl_time.h
index 4bbdcaa3e3..27164d50a0 100644
--- a/erts/emulator/beam/erl_time.h
+++ b/erts/emulator/beam/erl_time.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2006-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2006-2017. 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.
+ * 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%
*/
@@ -20,94 +21,82 @@
#ifndef ERL_TIME_H__
#define ERL_TIME_H__
-#define ERTS_SHORT_TIME_T_MAX ERTS_AINT32_T_MAX
-#define ERTS_SHORT_TIME_T_MIN ERTS_AINT32_T_MIN
-typedef erts_aint32_t erts_short_time_t;
+#if 0
+# define ERTS_TW_DEBUG
+#endif
+#if defined(DEBUG) && !defined(ERTS_TW_DEBUG)
+# define ERTS_TW_DEBUG
+#endif
-extern erts_smp_atomic32_t do_time; /* set at clock interrupt */
-extern SysTimeval erts_first_emu_time;
+#if defined(ERTS_TW_DEBUG)
+#define ERTS_TIME_ASSERT(B) ERTS_ASSERT(B)
+#else
+#define ERTS_TIME_ASSERT(B) ((void) 1)
+#endif
+#ifdef ERTS_TW_DEBUG
/*
-** Timer entry:
-*/
-typedef struct erl_timer {
- struct erl_timer* next; /* next entry tiw slot or chain */
- struct erl_timer* prev; /* prev entry tiw slot or chain */
- Uint slot; /* slot in timer wheel */
- Uint count; /* number of loops remaining */
- int active; /* 1=activated, 0=deactivated */
- /* called when timeout */
- void (*timeout)(void*);
- /* called when cancel (may be NULL) */
- void (*cancel)(void*);
- void* arg; /* argument to timeout/cancel procs */
-} ErlTimer;
-
-typedef void (*ErlTimeoutProc)(void*);
-typedef void (*ErlCancelProc)(void*);
-
-#ifdef ERTS_SMP
+ * Soon wheel will handle about 1 seconds
+ * Later wheel will handle about 8 minutes
+ */
+# define ERTS_TW_SOON_WHEEL_BITS 10
+# define ERTS_TW_LATER_WHEEL_BITS 10
+#else
+# ifdef SMALL_MEMORY
/*
- * Process and port timer
+ * Soon wheel will handle about 4 seconds
+ * Later wheel will handle about 2 hours and 19 minutes
*/
-typedef union ErtsSmpPTimer_ ErtsSmpPTimer;
-union ErtsSmpPTimer_ {
- struct {
- ErlTimer tm;
- Eterm id;
- void (*timeout_func)(void*);
- ErtsSmpPTimer **timer_ref;
- Uint32 flags;
- } timer;
- ErtsSmpPTimer *next;
-};
-
-
-void erts_create_smp_ptimer(ErtsSmpPTimer **timer_ref,
- Eterm id,
- ErlTimeoutProc timeout_func,
- Uint timeout);
-void erts_cancel_smp_ptimer(ErtsSmpPTimer *ptimer);
+# define ERTS_TW_SOON_WHEEL_BITS 12
+# define ERTS_TW_LATER_WHEEL_BITS 12
+# else
+/*
+ * Soon wheel will handle about 16 seconds
+ * Later wheel will handle about 37 hours and 16 minutes
+ */
+# define ERTS_TW_SOON_WHEEL_BITS 14
+# define ERTS_TW_LATER_WHEEL_BITS 14
+# endif
#endif
-/* timer-wheel api */
+/*
+ * Number of slots in each timer wheel...
+ *
+ * These *need* to be a power of 2
+ */
+#define ERTS_TW_SOON_WHEEL_SIZE (1 << ERTS_TW_SOON_WHEEL_BITS)
+#define ERTS_TW_LATER_WHEEL_SIZE (1 << ERTS_TW_LATER_WHEEL_BITS)
-void erts_init_time(void);
-void erts_set_timer(ErlTimer*, ErlTimeoutProc, ErlCancelProc, void*, Uint);
-void erts_cancel_timer(ErlTimer*);
-void erts_bump_timer(erts_short_time_t);
-Uint erts_timer_wheel_memory_size(void);
-Uint erts_time_left(ErlTimer *);
-erts_short_time_t erts_next_time(void);
+typedef enum {
+ ERTS_NO_TIME_WARP_MODE,
+ ERTS_SINGLE_TIME_WARP_MODE,
+ ERTS_MULTI_TIME_WARP_MODE
+} ErtsTimeWarpMode;
-#ifdef DEBUG
-void erts_p_slpq(void);
-#endif
+typedef struct ErtsTimerWheel_ ErtsTimerWheel;
+typedef ErtsMonotonicTime * ErtsNextTimeoutRef;
-ERTS_GLB_INLINE erts_short_time_t erts_do_time_read_and_reset(void);
-ERTS_GLB_INLINE void erts_do_time_add(erts_short_time_t);
+extern SysTimeval erts_first_emu_time;
-#if ERTS_GLB_INLINE_INCL_FUNC_DEF
-ERTS_GLB_INLINE erts_short_time_t erts_do_time_read_and_reset(void)
-{
- erts_short_time_t time = erts_smp_atomic32_xchg_acqb(&do_time, 0);
- if (time < 0)
- erl_exit(ERTS_ABORT_EXIT, "Internal time management error\n");
- return time;
-}
+void erts_monitor_time_offset(Eterm id, Eterm ref);
+int erts_demonitor_time_offset(Eterm ref);
-ERTS_GLB_INLINE void erts_do_time_add(erts_short_time_t elapsed)
-{
- erts_smp_atomic32_add_relb(&do_time, elapsed);
-}
+int erts_init_time_sup(int, ErtsTimeWarpMode);
+void erts_late_init_time_sup(void);
-#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
+ErtsNextTimeoutRef erts_get_next_timeout_reference(ErtsTimerWheel *);
+void erts_init_time(int time_correction, ErtsTimeWarpMode time_warp_mode);
+void erts_bump_timers(ErtsTimerWheel *, ErtsMonotonicTime);
+Uint erts_timer_wheel_memory_size(void);
+#ifdef DEBUG
+void erts_p_slpq(void);
+#endif
/* time_sup */
-#if (defined(HAVE_GETHRVTIME) || defined(HAVE_CLOCK_GETTIME))
+#if (defined(HAVE_GETHRVTIME) || defined(HAVE_CLOCK_GETTIME_CPU_TIME))
# ifndef HAVE_ERTS_NOW_CPU
# define HAVE_ERTS_NOW_CPU
# ifdef HAVE_GETHRVTIME
@@ -121,25 +110,405 @@ void erts_get_now_cpu(Uint* megasec, Uint* sec, Uint* microsec);
typedef UWord erts_approx_time_t;
erts_approx_time_t erts_get_approx_time(void);
-void erts_get_timeval(SysTimeval *tv);
-erts_time_t erts_get_time(void);
+int erts_has_time_correction(void);
+int erts_check_time_adj_support(int time_correction,
+ ErtsTimeWarpMode time_warp_mode);
+
+ErtsTimeWarpMode erts_time_warp_mode(void);
-ERTS_GLB_INLINE int erts_cmp_timeval(SysTimeval *t1p, SysTimeval *t2p);
+typedef enum {
+ ERTS_TIME_OFFSET_PRELIMINARY,
+ ERTS_TIME_OFFSET_FINAL,
+ ERTS_TIME_OFFSET_VOLATILE
+} ErtsTimeOffsetState;
+
+ErtsTimeOffsetState erts_time_offset_state(void);
+ErtsTimeOffsetState erts_finalize_time_offset(void);
+struct process;
+Eterm erts_get_monotonic_start_time(struct process *c_p);
+Eterm erts_get_monotonic_end_time(struct process *c_p);
+Eterm erts_monotonic_time_source(struct process*c_p);
+Eterm erts_system_time_source(struct process*c_p);
+
+void erts_runtime_elapsed_both(ErtsMonotonicTime *ms_user,
+ ErtsMonotonicTime *ms_sys,
+ ErtsMonotonicTime *ms_user_diff,
+ ErtsMonotonicTime *ms_sys_diff);
+void erts_wall_clock_elapsed_both(ErtsMonotonicTime *total,
+ ErtsMonotonicTime *diff);
+
+#ifdef SYS_CLOCK_RESOLUTION
+#define ERTS_CLKTCK_RESOLUTION ((ErtsMonotonicTime) (SYS_CLOCK_RESOLUTION*1000))
+#else
+#define ERTS_CLKTCK_RESOLUTION (erts_time_sup__.r.o.clktck_resolution)
+#endif
+
+#define ERTS_TW_SOON_WHEEL_MSEC (ERTS_TW_SOON_WHEEL_SIZE/(ERTS_CLKTCK_RESOLUTION/1000))
+#define ERTS_TW_LATER_WHEEL_MSEC (ERTS_TW_LATER_WHEEL_SIZE*ERTS_TW_SOON_WHEEL_MSEC/2)
+
+#define ERTS_TIMER_WHEEL_MSEC ERTS_TW_LATER_WHEEL_MSEC
+
+struct erts_time_sup_read_only__ {
+ ErtsMonotonicTime monotonic_time_unit;
+#if !ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT
+ ErtsMonotonicTime start;
+ struct {
+ ErtsMonotonicTime native;
+ ErtsMonotonicTime nsec;
+ ErtsMonotonicTime usec;
+ ErtsMonotonicTime msec;
+ ErtsMonotonicTime sec;
+ } start_offset;
+#endif
+#ifndef SYS_CLOCK_RESOLUTION
+ ErtsMonotonicTime clktck_resolution;
+#endif
+};
+
+typedef struct {
+ union {
+ struct erts_time_sup_read_only__ o;
+ char align__[(((sizeof(struct erts_time_sup_read_only__) - 1)
+ / ASSUMED_CACHE_LINE_SIZE) + 1)
+ * ASSUMED_CACHE_LINE_SIZE];
+ } r;
+} ErtsTimeSupData;
+
+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 int
-erts_cmp_timeval(SysTimeval *t1p, SysTimeval *t2p)
+ERTS_GLB_INLINE Uint64
+erts_time_unit_conversion(Uint64 value,
+ Uint32 from_time_unit,
+ Uint32 to_time_unit)
{
- if (t1p->tv_sec == t2p->tv_sec) {
- if (t1p->tv_usec < t2p->tv_usec)
- return -1;
- else if (t1p->tv_usec > t2p->tv_usec)
- return 1;
- return 0;
- }
- return t1p->tv_sec < t2p->tv_sec ? -1 : 1;
+ Uint64 high, low, result;
+ if (value <= ~((Uint64) 0)/to_time_unit)
+ return (value*to_time_unit)/from_time_unit;
+
+ low = value & ((Uint64) 0xffffffff);
+ high = (value >> 32) & ((Uint64) 0xffffffff);
+
+ low *= to_time_unit;
+ high *= to_time_unit;
+
+ high += (low >> 32) & ((Uint64) 0xffffffff);
+ low &= ((Uint64) 0xffffffff);
+
+ result = high % from_time_unit;
+ high /= from_time_unit;
+ high <<= 32;
+
+ result <<= 32;
+ result += low;
+ result /= from_time_unit;
+ result += high;
+
+ return result;
}
-#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
+#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
+
+/*
+ * Range of monotonic time internally
+ */
+
+#define ERTS_MONOTONIC_BEGIN \
+ ERTS_MONOTONIC_TIME_UNIT
+#define ERTS_MONOTONIC_END \
+ ((ERTS_MONOTONIC_TIME_MAX / ERTS_MONOTONIC_TIME_UNIT) \
+ * ERTS_MONOTONIC_TIME_UNIT)
+
+#if ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT
+
+/*
+ * If the monotonic time unit is a compile time constant,
+ * it is assumed (and need) to be a power of 10.
+ */
+
+#if ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT < 1000*1000
+# error Compile time time unit needs to be at least 1000000
+#endif
+
+#if ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT == 1000*1000*1000
+/* Nano-second time unit */
+
+#define ERTS_MONOTONIC_TO_SEC__(NSEC) ((NSEC) / (1000*1000*1000))
+#define ERTS_MONOTONIC_TO_MSEC__(NSEC) ((NSEC) / (1000*1000))
+#define ERTS_MONOTONIC_TO_USEC__(NSEC) ((NSEC) / 1000)
+#define ERTS_MONOTONIC_TO_NSEC__(NSEC) (NSEC)
+
+#define ERTS_SEC_TO_MONOTONIC__(SEC) (((ErtsMonotonicTime) (SEC))*(1000*1000*1000))
+#define ERTS_MSEC_TO_MONOTONIC__(MSEC) (((ErtsMonotonicTime) (MSEC))*(1000*1000))
+#define ERTS_USEC_TO_MONOTONIC__(USEC) (((ErtsMonotonicTime) (USEC))*1000)
+#define ERTS_NSEC_TO_MONOTONIC__(NSEC) ((ErtsMonotonicTime) (NSEC))
+
+#elif ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT == 1000*1000
+/* Micro-second time unit */
+
+#define ERTS_MONOTONIC_TO_SEC__(USEC) ((USEC) / (1000*1000))
+#define ERTS_MONOTONIC_TO_MSEC__(USEC) ((USEC) / 1000)
+#define ERTS_MONOTONIC_TO_USEC__(USEC) (USEC)
+#define ERTS_MONOTONIC_TO_NSEC__(USEC) ((USEC)*1000)
+
+#define ERTS_SEC_TO_MONOTONIC__(SEC) (((ErtsMonotonicTime) (SEC))*(1000*1000))
+#define ERTS_MSEC_TO_MONOTONIC__(MSEC) (((ErtsMonotonicTime) (MSEC))*1000)
+#define ERTS_USEC_TO_MONOTONIC__(USEC) ((ErtsMonotonicTime) (USEC))
+#define ERTS_NSEC_TO_MONOTONIC__(NSEC) (((ErtsMonotonicTime) (NSEC))/1000)
+
+#else
+#error Missing implementation for monotonic time unit
+#endif
+
+#define ERTS_MONOTONIC_TIME_UNIT \
+ ((ErtsMonotonicTime) ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT)
+
+/*
+ * NOTE! ERTS_MONOTONIC_TIME_START_EXTERNAL *need* to be a multiple
+ * of ERTS_MONOTONIC_TIME_UNIT.
+ */
+
+#ifdef ARCH_32
+/*
+ * Want to use a big-num of arity 2 as long as possible (584 years
+ * in the nano-second time unit case).
+ */
+#define ERTS_MONOTONIC_TIME_START_EXTERNAL \
+ (((((((ErtsMonotonicTime) 1) << 32)-1) \
+ / ERTS_MONOTONIC_TIME_UNIT) \
+ * ERTS_MONOTONIC_TIME_UNIT) \
+ + ERTS_MONOTONIC_TIME_UNIT)
+
+#else /* ARCH_64 */
+
+#if ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT <= 10*1000*1000
+
+/*
+ * Using micro second time unit or lower. Start at zero since
+ * time will remain an immediate for a very long time anyway
+ * (1827 years in the 10 micro second case)...
+ */
+#define ERTS_MONOTONIC_TIME_START_EXTERNAL ((ErtsMonotonicTime) 0)
+
+#else /* ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT > 10*1000*1000 */
+
+/*
+ * Want to use an immediate as long as possible (36 years in the
+ * nano-second time unit case).
+*/
+#define ERTS_MONOTONIC_TIME_START_EXTERNAL \
+ ((((ErtsMonotonicTime) MIN_SMALL) \
+ / ERTS_MONOTONIC_TIME_UNIT) \
+ * ERTS_MONOTONIC_TIME_UNIT)
+
+#endif /* ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT > 1000*1000 */
+
+#endif /* ARCH_64 */
+
+/*
+ * Offsets from internal monotonic time to external monotonic time
+ */
+
+#define ERTS_MONOTONIC_OFFSET_NATIVE \
+ (ERTS_MONOTONIC_TIME_START_EXTERNAL - ERTS_MONOTONIC_BEGIN)
+#define ERTS_MONOTONIC_OFFSET_NSEC \
+ ERTS_MONOTONIC_TO_NSEC__(ERTS_MONOTONIC_OFFSET_NATIVE)
+#define ERTS_MONOTONIC_OFFSET_USEC \
+ ERTS_MONOTONIC_TO_USEC__(ERTS_MONOTONIC_OFFSET_NATIVE)
+#define ERTS_MONOTONIC_OFFSET_MSEC \
+ ERTS_MONOTONIC_TO_MSEC__(ERTS_MONOTONIC_OFFSET_NATIVE)
+#define ERTS_MONOTONIC_OFFSET_SEC \
+ ERTS_MONOTONIC_TO_SEC__(ERTS_MONOTONIC_OFFSET_NATIVE)
+
+#define ERTS_MONOTONIC_TO_CLKTCKS__(MON) \
+ ((MON) / (ERTS_MONOTONIC_TIME_UNIT/ERTS_CLKTCK_RESOLUTION))
+#define ERTS_CLKTCKS_TO_MONOTONIC__(TCKS) \
+ ((TCKS) * (ERTS_MONOTONIC_TIME_UNIT/ERTS_CLKTCK_RESOLUTION))
+
+#else /* !ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT */
+
+/*
+ * Initialized in erts_init_sys_time_sup()
+ */
+#define ERTS_MONOTONIC_TIME_UNIT (erts_time_sup__.r.o.monotonic_time_unit)
+
+/*
+ * Offsets from internal monotonic time to external monotonic time
+ *
+ * Initialized in erts_init_time_sup()...
+ */
+#define ERTS_MONOTONIC_TIME_START_EXTERNAL (erts_time_sup__.r.o.start)
+#define ERTS_MONOTONIC_OFFSET_NATIVE (erts_time_sup__.r.o.start_offset.native)
+#define ERTS_MONOTONIC_OFFSET_NSEC (erts_time_sup__.r.o.start_offset.nsec)
+#define ERTS_MONOTONIC_OFFSET_USEC (erts_time_sup__.r.o.start_offset.usec)
+#define ERTS_MONOTONIC_OFFSET_MSEC (erts_time_sup__.r.o.start_offset.msec)
+#define ERTS_MONOTONIC_OFFSET_SEC (erts_time_sup__.r.o.start_offset.sec)
+
+#define ERTS_CONV_FROM_MON_UNIT___(M, TO) \
+ ((ErtsMonotonicTime) \
+ erts_time_unit_conversion((Uint64) (M), \
+ (Uint32) ERTS_MONOTONIC_TIME_UNIT, \
+ (Uint32) (TO)))
+
+#define ERTS_CONV_TO_MON_UNIT___(M, FROM) \
+ ((ErtsMonotonicTime) \
+ erts_time_unit_conversion((Uint64) (M), \
+ (Uint32) (FROM), \
+ (Uint32) ERTS_MONOTONIC_TIME_UNIT)) \
+
+#define ERTS_MONOTONIC_TO_SEC__(M) \
+ ERTS_CONV_FROM_MON_UNIT___((M), 1)
+#define ERTS_MONOTONIC_TO_MSEC__(M) \
+ ERTS_CONV_FROM_MON_UNIT___((M), 1000)
+#define ERTS_MONOTONIC_TO_USEC__(M) \
+ ERTS_CONV_FROM_MON_UNIT___((M), 1000*1000)
+#define ERTS_MONOTONIC_TO_NSEC__(M) \
+ ERTS_CONV_FROM_MON_UNIT___((M), 1000*1000*1000)
+
+#define ERTS_SEC_TO_MONOTONIC__(SEC) \
+ ERTS_CONV_TO_MON_UNIT___((SEC), 1)
+#define ERTS_MSEC_TO_MONOTONIC__(MSEC) \
+ ERTS_CONV_TO_MON_UNIT___((MSEC), 1000)
+#define ERTS_USEC_TO_MONOTONIC__(USEC) \
+ ERTS_CONV_TO_MON_UNIT___((USEC), 1000*1000)
+#define ERTS_NSEC_TO_MONOTONIC__(NSEC) \
+ ERTS_CONV_TO_MON_UNIT___((NSEC), 1000*1000*1000)
+
+#define ERTS_MONOTONIC_TO_CLKTCKS__(MON) \
+ ERTS_CONV_FROM_MON_UNIT___((MON), ERTS_CLKTCK_RESOLUTION)
+#define ERTS_CLKTCKS_TO_MONOTONIC__(TCKS) \
+ ERTS_CONV_TO_MON_UNIT___((TCKS), ERTS_CLKTCK_RESOLUTION)
+
+#endif /* !ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT */
+
+#define ERTS_MONOTONIC_TIME_END_EXTERNAL \
+ (ERTS_MONOTONIC_TIME_START_EXTERNAL < 0 \
+ ? (ERTS_MONOTONIC_TIME_START_EXTERNAL \
+ + (ERTS_MONOTONIC_END - ERTS_MONOTONIC_BEGIN)) \
+ : (ERTS_MONOTONIC_END - ERTS_MONOTONIC_TIME_START_EXTERNAL))
+
+#define ERTS_MSEC_TO_CLKTCKS__(MON) \
+ ((MON) * (ERTS_CLKTCK_RESOLUTION/1000))
+#define ERTS_CLKTCKS_TO_MSEC__(TCKS) \
+ ((TCKS) / (ERTS_CLKTCK_RESOLUTION/1000))
+
+#define ERTS_MONOTONIC_TO_SEC(X) \
+ (ERTS_TIME_ASSERT((X) >= 0), \
+ ERTS_MONOTONIC_TO_SEC__((X)))
+#define ERTS_MONOTONIC_TO_MSEC(X) \
+ (ERTS_TIME_ASSERT((X) >= 0), \
+ ERTS_MONOTONIC_TO_MSEC__((X)))
+#define ERTS_MONOTONIC_TO_USEC(X) \
+ (ERTS_TIME_ASSERT((X) >= 0), \
+ ERTS_MONOTONIC_TO_USEC__((X)))
+#define ERTS_MONOTONIC_TO_NSEC(X) \
+ (ERTS_TIME_ASSERT((X) >= 0), \
+ ERTS_MONOTONIC_TO_NSEC__((X)))
+#define ERTS_SEC_TO_MONOTONIC(X) \
+ (ERTS_TIME_ASSERT((X) >= 0), \
+ ERTS_SEC_TO_MONOTONIC__((X)))
+#define ERTS_MSEC_TO_MONOTONIC(X) \
+ (ERTS_TIME_ASSERT((X) >= 0), \
+ ERTS_MSEC_TO_MONOTONIC__((X)))
+#define ERTS_USEC_TO_MONOTONIC(X) \
+ (ERTS_TIME_ASSERT((X) >= 0), \
+ ERTS_USEC_TO_MONOTONIC__((X)))
+#define ERTS_NSEC_TO_MONOTONIC(X) \
+ (ERTS_TIME_ASSERT((X) >= 0), \
+ ERTS_NSEC_TO_MONOTONIC__((X)))
+
+#define ERTS_MONOTONIC_TO_CLKTCKS(X) \
+ (ERTS_TIME_ASSERT((X) >= 0), \
+ ERTS_MONOTONIC_TO_CLKTCKS__((X)))
+#define ERTS_CLKTCKS_TO_MONOTONIC(X) \
+ (ERTS_TIME_ASSERT((X) >= 0), \
+ ERTS_CLKTCKS_TO_MONOTONIC__((X)))
+
+#define ERTS_MSEC_TO_CLKTCKS(X) \
+ (ERTS_TIME_ASSERT((X) >= 0), \
+ ERTS_MSEC_TO_CLKTCKS__((X)))
+#define ERTS_CLKTCKS_TO_MSEC(X) \
+ (ERTS_TIME_ASSERT((X) >= 0), \
+ ERTS_CLKTCKS_TO_MSEC__((X)))
+
#endif /* ERL_TIME_H__ */
+
+/* timer-wheel api */
+#if defined(ERTS_WANT_TIMER_WHEEL_API) && !defined(ERTS_GOT_TIMER_WHEEL_API)
+#define ERTS_GOT_TIMER_WHEEL_API
+
+#include "erl_thr_progress.h"
+#include "erl_process.h"
+
+void erts_sched_init_time_sup(ErtsSchedulerData *esdp);
+
+
+#define ERTS_TW_SLOT_INACTIVE (-2)
+
+/*
+** Timer entry:
+*/
+typedef struct erl_timer {
+ ErtsMonotonicTime timeout_pos; /* Timeout in absolute clock ticks */
+ struct erl_timer* next; /* next entry tiw slot or chain */
+ struct erl_timer* prev; /* prev entry tiw slot or chain */
+ void (*timeout)(void*); /* called when timeout */
+ void* arg; /* argument to timeout/cancel procs */
+ int slot;
+} ErtsTWheelTimer;
+
+typedef void (*ErlTimeoutProc)(void*);
+
+void erts_twheel_set_timer(ErtsTimerWheel *tiw,
+ ErtsTWheelTimer *p, ErlTimeoutProc timeout,
+ void *arg, ErtsMonotonicTime timeout_pos);
+void erts_twheel_cancel_timer(ErtsTimerWheel *tiw, ErtsTWheelTimer *p);
+ErtsTimerWheel *erts_create_timer_wheel(ErtsSchedulerData *esdp);
+
+ErtsMonotonicTime erts_check_next_timeout_time(ErtsSchedulerData *);
+
+ERTS_GLB_INLINE void erts_twheel_init_timer(ErtsTWheelTimer *p);
+ERTS_GLB_INLINE ErtsMonotonicTime erts_next_timeout_time(ErtsNextTimeoutRef);
+ERTS_GLB_INLINE ErtsMonotonicTime erts_tweel_read_timeout(ErtsTWheelTimer *twt);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_INLINE void erts_twheel_init_timer(ErtsTWheelTimer *p)
+{
+ p->slot = ERTS_TW_SLOT_INACTIVE;
+}
+
+ERTS_GLB_INLINE ErtsMonotonicTime erts_next_timeout_time(ErtsNextTimeoutRef nxt_tmo_ref)
+{
+ return *((ErtsMonotonicTime *) nxt_tmo_ref);
+}
+
+ERTS_GLB_INLINE ErtsMonotonicTime
+erts_tweel_read_timeout(ErtsTWheelTimer *twt)
+{
+ return twt->timeout_pos;
+}
+
+#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
+
+void
+erts_twheel_debug_foreach(ErtsTimerWheel *tiw,
+ void (*tclbk)(void *),
+ void (*func)(void *,
+ ErtsMonotonicTime,
+ void *),
+ void *arg);
+
+#endif /* timer wheel api */
diff --git a/erts/emulator/beam/erl_time_sup.c b/erts/emulator/beam/erl_time_sup.c
index 3272a5326d..979c03fd43 100644
--- a/erts/emulator/beam/erl_time_sup.c
+++ b/erts/emulator/beam/erl_time_sup.c
@@ -1,77 +1,28 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1999-2012. All Rights Reserved.
+ * Copyright Ericsson AB 1999-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
/*
-** Support routines for the timer wheel
-**
-** This code contains two strategies for dealing with
-** date/time changes in the system.
-** If the system has some kind of high resolution timer (HAVE_GETHRTIME),
-** the high resolution timer is used to correct the time-of-day and the
-** timeouts, the base source is the hrtimer, but at certain intervals the
-** OS time-of-day is checked and if it is not within certain bounds, the
-** delivered time gets slowly adjusted for each call until
-** it corresponds to the system time (built-in adjtime...).
-** The call gethrtime() is detected by autoconf on Unix, but other
-** platforms may define it in erl_*_sys.h and implement
-** their own high resolution timer. The high resolution timer
-** strategy is (probably) best on all systems where the timer have
-** a resolution higher or equal to gettimeofday (or what's implemented
-** is sys_gettimeofday()). The actual resolution is the interesting thing,
-** not the unit's thats used (i.e. on VxWorks, nanoseconds can be
-** retrieved in terms of units, but the actual resolution is the same as
-** for the clock ticks).
-** If the systems best timer routine is kernel ticks returned from
-** sys_times(), and the actual resolution of sys_gettimeofday() is
-** better (like most unixes that does not have any realtime extensions),
-** another strategy is used. The tolerant gettimeofday() corrects
-** the value with respect to uptime (sys_times() return value) and checks
-** for correction both when delivering timeticks and delivering nowtime.
-** this strategy is slower, but accurate on systems without better timer
-** routines. The kernel tick resolution is not enough to implement
-** a gethrtime routine. On Linux and other non solaris unix-boxes the second
-** strategy is used, on all other platforms we use the first.
-**
-** The following is expected (from sys.[ch] and erl_*_sys.h):
-**
-** 64 bit integers. So it is, and so it will be.
-**
-** sys_init_time(), will return the clock resolution in MS and
-** that's about it. More could be added of course
-** If the clock-rate is constant (i.e. 1 ms) one can define
-** SYS_CLOCK_RESOLUTION (to 1),
-** which makes erts_deliver_time/erts_time_remaining a bit faster.
-**
-** if HAVE_GETHRTIME is defined:
-** sys_gethrtime() will return a SysHrTime (long long) representing
-** nanoseconds, sys_init_hrtime() will do any initialization.
-** else
-** a long (64bit) integer type called Sint64 should be defined.
-**
-** sys_times() will return clock_ticks since start and
-** fill in a SysTimes structure (struct tms). Instead of CLK_TCK,
-** SYS_CLK_TCK is used to determine the resolution of kernel ticks.
-**
-** sys_gettimeofday() will take a SysTimeval (a struct timeval) as parameter
-** and fill it in as gettimeofday(X,NULL).
-**
-*/
+ * Support routines for the time
+ */
+
+/* #define ERTS_TIME_CORRECTION_PRINT */
#ifdef HAVE_CONFIG_H
# include "config.h"
@@ -80,443 +31,1374 @@
#include "sys.h"
#include "erl_vm.h"
#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_get_time_mtx;
+
+ /* used by erts_runtime_elapsed_both */
+typedef struct {
+ erts_smp_mtx_t mtx;
+ ErtsMonotonicTime user;
+ ErtsMonotonicTime sys;
+} ErtsRunTimePrevData;
+
+static union {
+ ErtsRunTimePrevData data;
+ char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsRunTimePrevData))];
+} runtime_prev erts_align_attribute(ERTS_CACHE_LINE_SIZE);
+
+static union {
+ erts_smp_atomic64_t time;
+ char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(erts_smp_atomic64_t))];
+} wall_clock_prev erts_align_attribute(ERTS_CACHE_LINE_SIZE);
+
+static union {
+ erts_smp_atomic64_t time;
+ char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(erts_smp_atomic64_t))];
+} now_prev erts_align_attribute(ERTS_CACHE_LINE_SIZE);
+
+static ErtsMonitor *time_offset_monitors = NULL;
+static Uint no_time_offset_monitors = 0;
+
+#ifdef DEBUG
+static int time_sup_initialized = 0;
+#endif
-static erts_smp_mtx_t erts_timeofday_mtx;
+#define ERTS_MONOTONIC_TIME_KILO \
+ ((ErtsMonotonicTime) 1000)
+#define ERTS_MONOTONIC_TIME_MEGA \
+ (ERTS_MONOTONIC_TIME_KILO*ERTS_MONOTONIC_TIME_KILO)
+#define ERTS_MONOTONIC_TIME_GIGA \
+ (ERTS_MONOTONIC_TIME_MEGA*ERTS_MONOTONIC_TIME_KILO)
+#define ERTS_MONOTONIC_TIME_TERA \
+ (ERTS_MONOTONIC_TIME_GIGA*ERTS_MONOTONIC_TIME_KILO)
-static SysTimeval inittv; /* Used everywhere, the initial time-of-day */
+static void init_time_napi(void);
+static void
+schedule_send_time_offset_changed_notifications(ErtsMonotonicTime new_offset);
+
+struct time_sup_read_only__ {
+ ErtsMonotonicTime (*get_time)(void);
+ int correction;
+ ErtsTimeWarpMode warp_mode;
+#ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT
+ ErtsMonotonicTime moffset;
+ int os_corrected_monotonic_time;
+ int os_monotonic_time_disable;
+ char *os_monotonic_time_func;
+ char *os_monotonic_time_clock_id;
+ int os_monotonic_time_locked;
+ Uint64 os_monotonic_time_resolution;
+ Uint64 os_monotonic_time_extended;
+#endif
+ char *os_system_time_func;
+ char *os_system_time_clock_id;
+ int os_system_time_locked;
+ Uint64 os_system_time_resolution;
+ Uint64 os_system_time_extended;
+ struct {
+ ErtsMonotonicTime large_diff;
+ ErtsMonotonicTime small_diff;
+ } adj;
+ struct {
+ ErtsMonotonicTime error;
+ ErtsMonotonicTime resolution;
+ int intervals;
+ int use_avg;
+ } drift_adj;
+};
+
+typedef struct {
+ ErtsMonotonicTime drift; /* Correction for os monotonic drift */
+ ErtsMonotonicTime error; /* Correction for error between system times */
+} ErtsMonotonicCorrection;
+
+typedef struct {
+ ErtsMonotonicTime erl_mtime;
+ ErtsMonotonicTime os_mtime;
+ ErtsMonotonicCorrection correction;
+} ErtsMonotonicCorrectionInstance;
+
+#define ERTS_MAX_DRIFT_INTERVALS 50
+typedef struct {
+ struct {
+ struct {
+ ErtsMonotonicTime sys;
+ ErtsMonotonicTime mon;
+ } diff;
+ struct {
+ ErtsMonotonicTime sys;
+ ErtsMonotonicTime mon;
+ } time;
+ } intervals[ERTS_MAX_DRIFT_INTERVALS];
+ struct {
+ ErtsMonotonicTime sys;
+ ErtsMonotonicTime mon;
+ } acc;
+ int ix;
+ int dirty_counter;
+} ErtsMonotonicDriftData;
+
+typedef struct {
+ ErtsMonotonicCorrectionInstance prev;
+ ErtsMonotonicCorrectionInstance curr;
+} ErtsMonotonicCorrectionInstances;
+
+typedef struct {
+ ErtsMonotonicCorrectionInstances insts;
+ ErtsMonotonicDriftData drift;
+ ErtsMonotonicTime last_check;
+ int short_check_interval;
+} ErtsMonotonicCorrectionData;
+
+struct time_sup_infrequently_changed__ {
+#ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT
+ struct {
+ erts_smp_rwmtx_t rwmtx;
+ ErtsTWheelTimer timer;
+ ErtsMonotonicCorrectionData cdata;
+ } parmon;
+ ErtsMonotonicTime minit;
+#endif
+ ErtsSystemTime sinit;
+ ErtsMonotonicTime not_corrected_moffset;
+ erts_smp_atomic64_t offset;
+ ErtsMonotonicTime shadow_offset;
+ erts_smp_atomic32_t preliminary_offset;
+};
+
+struct time_sup_frequently_changed__ {
+ ErtsMonotonicTime last_not_corrected_time;
+};
+
+static struct {
+ union {
+ struct time_sup_read_only__ o;
+ char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(struct time_sup_read_only__))];
+ } r;
+ union {
+ struct time_sup_infrequently_changed__ c;
+ char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(struct time_sup_infrequently_changed__))];
+ } inf;
+ union {
+ struct time_sup_frequently_changed__ c;
+ char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(struct time_sup_frequently_changed__))];
+ } f;
+} time_sup erts_align_attribute(ERTS_CACHE_LINE_SIZE);
+
+ErtsTimeSupData erts_time_sup__ erts_align_attribute(ERTS_CACHE_LINE_SIZE);
-static SysTimes t_start; /* Used in elapsed_time_both */
-static SysTimeval gtv; /* Used in wall_clock_elapsed_time_both */
-static SysTimeval then; /* Used in get_now */
-static SysTimeval last_emu_time; /* Used in erts_get_emu_time() */
-SysTimeval erts_first_emu_time; /* Used in erts_get_emu_time() */
+/*
+ * erts_get_approx_time() returns an *approximate* time
+ * in seconds. NOTE that this time may jump backwards!!!
+ */
+erts_approx_time_t
+erts_get_approx_time(void)
+{
+ ErtsSystemTime stime = erts_os_system_time();
+ return (erts_approx_time_t) ERTS_MONOTONIC_TO_SEC(stime);
+}
-union {
- erts_smp_atomic_t time;
- char align[ERTS_CACHE_LINE_SIZE];
-} approx erts_align_attribute(ERTS_CACHE_LINE_SIZE);
+static ERTS_INLINE void
+init_time_offset(ErtsMonotonicTime offset)
+{
+ erts_smp_atomic64_init_nob(&time_sup.inf.c.offset, (erts_aint64_t) offset);
+}
-static void
-init_approx_time(void)
+static ERTS_INLINE void
+set_time_offset(ErtsMonotonicTime offset)
{
- erts_smp_atomic_init_nob(&approx.time, 0);
+ erts_smp_atomic64_set_relb(&time_sup.inf.c.offset, (erts_aint64_t) offset);
}
-static ERTS_INLINE erts_approx_time_t
-get_approx_time(void)
+static ERTS_INLINE ErtsMonotonicTime
+get_time_offset(void)
{
- return (erts_approx_time_t) erts_smp_atomic_read_nob(&approx.time);
+ return (ErtsMonotonicTime) erts_smp_atomic64_read_acqb(&time_sup.inf.c.offset);
}
static ERTS_INLINE void
-update_approx_time(SysTimeval *tv)
+update_last_mtime(ErtsSchedulerData *esdp, ErtsMonotonicTime mtime)
{
- erts_approx_time_t new_secs = (erts_approx_time_t) tv->tv_sec;
- erts_approx_time_t old_secs = get_approx_time();
- if (old_secs != new_secs)
- erts_smp_atomic_set_nob(&approx.time, new_secs);
+ if (!esdp)
+ esdp = erts_get_scheduler_data();
+ if (esdp) {
+ ASSERT(mtime >= esdp->last_monotonic_time);
+ esdp->last_monotonic_time = mtime;
+ esdp->check_time_reds = 0;
+ }
}
+#ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT
+
/*
- * erts_get_approx_time() returns an *approximate* time
- * in seconds. NOTE that this time may jump backwards!!!
+ * Time correction adjustments made due to
+ * error between Erlang system time and OS
+ * system time:
+ * - Large adjustment ~1%
+ * - Small adjustment ~0.05%
*/
-erts_approx_time_t
-erts_get_approx_time(void)
+#define ERTS_TCORR_ERR_UNIT 2048
+#define ERTS_TCORR_ERR_LARGE_ADJ 20
+#define ERTS_TCORR_ERR_SMALL_ADJ 1
+
+#define ERTS_INIT_SHORT_INTERVAL_COUNTER 10
+#define ERTS_LONG_TIME_CORRECTION_CHECK ERTS_SEC_TO_MONOTONIC(60)
+#define ERTS_SHORT_TIME_CORRECTION_CHECK ERTS_SEC_TO_MONOTONIC(15)
+
+#define ERTS_TIME_DRIFT_MAX_ADJ_DIFF ERTS_USEC_TO_MONOTONIC(50)
+#define ERTS_TIME_DRIFT_MIN_ADJ_DIFF ERTS_USEC_TO_MONOTONIC(5)
+
+/*
+ * Maximum drift of the OS monotonic clock expected.
+ *
+ * We use 1 milli second per second. If the monotonic
+ * clock drifts more than this we will fail to adjust for
+ * drift, and error correction will kick in instead.
+ * If it is larger than this, one could argue that the
+ * primitive is to poor to be used...
+ */
+#define ERTS_MAX_MONOTONIC_DRIFT ERTS_MSEC_TO_MONOTONIC(1)
+
+/*
+ * We assume that precision is 32 times worse than the
+ * resolution. This is a wild guess, but there are no
+ * practical way to determine actual precision.
+ */
+#define ERTS_ASSUMED_PRECISION_DROP 32
+
+#define ERTS_MIN_MONOTONIC_DRIFT_MEASUREMENT \
+ (ERTS_SHORT_TIME_CORRECTION_CHECK - 2*ERTS_MAX_MONOTONIC_DRIFT)
+
+
+static ERTS_INLINE ErtsMonotonicTime
+calc_corrected_erl_mtime(ErtsMonotonicTime os_mtime,
+ ErtsMonotonicCorrectionInstance *cip,
+ ErtsMonotonicTime *os_mdiff_p,
+ int os_drift_corrected)
{
- return get_approx_time();
+ ErtsMonotonicTime erl_mtime, diff = os_mtime - cip->os_mtime;
+ ERTS_TIME_ASSERT(diff >= 0);
+ if (!os_drift_corrected)
+ diff += (cip->correction.drift*diff)/ERTS_MONOTONIC_TIME_UNIT;
+ erl_mtime = cip->erl_mtime;
+ erl_mtime += diff;
+ erl_mtime += cip->correction.error*(diff/ERTS_TCORR_ERR_UNIT);
+ if (os_mdiff_p)
+ *os_mdiff_p = diff;
+ return erl_mtime;
}
-#ifdef HAVE_GETHRTIME
+static ERTS_INLINE ErtsMonotonicTime
+read_corrected_time(int os_drift_corrected)
+{
+ ErtsMonotonicTime os_mtime;
+ ErtsMonotonicCorrectionInstance ci;
-int erts_disable_tolerant_timeofday;
+ erts_smp_rwmtx_rlock(&time_sup.inf.c.parmon.rwmtx);
-static SysHrTime hr_init_time, hr_last_correction_check,
- hr_correction, hr_last_time;
+ os_mtime = erts_os_monotonic_time();
-static void init_tolerant_timeofday(void)
-{
- /* Should be in sys.c */
-#if defined(HAVE_SYSCONF) && defined(_SC_NPROCESSORS_CONF)
- if (sysconf(_SC_NPROCESSORS_CONF) > 1) {
- char b[1024];
- int maj,min,build;
- os_flavor(b,1024);
- os_version(&maj,&min,&build);
- if (!strcmp(b,"sunos") && maj <= 5 && min <= 7) {
- erts_disable_tolerant_timeofday = 1;
- }
+ if (os_mtime >= time_sup.inf.c.parmon.cdata.insts.curr.os_mtime)
+ ci = time_sup.inf.c.parmon.cdata.insts.curr;
+ else {
+ if (os_mtime < time_sup.inf.c.parmon.cdata.insts.prev.os_mtime)
+ erts_exit(ERTS_ABORT_EXIT,
+ "OS monotonic time stepped backwards\n");
+ ci = time_sup.inf.c.parmon.cdata.insts.prev;
}
+
+ erts_smp_rwmtx_runlock(&time_sup.inf.c.parmon.rwmtx);
+
+ return calc_corrected_erl_mtime(os_mtime, &ci, NULL,
+ os_drift_corrected);
+}
+
+static ErtsMonotonicTime get_os_drift_corrected_time(void)
+{
+ return read_corrected_time(!0);
+}
+
+static ErtsMonotonicTime get_corrected_time(void)
+{
+ return read_corrected_time(0);
+}
+
+#ifdef ERTS_TIME_CORRECTION_PRINT
+
+static ERTS_INLINE void
+print_correction(int change,
+ ErtsMonotonicTime sdiff,
+ ErtsMonotonicTime old_ecorr,
+ ErtsMonotonicTime old_dcorr,
+ ErtsMonotonicTime new_ecorr,
+ ErtsMonotonicTime new_dcorr,
+ Uint tmo)
+{
+ ErtsMonotonicTime usec_sdiff;
+ if (sdiff < 0)
+ usec_sdiff = -1*ERTS_MONOTONIC_TO_USEC(-1*sdiff);
+ else
+ usec_sdiff = ERTS_MONOTONIC_TO_USEC(sdiff);
+
+ if (!change)
+ erts_fprintf(stderr,
+ "sdiff = %b64d usec : [ec=%b64d ppm, dc=%b64d ppb] : "
+ "tmo = %bpu msec\r\n",
+ usec_sdiff,
+ (1000000*old_ecorr) / ERTS_TCORR_ERR_UNIT,
+ (1000000000*old_dcorr) / ERTS_MONOTONIC_TIME_UNIT,
+ tmo);
+ else
+ erts_fprintf(stderr,
+ "sdiff = %b64d usec : [ec=%b64d ppm, dc=%b64d ppb] "
+ "-> [ec=%b64d ppm, dc=%b64d ppb] : tmo = %bpu msec\r\n",
+ usec_sdiff,
+ (1000000*old_ecorr) / ERTS_TCORR_ERR_UNIT,
+ (1000000000*old_dcorr) / ERTS_MONOTONIC_TIME_UNIT,
+ (1000000*new_ecorr) / ERTS_TCORR_ERR_UNIT,
+ (1000000000*new_dcorr) / ERTS_MONOTONIC_TIME_UNIT,
+ tmo);
+}
+
#endif
- hr_init_time = sys_gethrtime();
- hr_last_correction_check = hr_last_time = hr_init_time;
- hr_correction = 0;
+
+static ERTS_INLINE ErtsMonotonicTime
+get_timeout_pos(ErtsMonotonicTime now, ErtsMonotonicTime tmo)
+{
+ ErtsMonotonicTime tpos;
+ tpos = ERTS_MONOTONIC_TO_CLKTCKS(now - 1);
+ tpos += ERTS_MSEC_TO_CLKTCKS(tmo);
+ tpos += 1;
+ return tpos;
}
-static void get_tolerant_timeofday(SysTimeval *tv)
+static void
+check_time_correction(void *vesdp)
{
- SysHrTime diff_time, curr;
+ int init_drift_adj = !vesdp;
+ ErtsSchedulerData *esdp = (ErtsSchedulerData *) vesdp;
+ ErtsMonotonicCorrection new_correction;
+ ErtsMonotonicCorrectionInstance ci;
+ ErtsMonotonicTime mdiff, sdiff, os_mtime, erl_mtime, os_stime,
+ erl_stime, time_offset, timeout_pos;
+ Uint timeout;
+ int os_drift_corrected = time_sup.r.o.os_corrected_monotonic_time;
+ int set_new_correction = 0, begin_short_intervals = 0;
- if (erts_disable_tolerant_timeofday) {
- sys_gettimeofday(tv);
- return;
+ erts_smp_rwmtx_rlock(&time_sup.inf.c.parmon.rwmtx);
+
+ erts_os_times(&os_mtime, &os_stime);
+
+ ci = time_sup.inf.c.parmon.cdata.insts.curr;
+
+ erts_smp_rwmtx_runlock(&time_sup.inf.c.parmon.rwmtx);
+
+ if (os_mtime < ci.os_mtime)
+ erts_exit(ERTS_ABORT_EXIT,
+ "OS monotonic time stepped backwards\n");
+
+ erl_mtime = calc_corrected_erl_mtime(os_mtime, &ci, &mdiff,
+ os_drift_corrected);
+ time_offset = get_time_offset();
+ erl_stime = erl_mtime + time_offset;
+
+ sdiff = erl_stime - os_stime;
+
+ if (time_sup.inf.c.shadow_offset) {
+ ERTS_TIME_ASSERT(time_sup.r.o.warp_mode == ERTS_SINGLE_TIME_WARP_MODE);
+ if (erts_smp_atomic32_read_nob(&time_sup.inf.c.preliminary_offset))
+ sdiff += time_sup.inf.c.shadow_offset;
+ else
+ time_sup.inf.c.shadow_offset = 0;
}
- *tv = inittv;
- diff_time = ((curr = sys_gethrtime()) + hr_correction - hr_init_time) / 1000;
- if (curr < hr_init_time) {
- erl_exit(1,"Unexpected behaviour from operating system high "
- "resolution timer");
+ new_correction = ci.correction;
+
+ if (time_sup.r.o.warp_mode == ERTS_MULTI_TIME_WARP_MODE
+ && (sdiff < -2*time_sup.r.o.adj.small_diff
+ || 2*time_sup.r.o.adj.small_diff < sdiff)) {
+ /* System time diff exeeded limits; change time offset... */
+ time_offset -= sdiff;
+ sdiff = 0;
+ set_time_offset(time_offset);
+ schedule_send_time_offset_changed_notifications(time_offset);
+ begin_short_intervals = 1;
+ if (ci.correction.error != 0) {
+ set_new_correction = 1;
+ new_correction.error = 0;
+ }
+ }
+ else if ((time_sup.r.o.warp_mode == ERTS_SINGLE_TIME_WARP_MODE
+ && erts_smp_atomic32_read_nob(&time_sup.inf.c.preliminary_offset))
+ && (sdiff < -2*time_sup.r.o.adj.small_diff
+ || 2*time_sup.r.o.adj.small_diff < sdiff)) {
+ /*
+ * System time diff exeeded limits; change shadow offset
+ * and let OS system time leap away from Erlang system
+ * time.
+ */
+ time_sup.inf.c.shadow_offset -= sdiff;
+ sdiff = 0;
+ begin_short_intervals = 1;
+ if (ci.correction.error != 0) {
+ set_new_correction = 1;
+ new_correction.error = 0;
+ }
+ }
+ else if (ci.correction.error == 0) {
+ if (sdiff < -time_sup.r.o.adj.small_diff) {
+ set_new_correction = 1;
+ if (sdiff < -time_sup.r.o.adj.large_diff)
+ new_correction.error = ERTS_TCORR_ERR_LARGE_ADJ;
+ else
+ new_correction.error = ERTS_TCORR_ERR_SMALL_ADJ;
+ }
+ else if (sdiff > time_sup.r.o.adj.small_diff) {
+ set_new_correction = 1;
+ if (sdiff > time_sup.r.o.adj.large_diff)
+ new_correction.error = -ERTS_TCORR_ERR_LARGE_ADJ;
+ else
+ new_correction.error = -ERTS_TCORR_ERR_SMALL_ADJ;
+ }
+ }
+ else if (ci.correction.error > 0) {
+ if (sdiff < 0) {
+ if (ci.correction.error != ERTS_TCORR_ERR_LARGE_ADJ
+ && sdiff < -time_sup.r.o.adj.large_diff) {
+ new_correction.error = ERTS_TCORR_ERR_LARGE_ADJ;
+ set_new_correction = 1;
+ }
+ }
+ else if (sdiff > time_sup.r.o.adj.small_diff) {
+ set_new_correction = 1;
+ if (sdiff > time_sup.r.o.adj.large_diff)
+ new_correction.error = -ERTS_TCORR_ERR_LARGE_ADJ;
+ else
+ new_correction.error = -ERTS_TCORR_ERR_SMALL_ADJ;
+ }
+ else {
+ set_new_correction = 1;
+ new_correction.error = 0;
+ }
+ }
+ else /* if (ci.correction.error < 0) */ {
+ if (0 < sdiff) {
+ if (ci.correction.error != -ERTS_TCORR_ERR_LARGE_ADJ
+ && time_sup.r.o.adj.large_diff < sdiff) {
+ new_correction.error = -ERTS_TCORR_ERR_LARGE_ADJ;
+ set_new_correction = 1;
+ }
+ }
+ else if (sdiff < -time_sup.r.o.adj.small_diff) {
+ set_new_correction = 1;
+ if (sdiff < -time_sup.r.o.adj.large_diff)
+ new_correction.error = ERTS_TCORR_ERR_LARGE_ADJ;
+ else
+ new_correction.error = ERTS_TCORR_ERR_SMALL_ADJ;
+ }
+ else {
+ set_new_correction = 1;
+ new_correction.error = 0;
+ }
}
- if ((curr - hr_last_correction_check) / 1000 > 1000000) {
- /* Check the correction need */
- SysHrTime tv_diff, diffdiff;
- SysTimeval tmp;
- int done = 0;
-
- sys_gettimeofday(&tmp);
- tv_diff = ((SysHrTime) tmp.tv_sec) * 1000000 + tmp.tv_usec;
- tv_diff -= ((SysHrTime) inittv.tv_sec) * 1000000 + inittv.tv_usec;
- diffdiff = diff_time - tv_diff;
- if (diffdiff > 10000) {
- SysHrTime corr = (curr - hr_last_time) / 100;
- if (corr / 1000 >= diffdiff) {
- ++done;
- hr_correction -= ((SysHrTime)diffdiff) * 1000;
- } else {
- hr_correction -= corr;
+ if (!os_drift_corrected) {
+ ErtsMonotonicDriftData *ddp = &time_sup.inf.c.parmon.cdata.drift;
+ int ix = ddp->ix;
+ ErtsMonotonicTime mtime_diff, old_os_mtime;
+
+ old_os_mtime = ddp->intervals[ix].time.mon;
+ mtime_diff = os_mtime - old_os_mtime;
+
+ if ((mtime_diff >= ERTS_MIN_MONOTONIC_DRIFT_MEASUREMENT)
+ | init_drift_adj) {
+ ErtsMonotonicTime drift_adj, drift_adj_diff, old_os_stime,
+ smtime_diff, stime_diff, mtime_acc, stime_acc,
+ avg_drift_adj, max_drift;
+
+ old_os_stime = ddp->intervals[ix].time.sys;
+
+ mtime_acc = ddp->acc.mon;
+ stime_acc = ddp->acc.sys;
+
+ avg_drift_adj = (((stime_acc - mtime_acc)
+ * ERTS_MONOTONIC_TIME_UNIT)
+ / mtime_acc);
+
+ mtime_diff = os_mtime - old_os_mtime;
+ stime_diff = os_stime - old_os_stime;
+ smtime_diff = stime_diff - mtime_diff;
+ ix++;
+ if (ix >= time_sup.r.o.drift_adj.intervals)
+ ix = 0;
+ mtime_acc -= ddp->intervals[ix].diff.mon;
+ mtime_acc += mtime_diff;
+ stime_acc -= ddp->intervals[ix].diff.sys;
+ stime_acc += stime_diff;
+
+ ddp->intervals[ix].diff.mon = mtime_diff;
+ ddp->intervals[ix].diff.sys = stime_diff;
+ ddp->intervals[ix].time.mon = os_mtime;
+ ddp->intervals[ix].time.sys = os_stime;
+
+ ddp->ix = ix;
+ ddp->acc.mon = mtime_acc;
+ ddp->acc.sys = stime_acc;
+
+ max_drift = ERTS_MAX_MONOTONIC_DRIFT;
+ max_drift *= ERTS_MONOTONIC_TO_SEC(mtime_diff);
+
+ if (smtime_diff > time_sup.r.o.drift_adj.error + max_drift
+ || smtime_diff < -1*time_sup.r.o.drift_adj.error - max_drift) {
+ dirty_intervals:
+ /*
+ * We had a leap in system time. Mark array as
+ * dirty to ensure that dirty values are rotated
+ * out before we use it again...
+ */
+ ddp->dirty_counter = time_sup.r.o.drift_adj.intervals;
+ begin_short_intervals = 1;
}
- diff_time = (curr + hr_correction - hr_init_time) / 1000;
- } else if (diffdiff < -10000) {
- SysHrTime corr = (curr - hr_last_time) / 100;
- if (corr / 1000 >= -diffdiff) {
- ++done;
- hr_correction -= ((SysHrTime)diffdiff) * 1000;
- } else {
- hr_correction += corr;
+ else if (ddp->dirty_counter > 0) {
+ if (init_drift_adj) {
+ new_correction.drift = ((smtime_diff
+ * ERTS_MONOTONIC_TIME_UNIT)
+ / mtime_diff);
+ set_new_correction = 1;
+ }
+ ddp->dirty_counter--;
+ }
+ else {
+ if (ddp->dirty_counter == 0) {
+ /* Force set new drift correction... */
+ set_new_correction = 1;
+ ddp->dirty_counter--;
+ }
+
+ if (time_sup.r.o.drift_adj.use_avg)
+ drift_adj = (((stime_acc - mtime_acc)
+ * ERTS_MONOTONIC_TIME_UNIT)
+ / mtime_acc);
+ else
+ drift_adj = ((smtime_diff
+ * ERTS_MONOTONIC_TIME_UNIT)
+ / mtime_diff);
+
+ drift_adj_diff = avg_drift_adj - drift_adj;
+ if (drift_adj_diff < -ERTS_TIME_DRIFT_MAX_ADJ_DIFF
+ || ERTS_TIME_DRIFT_MAX_ADJ_DIFF < drift_adj_diff)
+ goto dirty_intervals;
+
+ drift_adj_diff = drift_adj - new_correction.drift;
+ if (drift_adj_diff) {
+ if (drift_adj_diff > ERTS_TIME_DRIFT_MAX_ADJ_DIFF)
+ drift_adj_diff = ERTS_TIME_DRIFT_MAX_ADJ_DIFF;
+ else if (drift_adj_diff < -ERTS_TIME_DRIFT_MAX_ADJ_DIFF)
+ drift_adj_diff = -ERTS_TIME_DRIFT_MAX_ADJ_DIFF;
+ new_correction.drift += drift_adj_diff;
+ if (drift_adj_diff < -ERTS_TIME_DRIFT_MIN_ADJ_DIFF
+ || ERTS_TIME_DRIFT_MIN_ADJ_DIFF < drift_adj_diff) {
+ set_new_correction = 1;
+ }
+ }
}
- diff_time = (curr + hr_correction - hr_init_time) / 1000;
- } else {
- ++done;
}
- if (done) {
- hr_last_correction_check = curr;
+ }
+
+ begin_short_intervals |= set_new_correction;
+
+ if (begin_short_intervals) {
+ time_sup.inf.c.parmon.cdata.short_check_interval
+ = ERTS_INIT_SHORT_INTERVAL_COUNTER;
+ }
+ else if ((os_mtime - time_sup.inf.c.parmon.cdata.last_check
+ >= ERTS_SHORT_TIME_CORRECTION_CHECK - ERTS_MONOTONIC_TIME_UNIT)
+ && time_sup.inf.c.parmon.cdata.short_check_interval > 0) {
+ time_sup.inf.c.parmon.cdata.short_check_interval--;
+ }
+ time_sup.inf.c.parmon.cdata.last_check = os_mtime;
+
+ if (new_correction.error == 0)
+ timeout = ERTS_MONOTONIC_TO_MSEC(ERTS_LONG_TIME_CORRECTION_CHECK);
+ else {
+ ErtsMonotonicTime ecorr = new_correction.error;
+ ErtsMonotonicTime abs_sdiff;
+ abs_sdiff = (sdiff < 0) ? -1*sdiff : sdiff;
+ if (ecorr < 0)
+ ecorr = -1*ecorr;
+ if (abs_sdiff > ecorr*(ERTS_LONG_TIME_CORRECTION_CHECK/ERTS_TCORR_ERR_UNIT))
+ timeout = ERTS_MONOTONIC_TO_MSEC(ERTS_LONG_TIME_CORRECTION_CHECK);
+ else {
+ timeout = ERTS_MONOTONIC_TO_MSEC((ERTS_TCORR_ERR_UNIT*abs_sdiff)/ecorr);
+ if (timeout < 10)
+ timeout = 10;
}
}
- tv->tv_sec += (int) (diff_time / ((SysHrTime) 1000000));
- tv->tv_usec += (int) (diff_time % ((SysHrTime) 1000000));
- if (tv->tv_usec >= 1000000) {
- tv->tv_usec -= 1000000;
- tv->tv_sec += 1;
+
+ if (timeout > ERTS_MONOTONIC_TO_MSEC(ERTS_SHORT_TIME_CORRECTION_CHECK)
+ && (time_sup.inf.c.parmon.cdata.short_check_interval
+ || time_sup.inf.c.parmon.cdata.drift.dirty_counter >= 0)) {
+ timeout = ERTS_MONOTONIC_TO_MSEC(ERTS_SHORT_TIME_CORRECTION_CHECK);
+ }
+
+ timeout_pos = get_timeout_pos(erl_mtime, timeout);
+
+#ifdef ERTS_TIME_CORRECTION_PRINT
+ print_correction(set_new_correction,
+ sdiff,
+ ci.correction.error,
+ ci.correction.drift,
+ new_correction.error,
+ new_correction.drift,
+ timeout);
+#endif
+
+ if (set_new_correction) {
+ erts_smp_rwmtx_rwlock(&time_sup.inf.c.parmon.rwmtx);
+
+ os_mtime = erts_os_monotonic_time();
+
+ /* Save previous correction instance */
+ time_sup.inf.c.parmon.cdata.insts.prev = ci;
+
+ /*
+ * Current correction instance begin when
+ * OS monotonic time has increased two units.
+ */
+ os_mtime += 2;
+
+ /*
+ * Erlang monotonic time corresponding to
+ * next OS monotonic time using previous
+ * correction.
+ */
+ erl_mtime = calc_corrected_erl_mtime(os_mtime, &ci, NULL,
+ os_drift_corrected);
+
+ /*
+ * Save new current correction instance.
+ */
+ time_sup.inf.c.parmon.cdata.insts.curr.erl_mtime = erl_mtime;
+ time_sup.inf.c.parmon.cdata.insts.curr.os_mtime = os_mtime;
+ time_sup.inf.c.parmon.cdata.insts.curr.correction = new_correction;
+
+ erts_smp_rwmtx_rwunlock(&time_sup.inf.c.parmon.rwmtx);
}
- hr_last_time = curr;
+
+ if (!esdp)
+ esdp = erts_get_scheduler_data();
+
+ erts_twheel_set_timer(esdp->timer_wheel,
+ &time_sup.inf.c.parmon.timer,
+ check_time_correction,
+ (void *) esdp,
+ timeout_pos);
}
-#define correction (hr_correction/1000000)
+static ErtsMonotonicTime get_os_corrected_time(void)
+{
+ ASSERT(time_sup.r.o.warp_mode == ERTS_MULTI_TIME_WARP_MODE);
+ return erts_os_monotonic_time() + time_sup.r.o.moffset;
+}
-#else /* !HAVE_GETHRTIME */
-#if !defined(CORRECT_USING_TIMES)
-#define init_tolerant_timeofday()
-#define get_tolerant_timeofday(tvp) sys_gettimeofday(tvp)
-#else
+static void
+check_time_offset(void *vesdp)
+{
+ ErtsSchedulerData *esdp = (ErtsSchedulerData *) vesdp;
+ ErtsMonotonicTime sdiff, os_mtime, erl_mtime, os_stime,
+ erl_stime, time_offset, timeout, timeout_pos;
-typedef Sint64 Milli;
-
-static clock_t init_ct;
-static Sint64 ct_wrap;
-static Milli init_tv_m;
-static Milli correction_supress;
-static Milli last_ct_diff;
-static Milli last_cc;
-static clock_t last_ct;
-
-/* sys_times() might need to be wrapped and the values shifted (right)
- a bit to cope with newer linux (2.5.*) kernels, this has to be taken care
- of dynamically to start with, a special version that uses
- the times() return value as a high resolution timer can be made
- to fully utilize the faster ticks, like on windows, but for now, we'll
- settle with this silly workaround */
-#ifdef ERTS_WRAP_SYS_TIMES
-#define KERNEL_TICKS() (sys_times_wrap() & \
- ((1UL << ((sizeof(clock_t) * 8) - 1)) - 1))
-#else
-SysTimes dummy_tms;
+ ASSERT(time_sup.r.o.warp_mode == ERTS_MULTI_TIME_WARP_MODE);
+
+ erts_os_times(&os_mtime, &os_stime);
-#define KERNEL_TICKS() (sys_times(&dummy_tms) & \
- ((1UL << ((sizeof(clock_t) * 8) - 1)) - 1))
+ erl_mtime = os_mtime + time_sup.r.o.moffset;
+ time_offset = get_time_offset();
+ erl_stime = erl_mtime + time_offset;
+ sdiff = erl_stime - os_stime;
+
+ if ((sdiff < -2*time_sup.r.o.adj.small_diff
+ || 2*time_sup.r.o.adj.small_diff < sdiff)) {
+ /* System time diff exeeded limits; change time offset... */
+#ifdef ERTS_TIME_CORRECTION_PRINT
+ erts_fprintf(stderr, "sdiff = %b64d nsec -> 0 nsec\n",
+ ERTS_MONOTONIC_TO_NSEC(sdiff));
+#endif
+ time_offset -= sdiff;
+ sdiff = 0;
+ set_time_offset(time_offset);
+ schedule_send_time_offset_changed_notifications(time_offset);
+ }
+#ifdef ERTS_TIME_CORRECTION_PRINT
+ else erts_fprintf(stderr, "sdiff = %b64d nsec\n",
+ ERTS_MONOTONIC_TO_NSEC(sdiff));
#endif
-static void init_tolerant_timeofday(void)
+ timeout = ERTS_MONOTONIC_TO_MSEC(ERTS_LONG_TIME_CORRECTION_CHECK);
+ timeout_pos = get_timeout_pos(erl_mtime, timeout);
+
+ erts_twheel_set_timer(esdp->timer_wheel,
+ &time_sup.inf.c.parmon.timer,
+ check_time_offset,
+ vesdp,
+ timeout_pos);
+}
+
+static void
+init_check_time_correction(void *vesdp)
{
- last_ct = init_ct = KERNEL_TICKS();
- last_cc = 0;
- init_tv_m = (((Milli) inittv.tv_sec) * 1000) +
- (inittv.tv_usec / 1000);
- ct_wrap = 0;
- correction_supress = 0;
+ ErtsMonotonicDriftData *ddp;
+ ErtsMonotonicTime old_mtime, old_stime, mtime, stime, mtime_diff,
+ stime_diff, smtime_diff, max_drift;
+ int ix;
+
+ ddp = &time_sup.inf.c.parmon.cdata.drift;
+ ix = ddp->ix;
+ old_mtime = ddp->intervals[0].time.mon;
+ old_stime = ddp->intervals[0].time.sys;
+
+ erts_os_times(&mtime, &stime);
+
+ mtime_diff = mtime - old_mtime;
+ stime_diff = stime - old_stime;
+ smtime_diff = stime_diff - mtime_diff;
+
+ max_drift = ERTS_MAX_MONOTONIC_DRIFT;
+ max_drift *= ERTS_MONOTONIC_TO_SEC(mtime_diff);
+
+ if (smtime_diff > time_sup.r.o.drift_adj.error + max_drift
+ || smtime_diff < -1*time_sup.r.o.drift_adj.error - max_drift) {
+ /* Had a system time leap... pretend no drift... */
+ stime_diff = mtime_diff;
+ }
+
+ /*
+ * We use old time values in order to trigger
+ * a drift adjustment, and repeat this interval
+ * in all slots...
+ */
+ for (ix = 0; ix < time_sup.r.o.drift_adj.intervals; ix++) {
+ ddp->intervals[ix].diff.mon = mtime_diff;
+ ddp->intervals[ix].diff.sys = stime_diff;
+ ddp->intervals[ix].time.mon = old_mtime;
+ ddp->intervals[ix].time.sys = old_stime;
+ }
+
+ ddp->acc.sys = stime_diff*time_sup.r.o.drift_adj.intervals;
+ ddp->acc.mon = mtime_diff*time_sup.r.o.drift_adj.intervals;
+ ddp->ix = 0;
+ ddp->dirty_counter = time_sup.r.o.drift_adj.intervals;
+
+ check_time_correction(vesdp);
}
+static ErtsMonotonicTime
+finalize_corrected_time_offset(ErtsSystemTime *stimep)
+{
+ ErtsMonotonicTime os_mtime;
+ ErtsMonotonicCorrectionInstance ci;
+ int os_drift_corrected = time_sup.r.o.os_corrected_monotonic_time;
+
+ erts_smp_rwmtx_rlock(&time_sup.inf.c.parmon.rwmtx);
+
+ erts_os_times(&os_mtime, stimep);
+
+ ci = time_sup.inf.c.parmon.cdata.insts.curr;
+
+ erts_smp_rwmtx_runlock(&time_sup.inf.c.parmon.rwmtx);
+
+ if (os_mtime < ci.os_mtime)
+ erts_exit(ERTS_ABORT_EXIT,
+ "OS monotonic time stepped backwards\n");
+
+ return calc_corrected_erl_mtime(os_mtime, &ci, NULL,
+ os_drift_corrected);
+}
-static void get_tolerant_timeofday(SysTimeval *tvp)
+static void
+late_init_time_correction(ErtsSchedulerData *esdp)
{
- clock_t current_ct;
- SysTimeval current_tv;
- Milli ct_diff;
- Milli tv_diff;
- Milli current_correction;
- Milli act_correction; /* long shown to be too small */
- Milli max_adjust;
+ int quick_init_drift_adj;
+ void (*check_func)(void *);
+ ErtsMonotonicTime timeout, timeout_pos;
+
+ quick_init_drift_adj =
+ ERTS_MONOTONIC_TO_USEC(time_sup.r.o.drift_adj.error) == 0;
+
+ if (quick_init_drift_adj)
+ timeout = ERTS_MONOTONIC_TO_MSEC(ERTS_SHORT_TIME_CORRECTION_CHECK/10);
+ else
+ timeout = ERTS_MONOTONIC_TO_MSEC(ERTS_SHORT_TIME_CORRECTION_CHECK);
+
+ if (!time_sup.r.o.os_corrected_monotonic_time)
+ check_func = init_check_time_correction;
+ else if (time_sup.r.o.get_time == get_os_corrected_time) {
+ quick_init_drift_adj = 0;
+ check_func = check_time_offset;
+ }
+ else
+ check_func = check_time_correction;
+
+ timeout_pos = get_timeout_pos(erts_get_monotonic_time(esdp),
+ timeout);
+
+ erts_twheel_init_timer(&time_sup.inf.c.parmon.timer);
+ erts_twheel_set_timer(esdp->timer_wheel,
+ &time_sup.inf.c.parmon.timer,
+ check_func,
+ (quick_init_drift_adj
+ ? NULL
+ : esdp),
+ timeout_pos);
+}
+
+#endif /* ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT */
+
+static ErtsMonotonicTime get_not_corrected_time(void)
+{
+ ErtsMonotonicTime stime, mtime;
+
+ erts_smp_mtx_lock(&erts_get_time_mtx);
+
+ stime = erts_os_system_time();
+
+ mtime = stime - time_sup.inf.c.not_corrected_moffset;
+
+ if (mtime >= time_sup.f.c.last_not_corrected_time)
+ time_sup.f.c.last_not_corrected_time = mtime;
+ else {
+ mtime = time_sup.f.c.last_not_corrected_time;
+
+ if (time_sup.r.o.warp_mode == ERTS_MULTI_TIME_WARP_MODE) {
+ ErtsMonotonicTime new_offset = stime - mtime;
+ new_offset = ERTS_MONOTONIC_TO_USEC(new_offset);
+ new_offset = ERTS_USEC_TO_MONOTONIC(new_offset);
+ if (time_sup.inf.c.not_corrected_moffset != new_offset) {
+ time_sup.inf.c.not_corrected_moffset = new_offset;
+ set_time_offset(new_offset);
+ schedule_send_time_offset_changed_notifications(new_offset);
+ }
+ }
- if (erts_disable_tolerant_timeofday) {
- sys_gettimeofday(tvp);
- return;
}
-#ifdef ERTS_WRAP_SYS_TIMES
-#define TICK_MS (1000 / SYS_CLK_TCK_WRAP)
+ ASSERT(stime == mtime + time_sup.inf.c.not_corrected_moffset);
+
+ erts_smp_mtx_unlock(&erts_get_time_mtx);
+
+ return mtime;
+}
+
+int erts_check_time_adj_support(int time_correction,
+ ErtsTimeWarpMode time_warp_mode)
+{
+ if (!time_correction)
+ return 1;
+
+ /* User wants time correction */
+
+#ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT
+ return !time_sup.r.o.os_monotonic_time_disable;
#else
-#define TICK_MS (1000 / SYS_CLK_TCK)
+ return 0;
#endif
- current_ct = KERNEL_TICKS();
- sys_gettimeofday(&current_tv);
-
- /* I dont know if uptime can move some units backwards
- on some systems, but I allow for small backward
- jumps to avoid such problems if they exist...*/
- if (last_ct > 100 && current_ct < (last_ct - 100)) {
- ct_wrap += ((Sint64) 1) << ((sizeof(clock_t) * 8) - 1);
- }
- last_ct = current_ct;
- ct_diff = ((ct_wrap + current_ct) - init_ct) * TICK_MS;
+}
+
+int
+erts_has_time_correction(void)
+{
+ return time_sup.r.o.correction;
+}
+
+void erts_init_sys_time_sup(void)
+{
+ ErtsSysInitTimeResult sys_init_time_res
+ = ERTS_SYS_INIT_TIME_RESULT_INITER;
+
+ sys_init_time(&sys_init_time_res);
+
+ erts_time_sup__.r.o.monotonic_time_unit
+ = sys_init_time_res.os_monotonic_time_unit;
+
+#ifndef SYS_CLOCK_RESOLUTION
+ erts_time_sup__.r.o.clktck_resolution
+ = sys_init_time_res.sys_clock_resolution;
+ erts_time_sup__.r.o.clktck_resolution *= 1000;
+#endif
+
+#ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT
+ time_sup.r.o.os_monotonic_time_disable
+ = !sys_init_time_res.have_os_monotonic_time;
+ time_sup.r.o.os_corrected_monotonic_time =
+ sys_init_time_res.have_corrected_os_monotonic_time;
+ time_sup.r.o.os_monotonic_time_func
+ = sys_init_time_res.os_monotonic_time_info.func;
+ time_sup.r.o.os_monotonic_time_clock_id
+ = sys_init_time_res.os_monotonic_time_info.clock_id;
+ time_sup.r.o.os_monotonic_time_locked
+ = sys_init_time_res.os_monotonic_time_info.locked_use;
+ time_sup.r.o.os_monotonic_time_resolution
+ = sys_init_time_res.os_monotonic_time_info.resolution;
+ time_sup.r.o.os_monotonic_time_extended
+ = sys_init_time_res.os_monotonic_time_info.extended;
+#endif
+ time_sup.r.o.os_system_time_func
+ = sys_init_time_res.os_system_time_info.func;
+ time_sup.r.o.os_system_time_clock_id
+ = sys_init_time_res.os_system_time_info.clock_id;
+ time_sup.r.o.os_system_time_locked
+ = sys_init_time_res.os_system_time_info.locked_use;
+ time_sup.r.o.os_system_time_resolution
+ = sys_init_time_res.os_system_time_info.resolution;
+}
+
+int
+erts_init_time_sup(int time_correction, ErtsTimeWarpMode time_warp_mode)
+{
+ ErtsMonotonicTime resolution, ilength, intervals, short_isecs;
+#if !ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT
+ ErtsMonotonicTime abs_native_offset, native_offset;
+#endif
+
+ init_time_napi();
+
+ erts_hl_timer_init();
+
+ ASSERT(ERTS_MONOTONIC_TIME_MIN < ERTS_MONOTONIC_TIME_MAX);
+
+ erts_smp_mtx_init(&erts_get_time_mtx, "get_time", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
+ erts_smp_mtx_init(&runtime_prev.data.mtx, "runtime", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
+ runtime_prev.data.user = 0;
+ runtime_prev.data.sys = 0;
+
+ time_sup.r.o.correction = time_correction;
+ time_sup.r.o.warp_mode = time_warp_mode;
+
+ if (time_warp_mode == ERTS_SINGLE_TIME_WARP_MODE)
+ erts_smp_atomic32_init_nob(&time_sup.inf.c.preliminary_offset, 1);
+ else
+ erts_smp_atomic32_init_nob(&time_sup.inf.c.preliminary_offset, 0);
+ time_sup.inf.c.shadow_offset = 0;
+
+#if !ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT
/*
- * We will adjust the time in milliseconds and we allow for 1%
- * adjustments, but if this function is called more often then every 100
- * millisecond (which is obviously possible), we will never adjust, so
- * we accumulate small times by setting last_ct_diff iff max_adjust > 0
+ * NOTE! erts_time_sup__.r.o.start *need* to be a multiple
+ * of ERTS_MONOTONIC_TIME_UNIT.
*/
- if ((max_adjust = (ct_diff - last_ct_diff)/100) > 0)
- last_ct_diff = ct_diff;
- tv_diff = ((((Milli) current_tv.tv_sec) * 1000) +
- (current_tv.tv_usec / 1000)) - init_tv_m;
+#ifdef ARCH_32
+ erts_time_sup__.r.o.start = ((((ErtsMonotonicTime) 1) << 32)-1);
+ erts_time_sup__.r.o.start /= ERTS_MONOTONIC_TIME_UNIT;
+ erts_time_sup__.r.o.start *= ERTS_MONOTONIC_TIME_UNIT;
+ erts_time_sup__.r.o.start += ERTS_MONOTONIC_TIME_UNIT;
+ native_offset = erts_time_sup__.r.o.start - ERTS_MONOTONIC_BEGIN;
+ abs_native_offset = native_offset;
+#else /* ARCH_64 */
+ if (ERTS_MONOTONIC_TIME_UNIT <= 10*1000*1000) {
+ erts_time_sup__.r.o.start = 0;
+ native_offset = -ERTS_MONOTONIC_BEGIN;
+ abs_native_offset = ERTS_MONOTONIC_BEGIN;
+ }
+ else {
+ erts_time_sup__.r.o.start = ((ErtsMonotonicTime) MIN_SMALL);
+ erts_time_sup__.r.o.start /= ERTS_MONOTONIC_TIME_UNIT;
+ erts_time_sup__.r.o.start *= ERTS_MONOTONIC_TIME_UNIT;
+ native_offset = erts_time_sup__.r.o.start - ERTS_MONOTONIC_BEGIN;
+ abs_native_offset = -1*native_offset;
+ }
+#endif
- current_correction = ((ct_diff - tv_diff) / TICK_MS) * TICK_MS; /* trunc */
+ erts_time_sup__.r.o.start_offset.native = native_offset;
+ erts_time_sup__.r.o.start_offset.nsec = (ErtsMonotonicTime)
+ erts_time_unit_conversion((Uint64) abs_native_offset,
+ (Uint32) ERTS_MONOTONIC_TIME_UNIT,
+ (Uint32) 1000*1000*1000);
+ erts_time_sup__.r.o.start_offset.usec = (ErtsMonotonicTime)
+ erts_time_unit_conversion((Uint64) abs_native_offset,
+ (Uint32) ERTS_MONOTONIC_TIME_UNIT,
+ (Uint32) 1000*1000);
+ erts_time_sup__.r.o.start_offset.msec = (ErtsMonotonicTime)
+ erts_time_unit_conversion((Uint64) abs_native_offset,
+ (Uint32) ERTS_MONOTONIC_TIME_UNIT,
+ (Uint32) 1000);
+ erts_time_sup__.r.o.start_offset.sec = (ErtsMonotonicTime)
+ erts_time_unit_conversion((Uint64) abs_native_offset,
+ (Uint32) ERTS_MONOTONIC_TIME_UNIT,
+ (Uint32) 1);
+ if (native_offset < 0) {
+ erts_time_sup__.r.o.start_offset.nsec *= -1;
+ erts_time_sup__.r.o.start_offset.usec *= -1;
+ erts_time_sup__.r.o.start_offset.msec *= -1;
+ erts_time_sup__.r.o.start_offset.sec *= -1;
+ }
- /*
- * We allow the current_correction value to wobble a little, as it
- * suffers from the low resolution of the kernel ticks.
- * if it hasn't changed more than one tick in either direction,
- * we will keep the old value.
- */
- if ((last_cc > current_correction + TICK_MS) ||
- (last_cc < current_correction - TICK_MS)) {
- last_cc = current_correction;
- } else {
- current_correction = last_cc;
+#endif
+
+ resolution = time_sup.r.o.os_system_time_resolution;
+#ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT
+ if (resolution > time_sup.r.o.os_monotonic_time_resolution)
+ resolution = time_sup.r.o.os_monotonic_time_resolution;
+#endif
+
+ time_sup.r.o.adj.large_diff = erts_time_sup__.r.o.monotonic_time_unit;
+ time_sup.r.o.adj.large_diff *= 50;
+ time_sup.r.o.adj.large_diff /= resolution;
+ if (time_sup.r.o.adj.large_diff < ERTS_USEC_TO_MONOTONIC(500))
+ time_sup.r.o.adj.large_diff = ERTS_USEC_TO_MONOTONIC(500);
+ time_sup.r.o.adj.small_diff = time_sup.r.o.adj.large_diff/10;
+
+ time_sup.r.o.drift_adj.resolution = resolution;
+
+ if (time_sup.r.o.os_corrected_monotonic_time) {
+ time_sup.r.o.drift_adj.use_avg = 0;
+ time_sup.r.o.drift_adj.intervals = 0;
+ time_sup.r.o.drift_adj.error = 0;
+ time_sup.inf.c.parmon.cdata.drift.dirty_counter = -1;
}
-
- /*
- * As time goes, we try to get the actual correction to 0,
- * that is, make erlangs time correspond to the systems dito.
- * The act correction is what we seem to need (current_correction)
- * minus the correction suppression. The correction supression
- * will change slowly (max 1% of elapsed time) but in millisecond steps.
- */
- act_correction = current_correction - correction_supress;
- if (max_adjust > 0) {
+ else {
/*
- * Here we slowly adjust erlangs time to correspond with the
- * system time by changing the correction_supress variable.
- * It can change max_adjust milliseconds which is 1% of elapsed time
+ * Calculate length of the interval in seconds needed
+ * in order to get an error that is at most 1 micro second.
+ * If this interval is longer than the short time correction
+ * check interval we use the average of all values instead
+ * of the latest value.
*/
- if (act_correction > 0) {
- if (current_correction - correction_supress > max_adjust) {
- correction_supress += max_adjust;
- } else {
- correction_supress = current_correction;
- }
- act_correction = current_correction - correction_supress;
- } else if (act_correction < 0) {
- if (correction_supress - current_correction > max_adjust) {
- correction_supress -= max_adjust;
- } else {
- correction_supress = current_correction;
- }
- act_correction = current_correction - correction_supress;
+ short_isecs = ERTS_MONOTONIC_TO_SEC(ERTS_SHORT_TIME_CORRECTION_CHECK);
+ ilength = ERTS_ASSUMED_PRECISION_DROP * ERTS_MONOTONIC_TIME_UNIT;
+ ilength /= (resolution * ERTS_USEC_TO_MONOTONIC(1));
+ time_sup.r.o.drift_adj.use_avg = ilength > short_isecs;
+
+ if (ilength == 0)
+ intervals = 5;
+ else {
+ intervals = ilength / short_isecs;
+ if (intervals > ERTS_MAX_DRIFT_INTERVALS)
+ intervals = ERTS_MAX_DRIFT_INTERVALS;
+ else if (intervals < 5)
+ intervals = 5;
}
+ time_sup.r.o.drift_adj.intervals = (int) intervals;
+
+ /*
+ * drift_adj.error equals maximum assumed error
+ * over a short time interval. We use this value also
+ * when examining a large interval. In this case the
+ * error will be smaller, but we do not want to
+ * recalculate this over and over again.
+ */
+
+ time_sup.r.o.drift_adj.error = ERTS_MONOTONIC_TIME_UNIT;
+ time_sup.r.o.drift_adj.error *= ERTS_ASSUMED_PRECISION_DROP;
+ time_sup.r.o.drift_adj.error /= resolution * short_isecs;
}
- /*
- * The actual correction will correct the timeval so that system
- * time warps gets smothed down.
- */
- current_tv.tv_sec += act_correction / 1000;
- current_tv.tv_usec += (act_correction % 1000) * 1000;
-
- if (current_tv.tv_usec >= 1000000) {
- ++current_tv.tv_sec ;
- current_tv.tv_usec -= 1000000;
- } else if (current_tv.tv_usec < 0) {
- --current_tv.tv_sec;
- current_tv.tv_usec += 1000000;
+#ifdef ERTS_TIME_CORRECTION_PRINT
+ erts_fprintf(stderr, "resolution = %b64d\n", resolution);
+ erts_fprintf(stderr, "adj large diff = %b64d usec\n",
+ ERTS_MONOTONIC_TO_USEC(time_sup.r.o.adj.large_diff));
+ erts_fprintf(stderr, "adj small diff = %b64d usec\n",
+ ERTS_MONOTONIC_TO_USEC(time_sup.r.o.adj.small_diff));
+ if (!time_sup.r.o.os_corrected_monotonic_time) {
+ erts_fprintf(stderr, "drift intervals = %d\n",
+ time_sup.r.o.drift_adj.intervals);
+ erts_fprintf(stderr, "drift adj error = %b64d usec\n",
+ ERTS_MONOTONIC_TO_USEC(time_sup.r.o.drift_adj.error));
+ erts_fprintf(stderr, "drift adj max diff = %b64d nsec\n",
+ ERTS_MONOTONIC_TO_NSEC(ERTS_TIME_DRIFT_MAX_ADJ_DIFF));
+ erts_fprintf(stderr, "drift adj min diff = %b64d nsec\n",
+ ERTS_MONOTONIC_TO_NSEC(ERTS_TIME_DRIFT_MIN_ADJ_DIFF));
}
- *tvp = current_tv;
-#undef TICK_MS
-}
+#endif
-#endif /* CORRECT_USING_TIMES */
-#endif /* !HAVE_GETHRTIME */
+ if (ERTS_MONOTONIC_TIME_UNIT < ERTS_CLKTCK_RESOLUTION)
+ ERTS_INTERNAL_ERROR("Too small monotonic time time unit");
-/*
-** Why this? Well, most platforms have a constant clock resolution of 1,
-** we dont want the deliver_time/time_remaining routines to waste
-** time dividing and multiplying by/with a variable that's always one.
-** so the return value of sys_init_time is ignored on those platforms.
-*/
-
-#ifndef SYS_CLOCK_RESOLUTION
-static int clock_resolution;
-#define CLOCK_RESOLUTION clock_resolution
+#ifndef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT
+ time_sup.r.o.correction = 0;
#else
-#define CLOCK_RESOLUTION SYS_CLOCK_RESOLUTION
+ if (time_sup.r.o.os_monotonic_time_disable)
+ time_sup.r.o.correction = 0;
+
+ if (time_sup.r.o.correction) {
+ ErtsMonotonicCorrectionData *cdatap;
+ erts_smp_rwmtx_opt_t rwmtx_opts = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER;
+ ErtsMonotonicTime offset;
+ erts_os_times(&time_sup.inf.c.minit,
+ &time_sup.inf.c.sinit);
+ time_sup.r.o.moffset = -1*time_sup.inf.c.minit;
+ time_sup.r.o.moffset += ERTS_MONOTONIC_BEGIN;
+ offset = time_sup.inf.c.sinit;
+ offset -= ERTS_MONOTONIC_BEGIN;
+ init_time_offset(offset);
+
+ rwmtx_opts.type = ERTS_SMP_RWMTX_TYPE_EXTREMELY_FREQUENT_READ;
+ rwmtx_opts.lived = ERTS_SMP_RWMTX_LONG_LIVED;
+
+ erts_smp_rwmtx_init_opt(&time_sup.inf.c.parmon.rwmtx, &rwmtx_opts,
+ "get_corrected_time", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
+
+ cdatap = &time_sup.inf.c.parmon.cdata;
+
+ cdatap->drift.intervals[0].time.sys = time_sup.inf.c.sinit;
+ cdatap->drift.intervals[0].time.mon = time_sup.inf.c.minit;
+ cdatap->insts.curr.correction.drift = 0;
+ cdatap->insts.curr.correction.error = 0;
+ cdatap->insts.curr.erl_mtime = ERTS_MONOTONIC_BEGIN;
+ cdatap->insts.curr.os_mtime = time_sup.inf.c.minit;
+ cdatap->last_check = time_sup.inf.c.minit;
+ cdatap->short_check_interval = ERTS_INIT_SHORT_INTERVAL_COUNTER;
+ cdatap->insts.prev = cdatap->insts.curr;
+
+ if (!time_sup.r.o.os_corrected_monotonic_time)
+ time_sup.r.o.get_time = get_corrected_time;
+ else if (time_sup.r.o.warp_mode == ERTS_MULTI_TIME_WARP_MODE)
+ time_sup.r.o.get_time = get_os_corrected_time;
+ else
+ time_sup.r.o.get_time = get_os_drift_corrected_time;
+ }
+ else
#endif
+ {
+ ErtsMonotonicTime stime, offset;
+ time_sup.r.o.get_time = get_not_corrected_time;
+ stime = time_sup.inf.c.sinit = erts_os_system_time();
+ offset = stime - ERTS_MONOTONIC_BEGIN;
+ time_sup.inf.c.not_corrected_moffset = offset;
+ init_time_offset(offset);
+ time_sup.f.c.last_not_corrected_time = 0;
+ }
-/*
-** The clock resolution should really be the resolution of the
-** time function in use, which on most platforms
-** is 1. On VxWorks the resolution should be
-** the number of ticks per second (or 1, which would work nicely to).
-**
-** Setting lower resolutions is mostly interesting when timers are used
-** instead of something like select.
-*/
+ erts_smp_atomic64_init_nob(&wall_clock_prev.time,
+ (erts_aint64_t) 0);
+
+ erts_smp_atomic64_init_nob(
+ &now_prev.time,
+ (erts_aint64_t) ERTS_MONOTONIC_TO_USEC(get_time_offset()));
+
+
+#ifdef DEBUG
+ time_sup_initialized = 1;
+#endif
-static SysTimeval last_delivered;
+ return ERTS_CLKTCK_RESOLUTION/1000;
+}
-static void init_erts_deliver_time(const SysTimeval *inittv)
+void
+erts_late_init_time_sup(void)
{
- /* We set the initial values for deliver_time here */
- last_delivered = *inittv;
- last_delivered.tv_usec = 1000 * (last_delivered.tv_usec / 1000);
- /* ms resolution */
+ erts_late_sys_init_time();
}
-static void do_erts_deliver_time(const SysTimeval *current)
+void
+erts_sched_init_time_sup(ErtsSchedulerData *esdp)
{
- SysTimeval cur_time;
- erts_time_t elapsed;
-
- /* calculate and deliver appropriate number of ticks */
- cur_time = *current;
- cur_time.tv_usec = 1000 * (cur_time.tv_usec / 1000); /* ms resolution */
- elapsed = (1000 * (cur_time.tv_sec - last_delivered.tv_sec) +
- (cur_time.tv_usec - last_delivered.tv_usec) / 1000) /
- CLOCK_RESOLUTION;
-
- /* Sometimes the time jump backwards,
- resulting in a negative elapsed time. We compensate for
- this by simply pretend as if the time stood still. :) */
-
- if (elapsed > 0) {
+ esdp->timer_wheel = erts_create_timer_wheel(esdp);
+ esdp->next_tmo_ref = erts_get_next_timeout_reference(esdp->timer_wheel);
+ esdp->timer_service = erts_create_timer_service();
+#ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT
+ if (esdp->no == 1) {
+ /* A timer wheel to use must have beeen initialized */
+ if (time_sup.r.o.get_time != get_not_corrected_time)
+ late_init_time_correction(esdp);
+ }
+#endif
+}
- ASSERT(elapsed < ((erts_time_t) ERTS_SHORT_TIME_T_MAX));
+ErtsTimeWarpMode erts_time_warp_mode(void)
+{
+ return time_sup.r.o.warp_mode;
+}
- erts_do_time_add((erts_short_time_t) elapsed);
- last_delivered = cur_time;
+ErtsTimeOffsetState erts_time_offset_state(void)
+{
+ switch (time_sup.r.o.warp_mode) {
+ case ERTS_NO_TIME_WARP_MODE:
+ return ERTS_TIME_OFFSET_FINAL;
+ case ERTS_SINGLE_TIME_WARP_MODE:
+ if (erts_smp_atomic32_read_nob(&time_sup.inf.c.preliminary_offset))
+ return ERTS_TIME_OFFSET_PRELIMINARY;
+ return ERTS_TIME_OFFSET_FINAL;
+ case ERTS_MULTI_TIME_WARP_MODE:
+ return ERTS_TIME_OFFSET_VOLATILE;
+ default:
+ ERTS_INTERNAL_ERROR("Invalid time warp mode");
+ return ERTS_TIME_OFFSET_VOLATILE;
}
}
-int
-erts_init_time_sup(void)
+/*
+ * erts_finalize_time_offset() will only change time offset
+ * the first time it is called when the emulator has been
+ * started in "single time warp" mode. Returns previous
+ * state:
+ * * ERTS_TIME_OFFSET_PRELIMINARY - Finalization performed
+ * * ERTS_TIME_OFFSET_FINAL - Already finialized; nothing changed
+ * * ERTS_TIME_OFFSET_VOLATILE - Not supported, either in
+ * * no correction mode (or multi time warp mode; not yet implemented).
+ */
+
+ErtsTimeOffsetState
+erts_finalize_time_offset(void)
{
- erts_smp_mtx_init(&erts_timeofday_mtx, "timeofday");
+ switch (time_sup.r.o.warp_mode) {
+ case ERTS_NO_TIME_WARP_MODE:
+ return ERTS_TIME_OFFSET_FINAL;
+ case ERTS_MULTI_TIME_WARP_MODE:
+ return ERTS_TIME_OFFSET_VOLATILE;
+ case ERTS_SINGLE_TIME_WARP_MODE: {
+ ErtsTimeOffsetState res = ERTS_TIME_OFFSET_FINAL;
- init_approx_time();
+ erts_smp_mtx_lock(&erts_get_time_mtx);
- last_emu_time.tv_sec = 0;
- last_emu_time.tv_usec = 0;
+ if (erts_smp_atomic32_read_nob(&time_sup.inf.c.preliminary_offset)) {
+ ErtsMonotonicTime mtime, new_offset;
-#ifndef SYS_CLOCK_RESOLUTION
- clock_resolution = sys_init_time();
-#else
- (void) sys_init_time();
+#ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT
+ if (!time_sup.r.o.correction)
#endif
- sys_gettimeofday(&inittv);
-
-#ifdef HAVE_GETHRTIME
- sys_init_hrtime();
+ {
+ ErtsMonotonicTime stime = erts_os_system_time();
+
+ mtime = stime - time_sup.inf.c.not_corrected_moffset;
+
+ if (mtime >= time_sup.f.c.last_not_corrected_time) {
+ time_sup.f.c.last_not_corrected_time = mtime;
+ new_offset = time_sup.inf.c.not_corrected_moffset;
+ }
+ else {
+ mtime = time_sup.f.c.last_not_corrected_time;
+
+ ASSERT(time_sup.inf.c.not_corrected_moffset != stime - mtime);
+ new_offset = stime - mtime;
+ time_sup.inf.c.not_corrected_moffset = new_offset;
+ }
+
+ }
+#ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT
+ else {
+ ErtsSystemTime stime;
+ mtime = finalize_corrected_time_offset(&stime);
+ new_offset = stime - mtime;
+ }
#endif
- init_tolerant_timeofday();
+ new_offset = ERTS_MONOTONIC_TO_USEC(new_offset);
+ new_offset = ERTS_USEC_TO_MONOTONIC(new_offset);
+
+ set_time_offset(new_offset);
+ schedule_send_time_offset_changed_notifications(new_offset);
- init_erts_deliver_time(&inittv);
- gtv = inittv;
- then.tv_sec = then.tv_usec = 0;
+ erts_smp_atomic32_set_nob(&time_sup.inf.c.preliminary_offset, 0);
+ res = ERTS_TIME_OFFSET_PRELIMINARY;
+ }
- erts_deliver_time();
+ erts_smp_mtx_unlock(&erts_get_time_mtx);
+
+ return res;
+ }
+ default:
+ ERTS_INTERNAL_ERROR("Invalid time warp mode");
+ return ERTS_TIME_OFFSET_VOLATILE;
+ }
+}
- return CLOCK_RESOLUTION;
-}
/* info functions */
void
-elapsed_time_both(UWord *ms_user, UWord *ms_sys,
- UWord *ms_user_diff, UWord *ms_sys_diff)
+erts_runtime_elapsed_both(ErtsMonotonicTime *ms_user, ErtsMonotonicTime *ms_sys,
+ ErtsMonotonicTime *ms_user_diff, ErtsMonotonicTime *ms_sys_diff)
{
- UWord prev_total_user, prev_total_sys;
- UWord total_user, total_sys;
+ ErtsMonotonicTime prev_user, prev_sys, user, sys;
+
+#ifdef HAVE_GETRUSAGE
+
+ struct rusage now;
+
+ if (getrusage(RUSAGE_SELF, &now) != 0) {
+ erts_exit(ERTS_ABORT_EXIT, "getrusage(RUSAGE_SELF, _) failed: %d\n", errno);
+ return;
+ }
+
+ user = (ErtsMonotonicTime) now.ru_utime.tv_sec;
+ user *= (ErtsMonotonicTime) 1000000;
+ user += (ErtsMonotonicTime) now.ru_utime.tv_usec;
+ user /= (ErtsMonotonicTime) 1000;
+
+ sys = (ErtsMonotonicTime) now.ru_stime.tv_sec;
+ sys *= (ErtsMonotonicTime) 1000000;
+ sys += (ErtsMonotonicTime) now.ru_stime.tv_usec;
+ sys /= (ErtsMonotonicTime) 1000;
+
+#else
+
SysTimes now;
sys_times(&now);
- total_user = (now.tms_utime * 1000) / SYS_CLK_TCK;
- total_sys = (now.tms_stime * 1000) / SYS_CLK_TCK;
+ user = (ErtsMonotonicTime) now.tms_utime;
+ user *= (ErtsMonotonicTime) 1000;
+ user /= (ErtsMonotonicTime) SYS_CLK_TCK;
- if (ms_user != NULL)
- *ms_user = total_user;
- if (ms_sys != NULL)
- *ms_sys = total_sys;
+ sys = (ErtsMonotonicTime) now.tms_stime;
+ sys *= (ErtsMonotonicTime) 1000;
+ sys /= (ErtsMonotonicTime) SYS_CLK_TCK;
- erts_smp_mtx_lock(&erts_timeofday_mtx);
-
- prev_total_user = (t_start.tms_utime * 1000) / SYS_CLK_TCK;
- prev_total_sys = (t_start.tms_stime * 1000) / SYS_CLK_TCK;
- t_start = now;
-
- erts_smp_mtx_unlock(&erts_timeofday_mtx);
+#endif
+
+ if (ms_user)
+ *ms_user = user;
+ if (ms_sys)
+ *ms_sys = sys;
+
+ if (ms_user_diff || ms_sys_diff) {
+
+ erts_smp_mtx_lock(&runtime_prev.data.mtx);
+
+ prev_user = runtime_prev.data.user;
+ prev_sys = runtime_prev.data.sys;
+ runtime_prev.data.user = user;
+ runtime_prev.data.sys = sys;
- if (ms_user_diff != NULL)
- *ms_user_diff = total_user - prev_total_user;
-
- if (ms_sys_diff != NULL)
- *ms_sys_diff = total_sys - prev_total_sys;
+ erts_smp_mtx_unlock(&runtime_prev.data.mtx);
+
+ if (ms_user_diff)
+ *ms_user_diff = user - prev_user;
+ if (ms_sys_diff)
+ *ms_sys_diff = sys - prev_sys;
+ }
}
/* wall clock routines */
void
-wall_clock_elapsed_time_both(UWord *ms_total, UWord *ms_diff)
+erts_wall_clock_elapsed_both(ErtsMonotonicTime *ms_total, ErtsMonotonicTime *ms_diff)
{
- UWord prev_total;
- SysTimeval tv;
+ ErtsMonotonicTime now, elapsed;
- erts_smp_mtx_lock(&erts_timeofday_mtx);
+ now = time_sup.r.o.get_time();
+ update_last_mtime(NULL, now);
- get_tolerant_timeofday(&tv);
+ elapsed = ERTS_MONOTONIC_TO_MSEC(now);
+ elapsed -= ERTS_MONOTONIC_TO_MSEC(ERTS_MONOTONIC_BEGIN);
- *ms_total = 1000 * (tv.tv_sec - inittv.tv_sec) +
- (tv.tv_usec - inittv.tv_usec) / 1000;
+ *ms_total = elapsed;
- prev_total = 1000 * (gtv.tv_sec - inittv.tv_sec) +
- (gtv.tv_usec - inittv.tv_usec) / 1000;
- *ms_diff = *ms_total - prev_total;
- gtv = tv;
+ if (ms_diff) {
+ ErtsMonotonicTime prev;
- /* must sync the machine's idea of time here */
- do_erts_deliver_time(&tv);
+ prev = ((ErtsMonotonicTime)
+ erts_smp_atomic64_xchg_mb(&wall_clock_prev.time,
+ (erts_aint64_t) elapsed));
- erts_smp_mtx_unlock(&erts_timeofday_mtx);
+ *ms_diff = elapsed - prev;
+ }
}
/* get current time */
@@ -680,7 +1562,7 @@ static time_t gregday(int year, int month, int day)
pyear = gyear - 1;
ndays = (pyear/4) - (pyear/100) + (pyear/400) + pyear*365 + 366;
}
- /* number of days in all months preceeding month */
+ /* number of days in all months preceding month */
for (m = 1; m < month; m++)
ndays += mdays[m];
/* Extra day if leap year and March or later */
@@ -890,146 +1772,754 @@ univ_to_local(Sint *year, Sint *month, Sint *day,
return 0;
}
-
/* get a timestamp */
void
get_now(Uint* megasec, Uint* sec, Uint* microsec)
{
- SysTimeval now;
+ ErtsMonotonicTime now_megasec, now_sec, now, prev, mtime, time_offset;
- erts_smp_mtx_lock(&erts_timeofday_mtx);
-
- get_tolerant_timeofday(&now);
- do_erts_deliver_time(&now);
-
- /* Make sure time is later than last */
- if (then.tv_sec > now.tv_sec ||
- (then.tv_sec == now.tv_sec && then.tv_usec >= now.tv_usec)) {
- now = then;
- now.tv_usec++;
- }
- /* Check for carry from above + general reasonability */
- if (now.tv_usec >= 1000000) {
- now.tv_usec = 0;
- now.tv_sec++;
+ mtime = time_sup.r.o.get_time();
+ time_offset = get_time_offset();
+ update_last_mtime(NULL, mtime);
+ now = ERTS_MONOTONIC_TO_USEC(mtime + time_offset);
+
+ /* Make sure now time is later than last time */
+ prev = erts_smp_atomic64_read_nob(&now_prev.time);
+ while (1) {
+ ErtsMonotonicTime act;
+ if (now <= prev)
+ now = prev + 1;
+ act = ((ErtsMonotonicTime)
+ erts_smp_atomic64_cmpxchg_mb(&now_prev.time,
+ (erts_aint64_t) now,
+ (erts_aint64_t) prev));
+ if (act == prev)
+ break;
+ prev = act;
}
- then = now;
-
- erts_smp_mtx_unlock(&erts_timeofday_mtx);
-
- *megasec = (Uint) (now.tv_sec / 1000000);
- *sec = (Uint) (now.tv_sec % 1000000);
- *microsec = (Uint) (now.tv_usec);
- update_approx_time(&now);
+ now_megasec = now / ERTS_MONOTONIC_TIME_TERA;
+ now_sec = now / ERTS_MONOTONIC_TIME_MEGA;
+ *megasec = (Uint) now_megasec;
+ *sec = (Uint) (now_sec - now_megasec*ERTS_MONOTONIC_TIME_MEGA);
+ *microsec = (Uint) (now - now_sec*ERTS_MONOTONIC_TIME_MEGA);
+
+ ASSERT(((ErtsMonotonicTime) *megasec)*ERTS_MONOTONIC_TIME_TERA
+ + ((ErtsMonotonicTime) *sec)*ERTS_MONOTONIC_TIME_MEGA
+ + ((ErtsMonotonicTime) *microsec) == now);
+}
+
+ErtsMonotonicTime
+erts_get_monotonic_time(ErtsSchedulerData *esdp)
+{
+ ErtsMonotonicTime mtime = time_sup.r.o.get_time();
+ update_last_mtime(esdp, 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
get_sys_now(Uint* megasec, Uint* sec, Uint* microsec)
{
- SysTimeval now;
-
- sys_gettimeofday(&now);
-
- *megasec = (Uint) (now.tv_sec / 1000000);
- *sec = (Uint) (now.tv_sec % 1000000);
- *microsec = (Uint) (now.tv_usec);
+ ErtsSystemTime stime = erts_os_system_time();
+ ErtsSystemTime ms, s, us;
+
+ us = ERTS_MONOTONIC_TO_USEC(stime);
+ s = us / (1000*1000);
+ ms = s / (1000*1000);
- update_approx_time(&now);
+ *megasec = (Uint) ms;
+ *sec = (Uint) (s - ms*(1000*1000));
+ *microsec = (Uint) (us - s*(1000*1000));
}
+#ifdef HAVE_ERTS_NOW_CPU
+void erts_get_now_cpu(Uint* megasec, Uint* sec, Uint* microsec) {
+ SysCpuTime t;
+ SysTimespec tp;
-/* deliver elapsed *ticks* to the machine - takes a pointer
- to a struct timeval representing current time (to save
- a gettimeofday() where possible) or NULL */
+ sys_get_proc_cputime(t, tp);
+ *microsec = (Uint)(tp.tv_nsec / 1000);
+ t = (tp.tv_sec / 1000000);
+ *megasec = (Uint)(t % 1000000);
+ *sec = (Uint)(tp.tv_sec % 1000000);
+}
+#endif
-void erts_deliver_time(void) {
- SysTimeval now;
-
- erts_smp_mtx_lock(&erts_timeofday_mtx);
-
- get_tolerant_timeofday(&now);
- do_erts_deliver_time(&now);
-
- erts_smp_mtx_unlock(&erts_timeofday_mtx);
+#include "big.h"
- update_approx_time(&now);
+void
+erts_monitor_time_offset(Eterm id, Eterm ref)
+{
+ erts_smp_mtx_lock(&erts_get_time_mtx);
+ erts_add_monitor(&time_offset_monitors, MON_TIME_OFFSET, ref, id, NIL);
+ no_time_offset_monitors++;
+ erts_smp_mtx_unlock(&erts_get_time_mtx);
}
-/* get *real* time (not ticks) remaining until next timeout - if there
- isn't one, give a "long" time, that is guaranteed
- to not cause overflow when we report elapsed time later on */
+int
+erts_demonitor_time_offset(Eterm ref)
+{
+ int res;
+ ErtsMonitor *mon;
+ ASSERT(is_internal_ref(ref));
+ erts_smp_mtx_lock(&erts_get_time_mtx);
+ if (is_internal_ordinary_ref(ref))
+ mon = erts_remove_monitor(&time_offset_monitors, ref);
+ else
+ mon = NULL;
+ if (!mon)
+ res = 0;
+ else {
+ ASSERT(no_time_offset_monitors > 0);
+ no_time_offset_monitors--;
+ res = 1;
+ }
+ erts_smp_mtx_unlock(&erts_get_time_mtx);
+ if (res)
+ erts_destroy_monitor(mon);
+ return res;
+}
+
+typedef struct {
+ Eterm pid;
+ Eterm ref;
+ Eterm heap[ERTS_REF_THING_SIZE];
+} ErtsTimeOffsetMonitorInfo;
-void erts_time_remaining(SysTimeval *rem_time)
+typedef struct {
+ Uint ix;
+ ErtsTimeOffsetMonitorInfo *to_mon_info;
+} ErtsTimeOffsetMonitorContext;
+
+static void
+save_time_offset_monitor(ErtsMonitor *mon, void *vcntxt)
{
- erts_time_t ticks;
- SysTimeval cur_time;
- erts_time_t elapsed;
+ ErtsTimeOffsetMonitorContext *cntxt;
+ Eterm *from_hp, *to_hp;
+ Uint mix;
+ int hix;
- /* erts_next_time() returns no of ticks to next timeout or -1 if none */
+ cntxt = (ErtsTimeOffsetMonitorContext *) vcntxt;
+ mix = (cntxt->ix)++;
+ cntxt->to_mon_info[mix].pid = mon->u.pid;
+ to_hp = &cntxt->to_mon_info[mix].heap[0];
- ticks = (erts_time_t) erts_next_time();
- if (ticks == (erts_time_t) -1) {
- /* timer queue empty */
- /* this will cause at most 100000000 ticks */
- rem_time->tv_sec = 100000;
- rem_time->tv_usec = 0;
- } else {
- /* next timeout after ticks ticks */
- ticks *= CLOCK_RESOLUTION;
-
- erts_smp_mtx_lock(&erts_timeofday_mtx);
-
- get_tolerant_timeofday(&cur_time);
- cur_time.tv_usec = 1000 *
- (cur_time.tv_usec / 1000);/* ms resolution*/
- elapsed = 1000 * (cur_time.tv_sec - last_delivered.tv_sec) +
- (cur_time.tv_usec - last_delivered.tv_usec) / 1000;
-
- erts_smp_mtx_unlock(&erts_timeofday_mtx);
+ ASSERT(is_internal_ordinary_ref(mon->ref));
+ from_hp = internal_ref_val(mon->ref);
+ ASSERT(thing_arityval(*from_hp) + 1 == ERTS_REF_THING_SIZE);
+
+ for (hix = 0; hix < ERTS_REF_THING_SIZE; hix++)
+ to_hp[hix] = from_hp[hix];
+
+ cntxt->to_mon_info[mix].ref
+ = make_internal_ref(&cntxt->to_mon_info[mix].heap[0]);
+
+}
+
+static void
+send_time_offset_changed_notifications(void *new_offsetp)
+{
+ ErtsMonotonicTime new_offset;
+ ErtsTimeOffsetMonitorInfo *to_mon_info = NULL; /* Shut up faulty warning */
+ Uint no_monitors;
+ char *tmp = NULL;
+
+#ifdef ARCH_64
+ new_offset = (ErtsMonotonicTime) new_offsetp;
+#else
+ new_offset = *((ErtsMonotonicTime *) new_offsetp);
+ erts_free(ERTS_ALC_T_NEW_TIME_OFFSET, new_offsetp);
+#endif
+ new_offset -= ERTS_MONOTONIC_OFFSET_NATIVE;
+
+ erts_smp_mtx_lock(&erts_get_time_mtx);
+
+ no_monitors = no_time_offset_monitors;
+ if (no_monitors) {
+ ErtsTimeOffsetMonitorContext cntxt;
+ Uint alloc_sz;
- if (ticks <= elapsed) { /* Ooops, better hurry */
- rem_time->tv_sec = rem_time->tv_usec = 0;
- return;
+ /* Monitor info array size */
+ alloc_sz = no_monitors*sizeof(ErtsTimeOffsetMonitorInfo);
+ /* + template max size */
+ alloc_sz += 6*sizeof(Eterm); /* 5-tuple */
+ alloc_sz += ERTS_MAX_SINT64_HEAP_SIZE*sizeof(Eterm); /* max offset size */
+ tmp = erts_alloc(ERTS_ALC_T_TMP, alloc_sz);
+
+ to_mon_info = (ErtsTimeOffsetMonitorInfo *) tmp;
+ cntxt.ix = 0;
+ cntxt.to_mon_info = to_mon_info;
+
+ erts_doforall_monitors(time_offset_monitors,
+ save_time_offset_monitor,
+ &cntxt);
+
+ ASSERT(cntxt.ix == no_monitors);
+ }
+
+ erts_smp_mtx_unlock(&erts_get_time_mtx);
+
+ if (no_monitors) {
+ Eterm *hp, *patch_refp, new_offset_term, message_template;
+ Uint mix, hsz;
+
+ /* Make message template */
+
+ hp = (Eterm *) (tmp + no_monitors*sizeof(ErtsTimeOffsetMonitorInfo));
+
+ hsz = 6; /* 5-tuple */
+ hsz += ERTS_REF_THING_SIZE;
+ hsz += ERTS_SINT64_HEAP_SIZE(new_offset);
+
+ if (IS_SSMALL(new_offset))
+ new_offset_term = make_small(new_offset);
+ else
+ new_offset_term = erts_sint64_to_big(new_offset, &hp);
+ message_template = TUPLE5(hp,
+ am_CHANGE,
+ THE_NON_VALUE, /* Patch point for ref */
+ am_time_offset,
+ am_clock_service,
+ new_offset_term);
+ patch_refp = &hp[2];
+
+ ASSERT(*patch_refp == THE_NON_VALUE);
+
+ for (mix = 0; mix < no_monitors; mix++) {
+ Process *rp = erts_proc_lookup(to_mon_info[mix].pid);
+ if (rp) {
+ Eterm ref = to_mon_info[mix].ref;
+ 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)) {
+ ErtsMessage *mp;
+ ErlOffHeap *ohp;
+ Eterm message;
+
+ 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, mp, message, am_clock_service);
+ }
+ erts_smp_proc_unlock(rp, rp_locks);
+ }
}
- rem_time->tv_sec = (ticks - elapsed) / 1000;
- rem_time->tv_usec = 1000 * ((ticks - elapsed) % 1000);
+
+ erts_free(ERTS_ALC_T_TMP, tmp);
}
}
-void erts_get_timeval(SysTimeval *tv)
+static void
+schedule_send_time_offset_changed_notifications(ErtsMonotonicTime new_offset)
{
- erts_smp_mtx_lock(&erts_timeofday_mtx);
- get_tolerant_timeofday(tv);
- erts_smp_mtx_unlock(&erts_timeofday_mtx);
- update_approx_time(tv);
+#ifdef ARCH_64
+ void *new_offsetp = (void *) new_offset;
+ ASSERT(sizeof(void *) == sizeof(ErtsMonotonicTime));
+#else
+ void *new_offsetp = erts_alloc(ERTS_ALC_T_NEW_TIME_OFFSET,
+ sizeof(ErtsMonotonicTime));
+ *((ErtsMonotonicTime *) new_offsetp) = new_offset;
+#endif
+ erts_schedule_misc_aux_work(1,
+ send_time_offset_changed_notifications,
+ new_offsetp);
}
-erts_time_t
-erts_get_time(void)
+static ERTS_INLINE Eterm
+make_time_val(Process *c_p, ErtsMonotonicTime time_val)
{
- SysTimeval sys_tv;
-
- erts_smp_mtx_lock(&erts_timeofday_mtx);
-
- get_tolerant_timeofday(&sys_tv);
-
- erts_smp_mtx_unlock(&erts_timeofday_mtx);
+ Sint64 val = (Sint64) time_val;
+ Eterm *hp;
+ Uint sz;
- update_approx_time(&sys_tv);
+ if (IS_SSMALL(val))
+ return make_small(val);
- return sys_tv.tv_sec;
+ sz = ERTS_SINT64_HEAP_SIZE(val);
+ hp = HAlloc(c_p, sz);
+ return erts_sint64_to_big(val, &hp);
}
-#ifdef HAVE_ERTS_NOW_CPU
-void erts_get_now_cpu(Uint* megasec, Uint* sec, Uint* microsec) {
- SysCpuTime t;
- SysTimespec tp;
+Eterm
+erts_get_monotonic_start_time(struct process *c_p)
+{
+ return make_time_val(c_p, ERTS_MONOTONIC_TIME_START_EXTERNAL);
+}
- sys_get_proc_cputime(t, tp);
- *microsec = (Uint)(tp.tv_nsec / 1000);
- t = (tp.tv_sec / 1000000);
- *megasec = (Uint)(t % 1000000);
- *sec = (Uint)(tp.tv_sec % 1000000);
+Eterm
+erts_get_monotonic_end_time(struct process *c_p)
+{
+ return make_time_val(c_p, ERTS_MONOTONIC_TIME_END_EXTERNAL);
+}
+
+static Eterm
+bld_monotonic_time_source(Uint **hpp, Uint *szp, Sint64 os_mtime)
+{
+#ifndef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT
+ return NIL;
+#else
+ int i = 0;
+ Eterm k[6];
+ Eterm v[6];
+
+ if (time_sup.r.o.os_monotonic_time_disable)
+ return NIL;
+
+ k[i] = erts_bld_atom(hpp, szp, "function");
+ v[i++] = erts_bld_atom(hpp, szp,
+ time_sup.r.o.os_monotonic_time_func);
+
+ if (time_sup.r.o.os_monotonic_time_clock_id) {
+ k[i] = erts_bld_atom(hpp, szp, "clock_id");
+ v[i++] = erts_bld_atom(hpp, szp,
+ time_sup.r.o.os_monotonic_time_clock_id);
+ }
+
+ k[i] = erts_bld_atom(hpp, szp, "resolution");
+ v[i++] = erts_bld_uint64(hpp, szp,
+ time_sup.r.o.os_monotonic_time_resolution);
+
+ k[i] = erts_bld_atom(hpp, szp, "extended");
+ v[i++] = time_sup.r.o.os_monotonic_time_extended ? am_yes : am_no;
+
+ k[i] = erts_bld_atom(hpp, szp, "parallel");
+ v[i++] = time_sup.r.o.os_monotonic_time_locked ? am_no : am_yes;
+
+ k[i] = erts_bld_atom(hpp, szp, "time");
+ v[i++] = erts_bld_sint64(hpp, szp, os_mtime);
+
+ return erts_bld_2tup_list(hpp, szp, (Sint) i, k, v);
+#endif
}
+
+Eterm
+erts_monotonic_time_source(struct process *c_p)
+{
+ Uint hsz = 0;
+ Eterm *hp = NULL;
+ Sint64 os_mtime = 0;
+#ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT
+ if (!time_sup.r.o.os_monotonic_time_disable)
+ os_mtime = (Sint64) erts_os_monotonic_time();
+#endif
+
+ bld_monotonic_time_source(NULL, &hsz, os_mtime);
+ if (hsz)
+ hp = HAlloc(c_p, hsz);
+ return bld_monotonic_time_source(&hp, NULL, os_mtime);
+}
+
+static Eterm
+bld_system_time_source(Uint **hpp, Uint *szp, Sint64 os_stime)
+{
+ int i = 0;
+ Eterm k[5];
+ Eterm v[5];
+
+ k[i] = erts_bld_atom(hpp, szp, "function");
+ v[i++] = erts_bld_atom(hpp, szp,
+ time_sup.r.o.os_system_time_func);
+
+ if (time_sup.r.o.os_system_time_clock_id) {
+ k[i] = erts_bld_atom(hpp, szp, "clock_id");
+ v[i++] = erts_bld_atom(hpp, szp,
+ time_sup.r.o.os_system_time_clock_id);
+ }
+
+ k[i] = erts_bld_atom(hpp, szp, "resolution");
+ v[i++] = erts_bld_uint64(hpp, szp,
+ time_sup.r.o.os_system_time_resolution);
+
+ k[i] = erts_bld_atom(hpp, szp, "parallel");
+ v[i++] = am_yes;
+
+ k[i] = erts_bld_atom(hpp, szp, "time");
+ v[i++] = erts_bld_sint64(hpp, szp, os_stime);
+
+ return erts_bld_2tup_list(hpp, szp, (Sint) i, k, v);
+}
+
+Eterm
+erts_system_time_source(struct process *c_p)
+{
+ Uint hsz = 0;
+ Eterm *hp = NULL;
+ Sint64 os_stime = (Sint64) erts_os_system_time();
+
+ bld_system_time_source(NULL, &hsz, os_stime);
+ if (hsz)
+ hp = HAlloc(c_p, hsz);
+ return bld_system_time_source(&hp, NULL, os_stime);
+}
+
+
+#include "bif.h"
+
+static ERTS_INLINE Eterm
+time_unit_conversion(Process *c_p, Eterm term, ErtsMonotonicTime val, ErtsMonotonicTime muloff)
+{
+ ErtsMonotonicTime result;
+ BIF_RETTYPE ret;
+
+ if (val < 0)
+ goto trap_to_erlang_code;
+
+ /* Convert to common user specified time units */
+ switch (term) {
+ case am_second:
+ case am_seconds:
+ case make_small(1):
+ result = ERTS_MONOTONIC_TO_SEC(val) + muloff*ERTS_MONOTONIC_OFFSET_SEC;
+ ERTS_BIF_PREP_RET(ret, make_time_val(c_p, result));
+ break;
+ case am_millisecond:
+ case am_milli_seconds:
+ case make_small(1000):
+ result = ERTS_MONOTONIC_TO_MSEC(val) + muloff*ERTS_MONOTONIC_OFFSET_MSEC;
+ ERTS_BIF_PREP_RET(ret, make_time_val(c_p, result));
+ break;
+ case am_microsecond:
+ case am_micro_seconds:
+ case make_small(1000*1000):
+ result = ERTS_MONOTONIC_TO_USEC(val) + muloff*ERTS_MONOTONIC_OFFSET_USEC;
+ ERTS_BIF_PREP_RET(ret, make_time_val(c_p, result));
+ break;
+#ifdef ARCH_64
+ case am_nanosecond:
+ case am_nano_seconds:
+ case make_small(1000*1000*1000):
+ result = ERTS_MONOTONIC_TO_NSEC(val) + muloff*ERTS_MONOTONIC_OFFSET_NSEC;
+ ERTS_BIF_PREP_RET(ret, make_time_val(c_p, result));
+ break;
+#endif
+ default: {
+ Eterm value, native_res;
+#ifndef ARCH_64
+ Sint user_res;
+ if (term == am_nanosecond || term == am_nano_seconds)
+ goto to_nano_seconds;
+ if (term_to_Sint(term, &user_res)) {
+ if (user_res == 1000*1000*1000) {
+ to_nano_seconds:
+ result = (ERTS_MONOTONIC_TO_NSEC(val)
+ + muloff*ERTS_MONOTONIC_OFFSET_NSEC);
+ ERTS_BIF_PREP_RET(ret, make_time_val(c_p, result));
+ break;
+ }
+ if (user_res <= 0)
+ goto badarg;
+ }
+#else
+ if (is_small(term)) {
+ if (signed_val(term) <= 0)
+ goto badarg;
+ }
#endif
+ else if (is_big(term)) {
+ if (big_sign(term))
+ goto badarg;
+ }
+ else {
+ badarg:
+ ERTS_BIF_PREP_ERROR(ret, c_p, BADARG);
+ break;
+ }
+
+ trap_to_erlang_code:
+ /* Do it in erlang code instead; pass along values to use... */
+ value = make_time_val(c_p, val + muloff*ERTS_MONOTONIC_OFFSET_NATIVE);
+ native_res = make_time_val(c_p, ERTS_MONOTONIC_TIME_UNIT);
+
+ ERTS_BIF_PREP_TRAP3(ret, erts_convert_time_unit_trap, c_p,
+ value, native_res, term);
+
+ break;
+ }
+ }
+
+ 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)
+{
+ ErtsMonotonicTime mtime = time_sup.r.o.get_time();
+ update_last_mtime(erts_proc_sched_data(BIF_P), mtime);
+ mtime += ERTS_MONOTONIC_OFFSET_NATIVE;
+ BIF_RET(make_time_val(BIF_P, mtime));
+}
+
+BIF_RETTYPE monotonic_time_1(BIF_ALIST_1)
+{
+ ErtsMonotonicTime mtime = time_sup.r.o.get_time();
+ update_last_mtime(erts_proc_sched_data(BIF_P), mtime);
+ BIF_RET(time_unit_conversion(BIF_P, BIF_ARG_1, mtime, 1));
+}
+
+BIF_RETTYPE system_time_0(BIF_ALIST_0)
+{
+ ErtsMonotonicTime mtime, offset;
+ mtime = time_sup.r.o.get_time();
+ offset = get_time_offset();
+ update_last_mtime(erts_proc_sched_data(BIF_P), mtime);
+ BIF_RET(make_time_val(BIF_P, mtime + offset));
+}
+
+BIF_RETTYPE system_time_1(BIF_ALIST_0)
+{
+ ErtsMonotonicTime mtime, offset;
+ mtime = time_sup.r.o.get_time();
+ offset = get_time_offset();
+ update_last_mtime(erts_proc_sched_data(BIF_P), mtime);
+ BIF_RET(time_unit_conversion(BIF_P, BIF_ARG_1, mtime + offset, 0));
+}
+
+BIF_RETTYPE erts_internal_time_unit_0(BIF_ALIST_0)
+{
+ BIF_RET(make_time_val(BIF_P, ERTS_MONOTONIC_TIME_UNIT));
+}
+
+BIF_RETTYPE time_offset_0(BIF_ALIST_0)
+{
+ ErtsMonotonicTime time_offset = get_time_offset();
+ time_offset -= ERTS_MONOTONIC_OFFSET_NATIVE;
+ BIF_RET(make_time_val(BIF_P, time_offset));
+}
+
+BIF_RETTYPE time_offset_1(BIF_ALIST_1)
+{
+ BIF_RET(time_unit_conversion(BIF_P, BIF_ARG_1, get_time_offset(), -1));
+}
+
+
+BIF_RETTYPE timestamp_0(BIF_ALIST_0)
+{
+ Eterm *hp, res;
+ 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_sched_data(BIF_P), mtime);
+
+ make_timestamp_value(&mega_sec, &sec, &micro_sec, mtime, offset);
+
+ /*
+ * Mega seconds is the only value that potentially
+ * ever could be a bignum. However, that wont happen
+ * during at least the next 4 million years...
+ *
+ * (System time will also have wrapped in the
+ * 64-bit integer before we get there...)
+ */
+
+ ASSERT(IS_USMALL(0, mega_sec));
+ ASSERT(IS_USMALL(0, sec));
+ ASSERT(IS_USMALL(0, micro_sec));
+
+ hp = HAlloc(BIF_P, 4);
+ res = TUPLE3(hp,
+ make_small(mega_sec),
+ make_small(sec),
+ make_small(micro_sec));
+ BIF_RET(res);
+}
+
+BIF_RETTYPE os_system_time_0(BIF_ALIST_0)
+{
+ ErtsSystemTime stime = erts_os_system_time();
+ BIF_RET(make_time_val(BIF_P, stime));
+}
+
+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 305058ceff..db7d0ac449 100644
--- a/erts/emulator/beam/erl_trace.c
+++ b/erts/emulator/beam/erl_trace.c
@@ -1,24 +1,38 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1999-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1999-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
/*
* Support functions for tracing.
+ *
+ * Ideas for future speed improvements in tracing framework:
+ * * Move ErtsTracerNif into ErtsTracer
+ * + Removes need for locking
+ * + Removes hash lookup overhead
+ * + Use a refc on the ErtsTracerNif to know when it can
+ * be freed. We don't want to allocate a separate
+ * ErtsTracerNif for each module used.
+ * * Optimize GenericBp for cache locality by reusing equivalent
+ * GenericBp and GenericBpData in multiple tracer points.
+ * + Possibly we want to use specialized instructions for different
+ * types of trace so that the knowledge of which struct is used
+ * can be in the instruction.
*/
#ifdef HAVE_CONFIG_H
@@ -37,6 +51,8 @@
#include "erl_binary.h"
#include "erl_bits.h"
#include "erl_thr_progress.h"
+#include "erl_bif_unique.h"
+#include "erl_map.h"
#if 0
#define DEBUG_PRINTOUTS
@@ -44,17 +60,15 @@
#undef DEBUG_PRINTOUTS
#endif
-extern BeamInstr beam_return_to_trace[1]; /* OpCode(i_return_to_trace) */
-extern BeamInstr beam_return_trace[1]; /* OpCode(i_return_trace) */
-extern BeamInstr beam_return_time_trace[1]; /* OpCode(i_return_time_trace) */
-
/* Pseudo export entries. Never filled in with data, only used to
yield unique pointers of the correct type. */
Export exp_send, exp_receive, exp_timeout;
-static Eterm system_seq_tracer;
-static Uint default_trace_flags;
-static Eterm default_tracer;
+static ErtsTracer system_seq_tracer;
+static Uint default_proc_trace_flags;
+static ErtsTracer default_proc_tracer;
+static Uint default_port_trace_flags;
+static ErtsTracer default_port_tracer;
static Eterm system_monitor;
static Eterm system_profile;
@@ -68,14 +82,233 @@ static erts_smp_rwmtx_t sys_trace_rwmtx;
enum ErtsSysMsgType {
SYS_MSG_TYPE_UNDEFINED,
- SYS_MSG_TYPE_TRACE,
- SYS_MSG_TYPE_SEQTRACE,
SYS_MSG_TYPE_SYSMON,
SYS_MSG_TYPE_ERRLGR,
SYS_MSG_TYPE_PROC_MSG,
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, 0);
+ }
+ 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, 0);
+ res = TUPLE2(*hpp, emtime, unique);
+ *hpp += 3;
+ return res;
+ }
+ default:
+ ERTS_INTERNAL_ERROR("invalid timestamp type");
+ return THE_NON_VALUE;
+ }
+}
+
+#ifdef ERTS_SMP
+
+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;
+ }
+}
+#endif /* ERTS_SMP */
+
+/*
+ * 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;
+}
+
#ifdef ERTS_SMP
static void enqueue_sys_msg_unlocked(enum ErtsSysMsgType type,
Eterm from,
@@ -90,12 +323,21 @@ static void enqueue_sys_msg(enum ErtsSysMsgType type,
static void init_sys_msg_dispatcher(void);
#endif
+static void init_tracer_nif(void);
+static int tracer_cmp_fun(void*, void*);
+static HashValue tracer_hash_fun(void*);
+static void *tracer_alloc_fun(void*);
+static void tracer_free_fun(void*);
+
+typedef struct ErtsTracerNif_ ErtsTracerNif;
+
void erts_init_trace(void) {
erts_smp_rwmtx_opt_t rwmtx_opts = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER;
rwmtx_opts.type = ERTS_SMP_RWMTX_TYPE_EXTREMELY_FREQUENT_READ;
rwmtx_opts.lived = ERTS_SMP_RWMTX_LONG_LIVED;
- erts_smp_rwmtx_init_opt(&sys_trace_rwmtx, &rwmtx_opts, "sys_tracers");
+ erts_smp_rwmtx_init_opt(&sys_trace_rwmtx, &rwmtx_opts, "sys_tracers", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
#ifdef HAVE_ERTS_NOW_CPU
erts_cpu_timestamp = 0;
@@ -103,86 +345,67 @@ void erts_init_trace(void) {
erts_bif_trace_init();
erts_system_monitor_clear(NULL);
erts_system_profile_clear(NULL);
- default_trace_flags = F_INITIAL_TRACE_FLAGS;
- default_tracer = NIL;
- system_seq_tracer = am_false;
+ default_proc_trace_flags = F_INITIAL_TRACE_FLAGS;
+ default_proc_tracer = erts_tracer_nil;
+ default_port_trace_flags = F_INITIAL_TRACE_FLAGS;
+ default_port_tracer = erts_tracer_nil;
+ system_seq_tracer = erts_tracer_nil;
#ifdef ERTS_SMP
init_sys_msg_dispatcher();
#endif
+ init_tracer_nif();
}
-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) \
-do { \
- ERTS_LC_ASSERT(erts_smp_lc_mtx_is_locked(&smq_mtx)); \
- enqueue_sys_msg_unlocked(SYS_MSG_TYPE_TRACE, (FPID), (TPID), (MSG), (BP)); \
-} while(0)
-#else
-#ifdef USE_VM_PROBES
-#define ERTS_ENQ_TRACE_MSG(FPID, TPROC, MSG, BP) \
- erts_queue_message((TPROC), NULL, (BP), (MSG), NIL, NIL)
-#else
-#define ERTS_ENQ_TRACE_MSG(FPID, TPROC, MSG, BP) \
- erts_queue_message((TPROC), NULL, (BP), (MSG), NIL)
-#endif
-#endif
+enum ErtsTracerOpt {
+ TRACE_FUN_DEFAULT = 0,
+ TRACE_FUN_ENABLED = 1,
+ TRACE_FUN_T_SEND = 2,
+ TRACE_FUN_T_RECEIVE = 3,
+ TRACE_FUN_T_CALL = 4,
+ TRACE_FUN_T_SCHED_PROC = 5,
+ TRACE_FUN_T_SCHED_PORT = 6,
+ TRACE_FUN_T_GC = 7,
+ TRACE_FUN_T_PROCS = 8,
+ TRACE_FUN_T_PORTS = 9,
+ TRACE_FUN_E_SEND = 10,
+ TRACE_FUN_E_RECEIVE = 11,
+ TRACE_FUN_E_CALL = 12,
+ TRACE_FUN_E_SCHED_PROC = 13,
+ TRACE_FUN_E_SCHED_PORT = 14,
+ TRACE_FUN_E_GC = 15,
+ TRACE_FUN_E_PROCS = 16,
+ TRACE_FUN_E_PORTS = 17
+};
-/*
- * NOTE that the ERTS_GET_TRACER_REF() returns from the function (!!!)
- * using it, and resets the parameters used if the tracer is invalid, i.e.,
- * use it with extreme care!
- */
-#ifdef ERTS_SMP
-#define ERTS_NULL_TRACER_REF NIL
-#define ERTS_TRACER_REF_TYPE Eterm
- /* In the smp case, we never find the tracer invalid here (the sys
- message dispatcher thread takes care of that). */
-#define ERTS_GET_TRACER_REF(RES, TPID, TRACEE_FLGS) \
-do { (RES) = (TPID); } while(0)
-int
-erts_is_tracer_proc_valid(Process* p)
-{
- return 1;
-}
-#else
-#define ERTS_NULL_TRACER_REF NULL
-#define ERTS_TRACER_REF_TYPE Process *
-#define ERTS_GET_TRACER_REF(RES, TPID, TRACEE_FLGS) \
-do { \
- (RES) = erts_proc_lookup((TPID)); \
- if (!(RES) || !(ERTS_TRACE_FLAGS((RES)) & F_TRACER)) { \
- (TPID) = NIL; \
- (TRACEE_FLGS) &= ~TRACEE_FLAGS; \
- return; \
- } \
-} while (0)
-int
-erts_is_tracer_proc_valid(Process* p)
-{
- Process* tracer;
+#define NIF_TRACER_TYPES (18)
- tracer = erts_proc_lookup(ERTS_TRACER_PROC(p));
- if (tracer && ERTS_TRACE_FLAGS(tracer) & F_TRACER) {
- return 1;
- } else {
- ERTS_TRACER_PROC(p) = NIL;
- ERTS_TRACE_FLAGS(p) = ~TRACEE_FLAGS;
- return 0;
- }
-}
-#endif
+
+static ERTS_INLINE int
+send_to_tracer_nif_raw(Process *c_p, Process *tracee, const ErtsTracer tracer,
+ Uint trace_flags, Eterm t_p_id, ErtsTracerNif *tnif,
+ enum ErtsTracerOpt topt,
+ Eterm tag, Eterm msg, Eterm extra, Eterm pam_result);
+static ERTS_INLINE int
+send_to_tracer_nif(Process *c_p, ErtsPTabElementCommon *t_p,
+ Eterm t_p_id, ErtsTracerNif *tnif,
+ enum ErtsTracerOpt topt,
+ Eterm tag, Eterm msg, Eterm extra,
+ Eterm pam_result);
+static ERTS_INLINE Eterm
+call_enabled_tracer(const ErtsTracer tracer,
+ ErtsTracerNif **tnif_ref,
+ enum ErtsTracerOpt topt,
+ Eterm tag, Eterm t_p_id);
+static int
+is_tracer_enabled(Process* c_p, ErtsProcLocks c_p_locks,
+ ErtsPTabElementCommon *t_p,
+ ErtsTracerNif **tnif_ret,
+ enum ErtsTracerOpt topt, Eterm tag);
static Uint active_sched;
@@ -197,19 +420,6 @@ static void
exiting_reset(Eterm exiting)
{
erts_smp_rwmtx_rwlock(&sys_trace_rwmtx);
- if (exiting == default_tracer) {
- default_tracer = NIL;
- default_trace_flags &= TRACEE_FLAGS;
-#ifdef DEBUG
- default_trace_flags |= F_INITIAL_TRACE_FLAGS;
-#endif
- }
- if (exiting == system_seq_tracer) {
-#ifdef DEBUG_PRINTOUTS
- erts_fprintf(stderr, "seq tracer %T exited\n", exiting);
-#endif
- system_seq_tracer = am_false;
- }
if (exiting == system_monitor) {
#ifdef ERTS_SMP
system_monitor = NIL;
@@ -234,11 +444,7 @@ erts_trace_check_exiting(Eterm exiting)
{
int reset = 0;
erts_smp_rwmtx_rlock(&sys_trace_rwmtx);
- if (exiting == default_tracer)
- reset = 1;
- else if (exiting == system_seq_tracer)
- reset = 1;
- else if (exiting == system_monitor)
+ if (exiting == system_monitor)
reset = 1;
else if (exiting == system_profile)
reset = 1;
@@ -247,23 +453,25 @@ erts_trace_check_exiting(Eterm exiting)
exiting_reset(exiting);
}
-static ERTS_INLINE int
-is_valid_tracer(Eterm tracer)
+ErtsTracer
+erts_set_system_seq_tracer(Process *c_p, ErtsProcLocks c_p_locks, ErtsTracer new)
{
- return erts_proc_lookup(tracer) || erts_is_valid_tracer_port(tracer);
-}
+ ErtsTracer old;
-Eterm
-erts_set_system_seq_tracer(Process *c_p, ErtsProcLocks c_p_locks, Eterm new)
-{
- Eterm old;
-
- if (new != am_false && !is_valid_tracer(new))
- return THE_NON_VALUE;
+ if (!ERTS_TRACER_IS_NIL(new)) {
+ Eterm nif_result = call_enabled_tracer(
+ new, NULL, TRACE_FUN_ENABLED, am_trace_status, am_undefined);
+ switch (nif_result) {
+ case am_trace: break;
+ default:
+ return THE_NON_VALUE;
+ }
+ }
erts_smp_rwmtx_rwlock(&sys_trace_rwmtx);
old = system_seq_tracer;
- system_seq_tracer = new;
+ system_seq_tracer = erts_tracer_nil;
+ erts_tracer_update(&system_seq_tracer, new);
#ifdef DEBUG_PRINTOUTS
erts_fprintf(stderr, "set seq tracer new=%T old=%T\n", new, old);
@@ -272,66 +480,134 @@ erts_set_system_seq_tracer(Process *c_p, ErtsProcLocks c_p_locks, Eterm new)
return old;
}
-Eterm
+ErtsTracer
erts_get_system_seq_tracer(void)
{
- Eterm st;
+ ErtsTracer st;
erts_smp_rwmtx_rlock(&sys_trace_rwmtx);
st = system_seq_tracer;
#ifdef DEBUG_PRINTOUTS
erts_fprintf(stderr, "get seq tracer %T\n", st);
#endif
erts_smp_rwmtx_runlock(&sys_trace_rwmtx);
+
+ if (st != erts_tracer_nil &&
+ call_enabled_tracer(st, NULL, TRACE_FUN_ENABLED,
+ am_trace_status, am_undefined) == am_remove) {
+ st = erts_set_system_seq_tracer(NULL, 0, erts_tracer_nil);
+ ERTS_TRACER_CLEAR(&st);
+ }
+
return st;
}
static ERTS_INLINE void
-get_default_tracing(Uint *flagsp, Eterm *tracerp)
-{
- if (!(default_trace_flags & TRACEE_FLAGS))
- default_tracer = NIL;
-
- if (is_nil(default_tracer)) {
- default_trace_flags &= ~TRACEE_FLAGS;
- } else if (is_internal_pid(default_tracer)) {
- if (!erts_proc_lookup(default_tracer)) {
- reset_tracer:
- default_trace_flags &= ~TRACEE_FLAGS;
- default_tracer = NIL;
- }
+get_default_tracing(Uint *flagsp, ErtsTracer *tracerp,
+ Uint *default_trace_flags,
+ ErtsTracer *default_tracer)
+{
+ if (!(*default_trace_flags & TRACEE_FLAGS))
+ ERTS_TRACER_CLEAR(default_tracer);
+
+ if (ERTS_TRACER_IS_NIL(*default_tracer)) {
+ *default_trace_flags &= ~TRACEE_FLAGS;
} else {
- ASSERT(is_internal_port(default_tracer));
- if (!erts_is_valid_tracer_port(default_tracer))
- goto reset_tracer;
+ Eterm nif_res;
+ nif_res = call_enabled_tracer(*default_tracer,
+ NULL, TRACE_FUN_ENABLED,
+ am_trace_status, am_undefined);
+ switch (nif_res) {
+ case am_trace: break;
+ default: {
+ ErtsTracer curr_default_tracer = *default_tracer;
+ if (tracerp) {
+ /* we only have a rlock, so we have to unlock and then rwlock */
+ erts_smp_rwmtx_runlock(&sys_trace_rwmtx);
+ erts_smp_rwmtx_rwlock(&sys_trace_rwmtx);
+ }
+ /* check if someone else changed default tracer
+ while we got the write lock, if so we don't do
+ anything. */
+ if (curr_default_tracer == *default_tracer) {
+ *default_trace_flags &= ~TRACEE_FLAGS;
+ ERTS_TRACER_CLEAR(default_tracer);
+ }
+ if (tracerp) {
+ erts_smp_rwmtx_rwunlock(&sys_trace_rwmtx);
+ erts_smp_rwmtx_rlock(&sys_trace_rwmtx);
+ }
+ }
+ }
}
if (flagsp)
- *flagsp = default_trace_flags;
- if (tracerp)
- *tracerp = default_tracer;
+ *flagsp = *default_trace_flags;
+ if (tracerp) {
+ erts_tracer_update(tracerp,*default_tracer);
+ }
+}
+
+static ERTS_INLINE void
+erts_change_default_tracing(int setflags, Uint flags,
+ const ErtsTracer tracer,
+ Uint *default_trace_flags,
+ ErtsTracer *default_tracer)
+{
+ if (setflags)
+ *default_trace_flags |= flags;
+ else
+ *default_trace_flags &= ~flags;
+
+ erts_tracer_update(default_tracer, tracer);
+
+ get_default_tracing(NULL, NULL, default_trace_flags, default_tracer);
}
void
-erts_change_default_tracing(int setflags, Uint *flagsp, Eterm *tracerp)
+erts_change_default_proc_tracing(int setflags, Uint flagsp,
+ const ErtsTracer tracer)
{
erts_smp_rwmtx_rwlock(&sys_trace_rwmtx);
- if (flagsp) {
- if (setflags)
- default_trace_flags |= *flagsp;
- else
- default_trace_flags &= ~(*flagsp);
- }
- if (tracerp)
- default_tracer = *tracerp;
- get_default_tracing(flagsp, tracerp);
+ erts_change_default_tracing(
+ setflags, flagsp, tracer,
+ &default_proc_trace_flags,
+ &default_proc_tracer);
+ erts_smp_rwmtx_rwunlock(&sys_trace_rwmtx);
+}
+
+void
+erts_change_default_port_tracing(int setflags, Uint flagsp,
+ const ErtsTracer tracer)
+{
+ erts_smp_rwmtx_rwlock(&sys_trace_rwmtx);
+ erts_change_default_tracing(
+ setflags, flagsp, tracer,
+ &default_port_trace_flags,
+ &default_port_tracer);
erts_smp_rwmtx_rwunlock(&sys_trace_rwmtx);
}
void
-erts_get_default_tracing(Uint *flagsp, Eterm *tracerp)
+erts_get_default_proc_tracing(Uint *flagsp, ErtsTracer *tracerp)
{
erts_smp_rwmtx_rlock(&sys_trace_rwmtx);
- get_default_tracing(flagsp, tracerp);
+ *tracerp = erts_tracer_nil; /* initialize */
+ get_default_tracing(
+ flagsp, tracerp,
+ &default_proc_trace_flags,
+ &default_proc_tracer);
+ erts_smp_rwmtx_runlock(&sys_trace_rwmtx);
+}
+
+void
+erts_get_default_port_tracing(Uint *flagsp, ErtsTracer *tracerp)
+{
+ erts_smp_rwmtx_rlock(&sys_trace_rwmtx);
+ *tracerp = erts_tracer_nil; /* initialize */
+ get_default_tracing(
+ flagsp, tracerp,
+ &default_port_trace_flags,
+ &default_port_tracer);
erts_smp_rwmtx_runlock(&sys_trace_rwmtx);
}
@@ -383,32 +659,8 @@ do { \
#endif
-
-static Eterm* patch_ts(Eterm tuple4, Eterm* hp);
-
-#ifdef ERTS_SMP
static void
-do_send_to_port(Eterm to,
- Port* unused_port,
- Eterm from,
- enum ErtsSysMsgType type,
- Eterm message)
-{
- Uint sz = size_object(message);
- ErlHeapFragment *bp = new_message_buffer(sz);
- Uint *hp = bp->mem;
- Eterm msg = copy_struct(message, sz, &hp, &bp->off_heap);
-
- enqueue_sys_msg_unlocked(type, from, to, msg, bp);
-}
-
-#define WRITE_SYS_MSG_TO_PORT write_sys_msg_to_port
-#else
-#define WRITE_SYS_MSG_TO_PORT do_send_to_port
-#endif
-
-static void
-WRITE_SYS_MSG_TO_PORT(Eterm unused_to,
+write_sys_msg_to_port(Eterm unused_to,
Port* trace_port,
Eterm unused_from,
enum ErtsSysMsgType unused_type,
@@ -424,7 +676,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
@@ -435,157 +687,6 @@ WRITE_SYS_MSG_TO_PORT(Eterm unused_to,
erts_free(ERTS_ALC_T_TMP, (void *) buffer);
}
-
-#ifndef ERTS_SMP
-/* Send {trace_ts, Pid, out, 0, Timestamp}
- * followed by {trace_ts, Pid, in, 0, NewTimestamp}
- *
- * 'NewTimestamp' is fetched from GET_NOW() through patch_ts().
- */
-static void
-do_send_schedfix_to_port(Port *trace_port, Eterm pid, Eterm timestamp) {
-#define LOCAL_HEAP_SIZE (4+5+5)
- DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
- Eterm message;
- Eterm *hp;
- Eterm mfarity;
-
- UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
- ASSERT(is_pid(pid));
- ASSERT(is_tuple(timestamp));
- ASSERT(*tuple_val(timestamp) == make_arityval(3));
-
- hp = local_heap;
- mfarity = make_small(0);
- message = TUPLE5(hp, am_trace_ts, pid, am_out, mfarity, timestamp);
- /* Note, hp is deliberately NOT incremented since it will be reused */
-
- do_send_to_port(trace_port->common.id,
- trace_port,
- pid,
- SYS_MSG_TYPE_UNDEFINED,
- message);
-
- message = TUPLE4(hp, am_trace_ts, pid, am_in, mfarity);
- hp += 5;
- hp = patch_ts(message, hp);
-
- do_send_to_port(trace_port->common.id,
- trace_port,
- pid,
- SYS_MSG_TYPE_UNDEFINED,
- message);
- UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
-#undef LOCAL_HEAP_SIZE
-}
-#endif
-
-/* If (c_p != NULL), a fake schedule out/in message pair will be sent,
- * if the driver so requests.
- * 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),
- * 'message' must contain a timestamp.
- */
-static void
-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;
- DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
-#endif
-
- ASSERT(is_internal_port(*tracer_pid));
-#ifdef ERTS_SMP
- if (is_not_internal_port(*tracer_pid))
- return;
-
- trace_port = NULL;
-#else
-
- trace_port = erts_id2port_sflgs(*tracer_pid,
- NULL,
- 0,
- ERTS_PORT_SFLGS_INVALID_TRACER_LOOKUP);
-
- if (!trace_port) {
- *tracee_flags &= ~TRACEE_FLAGS;
- *tracer_pid = NIL;
- return;
- }
-
- /*
- * Make a fake schedule only if the current process is traced
- * with 'running' and 'timestamp'.
- */
-
- if ( c_p == NULL ||
- (! IS_TRACED_FL(c_p, F_TRACE_SCHED | F_TIMESTAMP))) {
-#endif
- do_send_to_port(*tracer_pid,
- trace_port,
- c_p ? c_p->common.id : NIL,
- SYS_MSG_TYPE_TRACE,
- message);
-#ifndef ERTS_SMP
- erts_port_release(trace_port);
- return;
- }
-
- /*
- * Note that the process being traced for some type of trace messages
- * (e.g. getting_linked) need not be the current process. That other
- * process might not have timestamps enabled.
- */
- 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;
- }
-
- trace_port->control_flags &= ~PORT_CONTROL_FLAG_HEAVY;
- do_send_to_port(*tracer_pid,
- trace_port,
- c_p ? c_p->common.id : NIL,
- SYS_MSG_TYPE_TRACE,
- message);
-
- if (trace_port->control_flags & PORT_CONTROL_FLAG_HEAVY) {
- /* The driver has just informed us that the last write took a
- * non-neglectible amount of time.
- *
- * We need to fake some trace messages to compensate for the time the
- * current process had to sacrifice for the writing of the previous
- * trace message. We pretend that the process got scheduled out
- * 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);
- }
-
- erts_port_release(trace_port);
-
- UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
-#undef LOCAL_HEAP_SIZE
-#endif
-}
-
#ifndef ERTS_SMP
/* Profile send
* Checks if profiler is port or process
@@ -595,11 +696,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();
@@ -616,15 +715,16 @@ profile_send(Eterm from, Eterm message) {
0,
ERTS_PORT_SFLGS_INVALID_TRACER_LOOKUP);
if (profiler_port) {
- do_send_to_port(profiler,
- profiler_port,
- NIL, /* or current process->common.id */
- SYS_MSG_TYPE_SYSPROF,
- message);
+ write_sys_msg_to_port(profiler,
+ profiler_port,
+ NIL, /* or current process->common.id */
+ SYS_MSG_TYPE_SYSPROF,
+ message);
erts_port_release(profiler_port);
}
} else {
+ ErtsMessage *mp;
ASSERT(is_internal_pid(profiler));
profile_p = erts_proc_lookup(profiler);
@@ -633,196 +733,32 @@ 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
-#ifdef USE_VM_PROBES
- , NIL
-#endif
- );
- }
-}
-
-#endif
-
-
-/* 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)
-{
- Port* trace_port;
-#ifndef ERTS_SMP
- Eterm ts, *hp;
-#define LOCAL_HEAP_SIZE (4)
- DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
- UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
-#endif
-
- ASSERT(is_internal_port(seq_tracer));
-#ifdef ERTS_SMP
- if (is_not_internal_port(seq_tracer))
- return;
-
- trace_port = NULL;
-#else
- trace_port = erts_id2port_sflgs(seq_tracer,
- NULL,
- 0,
- ERTS_PORT_SFLGS_INVALID_TRACER_LOOKUP);
- if (!trace_port) {
- system_seq_tracer = am_false;
-#ifndef ERTS_SMP
- UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
-#endif
- return;
- }
-
- if (c_p == NULL
- || (! IS_TRACED_FL(c_p, F_TRACE_SCHED | F_TIMESTAMP))) {
-#endif
- do_send_to_port(seq_tracer,
- trace_port,
- c_p ? c_p->common.id : NIL,
- SYS_MSG_TYPE_SEQTRACE,
- message);
-
-#ifndef ERTS_SMP
- erts_port_release(trace_port);
- UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
- return;
- }
- /* Make a fake schedule only if the current process is traced
- * 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;
- }
+ mp = erts_alloc_message(sz, &hp);
+ if (sz == 0)
+ msg = message;
+ else
+ msg = copy_struct(message, sz, &hp, &mp->hfrag.off_heap);
- trace_port->control_flags &= ~PORT_CONTROL_FLAG_HEAVY;
- do_send_to_port(seq_tracer,
- trace_port,
- c_p ? c_p->common.id : NIL,
- SYS_MSG_TYPE_SEQTRACE,
- message);
-
- if (trace_port->control_flags & PORT_CONTROL_FLAG_HEAVY) {
- /* The driver has just informed us that the last write took a
- * non-neglectible amount of time.
- *
- * We need to fake some trace messages to compensate for the time the
- * current process had to sacrifice for the writing of the previous
- * trace message. We pretend that the process got scheduled out
- * 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);
+ erts_queue_message(profile_p, 0, mp, msg, from);
}
-
- erts_port_release(trace_port);
-
- UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
-#undef LOCAL_HEAP_SIZE
-#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,
- Eterm msg,
- Eterm **hpp,
- ErlHeapFragment *bp,
- int no_fake_sched)
-{
- ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(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)))
- ERTS_ENQ_TRACE_MSG(tracee->common.id, tracer_ref, msg, bp);
- else {
- ASSERT(is_internal_port(ERTS_TRACER_PROC(tracee)));
- send_to_port(no_fake_sched ? NULL : tracee,
- msg,
- &ERTS_TRACER_PROC(tracee),
- &ERTS_TRACE_FLAGS(tracee));
- }
-
- erts_smp_mtx_unlock(&smq_mtx);
-
-}
+#endif
static void
-trace_sched_aux(Process *p, Eterm what, int never_fake_sched)
+trace_sched_aux(Process *p, ErtsProcLocks locks, Eterm what)
{
-#define LOCAL_HEAP_SIZE (5+4+1+TS_HEAP_WORDS)
- DeclareTmpHeap(local_heap,LOCAL_HEAP_SIZE,p);
- Eterm tmp, mess, *hp;
- ErlHeapFragment *bp = NULL;
- ErlOffHeap *off_heap;
- ERTS_TRACER_REF_TYPE tracer_ref = ERTS_NULL_TRACER_REF;
- int sched_no, curr_func, to_port, no_fake_sched;
+ Eterm tmp, *hp;
+ int curr_func;
+ ErtsTracerNif *tnif = NULL;
- if (is_nil(ERTS_TRACER_PROC(p)))
+ if (ERTS_TRACER_IS_NIL(ERTS_TRACER(p)))
return;
- no_fake_sched = never_fake_sched;
-
switch (what) {
case am_out:
case am_out_exiting:
case am_out_exited:
- no_fake_sched = 1;
- break;
case am_in:
case am_in_exiting:
break;
@@ -831,16 +767,8 @@ trace_sched_aux(Process *p, Eterm what, int never_fake_sched)
break;
}
- sched_no = IS_TRACED_FL(p, F_TRACE_SCHED_NO);
- to_port = is_internal_port(ERTS_TRACER_PROC(p));
-
- if (!to_port) {
- ASSERT(is_internal_pid(ERTS_TRACER_PROC(p)));
-
- ERTS_GET_TRACER_REF(tracer_ref,
- ERTS_TRACER_PROC(p),
- ERTS_TRACE_FLAGS(p));
- }
+ if (!is_tracer_enabled(p, locks, &p->common, &tnif, TRACE_FUN_E_SCHED_PROC, what))
+ return;
if (ERTS_PROC_IS_EXITING(p))
curr_func = 0;
@@ -850,44 +778,17 @@ trace_sched_aux(Process *p, Eterm what, int never_fake_sched)
curr_func = p->current != NULL;
}
- UseTmpHeap(LOCAL_HEAP_SIZE,p);
-
- if (to_port)
- hp = local_heap;
- else {
- Uint size = 5;
- if (curr_func)
- size += 4;
- if (sched_no)
- size += 1;
- size += TS_SIZE(p);
- hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref);
- }
-
if (!curr_func) {
tmp = make_small(0);
} else {
- tmp = TUPLE3(hp,p->current[0],p->current[1],make_small(p->current[2]));
+ hp = HAlloc(p, 4);
+ tmp = TUPLE3(hp,p->current->module,p->current->function,
+ make_small(p->current->arity));
hp += 4;
}
- if (!sched_no) {
- mess = TUPLE4(hp, am_trace, p->common.id, what, tmp);
- hp += 5;
- }
- else {
-#ifdef ERTS_SMP
- Eterm sched_id = make_small(p->scheduler_data->no);
-#else
- Eterm sched_id = make_small(1);
-#endif
- mess = TUPLE5(hp, am_trace, p->common.id, what, sched_id, tmp);
- hp += 6;
- }
-
- send_to_tracer(p, tracer_ref, mess, &hp, bp, no_fake_sched);
- UnUseTmpHeap(LOCAL_HEAP_SIZE,p);
-#undef LOCAL_HEAP_SIZE
+ send_to_tracer_nif(p, &p->common, p->common.id, tnif, TRACE_FUN_T_SCHED_PROC,
+ what, tmp, THE_NON_VALUE, am_true);
}
/* Send {trace_ts, Pid, What, {Mod, Func, Arity}, Timestamp}
@@ -897,9 +798,9 @@ trace_sched_aux(Process *p, Eterm what, int never_fake_sched)
* 'out_exiting', or 'out_exited'.
*/
void
-trace_sched(Process *p, Eterm what)
+trace_sched(Process *p, ErtsProcLocks locks, Eterm what)
{
- trace_sched_aux(p, what, 0);
+ trace_sched_aux(p, locks, what);
}
/* Send {trace_ts, Pid, Send, Msg, DestPid, Timestamp}
@@ -910,150 +811,126 @@ trace_sched(Process *p, Eterm what)
void
trace_send(Process *p, Eterm to, Eterm msg)
{
- Eterm operation;
- unsigned sz_msg;
- unsigned sz_to;
- Eterm* hp;
- Eterm mess;
-
- if (!ARE_TRACE_FLAGS_ON(p, F_TRACE_SEND)) {
+ Eterm operation = am_send;
+ ErtsTracerNif *tnif = NULL;
+ ErtsTracingEvent* te;
+ Eterm pam_result;
+#ifdef ERTS_SMP
+ ErtsThrPrgrDelayHandle dhndl;
+#endif
+
+ ASSERT(ARE_TRACE_FLAGS_ON(p, F_TRACE_SEND));
+
+ te = &erts_send_tracing[erts_active_bp_ix()];
+ if (!te->on) {
return;
}
+ if (te->match_spec) {
+ Eterm args[2];
+ Uint32 return_flags;
+ args[0] = to;
+ args[1] = msg;
+ pam_result = erts_match_set_run_trace(p, p,
+ te->match_spec, args, 2,
+ ERTS_PAM_TMP_RESULT, &return_flags);
+ if (pam_result == am_false)
+ return;
+ if (ERTS_TRACE_FLAGS(p) & F_TRACE_SILENT) {
+ erts_match_set_release_result_trace(p, pam_result);
+ return;
+ }
+ } else
+ pam_result = am_true;
+
+#ifdef ERTS_SMP
+ dhndl = erts_thr_progress_unmanaged_delay();
+#endif
- operation = am_send;
if (is_internal_pid(to)) {
if (!erts_proc_lookup(to))
goto send_to_non_existing_process;
}
else if(is_external_pid(to)
&& external_pid_dist_entry(to) == erts_this_dist_entry) {
- char *s;
send_to_non_existing_process:
- s = "send_to_non_existing_process";
- operation = am_atom_put(s, sys_strlen(s));
+ operation = am_send_to_non_existing_process;
}
- if (is_internal_port(ERTS_TRACER_PROC(p))) {
-#define LOCAL_HEAP_SIZE (11)
- DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
- UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
-
- hp = local_heap;
- 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);
- }
- send_to_port(p, mess, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p));
- UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
-#undef LOCAL_HEAP_SIZE
- erts_smp_mtx_unlock(&smq_mtx);
- } else {
- Uint need;
- ErlHeapFragment *bp;
- ErlOffHeap *off_heap;
- ERTS_TRACER_REF_TYPE tracer_ref;
-
- ASSERT(is_internal_pid(ERTS_TRACER_PROC(p)));
-
- ERTS_GET_TRACER_REF(tracer_ref,
- ERTS_TRACER_PROC(p),
- ERTS_TRACE_FLAGS(p));
-
- sz_msg = size_object(msg);
- sz_to = size_object(to);
- need = sz_msg + sz_to + 6 + TS_SIZE(p);
-
- hp = ERTS_ALLOC_SYSMSG_HEAP(need, &bp, &off_heap, tracer_ref);
-
- to = copy_struct(to,
- sz_to,
- &hp,
- off_heap);
- msg = copy_struct(msg,
- sz_msg,
- &hp,
- off_heap);
- mess = TUPLE5(hp, am_trace, p->common.id, operation, msg, to);
- hp += 6;
-
- erts_smp_mtx_lock(&smq_mtx);
+ if (is_tracer_enabled(p, ERTS_PROC_LOCK_MAIN, &p->common, &tnif,
+ TRACE_FUN_E_SEND, operation)) {
+ send_to_tracer_nif(p, &p->common, p->common.id, tnif, TRACE_FUN_T_SEND,
+ operation, msg, to, pam_result);
+ }
- if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) {
- patch_ts(mess, hp);
- }
+#ifdef ERTS_SMP
+ erts_thr_progress_unmanaged_continue(dhndl);
+#endif
- ERTS_ENQ_TRACE_MSG(p->common.id, tracer_ref, mess, bp);
- erts_smp_mtx_unlock(&smq_mtx);
- }
+ erts_match_set_release_result_trace(p, pam_result);
}
/* Send {trace_ts, Pid, receive, Msg, Timestamp}
* or {trace, Pid, receive, Msg}
*/
void
-trace_receive(Process *rp, Eterm msg)
+trace_receive(Process* receiver,
+ Eterm from,
+ Eterm msg, ErtsTracingEvent* te)
{
- Eterm mess;
- size_t sz_msg;
- Eterm* hp;
-
- if (is_internal_port(ERTS_TRACER_PROC(rp))) {
-#define LOCAL_HEAP_SIZE (10)
- DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
- UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
-
- hp = local_heap;
- 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);
- }
- send_to_port(rp, mess, &ERTS_TRACER_PROC(rp), &ERTS_TRACE_FLAGS(rp));
- UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
-#undef LOCAL_HEAP_SIZE
- erts_smp_mtx_unlock(&smq_mtx);
- } else {
- Uint hsz;
- ErlHeapFragment *bp;
- ErlOffHeap *off_heap;
- ERTS_TRACER_REF_TYPE tracer_ref;
-
- ASSERT(is_internal_pid(ERTS_TRACER_PROC(rp)));
-
- ERTS_GET_TRACER_REF(tracer_ref,
- ERTS_TRACER_PROC(rp),
- ERTS_TRACE_FLAGS(rp));
-
- sz_msg = size_object(msg);
-
- hsz = sz_msg + 5 + TS_SIZE(rp);
-
- hp = ERTS_ALLOC_SYSMSG_HEAP(hsz, &bp, &off_heap, tracer_ref);
-
- msg = copy_struct(msg, sz_msg, &hp, off_heap);
- 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) {
- patch_ts(mess, hp);
- }
-
- ERTS_ENQ_TRACE_MSG(rp->common.id, tracer_ref, mess, bp);
- erts_smp_mtx_unlock(&smq_mtx);
- }
+ ErtsTracerNif *tnif = NULL;
+ Eterm pam_result;
+
+ if (!te) {
+ te = &erts_receive_tracing[erts_active_bp_ix()];
+ if (!te->on)
+ return;
+ }
+ else ASSERT(te->on);
+
+ if (te->match_spec) {
+ Eterm args[3];
+ Uint32 return_flags;
+ if (is_pid(from)) {
+ args[0] = pid_node_name(from);
+ args[1] = from;
+ }
+ else {
+ ASSERT(is_atom(from));
+ args[0] = from; /* node name or other atom (e.g 'system') */
+ args[1] = am_undefined;
+ }
+ args[2] = msg;
+ pam_result = erts_match_set_run_trace(NULL, receiver,
+ te->match_spec, args, 3,
+ ERTS_PAM_TMP_RESULT, &return_flags);
+ if (pam_result == am_false)
+ return;
+ if (ERTS_TRACE_FLAGS(receiver) & F_TRACE_SILENT) {
+ erts_match_set_release_result_trace(NULL, pam_result);
+ return;
+ }
+ } else
+ pam_result = am_true;
+
+ if (is_tracer_enabled(NULL, 0, &receiver->common, &tnif,
+ TRACE_FUN_E_RECEIVE, am_receive)) {
+ send_to_tracer_nif(NULL, &receiver->common, receiver->common.id,
+ tnif, TRACE_FUN_T_RECEIVE,
+ am_receive, msg, THE_NON_VALUE, pam_result);
+ }
+ erts_match_set_release_result_trace(NULL, pam_result);
}
int
seq_trace_update_send(Process *p)
{
- Eterm seq_tracer = erts_get_system_seq_tracer();
+ ErtsTracer 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)
+ if (have_no_seqtrace(SEQ_TRACE_TOKEN(p)) ||
+ (seq_tracer != NIL &&
+ call_enabled_tracer(seq_tracer, NULL,
+ TRACE_FUN_ENABLED, am_seq_trace,
+ p ? p->common.id : am_undefined) != am_trace)
#ifdef USE_VM_PROBES
|| (SEQ_TRACE_TOKEN(p) == am_have_dt_utag)
#endif
@@ -1085,19 +962,29 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type,
Eterm receiver, Process *process, Eterm exitfrom)
{
Eterm mess;
- ErlHeapFragment* bp;
Eterm* hp;
Eterm label;
Eterm lastcnt_serial;
Eterm type_atom;
- int sz_exit;
- Eterm seq_tracer;
+ ErtsTracer seq_tracer;
+ int seq_tracer_flags = 0;
+#define LOCAL_HEAP_SIZE (64)
+ DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
seq_tracer = erts_get_system_seq_tracer();
ASSERT(is_tuple(token) || is_nil(token));
- if (SEQ_TRACE_T_SENDER(token) == seq_tracer || token == NIL ||
- (process && ERTS_TRACE_FLAGS(process) & F_SENSITIVE)) {
+ if (token == NIL || (process && ERTS_TRACE_FLAGS(process) & F_SENSITIVE) ||
+ ERTS_TRACER_IS_NIL(seq_tracer) ||
+ call_enabled_tracer(seq_tracer,
+ NULL, TRACE_FUN_ENABLED,
+ am_seq_trace,
+ process ? process->common.id : am_undefined) != am_trace) {
+ return;
+ }
+
+ if ((unsigned_val(SEQ_TRACE_T_FLAGS(token)) & type) == 0) {
+ /* No flags set, nothing to do */
return;
}
@@ -1106,147 +993,32 @@ 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 */
}
- if ((unsigned_val(SEQ_TRACE_T_FLAGS(token)) & type) == 0) {
- /* No flags set, nothing to do */
- return;
- }
+ UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
- if (seq_tracer == am_false) {
- return; /* no need to send anything */
+ hp = local_heap;
+ label = SEQ_TRACE_T_LABEL(token);
+ lastcnt_serial = TUPLE2(hp, SEQ_TRACE_T_LASTCNT(token),
+ SEQ_TRACE_T_SERIAL(token));
+ hp += 3;
+ if (exitfrom != NIL) {
+ msg = TUPLE3(hp, am_EXIT, exitfrom, msg);
+ hp += 4;
}
+ mess = TUPLE5(hp, type_atom, lastcnt_serial, SEQ_TRACE_T_SENDER(token), receiver, msg);
+ hp += 6;
- if (is_internal_port(seq_tracer)) {
-#define LOCAL_HEAP_SIZE (64)
- DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
- UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
-
- hp = local_heap;
- label = SEQ_TRACE_T_LABEL(token);
- lastcnt_serial = TUPLE2(hp, SEQ_TRACE_T_LASTCNT(token),
- SEQ_TRACE_T_SERIAL(token));
- hp += 3;
- if (exitfrom != NIL) {
- msg = TUPLE3(hp, am_EXIT, exitfrom, msg);
- hp += 4;
- }
- 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) {
- mess = TUPLE3(hp, am_seq_trace, label, mess);
- seq_trace_send_to_port(NULL, seq_tracer, mess, NIL);
- } 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);
- }
- UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
-#undef LOCAL_HEAP_SIZE
- erts_smp_mtx_unlock(&smq_mtx);
- } else {
-#ifndef ERTS_SMP
- Process* tracer;
-#endif
- Eterm sender_copy;
- Eterm receiver_copy;
- Eterm m2;
- Uint sz_label, sz_lastcnt_serial, sz_msg, sz_ts, sz_sender,
- sz_exitfrom, sz_receiver;
-
- ASSERT(is_internal_pid(seq_tracer));
-
-#ifndef ERTS_SMP
-
- tracer = erts_proc_lookup(seq_tracer);
- if (!tracer) {
- system_seq_tracer = am_false;
- return; /* no need to send anything */
- }
-#endif
- if (receiver == seq_tracer) {
- return; /* no need to send anything */
- }
-
- sz_label = size_object(SEQ_TRACE_T_LABEL(token));
- sz_sender = size_object(SEQ_TRACE_T_SENDER(token));
- sz_receiver = size_object(receiver);
- sz_lastcnt_serial = 3; /* TUPLE2 */
- sz_msg = size_object(msg);
-
- sz_ts = ((unsigned_val(SEQ_TRACE_T_FLAGS(token)) & SEQ_TRACE_TIMESTAMP) ?
- 5 : 0);
- if (exitfrom != NIL) {
- sz_exit = 4; /* create {'EXIT',exitfrom,msg} */
- sz_exitfrom = size_object(exitfrom);
- }
- else {
- sz_exit = 0;
- sz_exitfrom = 0;
- }
- bp = new_message_buffer(4 /* TUPLE3 */ + sz_ts + 6 /* TUPLE5 */
- + sz_lastcnt_serial + sz_label + sz_msg
- + sz_exit + sz_exitfrom
- + sz_sender + sz_receiver);
- hp = bp->mem;
- label = copy_struct(SEQ_TRACE_T_LABEL(token), sz_label, &hp, &bp->off_heap);
- lastcnt_serial = TUPLE2(hp,SEQ_TRACE_T_LASTCNT(token),SEQ_TRACE_T_SERIAL(token));
- hp += 3;
- m2 = copy_struct(msg, sz_msg, &hp, &bp->off_heap);
- if (sz_exit) {
- Eterm exitfrom_copy = copy_struct(exitfrom,
- sz_exitfrom,
- &hp,
- &bp->off_heap);
- m2 = TUPLE3(hp, am_EXIT, exitfrom_copy, m2);
- hp += 4;
- }
- sender_copy = copy_struct(SEQ_TRACE_T_SENDER(token),
- sz_sender,
- &hp,
- &bp->off_heap);
- receiver_copy = copy_struct(receiver,
- sz_receiver,
- &hp,
- &bp->off_heap);
- mess = TUPLE5(hp,
- type_atom,
- lastcnt_serial,
- sender_copy,
- receiver_copy,
- m2);
- hp += 6;
-
- erts_smp_mtx_lock(&smq_mtx);
+ seq_tracer_flags |= ERTS_SEQTFLGS2TFLGS(unsigned_val(SEQ_TRACE_T_FLAGS(token)));
- 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 {
- mess = TUPLE3(hp, am_seq_trace, label, mess);
- }
+ send_to_tracer_nif_raw(NULL, process, seq_tracer, seq_tracer_flags,
+ label, NULL, TRACE_FUN_DEFAULT, am_seq_trace, mess,
+ THE_NON_VALUE, am_true);
-#ifdef ERTS_SMP
- enqueue_sys_msg_unlocked(SYS_MSG_TYPE_SEQTRACE, NIL, NIL, mess, bp);
- erts_smp_mtx_unlock(&smq_mtx);
-#else
- erts_queue_message(tracer, NULL, bp, mess, NIL
-#ifdef USE_VM_PROBES
- , NIL
-#endif
- ); /* trace_token must be NIL here */
-#endif
- }
+ UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
+#undef LOCAL_HEAP_SIZE
}
/* Send {trace_ts, Pid, return_to, {Mod, Func, Arity}, Timestamp}
@@ -1255,65 +1027,20 @@ 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)
- Eterm* hp;
Eterm mfa;
- Eterm mess;
- DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
-
- BeamInstr *code_ptr = find_function_from_pc(pc);
+ ErtsCodeMFA *cmfa = find_function_from_pc(pc);
- UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
-
- hp = local_heap;
-
- if (!code_ptr) {
+ if (!cmfa) {
mfa = am_undefined;
} else {
- mfa = TUPLE3(hp, code_ptr[0], code_ptr[1], make_small(code_ptr[2]));
- hp += 4;
- }
-
- mess = TUPLE4(hp, am_trace, p->common.id, am_return_to, mfa);
- hp += 5;
-
- erts_smp_mtx_lock(&smq_mtx);
-
- if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) {
- hp = patch_ts(mess, hp);
+ Eterm *hp = HAlloc(p, 4);
+ mfa = TUPLE3(hp, cmfa->module, cmfa->function,
+ make_small(cmfa->arity));
}
- if (is_internal_port(ERTS_TRACER_PROC(p))) {
- send_to_port(p, mess, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p));
- } else {
- ErlHeapFragment *bp;
- ErlOffHeap *off_heap;
- ERTS_TRACER_REF_TYPE tracer_ref;
- unsigned size;
-
- /*
- * Find the tracer.
- */
- ASSERT(is_internal_pid(ERTS_TRACER_PROC(p)));
-
- ERTS_GET_TRACER_REF(tracer_ref,
- ERTS_TRACER_PROC(p),
- ERTS_TRACE_FLAGS(p));
-
- size = size_object(mess);
-
- hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref);
-
- /*
- * Copy the trace message into the buffer and enqueue it.
- */
- mess = copy_struct(mess, size, &hp, off_heap);
- ERTS_ENQ_TRACE_MSG(p->common.id, tracer_ref, mess, bp);
- }
- UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
-#undef LOCAL_HEAP_SIZE
- erts_smp_mtx_unlock(&smq_mtx);
+ send_to_tracer_nif(p, &p->common, p->common.id, NULL, TRACE_FUN_T_CALL,
+ am_return_to, mfa, THE_NON_VALUE, am_true);
}
@@ -1321,126 +1048,51 @@ erts_trace_return_to(Process *p, BeamInstr *pc)
* or {trace, Pid, return_from, {Mod, Name, Arity}, Retval}
*/
void
-erts_trace_return(Process* p, BeamInstr* fi, Eterm retval, Eterm *tracer_pid)
+erts_trace_return(Process* p, ErtsCodeMFA *mfa,
+ Eterm retval, ErtsTracer *tracer)
{
Eterm* hp;
- Eterm mfa;
- Eterm mess;
- Eterm mod, name;
- int arity;
+ Eterm mfa_tuple;
Uint meta_flags, *tracee_flags;
-#ifdef ERTS_SMP
- Eterm tracee;
-#endif
-
- ASSERT(tracer_pid);
- if (*tracer_pid == am_true) {
+
+ ASSERT(tracer);
+ if (ERTS_TRACER_COMPARE(*tracer, erts_tracer_true)) {
/* Breakpoint trace enabled without specifying tracer =>
* use process tracer and flags
*/
- tracer_pid = &ERTS_TRACER_PROC(p);
+ tracer = &ERTS_TRACER(p);
}
- if (is_nil(*tracer_pid)) {
+ if (ERTS_TRACER_IS_NIL(*tracer)) {
/* Trace disabled */
return;
}
- ASSERT(is_internal_pid(*tracer_pid) || is_internal_port(*tracer_pid));
- if (*tracer_pid == p->common.id) {
- /* Do not generate trace messages to oneself */
- return;
- }
- if (tracer_pid == &ERTS_TRACER_PROC(p)) {
+ ASSERT(IS_TRACER_VALID(*tracer));
+ if (tracer == &ERTS_TRACER(p)) {
/* Tracer specified in process structure =>
* non-breakpoint trace =>
* use process flags
*/
tracee_flags = &ERTS_TRACE_FLAGS(p);
-#ifdef ERTS_SMP
- tracee = p->common.id;
-#endif
+ if (! (*tracee_flags & F_TRACE_CALLS)) {
+ return;
+ }
} else {
/* Tracer not specified in process structure =>
* tracer specified in breakpoint =>
* 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
- }
- if (! (*tracee_flags & F_TRACE_CALLS)) {
- return;
}
-
- mod = fi[0];
- name = fi[1];
- arity = fi[2];
-
- if (is_internal_port(*tracer_pid)) {
-#define LOCAL_HEAP_SIZE (4+6+5)
- DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
- UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
- hp = local_heap;
- mfa = TUPLE3(hp, mod, name, make_small(arity));
- hp += 4;
- 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);
- }
- send_to_port(p, mess, tracer_pid, tracee_flags);
- UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
-#undef LOCAL_HEAP_SIZE
- erts_smp_mtx_unlock(&smq_mtx);
- } else {
- ErlHeapFragment *bp;
- ErlOffHeap *off_heap;
- 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;
- }
-
- 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.
- */
-
- mfa = TUPLE3(hp, mod, name, make_small(arity));
- hp += 4;
- retval = copy_struct(retval, retval_size, &hp, off_heap);
- 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);
- }
-
- ASSERT(hp == limit);
-
- ERTS_ENQ_TRACE_MSG(tracee, tracer_ref, mess, bp);
- erts_smp_mtx_unlock(&smq_mtx);
- }
+ hp = HAlloc(p, 4);
+ mfa_tuple = TUPLE3(hp, mfa->module, mfa->function,
+ make_small(mfa->arity));
+ hp += 4;
+ send_to_tracer_nif_raw(p, NULL, *tracer, *tracee_flags, p->common.id,
+ NULL, TRACE_FUN_T_CALL, am_return_from, mfa_tuple,
+ retval, am_true);
}
/* Send {trace_ts, Pid, exception_from, {Mod, Name, Arity}, {Class,Value},
@@ -1451,130 +1103,51 @@ erts_trace_return(Process* p, BeamInstr* fi, Eterm retval, Eterm *tracer_pid)
* Where Class is atomic but Value is any term.
*/
void
-erts_trace_exception(Process* p, BeamInstr mfa[3], Eterm class, Eterm value,
- Eterm *tracer_pid)
+erts_trace_exception(Process* p, ErtsCodeMFA *mfa, Eterm class, Eterm value,
+ ErtsTracer *tracer)
{
Eterm* hp;
- Eterm mfa_tuple;
- Eterm cv;
- Eterm mess;
+ Eterm mfa_tuple, cv;
Uint meta_flags, *tracee_flags;
-#ifdef ERTS_SMP
- Eterm tracee;
-#endif
-
- ASSERT(tracer_pid);
- if (*tracer_pid == am_true) {
+
+ ASSERT(tracer);
+ if (ERTS_TRACER_COMPARE(*tracer, erts_tracer_true)) {
/* Breakpoint trace enabled without specifying tracer =>
* use process tracer and flags
*/
- tracer_pid = &ERTS_TRACER_PROC(p);
+ tracer = &ERTS_TRACER(p);
}
- if (is_nil(*tracer_pid)) {
+ if (ERTS_TRACER_IS_NIL(*tracer)) {
/* Trace disabled */
return;
}
- ASSERT(is_internal_pid(*tracer_pid) || is_internal_port(*tracer_pid));
- if (*tracer_pid == p->common.id) {
- /* Do not generate trace messages to oneself */
- return;
- }
- if (tracer_pid == &ERTS_TRACER_PROC(p)) {
+ ASSERT(IS_TRACER_VALID(*tracer));
+ if (tracer == &ERTS_TRACER(p)) {
/* Tracer specified in process structure =>
* non-breakpoint trace =>
* use process flags
*/
tracee_flags = &ERTS_TRACE_FLAGS(p);
-#ifdef ERTS_SMP
- tracee = p->common.id;
-#endif
- if (! (*tracee_flags & F_TRACE_CALLS)) {
- return;
- }
+ if (! (*tracee_flags & F_TRACE_CALLS)) {
+ return;
+ }
} else {
/* Tracer not specified in process structure =>
* tracer specified in breakpoint =>
* 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
}
-
- if (is_internal_port(*tracer_pid)) {
-#define LOCAL_HEAP_SIZE (4+3+6+5)
- DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
- UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
-
- hp = local_heap;
- mfa_tuple = TUPLE3(hp, (Eterm) mfa[0], (Eterm) mfa[1], make_small((Eterm)mfa[2]));
- hp += 4;
- cv = TUPLE2(hp, class, value);
- hp += 3;
- mess = TUPLE5(hp, am_trace, p->common.id, am_exception_from, mfa_tuple, cv);
- 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);
- }
- send_to_port(p, mess, tracer_pid, tracee_flags);
- UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
-#undef LOCAL_HEAP_SIZE
- erts_smp_mtx_unlock(&smq_mtx);
- } else {
- ErlHeapFragment *bp;
- ErlOffHeap *off_heap;
- 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;
- }
-
- 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.
- */
-
- mfa_tuple = TUPLE3(hp, (Eterm) mfa[0], (Eterm) mfa[1], make_small((Eterm) mfa[2]));
- hp += 4;
- value = copy_struct(value, value_size, &hp, off_heap);
- cv = TUPLE2(hp, class, value);
- hp += 3;
- mess = TUPLE5(hp, am_trace, p->common.id,
- am_exception_from, mfa_tuple, cv);
- hp += 6;
-
- erts_smp_mtx_lock(&smq_mtx);
-
- if (*tracee_flags & F_TIMESTAMP) {
- hp = patch_ts(mess, hp);
- }
-
- ASSERT(hp == limit);
-
- ERTS_ENQ_TRACE_MSG(tracee, tracer_ref, mess, bp);
- erts_smp_mtx_unlock(&smq_mtx);
- }
+ hp = HAlloc(p, 7);;
+ mfa_tuple = TUPLE3(hp, mfa->module, mfa->function, make_small(mfa->arity));
+ hp += 4;
+ cv = TUPLE2(hp, class, value);
+ hp += 3;
+ send_to_tracer_nif_raw(p, NULL, *tracer, *tracee_flags, p->common.id,
+ NULL, TRACE_FUN_T_CALL, am_exception_from, mfa_tuple, cv, am_true);
}
/*
@@ -1592,8 +1165,8 @@ erts_trace_exception(Process* p, BeamInstr mfa[3], Eterm class, Eterm value,
* if it is a pid or port we do a meta trace.
*/
Uint32
-erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
- Eterm* args, int local, Eterm *tracer_pid)
+erts_call_trace(Process* p, ErtsCodeInfo *info, Binary *match_spec,
+ Eterm* args, int local, ErtsTracer *tracer)
{
Eterm* hp;
Eterm mfa_tuple;
@@ -1601,54 +1174,67 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
int i;
Uint32 return_flags;
Eterm pam_result = am_true;
- Eterm mess;
Uint meta_flags, *tracee_flags;
-#ifdef ERTS_SMP
- Eterm tracee;
-#endif
+ ErtsTracerNif *tnif = NULL;
Eterm transformed_args[MAX_ARG];
- DeclareTypedTmpHeap(ErlSubBin,sub_bin_heap,p);
+ ErtsTracer pre_ms_tracer = erts_tracer_nil;
- ASSERT(tracer_pid);
- if (*tracer_pid == am_true) {
- /* Breakpoint trace enabled without specifying tracer =>
+ ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(p) & ERTS_PROC_LOCK_MAIN);
+
+ ASSERT(tracer);
+ if (ERTS_TRACER_COMPARE(*tracer, erts_tracer_true)) {
+ /* Breakpoint trace enabled without specifying tracer =>
* use process tracer and flags
*/
- tracer_pid = &ERTS_TRACER_PROC(p);
- }
- if (is_nil(*tracer_pid)) {
- /* Trace disabled */
- return 0;
+ tracer = &ERTS_TRACER(p);
}
- ASSERT(is_internal_pid(*tracer_pid) || is_internal_port(*tracer_pid));
- if (*tracer_pid == p->common.id) {
- /* Do not generate trace messages to oneself */
+ if (ERTS_TRACER_IS_NIL(*tracer)) {
+ /* Trace disabled */
return 0;
}
- if (tracer_pid == &ERTS_TRACER_PROC(p)) {
+ ASSERT(IS_TRACER_VALID(*tracer));
+ if (tracer == &ERTS_TRACER(p)) {
/* Tracer specified in process structure =>
* non-breakpoint trace =>
* use process flags
*/
tracee_flags = &ERTS_TRACE_FLAGS(p);
-#ifdef ERTS_SMP
- tracee = p->common.id;
-#endif
+ /* Is is not ideal at all to call this check twice,
+ it should be optimized so that only one call is made. */
+ if (!is_tracer_enabled(p, ERTS_PROC_LOCK_MAIN, &p->common, &tnif,
+ TRACE_FUN_ENABLED, am_trace_status)
+ || !is_tracer_enabled(p, ERTS_PROC_LOCK_MAIN, &p->common, &tnif,
+ TRACE_FUN_E_CALL, am_call)) {
+ return 0;
+ }
} else {
/* Tracer not specified in process structure =>
* tracer specified in breakpoint =>
* meta trace =>
* use fixed flag set instead of process flags
- */
- if (ERTS_TRACE_FLAGS(p) & F_SENSITIVE) {
- /* No trace messages for sensitive processes. */
- return 0;
- }
- meta_flags = F_TRACE_CALLS | F_TIMESTAMP;
+ */
+ if (ERTS_TRACE_FLAGS(p) & F_SENSITIVE) {
+ /* No trace messages for sensitive processes. */
+ return 0;
+ }
+ meta_flags = F_TRACE_CALLS | F_NOW_TS;
tracee_flags = &meta_flags;
-#ifdef ERTS_SMP
- tracee = NIL;
-#endif
+ switch (call_enabled_tracer(*tracer,
+ &tnif, TRACE_FUN_ENABLED,
+ am_trace_status, p->common.id)) {
+ default:
+ case am_remove: *tracer = erts_tracer_nil;
+ case am_discard: return 0;
+ case am_trace:
+ switch (call_enabled_tracer(*tracer,
+ &tnif, TRACE_FUN_T_CALL,
+ am_call, p->common.id)) {
+ default:
+ case am_discard: return 0;
+ case am_trace: break;
+ }
+ break;
+ }
}
/*
@@ -1658,19 +1244,14 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
* such as size_object() and copy_struct(), we must make sure that we
* temporarily convert any match contexts to sub binaries.
*/
- arity = (Eterm) mfa[2];
- UseTmpHeap(ERL_SUB_BIN_SIZE,p);
-#ifdef DEBUG
- sub_bin_heap->thing_word = 0;
-#endif
+ arity = info->mfa.arity;
for (i = 0; i < arity; i++) {
Eterm arg = args[i];
if (is_boxed(arg) && header_is_bin_matchstate(*boxed_val(arg))) {
ErlBinMatchState* ms = (ErlBinMatchState *) boxed_val(arg);
ErlBinMatchBuffer* mb = &ms->mb;
Uint bit_size;
-
- ASSERT(sub_bin_heap->thing_word == 0); /* At most one of match context */
+ ErlSubBin *sub_bin_heap = (ErlSubBin *)HAlloc(p, ERL_SUB_BIN_SIZE);
bit_size = mb->size - mb->offset;
sub_bin_heap->thing_word = HEADER_SUB_BIN;
@@ -1687,311 +1268,94 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
}
args = transformed_args;
- 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
- hp = local_heap;
-
- if (!erts_is_valid_tracer_port(*tracer_pid)) {
-#ifdef ERTS_SMP
- ASSERT(is_nil(tracee) || tracer_pid == &ERTS_TRACER_PROC(p));
- if (is_not_nil(tracee))
- erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR);
-#endif
- *tracee_flags &= ~TRACEE_FLAGS;
- *tracer_pid = NIL;
-#ifdef ERTS_SMP
- 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;
- }
-
- /*
- * If there is a PAM program, run it. Return if it fails.
- *
- * Some precedence rules:
- *
- * - No proc flags, e.g 'silent' or 'return_to'
- * has any effect on meta trace.
- * - The 'silent' process trace flag silences all call
- * related messages, e.g 'call', 'return_to' and 'return_from'.
- * - The {message,_} PAM function does not affect {return_trace}.
- * - The {message,false} PAM function shall give the same
- * 'call' trace message as no PAM match.
- * - The {message,true} PAM function shall give the same
- * 'call' trace message as a nonexistent PAM program.
- */
-
- /* BEGIN this code should be the same for port and pid trace */
- return_flags = 0;
- if (match_spec) {
- pam_result = erts_match_set_run(p, match_spec, args, arity,
- 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;
- }
- }
- if (tracee_flags == &meta_flags) {
- /* 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;
- }
- } else {
- /* 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;
- }
- if (local && (*tracee_flags & F_TRACE_RETURN_TO)) {
- return_flags |= MATCH_SET_RETURN_TO_TRACE;
- }
- }
- /* END this code should be the same for port and pid trace */
-
- /*
- * Build the the {M,F,A} tuple in the local heap.
- * (A is arguments or arity.)
- */
-
- if (*tracee_flags & F_TRACE_ARITY_ONLY) {
- mfa_tuple = make_small(arity);
- } else {
- mfa_tuple = NIL;
- for (i = arity-1; i >= 0; i--) {
- mfa_tuple = CONS(hp, args[i], mfa_tuple);
- hp += 2;
- }
- }
- mfa_tuple = TUPLE3(hp, (Eterm) mfa[0], (Eterm) mfa[1], mfa_tuple);
- hp += 4;
-
- /*
- * Build the trace tuple and send it to the port.
- */
-
- mess = TUPLE4(hp, am_trace, p->common.id, am_call, mfa_tuple);
- hp += 5;
- if (pam_result != am_true) {
- hp[-5] = make_arityval(5);
- *hp++ = pam_result;
- }
- erts_smp_mtx_lock(&smq_mtx);
- if (*tracee_flags & F_TIMESTAMP) {
- hp = patch_ts(mess, hp);
- }
- 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;
+ /*
+ * If there is a PAM program, run it. Return if it fails.
+ *
+ * Some precedence rules:
+ *
+ * - No proc flags, e.g 'silent' or 'return_to'
+ * has any effect on meta trace.
+ * - The 'silent' process trace flag silences all call
+ * related messages, e.g 'call', 'return_to' and 'return_from'.
+ * - The {message,_} PAM function does not affect {return_trace}.
+ * - The {message,false} PAM function shall give the same
+ * 'call' trace message as no PAM match.
+ * - The {message,true} PAM function shall give the same
+ * 'call' trace message as a nonexistent PAM program.
+ */
+ return_flags = 0;
+ if (match_spec) {
+ /* we have to make a copy of the tracer here as the match spec
+ may remove it, and we still want to generate a trace message */
+ erts_tracer_update(&pre_ms_tracer, *tracer);
+ tracer = &pre_ms_tracer;
+ pam_result = erts_match_set_run_trace(p, p,
+ match_spec, args, arity,
+ ERTS_PAM_TMP_RESULT, &return_flags);
+ }
+
+ if (tracee_flags == &meta_flags) {
+ /* Meta trace */
+ if (pam_result == am_false) {
+ UnUseTmpHeap(ERL_SUB_BIN_SIZE,p);
+ ERTS_TRACER_CLEAR(&pre_ms_tracer);
+ return return_flags;
+ }
} else {
- ErlHeapFragment *bp;
- ErlOffHeap *off_heap;
- Process *tracer;
- ERTS_TRACER_REF_TYPE tracer_ref;
-#ifdef ERTS_SMP
- Eterm tpid;
-#endif
- unsigned size;
- unsigned sizes[MAX_ARG];
- unsigned pam_result_size = 0;
- int invalid_tracer;
-#ifdef DEBUG
- Eterm* limit;
-#endif
-
- ASSERT(is_internal_pid(*tracer_pid));
-
- tracer = erts_pid2proc(p, ERTS_PROC_LOCK_MAIN,
- *tracer_pid, ERTS_PROC_LOCK_STATUS);
- if (!tracer)
- invalid_tracer = 1;
- else {
- invalid_tracer = !(ERTS_TRACE_FLAGS(tracer) & F_TRACER);
- erts_smp_proc_unlock(tracer, ERTS_PROC_LOCK_STATUS);
- }
+ /* Non-meta trace */
+ if (*tracee_flags & F_TRACE_SILENT) {
+ erts_match_set_release_result_trace(p, pam_result);
+ UnUseTmpHeap(ERL_SUB_BIN_SIZE,p);
+ ERTS_TRACER_CLEAR(&pre_ms_tracer);
+ return 0;
+ }
+ if (pam_result == am_false) {
+ UnUseTmpHeap(ERL_SUB_BIN_SIZE,p);
+ ERTS_TRACER_CLEAR(&pre_ms_tracer);
+ return return_flags;
+ }
+ if (local && (*tracee_flags & F_TRACE_RETURN_TO)) {
+ return_flags |= MATCH_SET_RETURN_TO_TRACE;
+ }
+ }
+
+ ASSERT(!ERTS_TRACER_IS_NIL(*tracer));
- if (invalid_tracer) {
-#ifdef ERTS_SMP
- ASSERT(is_nil(tracee)
- || tracer_pid == &ERTS_TRACER_PROC(p));
- if (is_not_nil(tracee))
- erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR);
-#endif
- *tracee_flags &= ~TRACEE_FLAGS;
- *tracer_pid = NIL;
-#ifdef ERTS_SMP
- if (is_not_nil(tracee))
- erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL_MINOR);
-#endif
- UnUseTmpHeap(ERL_SUB_BIN_SIZE,p);
- return 0;
- }
-
-#ifdef ERTS_SMP
- tpid = *tracer_pid; /* Need to save tracer pid,
- since *tracer_pid might
- be reset by erts_match_set_run() */
- tracer_ref = tpid;
-#else
- tracer_ref = tracer;
-#endif
-
- /*
- * If there is a PAM program, run it. Return if it fails.
- *
- * See the rules above in the port trace code.
- */
-
- /* BEGIN this code should be the same for port and pid trace */
- return_flags = 0;
- if (match_spec) {
- pam_result = erts_match_set_run(p, match_spec, args, arity,
- ERTS_PAM_TMP_RESULT, &return_flags);
- if (is_non_value(pam_result)) {
- erts_match_set_release_result(p);
- UnUseTmpHeap(ERL_SUB_BIN_SIZE,p);
- return 0;
- }
- }
- if (tracee_flags == &meta_flags) {
- /* Meta trace */
- if (pam_result == am_false) {
- erts_match_set_release_result(p);
- UnUseTmpHeap(ERL_SUB_BIN_SIZE,p);
- return return_flags;
- }
- } else {
- /* Non-meta trace */
- if (*tracee_flags & F_TRACE_SILENT) {
- erts_match_set_release_result(p);
- UnUseTmpHeap(ERL_SUB_BIN_SIZE,p);
- return 0;
- }
- if (pam_result == am_false) {
- erts_match_set_release_result(p);
- UnUseTmpHeap(ERL_SUB_BIN_SIZE,p);
- return return_flags;
- }
- if (local && (*tracee_flags & F_TRACE_RETURN_TO)) {
- return_flags |= MATCH_SET_RETURN_TO_TRACE;
- }
- }
- /* END this code should be the same for port and pid trace */
-
- /*
- * Calculate number of words needed on heap.
- */
-
- size = 4 + 5; /* Trace tuple + MFA tuple. */
- if (! (*tracee_flags & F_TRACE_ARITY_ONLY)) {
- size += 2*arity;
- for (i = arity-1; i >= 0; i--) {
- sizes[i] = size_object(args[i]);
- size += sizes[i];
- }
- }
- if (*tracee_flags & F_TIMESTAMP) {
- size += 1 + 4;
- /* One element in trace tuple + timestamp tuple. */
- }
- if (pam_result != am_true) {
- pam_result_size = size_object(pam_result);
- size += 1 + pam_result_size;
- /* One element in trace tuple + term size. */
- }
-
- 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.
- * (A is arguments or arity.)
- */
-
- if (*tracee_flags & F_TRACE_ARITY_ONLY) {
- mfa_tuple = make_small(arity);
- } else {
- mfa_tuple = NIL;
- for (i = arity-1; i >= 0; i--) {
- Eterm term = copy_struct(args[i], sizes[i], &hp, off_heap);
- mfa_tuple = CONS(hp, term, mfa_tuple);
- hp += 2;
- }
- }
- mfa_tuple = TUPLE3(hp, (Eterm) mfa[0], (Eterm) mfa[1], mfa_tuple);
- hp += 4;
-
- /*
- * Copy the PAM result (if any) onto the heap.
- */
-
- if (pam_result != am_true) {
- pam_result = copy_struct(pam_result, pam_result_size, &hp, off_heap);
- }
-
- erts_match_set_release_result(p);
+ /*
+ * Build the the {M,F,A} tuple in the local heap.
+ * (A is arguments or arity.)
+ */
- /*
- * Build the trace tuple and enqueue it.
- */
-
- mess = TUPLE4(hp, am_trace, p->common.id, am_call, mfa_tuple);
- hp += 5;
- if (pam_result != am_true) {
- hp[-5] = make_arityval(5);
- *hp++ = pam_result;
- }
- erts_smp_mtx_lock(&smq_mtx);
+ if (*tracee_flags & F_TRACE_ARITY_ONLY) {
+ hp = HAlloc(p, 4);
+ mfa_tuple = make_small(arity);
+ } else {
+ hp = HAlloc(p, 4 + arity * 2);
+ mfa_tuple = NIL;
+ for (i = arity-1; i >= 0; i--) {
+ mfa_tuple = CONS(hp, args[i], mfa_tuple);
+ hp += 2;
+ }
+ }
+ mfa_tuple = TUPLE3(hp, info->mfa.module, info->mfa.function, mfa_tuple);
+ hp += 4;
- if (*tracee_flags & F_TIMESTAMP) {
- hp = patch_ts(mess, hp);
- }
+ /*
+ * Build the trace tuple and send it to the port.
+ */
+ send_to_tracer_nif_raw(p, NULL, *tracer, *tracee_flags, p->common.id,
+ tnif, TRACE_FUN_T_CALL, am_call, mfa_tuple,
+ THE_NON_VALUE, pam_result);
- ASSERT(hp == limit);
- ERTS_ENQ_TRACE_MSG(tracee, tracer_ref, mess, bp);
- erts_smp_mtx_unlock(&smq_mtx);
- UnUseTmpHeap(ERL_SUB_BIN_SIZE,p);
- return return_flags;
+ if (match_spec) {
+ erts_match_set_release_result_trace(p, pam_result);
+ if (tracer == &pre_ms_tracer)
+ ERTS_TRACER_CLEAR(&pre_ms_tracer);
}
+
+ return return_flags;
}
/* Sends trace message:
@@ -2003,73 +1367,14 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
* 't_p' is the traced process.
*/
void
-trace_proc(Process *c_p, Process *t_p, Eterm what, Eterm data)
+trace_proc(Process *c_p, ErtsProcLocks c_p_locks,
+ Process *t_p, Eterm what, Eterm data)
{
- Eterm mess;
- Eterm* hp;
- int need;
-
- ERTS_SMP_LC_ASSERT((erts_proc_lc_my_proc_locks(t_p) != 0)
- || erts_thr_progress_is_blocking());
- if (is_internal_port(ERTS_TRACER_PROC(t_p))) {
-#define LOCAL_HEAP_SIZE (5+5)
- DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
- UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
-
-
- hp = local_heap;
- 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);
- }
- send_to_port(
-#ifndef ERTS_SMP
- /* No fake schedule out and in again after an exit */
- what == am_exit ? NULL : c_p,
-#else
- /* Fake schedule out and in are never sent when smp enabled */
- c_p,
-#endif
- mess,
- &ERTS_TRACER_PROC(t_p),
- &ERTS_TRACE_FLAGS(t_p));
- UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
-#undef LOCAL_HEAP_SIZE
- erts_smp_mtx_unlock(&smq_mtx);
- } else {
- Eterm tmp;
- ErlHeapFragment *bp;
- ErlOffHeap *off_heap;
- ERTS_TRACER_REF_TYPE tracer_ref;
- size_t sz_data;
-
- ASSERT(is_internal_pid(ERTS_TRACER_PROC(t_p)));
-
- ERTS_GET_TRACER_REF(tracer_ref,
- ERTS_TRACER_PROC(t_p),
- ERTS_TRACE_FLAGS(t_p));
-
- sz_data = size_object(data);
-
- need = sz_data + 5 + TS_SIZE(t_p);
-
- hp = ERTS_ALLOC_SYSMSG_HEAP(need, &bp, &off_heap, tracer_ref);
-
- tmp = copy_struct(data, sz_data, &hp, off_heap);
- mess = TUPLE4(hp, am_trace, t_p->common.id, what, tmp);
- hp += 5;
-
- erts_smp_mtx_lock(&smq_mtx);
-
- if (ERTS_TRACE_FLAGS(t_p) & F_TIMESTAMP) {
- hp = patch_ts(mess, hp);
- }
-
- ERTS_ENQ_TRACE_MSG(t_p->common.id, tracer_ref, mess, bp);
- erts_smp_mtx_unlock(&smq_mtx);
- }
+ ErtsTracerNif *tnif = NULL;
+ if (is_tracer_enabled(NULL, 0, &t_p->common, &tnif,
+ TRACE_FUN_E_PROCS, what))
+ send_to_tracer_nif(NULL, &t_p->common, t_p->common.id, tnif, TRACE_FUN_T_PROCS,
+ what, data, THE_NON_VALUE, am_true);
}
@@ -2081,81 +1386,37 @@ trace_proc(Process *c_p, Process *t_p, Eterm what, Eterm data)
* and 'args' may be a deep term.
*/
void
-trace_proc_spawn(Process *p, Eterm pid,
+trace_proc_spawn(Process *p, Eterm what, Eterm pid,
Eterm mod, Eterm func, Eterm args)
{
- Eterm mfa;
- Eterm mess;
- Eterm* hp;
-
- if (is_internal_port(ERTS_TRACER_PROC(p))) {
-#define LOCAL_HEAP_SIZE (4+6+5)
- DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
- UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
+ ErtsTracerNif *tnif = NULL;
+ if (is_tracer_enabled(NULL, 0,
+ &p->common, &tnif, TRACE_FUN_E_PROCS, what)) {
+ Eterm mfa;
+ Eterm* hp;
- hp = local_heap;
- mfa = TUPLE3(hp, mod, func, args);
- hp += 4;
- 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);
- }
- send_to_port(p, mess, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p));
- UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
-#undef LOCAL_HEAP_SIZE
- erts_smp_mtx_unlock(&smq_mtx);
- } else {
- Eterm tmp;
- ErlHeapFragment *bp;
- ErlOffHeap *off_heap;
- ERTS_TRACER_REF_TYPE tracer_ref;
- size_t sz_args, sz_pid;
- Uint need;
-
- ASSERT(is_internal_pid(ERTS_TRACER_PROC(p)));
-
- ERTS_GET_TRACER_REF(tracer_ref,
- ERTS_TRACER_PROC(p),
- ERTS_TRACE_FLAGS(p));
-
- sz_args = size_object(args);
- sz_pid = size_object(pid);
- need = sz_args + 4 + 6 + TS_SIZE(p);
-
- hp = ERTS_ALLOC_SYSMSG_HEAP(need, &bp, &off_heap, tracer_ref);
-
- tmp = copy_struct(args, sz_args, &hp, off_heap);
- mfa = TUPLE3(hp, mod, func, tmp);
- hp += 4;
- tmp = copy_struct(pid, sz_pid, &hp, off_heap);
- mess = TUPLE5(hp, am_trace, p->common.id, am_spawn, tmp, mfa);
- hp += 6;
-
- erts_smp_mtx_lock(&smq_mtx);
-
- if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) {
- hp = patch_ts(mess, hp);
- }
-
- ERTS_ENQ_TRACE_MSG(p->common.id, tracer_ref, mess, bp);
- erts_smp_mtx_unlock(&smq_mtx);
+ hp = HAlloc(p, 4);
+ mfa = TUPLE3(hp, mod, func, args);
+ hp += 4;
+ send_to_tracer_nif(NULL, &p->common, p->common.id, tnif, TRACE_FUN_T_PROCS,
+ what, pid, mfa, am_true);
}
}
void save_calls(Process *p, Export *e)
{
- struct saved_calls *scb = ERTS_PROC_GET_SAVED_CALLS_BUF(p);
- if (scb) {
- Export **ct = &scb->ct[0];
- int len = scb->len;
-
- ct[scb->cur] = e;
- if (++scb->cur >= len)
- scb->cur = 0;
- if (scb->n < len)
- scb->n++;
+ if ((ERTS_TRACE_FLAGS(p) & F_SENSITIVE) == 0) {
+ struct saved_calls *scb = ERTS_PROC_GET_SAVED_CALLS_BUF(p);
+ if (scb) {
+ Export **ct = &scb->ct[0];
+ int len = scb->len;
+
+ ct[scb->cur] = e;
+ if (++scb->cur >= len)
+ scb->cur = 0;
+ if (scb->n < len)
+ scb->n++;
+ }
}
}
@@ -2172,123 +1433,37 @@ void save_calls(Process *p, Export *e)
* are all small (atomic) integers.
*/
void
-trace_gc(Process *p, Eterm what)
+trace_gc(Process *p, Eterm what, Uint size, Eterm msg)
{
- 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
- to eliminate
- compiler
- warning */
+ ErtsTracerNif *tnif = NULL;
+ Eterm* o_hp = NULL;
Eterm* hp;
- 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
- DeclareTmpHeap(local_heap,LOCAL_HEAP_SIZE,p);
-#ifdef DEBUG
- Eterm* limit;
-#endif
-
- ASSERT(sizeof(values)/sizeof(*values) == sizeof(tags)/sizeof(Eterm));
-
- UseTmpHeap(LOCAL_HEAP_SIZE,p);
-
- if (is_internal_port(ERTS_TRACER_PROC(p))) {
- 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);
-#endif
- } else {
- ASSERT(is_internal_pid(ERTS_TRACER_PROC(p)));
-
- ERTS_GET_TRACER_REF(tracer_ref,
- ERTS_TRACER_PROC(p),
- 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);
-
- hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref);
- }
+ Uint sz = 0;
+ Eterm tup;
-#ifdef DEBUG
- limit = hp + size;
- ASSERT(size <= LOCAL_HEAP_SIZE);
-#endif
+ if (is_tracer_enabled(p, ERTS_PROC_LOCK_MAIN, &p->common, &tnif,
+ TRACE_FUN_E_GC, what)) {
- msg = erts_bld_atom_uword_2tup_list(&hp,
- NULL,
- sizeof(values)/sizeof(*values),
- tags,
- values);
+ if (is_non_value(msg)) {
- msg = TUPLE4(hp, am_trace, p->common.id, what, msg);
- hp += 5;
+ (void) erts_process_gc_info(p, &sz, NULL, 0, 0);
+ o_hp = hp = erts_alloc(ERTS_ALC_T_TMP, (sz + 3 + 2) * sizeof(Eterm));
- erts_smp_mtx_lock(&smq_mtx);
+ msg = erts_process_gc_info(p, NULL, &hp, 0, 0);
+ tup = TUPLE2(hp, am_wordsize, make_small(size)); hp += 3;
+ msg = CONS(hp, tup, msg); hp += 2;
+ }
- if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) {
- hp = patch_ts(msg, hp);
+ send_to_tracer_nif(p, &p->common, p->common.id, tnif, TRACE_FUN_T_GC,
+ what, msg, THE_NON_VALUE, am_true);
+ if (o_hp)
+ erts_free(ERTS_ALC_T_TMP, o_hp);
}
- ASSERT(hp == limit);
- if (is_internal_port(ERTS_TRACER_PROC(p)))
- send_to_port(p, msg, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p));
- else
- 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
}
void
-monitor_long_schedule_proc(Process *p, BeamInstr *in_fp, BeamInstr *out_fp, Uint time)
+monitor_long_schedule_proc(Process *p, ErtsCodeMFA *in_fp,
+ ErtsCodeMFA *out_fp, Uint time)
{
ErlHeapFragment *bp;
ErlOffHeap *off_heap;
@@ -2319,11 +1494,13 @@ monitor_long_schedule_proc(Process *p, BeamInstr *in_fp, BeamInstr *out_fp, Uint
hp = ERTS_ALLOC_SYSMSG_HEAP(hsz, &bp, &off_heap, monitor_p);
tmo = erts_bld_uint(&hp, NULL, time);
if (in_fp != NULL) {
- in_mfa = TUPLE3(hp,(Eterm) in_fp[0], (Eterm) in_fp[1], make_small(in_fp[2]));
+ in_mfa = TUPLE3(hp, in_fp->module, in_fp->function,
+ make_small(in_fp->arity));
hp +=4;
}
if (out_fp != NULL) {
- out_mfa = TUPLE3(hp,(Eterm) out_fp[0], (Eterm) out_fp[1], make_small(out_fp[2]));
+ out_mfa = TUPLE3(hp, out_fp->module, out_fp->function,
+ make_small(out_fp->arity));
hp +=4;
}
tmo_tpl = TUPLE2(hp,am_timeout, tmo);
@@ -2343,11 +1520,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
-#ifdef USE_VM_PROBES
- , NIL
-#endif
- );
+ {
+ ErtsMessage *mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = bp;
+ erts_queue_message(monitor_p, 0, mp, msg, am_system);
+ }
#endif
}
void
@@ -2408,11 +1585,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
-#ifdef USE_VM_PROBES
- , NIL
-#endif
- );
+ {
+ ErtsMessage *mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = bp;
+ erts_queue_message(monitor_p, 0, mp, msg, am_system);
+ }
#endif
}
@@ -2483,11 +1660,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
-#ifdef USE_VM_PROBES
- , NIL
-#endif
- );
+ {
+ ErtsMessage *mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = bp;
+ erts_queue_message(monitor_p, 0, mp, msg, am_system);
+ }
#endif
}
@@ -2524,7 +1701,7 @@ monitor_large_heap(Process *p) {
#ifndef ERTS_SMP
ASSERT(is_internal_pid(system_monitor));
monitor_p = erts_proc_lookup(system_monitor);
- if (monitor_p || p == monitor_p) {
+ if (!monitor_p || p == monitor_p) {
return;
}
#endif
@@ -2558,11 +1735,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
-#ifdef USE_VM_PROBES
- , NIL
-#endif
- );
+ {
+ ErtsMessage *mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = bp;
+ erts_queue_message(monitor_p, 0, mp, msg, am_system);
+ }
#endif
}
@@ -2590,11 +1767,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
-#ifdef USE_VM_PROBES
- , NIL
-#endif
- );
+ {
+ ErtsMessage *mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = bp;
+ erts_queue_message(monitor_p, 0, mp, msg, am_system);
+ }
#endif
}
@@ -2605,19 +1782,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;
@@ -2637,46 +1813,14 @@ 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;
-#ifndef ERTS_SMP
- profile_send(NIL, msg);
- UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
-#undef LOCAL_HEAP_SIZE
-#else
- enqueue_sys_msg_unlocked(SYS_MSG_TYPE_SYSPROF, NIL, NIL, msg, bp);
-#endif
- erts_smp_mtx_unlock(&smq_mtx);
-
-}
-
-void
-profile_scheduler_q(Eterm scheduler_id, Eterm state, Eterm no_schedulers, Uint Ms, Uint s, Uint us) {
- Eterm *hp, msg, timestamp;
-
-#ifndef ERTS_SMP
-#define LOCAL_HEAP_SIZE (4 + 7)
- DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
- UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
-
- hp = local_heap;
-#else
- ErlHeapFragment *bp;
- Uint hsz;
+ /* Write timestamp in element 6 of the 'msg' tuple */
+ hp[-1] = write_ts(erts_system_profile_ts_type, hp, bp, NULL);
- hsz = 4 + 7;
-
- bp = new_message_buffer(hsz);
- hp = bp->mem;
-#endif
-
- erts_smp_mtx_lock(&smq_mtx);
-
- timestamp = TUPLE3(hp, make_small(Ms), make_small(s), make_small(us)); hp += 4;
- msg = TUPLE6(hp, am_profile, am_scheduler, scheduler_id, state, no_schedulers, timestamp); hp += 7;
#ifndef ERTS_SMP
profile_send(NIL, msg);
UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
@@ -2688,75 +1832,15 @@ profile_scheduler_q(Eterm scheduler_id, Eterm state, Eterm no_schedulers, Uint M
}
-
-/* Send {trace_ts, Pid, What, {Mod, Func, Arity}, Timestamp}
- * or {trace, Pid, What, {Mod, Func, Arity}}
- *
- * where 'What' is supposed to be 'in' or 'out'.
- *
- * Virtual scheduling do not fake scheduling for ports.
- */
-
-
-void trace_virtual_sched(Process *p, Eterm what)
-{
- trace_sched_aux(p, what, 1);
-}
-
/* Port profiling */
void
trace_port_open(Port *p, Eterm calling_pid, Eterm drv_name) {
- Eterm mess;
- Eterm* hp;
-
- if (is_internal_port(ERTS_TRACER_PROC(p))) {
-#define LOCAL_HEAP_SIZE (5+6)
- DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
- UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
-
- hp = local_heap;
-
- 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);
- }
- /* No fake schedule */
- send_to_port(NULL, mess, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p));
- UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
-#undef LOCAL_HEAP_SIZE
- erts_smp_mtx_unlock(&smq_mtx);
- } else {
- ErlHeapFragment *bp;
- ErlOffHeap *off_heap;
- size_t sz_data;
- ERTS_TRACER_REF_TYPE tracer_ref;
-
- ASSERT(is_internal_pid(ERTS_TRACER_PROC(p)));
-
- sz_data = 6 + TS_SIZE(p);
-
- ERTS_GET_TRACER_REF(tracer_ref,
- ERTS_TRACER_PROC(p),
- ERTS_TRACE_FLAGS(p));
-
- hp = ERTS_ALLOC_SYSMSG_HEAP(sz_data, &bp, &off_heap, tracer_ref);
-
- 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);
- }
-
- ERTS_ENQ_TRACE_MSG(p->common.id, tracer_ref, mess, bp);
- erts_smp_mtx_unlock(&smq_mtx);
- }
-
+ ErtsTracerNif *tnif = NULL;
+ ERTS_SMP_CHK_NO_PROC_LOCKS;
+ if (is_tracer_enabled(NULL, 0, &p->common, &tnif, TRACE_FUN_E_PORTS, am_open))
+ send_to_tracer_nif(NULL, &p->common, p->common.id, tnif, TRACE_FUN_T_PORTS,
+ am_open, calling_pid, drv_name, am_true);
}
/* Sends trace message:
@@ -2768,56 +1852,210 @@ trace_port_open(Port *p, Eterm calling_pid, Eterm drv_name) {
*/
void
trace_port(Port *t_p, Eterm what, Eterm data) {
- Eterm mess;
- Eterm* hp;
+ ErtsTracerNif *tnif = NULL;
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(t_p)
|| erts_thr_progress_is_blocking());
+ ERTS_SMP_CHK_NO_PROC_LOCKS;
+ if (is_tracer_enabled(NULL, 0, &t_p->common, &tnif, TRACE_FUN_E_PORTS, what))
+ send_to_tracer_nif(NULL, &t_p->common, t_p->common.id, tnif, TRACE_FUN_T_PORTS,
+ what, data, THE_NON_VALUE, am_true);
+}
- if (is_internal_port(ERTS_TRACER_PROC(t_p))) {
-#define LOCAL_HEAP_SIZE (5+5)
- DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
- UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
- hp = local_heap;
- 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);
- }
- /* No fake schedule */
- send_to_port(NULL,mess,&ERTS_TRACER_PROC(t_p),&ERTS_TRACE_FLAGS(t_p));
- UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
-#undef LOCAL_HEAP_SIZE
- erts_smp_mtx_unlock(&smq_mtx);
+static Eterm
+trace_port_tmp_binary(char *bin, Sint sz, Binary **bptrp, Eterm **hp)
+{
+ if (sz <= ERL_ONHEAP_BIN_LIMIT) {
+ ErlHeapBin *hb = (ErlHeapBin *)*hp;
+ hb->thing_word = header_heap_bin(sz);
+ hb->size = sz;
+ sys_memcpy(hb->data, bin, sz);
+ *hp += heap_bin_size(sz);
+ return make_binary(hb);
} else {
- ErlHeapFragment *bp;
- ErlOffHeap *off_heap;
- size_t sz_data;
- ERTS_TRACER_REF_TYPE tracer_ref;
+ ProcBin* pb = (ProcBin *)*hp;
+ Binary *bptr = erts_bin_nrml_alloc(sz);
+ sys_memcpy(bptr->orig_bytes, bin, sz);
+ pb->thing_word = HEADER_PROC_BIN;
+ pb->size = sz;
+ pb->next = NULL;
+ pb->val = bptr;
+ pb->bytes = (byte*) bptr->orig_bytes;
+ pb->flags = 0;
+ *bptrp = bptr;
+ *hp += PROC_BIN_SIZE;
+ return make_binary(pb);
+ }
+}
+
+/* Sends trace message:
+ * {trace, PortPid, 'receive', {pid(), {command, iolist()}}}
+ * {trace, PortPid, 'receive', {pid(), {control, pid()}}}
+ * {trace, PortPid, 'receive', {pid(), exit}}
+ *
+ */
+void
+trace_port_receive(Port *t_p, Eterm caller, Eterm what, ...)
+{
+ ErtsTracerNif *tnif = NULL;
+ ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(t_p)
+ || erts_thr_progress_is_blocking());
+ ERTS_SMP_CHK_NO_PROC_LOCKS;
+ if (is_tracer_enabled(NULL, 0, &t_p->common, &tnif, TRACE_FUN_E_RECEIVE, am_receive)) {
+ /* We can use a stack heap here, as the nif is called in the
+ context of a port */
+#define LOCAL_HEAP_SIZE (3 + 3 + heap_bin_size(ERL_ONHEAP_BIN_LIMIT) + 3)
+ DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
+
+ Eterm *hp, data, *orig_hp = NULL;
+ Binary *bptr = NULL;
+ va_list args;
+ UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
+ hp = local_heap;
+
+ if (what == am_close) {
+ data = what;
+ } else {
+ Eterm arg;
+ va_start(args, what);
+ if (what == am_command) {
+ char *bin = va_arg(args, char *);
+ Sint sz = va_arg(args, Sint);
+ va_end(args);
+ arg = trace_port_tmp_binary(bin, sz, &bptr, &hp);
+ } else if (what == am_call || what == am_control) {
+ unsigned int command = va_arg(args, unsigned int);
+ char *bin = va_arg(args, char *);
+ Sint sz = va_arg(args, Sint);
+ Eterm cmd;
+ va_end(args);
+ arg = trace_port_tmp_binary(bin, sz, &bptr, &hp);
+#if defined(ARCH_32)
+ if (!IS_USMALL(0, command)) {
+ *hp = make_pos_bignum_header(1);
+ BIG_DIGIT(hp, 0) = (Uint)command;
+ cmd = make_big(hp);
+ hp += 2;
+ } else
+#endif
+ {
+ cmd = make_small((Sint)command);
+ }
+ arg = TUPLE2(hp, cmd, arg);
+ hp += 3;
+ } else if (what == am_commandv) {
+ ErlIOVec *evp = va_arg(args, ErlIOVec*);
+ int i;
+ va_end(args);
+ if ((6 + evp->vsize * (2+PROC_BIN_SIZE+ERL_SUB_BIN_SIZE)) > LOCAL_HEAP_SIZE) {
+ hp = erts_alloc(ERTS_ALC_T_TMP,
+ (6 + evp->vsize * (2+PROC_BIN_SIZE+ERL_SUB_BIN_SIZE)) * sizeof(Eterm));
+ orig_hp = hp;
+ }
+ arg = NIL;
+ /* Convert each element in the ErlIOVec to a sub bin that points
+ to a procbin. We don't have to increment the proc bin refc as
+ the port task keeps the reference alive. */
+ for (i = evp->vsize-1; i >= 0; i--) {
+ if (evp->iov[i].iov_len) {
+ ProcBin* pb = (ProcBin*)hp;
+ ErlSubBin *sb;
+ ASSERT(evp->binv[i]);
+ pb->thing_word = HEADER_PROC_BIN;
+ pb->val = ErlDrvBinary2Binary(evp->binv[i]);
+ pb->size = pb->val->orig_size;
+ pb->next = NULL;
+ pb->bytes = (byte*) pb->val->orig_bytes;
+ pb->flags = 0;
+ hp += PROC_BIN_SIZE;
+
+ sb = (ErlSubBin*) hp;
+ sb->thing_word = HEADER_SUB_BIN;
+ sb->size = evp->iov[i].iov_len;
+ sb->offs = (byte*)(evp->iov[i].iov_base) - pb->bytes;
+ sb->orig = make_binary(pb);
+ sb->bitoffs = 0;
+ sb->bitsize = 0;
+ sb->is_writable = 0;
+ hp += ERL_SUB_BIN_SIZE;
+
+ arg = CONS(hp, make_binary(sb), arg);
+ hp += 2;
+ }
+ }
+ what = am_command;
+ } else {
+ arg = va_arg(args, Eterm);
+ va_end(args);
+ }
+ data = TUPLE2(hp, what, arg);
+ hp += 3;
+ }
+
+ data = TUPLE2(hp, caller, data);
+ hp += 3;
+ ASSERT(hp <= (local_heap + LOCAL_HEAP_SIZE) || orig_hp);
+ send_to_tracer_nif(NULL, &t_p->common, t_p->common.id, tnif,
+ TRACE_FUN_T_RECEIVE,
+ am_receive, data, THE_NON_VALUE, am_true);
+
+ if (bptr)
+ erts_bin_release(bptr);
+
+ if (orig_hp)
+ erts_free(ERTS_ALC_T_TMP, orig_hp);
+
+ UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
+ }
+#undef LOCAL_HEAP_SIZE
+}
- ASSERT(is_internal_pid(ERTS_TRACER_PROC(t_p)));
+void
+trace_port_send(Port *t_p, Eterm receiver, Eterm msg, int exists)
+{
+ ErtsTracerNif *tnif = NULL;
+ Eterm op = exists ? am_send : am_send_to_non_existing_process;
+ ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(t_p)
+ || erts_thr_progress_is_blocking());
+ ERTS_SMP_CHK_NO_PROC_LOCKS;
+ if (is_tracer_enabled(NULL, 0, &t_p->common, &tnif, TRACE_FUN_E_SEND, op))
+ send_to_tracer_nif(NULL, &t_p->common, t_p->common.id, tnif, TRACE_FUN_T_SEND,
+ op, msg, receiver, am_true);
+}
- sz_data = 5 + TS_SIZE(t_p);
+void trace_port_send_binary(Port *t_p, Eterm to, Eterm what, char *bin, Sint sz)
+{
+ ErtsTracerNif *tnif = NULL;
+ ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(t_p)
+ || erts_thr_progress_is_blocking());
+ ERTS_SMP_CHK_NO_PROC_LOCKS;
+ if (is_tracer_enabled(NULL, 0, &t_p->common, &tnif, TRACE_FUN_E_SEND, am_send)) {
+ Eterm msg;
+ Binary* bptr = NULL;
+#define LOCAL_HEAP_SIZE (3 + 3 + heap_bin_size(ERL_ONHEAP_BIN_LIMIT))
+ DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
- ERTS_GET_TRACER_REF(tracer_ref,
- ERTS_TRACER_PROC(t_p),
- ERTS_TRACE_FLAGS(t_p));
+ Eterm *hp;
- hp = ERTS_ALLOC_SYSMSG_HEAP(sz_data, &bp, &off_heap, tracer_ref);
+ ERTS_CT_ASSERT(heap_bin_size(ERL_ONHEAP_BIN_LIMIT) >= PROC_BIN_SIZE);
+ UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
+ hp = local_heap;
- mess = TUPLE4(hp, am_trace, t_p->common.id, what, data);
- hp += 5;
+ msg = trace_port_tmp_binary(bin, sz, &bptr, &hp);
- erts_smp_mtx_lock(&smq_mtx);
+ msg = TUPLE2(hp, what, msg);
+ hp += 3;
+ msg = TUPLE2(hp, t_p->common.id, msg);
+ hp += 3;
- if (ERTS_TRACE_FLAGS(t_p) & F_TIMESTAMP) {
- hp = patch_ts(mess, hp);
- }
+ send_to_tracer_nif(NULL, &t_p->common, t_p->common.id, tnif, TRACE_FUN_T_SEND,
+ am_send, msg, to, am_true);
+ if (bptr)
+ erts_bin_release(bptr);
- ERTS_ENQ_TRACE_MSG(t_p->common.id, tracer_ref, mess, bp);
- erts_smp_mtx_unlock(&smq_mtx);
+ UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
+#undef LOCAL_HEAP_SIZE
}
}
@@ -2831,100 +2069,31 @@ trace_port(Port *t_p, Eterm what, Eterm data) {
void
trace_sched_ports(Port *p, Eterm what) {
- trace_sched_ports_where(p,what, make_small(0));
+ trace_sched_ports_where(p, what, make_small(0));
}
-void
-trace_sched_ports_where(Port *p, Eterm what, Eterm where) {
- Eterm mess;
- Eterm* hp;
- int ws = 5;
- Eterm sched_id = am_undefined;
-
- if (is_internal_port(ERTS_TRACER_PROC(p))) {
-#define LOCAL_HEAP_SIZE (5+6)
- DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
- UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
-
- hp = local_heap;
-
- if (IS_TRACED_FL(p, F_TRACE_SCHED_NO)) {
-#ifdef ERTS_SMP
- ErtsSchedulerData *esd = erts_get_scheduler_data();
- if (esd) sched_id = make_small(esd->no);
- else sched_id = am_undefined;
-#else
- sched_id = make_small(1);
-#endif
- mess = TUPLE5(hp, am_trace, p->common.id, what, sched_id, where);
- ws = 6;
- } else {
- mess = TUPLE4(hp, am_trace, p->common.id, what, where);
- ws = 5;
- }
- hp += ws;
-
- erts_smp_mtx_lock(&smq_mtx);
- if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) {
- hp = patch_ts(mess, hp);
- }
-
- /* No fake scheduling */
- send_to_port(NULL, mess, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p));
- UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
-#undef LOCAL_HEAP_SIZE
- erts_smp_mtx_unlock(&smq_mtx);
- } else {
- ErlHeapFragment *bp;
- ErlOffHeap *off_heap;
- ERTS_TRACER_REF_TYPE tracer_ref;
-
- ASSERT(is_internal_pid(ERTS_TRACER_PROC(p)));
-
- if (IS_TRACED_FL(p, F_TRACE_SCHED_NO)) ws = 6; /* Make place for scheduler id */
-
- ERTS_GET_TRACER_REF(tracer_ref,
- ERTS_TRACER_PROC(p),
- ERTS_TRACE_FLAGS(p));
-
- hp = ERTS_ALLOC_SYSMSG_HEAP(ws+TS_SIZE(p), &bp, &off_heap, tracer_ref);
-
- if (IS_TRACED_FL(p, F_TRACE_SCHED_NO)) {
-#ifdef ERTS_SMP
- ErtsSchedulerData *esd = erts_get_scheduler_data();
- if (esd) sched_id = make_small(esd->no);
- else sched_id = am_undefined;
-#else
- sched_id = make_small(1);
-#endif
- mess = TUPLE5(hp, am_trace, p->common.id, what, sched_id, where);
- } else {
- mess = TUPLE4(hp, am_trace, p->common.id, what, where);
- }
- hp += ws;
-
- erts_smp_mtx_lock(&smq_mtx);
-
- if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) {
- hp = patch_ts(mess, hp);
- }
-
- ERTS_ENQ_TRACE_MSG(p->common.id, tracer_ref, mess, bp);
- erts_smp_mtx_unlock(&smq_mtx);
- }
+void
+trace_sched_ports_where(Port *t_p, Eterm what, Eterm where) {
+ ErtsTracerNif *tnif = NULL;
+ ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(t_p)
+ || erts_thr_progress_is_blocking());
+ ERTS_SMP_CHK_NO_PROC_LOCKS;
+ if (is_tracer_enabled(NULL, 0, &t_p->common, &tnif, TRACE_FUN_E_SCHED_PORT, what))
+ send_to_tracer_nif(NULL, &t_p->common, t_p->common.id,
+ tnif, TRACE_FUN_T_SCHED_PORT,
+ what, where, THE_NON_VALUE, am_true);
}
/* Port profiling */
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);
@@ -2932,10 +2101,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;
@@ -2943,9 +2111,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);
@@ -2960,46 +2131,67 @@ 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;
+ ErtsCodeMFA *cmfa = 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;
+ ErtsThrPrgrDelayHandle dhndl;
+ Uint hsz = 4 + 6 + patch_ts_size(erts_system_profile_ts_type)-1;
#endif
-
- if (!p->current) {
- p->current = find_function_from_pc(p->i);
+ /* Assumptions:
+ * We possibly don't have the MAIN_LOCK for the process p here.
+ * We assume that we can read from p->current and p->i atomically
+ */
+#ifdef ERTS_SMP
+ dhndl = erts_thr_progress_unmanaged_delay(); /* suspend purge operations */
+#endif
+
+ if (!ERTS_PROC_IS_EXITING(p)) {
+ if (p->current) {
+ cmfa = p->current;
+ } else {
+ cmfa = find_function_from_pc(p->i);
+ }
}
#ifdef ERTS_SMP
- if (!p->current) {
- hsz = 4 + 6;
+ if (!cmfa) {
+ hsz -= 4;
}
bp = new_message_buffer(hsz);
hp = bp->mem;
#endif
- if (p->current) {
- where = TUPLE3(hp, p->current[0], p->current[1], make_small(p->current[2])); hp += 4;
+ if (cmfa) {
+ where = TUPLE3(hp, cmfa->module, cmfa->function,
+ make_small(cmfa->arity));
+ hp += 4;
} else {
where = make_small(0);
}
+
+#ifdef ERTS_SMP
+ erts_thr_progress_unmanaged_continue(dhndl);
+#endif
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);
@@ -3015,28 +2207,6 @@ profile_runnable_proc(Process *p, Eterm status){
#ifdef ERTS_SMP
-void
-erts_check_my_tracer_proc(Process *p)
-{
- if (is_internal_pid(ERTS_TRACER_PROC(p))) {
- Process *tracer = erts_pid2proc(p,
- ERTS_PROC_LOCK_MAIN,
- ERTS_TRACER_PROC(p),
- ERTS_PROC_LOCK_STATUS);
- int invalid_tracer = (!tracer
- || !(ERTS_TRACE_FLAGS(tracer) & F_TRACER));
- if (tracer)
- erts_smp_proc_unlock(tracer, ERTS_PROC_LOCK_STATUS);
- if (invalid_tracer) {
- erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR);
- ERTS_TRACE_FLAGS(p) &= ~TRACEE_FLAGS;
- ERTS_TRACER_PROC(p) = NIL;
- erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL_MINOR);
- }
- }
-}
-
-
typedef struct ErtsSysMsgQ_ ErtsSysMsgQ;
struct ErtsSysMsgQ_ {
ErtsSysMsgQ *next;
@@ -3114,12 +2284,6 @@ static void
print_msg_type(ErtsSysMsgQ *smqp)
{
switch (smqp->type) {
- case SYS_MSG_TYPE_TRACE:
- erts_fprintf(stderr, "TRACE ");
- break;
- case SYS_MSG_TYPE_SEQTRACE:
- erts_fprintf(stderr, "SEQTRACE ");
- break;
case SYS_MSG_TYPE_SYSMON:
erts_fprintf(stderr, "SYSMON ");
break;
@@ -3130,8 +2294,8 @@ print_msg_type(ErtsSysMsgQ *smqp)
erts_fprintf(stderr, "ERRLGR ");
break;
case SYS_MSG_TYPE_PROC_MSG:
- erts_fprintf(stderr, "PROC_MSG ");
- break;
+ erts_fprintf(stderr, "PROC_MSG ");
+ break;
default:
erts_fprintf(stderr, "??? ");
break;
@@ -3143,17 +2307,6 @@ static void
sys_msg_disp_failure(ErtsSysMsgQ *smqp, Eterm receiver)
{
switch (smqp->type) {
- case SYS_MSG_TYPE_TRACE:
- /* Invalid tracer_proc's are removed when processes
- are scheduled in. */
- break;
- case SYS_MSG_TYPE_SEQTRACE:
- /* Reset seq_tracer if it hasn't changed */
- erts_smp_rwmtx_rwlock(&sys_trace_rwmtx);
- if (system_seq_tracer == receiver)
- system_seq_tracer = am_false;
- erts_smp_rwmtx_rwunlock(&sys_trace_rwmtx);
- break;
case SYS_MSG_TYPE_SYSMON:
if (receiver == NIL
&& !erts_system_monitor_long_gc
@@ -3214,7 +2367,7 @@ sys_msg_disp_failure(ErtsSysMsgQ *smqp, Eterm receiver)
break;
}
case SYS_MSG_TYPE_PROC_MSG:
- break;
+ break;
default:
ASSERT(0);
}
@@ -3328,19 +2481,13 @@ 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
switch (smqp->type) {
- case SYS_MSG_TYPE_TRACE:
- case SYS_MSG_TYPE_PROC_MSG:
- receiver = smqp->to;
- break;
- case SYS_MSG_TYPE_SEQTRACE:
- receiver = erts_get_system_seq_tracer();
- break;
+ case SYS_MSG_TYPE_PROC_MSG:
+ receiver = smqp->to;
+ break;
case SYS_MSG_TYPE_SYSMON:
receiver = erts_get_system_monitor();
if (smqp->from == receiver) {
@@ -3375,25 +2522,16 @@ sys_msg_dispatcher_func(void *unused)
if (is_internal_pid(receiver)) {
proc = erts_pid2proc(NULL, 0, receiver, proc_locks);
- if (!proc
- || (smqp->type == SYS_MSG_TYPE_TRACE
- && !(ERTS_TRACE_FLAGS(proc) & F_TRACER))) {
+ if (!proc) {
/* Bad tracer */
-#ifdef DEBUG_PRINTOUTS
- if (smqp->type == SYS_MSG_TYPE_TRACE && proc)
- erts_fprintf(stderr,
- "<tracer alive but missing "
- "F_TRACER flag> ");
-#endif
goto failure;
}
else {
+ ErtsMessage *mp;
queue_proc_msg:
- erts_queue_message(proc,&proc_locks,smqp->bp,smqp->msg,NIL
-#ifdef USE_VM_PROBES
- , NIL
-#endif
- );
+ mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = smqp->bp;
+ erts_queue_message(proc,proc_locks,mp,smqp->msg,am_system);
#ifdef DEBUG_PRINTOUTS
erts_fprintf(stderr, "delivered\n");
#endif
@@ -3459,12 +2597,6 @@ erts_foreach_sys_msg_in_q(void (*func)(Eterm,
for (sm = sys_message_queue; sm; sm = sm->next) {
Eterm to;
switch (sm->type) {
- case SYS_MSG_TYPE_TRACE:
- to = sm->to;
- break;
- case SYS_MSG_TYPE_SEQTRACE:
- to = erts_get_system_seq_tracer();
- break;
case SYS_MSG_TYPE_SYSMON:
to = erts_get_system_monitor();
break;
@@ -3488,20 +2620,14 @@ 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();
sys_message_queue = NULL;
sys_message_queue_end = NULL;
erts_smp_cnd_init(&smq_cnd);
- erts_smp_mtx_init(&smq_mtx, "sys_msg_q");
-
-#ifdef ETHR_HAVE_THREAD_NAMES
- thr_opts.name = "sys_msg_dispatcher";
-#endif
-
+ erts_smp_mtx_init(&smq_mtx, "sys_msg_q", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
erts_smp_thr_create(&sys_msg_dispatcher_tid,
sys_msg_dispatcher_func,
NULL,
@@ -3509,3 +2635,626 @@ init_sys_msg_dispatcher(void)
}
#endif
+
+#include "erl_nif.h"
+
+typedef struct {
+ char *name;
+ Uint arity;
+ ErlNifFunc *cb;
+} ErtsTracerType;
+
+struct ErtsTracerNif_ {
+ HashBucket hb;
+ Eterm module;
+ struct erl_module_nif* nif_mod;
+ ErtsTracerType tracers[NIF_TRACER_TYPES];
+};
+
+static void init_tracer_template(ErtsTracerNif *tnif) {
+
+ /* default tracer functions */
+ tnif->tracers[TRACE_FUN_DEFAULT].name = "trace";
+ tnif->tracers[TRACE_FUN_DEFAULT].arity = 5;
+ tnif->tracers[TRACE_FUN_DEFAULT].cb = NULL;
+
+ tnif->tracers[TRACE_FUN_ENABLED].name = "enabled";
+ tnif->tracers[TRACE_FUN_ENABLED].arity = 3;
+ tnif->tracers[TRACE_FUN_ENABLED].cb = NULL;
+
+ /* specific tracer functions */
+ tnif->tracers[TRACE_FUN_T_SEND].name = "trace_send";
+ tnif->tracers[TRACE_FUN_T_SEND].arity = 5;
+ tnif->tracers[TRACE_FUN_T_SEND].cb = NULL;
+
+ tnif->tracers[TRACE_FUN_T_RECEIVE].name = "trace_receive";
+ tnif->tracers[TRACE_FUN_T_RECEIVE].arity = 5;
+ tnif->tracers[TRACE_FUN_T_RECEIVE].cb = NULL;
+
+ tnif->tracers[TRACE_FUN_T_CALL].name = "trace_call";
+ tnif->tracers[TRACE_FUN_T_CALL].arity = 5;
+ tnif->tracers[TRACE_FUN_T_CALL].cb = NULL;
+
+ tnif->tracers[TRACE_FUN_T_SCHED_PROC].name = "trace_running_procs";
+ tnif->tracers[TRACE_FUN_T_SCHED_PROC].arity = 5;
+ tnif->tracers[TRACE_FUN_T_SCHED_PROC].cb = NULL;
+
+ tnif->tracers[TRACE_FUN_T_SCHED_PORT].name = "trace_running_ports";
+ tnif->tracers[TRACE_FUN_T_SCHED_PORT].arity = 5;
+ tnif->tracers[TRACE_FUN_T_SCHED_PORT].cb = NULL;
+
+ tnif->tracers[TRACE_FUN_T_GC].name = "trace_garbage_collection";
+ tnif->tracers[TRACE_FUN_T_GC].arity = 5;
+ tnif->tracers[TRACE_FUN_T_GC].cb = NULL;
+
+ tnif->tracers[TRACE_FUN_T_PROCS].name = "trace_procs";
+ tnif->tracers[TRACE_FUN_T_PROCS].arity = 5;
+ tnif->tracers[TRACE_FUN_T_PROCS].cb = NULL;
+
+ tnif->tracers[TRACE_FUN_T_PORTS].name = "trace_ports";
+ tnif->tracers[TRACE_FUN_T_PORTS].arity = 5;
+ tnif->tracers[TRACE_FUN_T_PORTS].cb = NULL;
+
+ /* specific enabled functions */
+ tnif->tracers[TRACE_FUN_E_SEND].name = "enabled_send";
+ tnif->tracers[TRACE_FUN_E_SEND].arity = 3;
+ tnif->tracers[TRACE_FUN_E_SEND].cb = NULL;
+
+ tnif->tracers[TRACE_FUN_E_RECEIVE].name = "enabled_receive";
+ tnif->tracers[TRACE_FUN_E_RECEIVE].arity = 3;
+ tnif->tracers[TRACE_FUN_E_RECEIVE].cb = NULL;
+
+ tnif->tracers[TRACE_FUN_E_CALL].name = "enabled_call";
+ tnif->tracers[TRACE_FUN_E_CALL].arity = 3;
+ tnif->tracers[TRACE_FUN_E_CALL].cb = NULL;
+
+ tnif->tracers[TRACE_FUN_E_SCHED_PROC].name = "enabled_running_procs";
+ tnif->tracers[TRACE_FUN_E_SCHED_PROC].arity = 3;
+ tnif->tracers[TRACE_FUN_E_SCHED_PROC].cb = NULL;
+
+ tnif->tracers[TRACE_FUN_E_SCHED_PORT].name = "enabled_running_ports";
+ tnif->tracers[TRACE_FUN_E_SCHED_PORT].arity = 3;
+ tnif->tracers[TRACE_FUN_E_SCHED_PORT].cb = NULL;
+
+ tnif->tracers[TRACE_FUN_E_GC].name = "enabled_garbage_collection";
+ tnif->tracers[TRACE_FUN_E_GC].arity = 3;
+ tnif->tracers[TRACE_FUN_E_GC].cb = NULL;
+
+ tnif->tracers[TRACE_FUN_E_PROCS].name = "enabled_procs";
+ tnif->tracers[TRACE_FUN_E_PROCS].arity = 3;
+ tnif->tracers[TRACE_FUN_E_PROCS].cb = NULL;
+
+ tnif->tracers[TRACE_FUN_E_PORTS].name = "enabled_ports";
+ tnif->tracers[TRACE_FUN_E_PORTS].arity = 3;
+ tnif->tracers[TRACE_FUN_E_PORTS].cb = NULL;
+}
+
+static Hash *tracer_hash = NULL;
+static erts_smp_rwmtx_t tracer_mtx;
+
+static ErtsTracerNif *
+load_tracer_nif(const ErtsTracer tracer)
+{
+ Module* mod = erts_get_module(ERTS_TRACER_MODULE(tracer),
+ erts_active_code_ix());
+ struct erl_module_instance *instance;
+ ErlNifFunc *funcs;
+ int num_of_funcs;
+ ErtsTracerNif tnif_tmpl, *tnif;
+ ErtsTracerType *tracers;
+ int i,j;
+
+ if (!mod || !mod->curr.nif) {
+ return NULL;
+ }
+
+ instance = &mod->curr;
+
+ init_tracer_template(&tnif_tmpl);
+ tnif_tmpl.nif_mod = instance->nif;
+ tnif_tmpl.module = ERTS_TRACER_MODULE(tracer);
+ tracers = tnif_tmpl.tracers;
+
+ num_of_funcs = erts_nif_get_funcs(instance->nif, &funcs);
+
+ for(i = 0; i < num_of_funcs; i++) {
+ for (j = 0; j < NIF_TRACER_TYPES; j++) {
+ if (strcmp(tracers[j].name, funcs[i].name) == 0 && tracers[j].arity == funcs[i].arity) {
+ tracers[j].cb = &(funcs[i]);
+ break;
+ }
+ }
+ }
+
+ if (tracers[TRACE_FUN_DEFAULT].cb == NULL || tracers[TRACE_FUN_ENABLED].cb == NULL ) {
+ return NULL;
+ }
+
+ erts_smp_rwmtx_rwlock(&tracer_mtx);
+ tnif = hash_put(tracer_hash, &tnif_tmpl);
+ erts_smp_rwmtx_rwunlock(&tracer_mtx);
+
+ return tnif;
+}
+
+static ERTS_INLINE ErtsTracerNif *
+lookup_tracer_nif(const ErtsTracer tracer)
+{
+ ErtsTracerNif tnif_tmpl;
+ ErtsTracerNif *tnif;
+ tnif_tmpl.module = ERTS_TRACER_MODULE(tracer);
+ erts_smp_rwmtx_rlock(&tracer_mtx);
+ if ((tnif = hash_get(tracer_hash, &tnif_tmpl)) == NULL) {
+ erts_smp_rwmtx_runlock(&tracer_mtx);
+ tnif = load_tracer_nif(tracer);
+ ASSERT(!tnif || tnif->nif_mod);
+ return tnif;
+ }
+ erts_smp_rwmtx_runlock(&tracer_mtx);
+ ASSERT(tnif->nif_mod);
+ return tnif;
+}
+
+/* This function converts an Erlang tracer term to ErtsTracer.
+ It returns THE_NON_VALUE if an invalid tracer term was given.
+ Accepted input is:
+ pid() || port() || {prefix, pid()} || {prefix, port()} ||
+ {prefix, atom(), term()} || {atom(), term()}
+ */
+ErtsTracer
+erts_term_to_tracer(Eterm prefix, Eterm t)
+{
+ ErtsTracer tracer = erts_tracer_nil;
+ ASSERT(is_atom(prefix) || prefix == THE_NON_VALUE);
+ if (!is_nil(t)) {
+ Eterm module = am_erl_tracer, state = THE_NON_VALUE;
+ Eterm hp[2];
+ if (is_tuple(t)) {
+ Eterm *tp = tuple_val(t);
+ if (prefix != THE_NON_VALUE) {
+ if (arityval(tp[0]) == 2 && tp[1] == prefix)
+ t = tp[2];
+ else if (arityval(tp[0]) == 3 && tp[1] == prefix && is_atom(tp[2])) {
+ module = tp[2];
+ state = tp[3];
+ }
+ } else {
+ if (arityval(tp[0]) == 2 && is_atom(tp[2])) {
+ module = tp[1];
+ state = tp[2];
+ }
+ }
+ }
+ if (state == THE_NON_VALUE && (is_internal_pid(t) || is_internal_port(t)))
+ state = t;
+ if (state == THE_NON_VALUE)
+ return THE_NON_VALUE;
+ erts_tracer_update(&tracer, CONS(hp, module, state));
+ }
+ if (!lookup_tracer_nif(tracer)) {
+ ASSERT(ERTS_TRACER_MODULE(tracer) != am_erl_tracer);
+ ERTS_TRACER_CLEAR(&tracer);
+ return THE_NON_VALUE;
+ }
+ return tracer;
+}
+
+Eterm
+erts_tracer_to_term(Process *p, ErtsTracer tracer)
+{
+ if (ERTS_TRACER_IS_NIL(tracer))
+ return am_false;
+ if (ERTS_TRACER_MODULE(tracer) == am_erl_tracer)
+ /* Have to manage these specifically in order to be
+ backwards compatible */
+ return ERTS_TRACER_STATE(tracer);
+ else {
+ Eterm *hp = HAlloc(p, 3);
+ return TUPLE2(hp, ERTS_TRACER_MODULE(tracer),
+ copy_object(ERTS_TRACER_STATE(tracer), p));
+ }
+}
+
+
+static ERTS_INLINE int
+send_to_tracer_nif_raw(Process *c_p, Process *tracee,
+ const ErtsTracer tracer, Uint tracee_flags,
+ Eterm t_p_id, ErtsTracerNif *tnif,
+ enum ErtsTracerOpt topt,
+ Eterm tag, Eterm msg, Eterm extra, Eterm pam_result)
+{
+ if (tnif || (tnif = lookup_tracer_nif(tracer)) != NULL) {
+#define MAP_SIZE 4
+ Eterm argv[5], local_heap[3+MAP_SIZE /* values */ + (MAP_SIZE+1 /* keys */)];
+ flatmap_t *map = (flatmap_t*)(local_heap+(MAP_SIZE+1));
+ Eterm *map_values = flatmap_get_values(map);
+ Eterm *map_keys = local_heap + 1;
+ Uint map_elem_count = 0;
+
+ topt = (tnif->tracers[topt].cb) ? topt : TRACE_FUN_DEFAULT;
+ ASSERT(topt < NIF_TRACER_TYPES);
+
+ argv[0] = tag;
+ argv[1] = ERTS_TRACER_STATE(tracer);
+ argv[2] = t_p_id;
+ argv[3] = msg;
+ argv[4] = make_flatmap(map);
+
+ map->thing_word = MAP_HEADER_FLATMAP;
+
+ if (extra != THE_NON_VALUE) {
+ map_keys[map_elem_count] = am_extra;
+ map_values[map_elem_count++] = extra;
+ }
+
+ if (pam_result != am_true) {
+ map_keys[map_elem_count] = am_match_spec_result;
+ map_values[map_elem_count++] = pam_result;
+ }
+
+ if (tracee_flags & F_TRACE_SCHED_NO) {
+ map_keys[map_elem_count] = am_scheduler_id;
+ map_values[map_elem_count++] = make_small(erts_get_scheduler_id());
+ }
+ map_keys[map_elem_count] = am_timestamp;
+ if (tracee_flags & F_NOW_TS)
+#ifdef HAVE_ERTS_NOW_CPU
+ if (erts_cpu_timestamp)
+ map_values[map_elem_count++] = am_cpu_timestamp;
+ else
+#endif
+ map_values[map_elem_count++] = am_timestamp;
+ else if (tracee_flags & F_STRICT_MON_TS)
+ map_values[map_elem_count++] = am_strict_monotonic;
+ else if (tracee_flags & F_MON_TS)
+ map_values[map_elem_count++] = am_monotonic;
+
+ map->size = map_elem_count;
+ map->keys = make_tuple(local_heap);
+ local_heap[0] = make_arityval(map_elem_count);
+
+#undef MAP_SIZE
+ erts_nif_call_function(c_p, tracee ? tracee : c_p,
+ tnif->nif_mod,
+ tnif->tracers[topt].cb,
+ tnif->tracers[topt].arity,
+ argv);
+ }
+ return 1;
+}
+
+static ERTS_INLINE int
+send_to_tracer_nif(Process *c_p, ErtsPTabElementCommon *t_p,
+ Eterm t_p_id, ErtsTracerNif *tnif, enum ErtsTracerOpt topt,
+ Eterm tag, Eterm msg, Eterm extra, Eterm pam_result)
+{
+#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
+ if (c_p) {
+ /* We have to hold the main lock of the currently executing process */
+ erts_proc_lc_chk_have_proc_locks(c_p, ERTS_PROC_LOCK_MAIN);
+ }
+ if (is_internal_pid(t_p->id)) {
+ /* We have to have at least one lock */
+ ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks((Process*)t_p) & ERTS_PROC_LOCKS_ALL);
+ } else {
+ ASSERT(is_internal_port(t_p->id));
+ ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked((Port*)t_p));
+ }
+#endif
+
+ return send_to_tracer_nif_raw(c_p,
+ is_internal_pid(t_p->id) ? (Process*)t_p : NULL,
+ t_p->tracer, t_p->trace_flags,
+ t_p_id, tnif, topt, tag, msg, extra,
+ pam_result);
+}
+
+static ERTS_INLINE Eterm
+call_enabled_tracer(const ErtsTracer tracer,
+ ErtsTracerNif **tnif_ret,
+ enum ErtsTracerOpt topt,
+ Eterm tag, Eterm t_p_id) {
+ ErtsTracerNif *tnif = lookup_tracer_nif(tracer);
+ if (tnif) {
+ Eterm argv[] = {tag, ERTS_TRACER_STATE(tracer), t_p_id},
+ ret;
+ topt = (tnif->tracers[topt].cb) ? topt : TRACE_FUN_ENABLED;
+ ASSERT(topt < NIF_TRACER_TYPES);
+ ASSERT(tnif->tracers[topt].cb != NULL);
+ if (tnif_ret) *tnif_ret = tnif;
+ ret = erts_nif_call_function(NULL, NULL, tnif->nif_mod,
+ tnif->tracers[topt].cb,
+ tnif->tracers[topt].arity,
+ argv);
+ if (tag == am_trace_status && ret != am_remove)
+ return am_trace;
+ ASSERT(tag == am_trace_status || ret != am_remove);
+ return ret;
+ }
+ return tag == am_trace_status ? am_remove : am_discard;
+}
+
+static int
+is_tracer_enabled(Process* c_p, ErtsProcLocks c_p_locks,
+ ErtsPTabElementCommon *t_p,
+ ErtsTracerNif **tnif_ret,
+ enum ErtsTracerOpt topt, Eterm tag) {
+ Eterm nif_result;
+
+#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
+ if (c_p)
+ ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) == c_p_locks
+ || erts_thr_progress_is_blocking());
+ if (is_internal_pid(t_p->id)) {
+ /* We have to have at least one lock */
+ ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks((Process*)t_p) & ERTS_PROC_LOCKS_ALL
+ || erts_thr_progress_is_blocking());
+ } else {
+ ASSERT(is_internal_port(t_p->id));
+ ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked((Port*)t_p)
+ || erts_thr_progress_is_blocking());
+ }
+#endif
+
+ nif_result = call_enabled_tracer(t_p->tracer, tnif_ret, topt, tag, t_p->id);
+ switch (nif_result) {
+ case am_discard: return 0;
+ case am_trace: return 1;
+ case THE_NON_VALUE:
+ case am_remove: ASSERT(tag == am_trace_status); break;
+ default:
+ /* only am_remove should be returned, but if
+ something else is returned we fall-through
+ and remove the tracer. */
+ ASSERT(0);
+ }
+
+ /* Only remove tracer on self() and ports */
+ if (is_internal_port(t_p->id) || (c_p && c_p->common.id == t_p->id)) {
+ ErtsProcLocks c_p_xlocks = 0;
+ if (is_internal_pid(t_p->id)) {
+ ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) & ERTS_PROC_LOCK_MAIN);
+ if (c_p_locks != ERTS_PROC_LOCKS_ALL) {
+ c_p_xlocks = ~c_p_locks & ERTS_PROC_LOCKS_ALL;
+ if (erts_smp_proc_trylock(c_p, c_p_xlocks) == EBUSY) {
+ erts_smp_proc_unlock(c_p, c_p_locks & ~ERTS_PROC_LOCK_MAIN);
+ erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
+ }
+ }
+ }
+ erts_tracer_replace(t_p, erts_tracer_nil);
+ t_p->trace_flags &= ~TRACEE_FLAGS;
+
+ if (c_p_xlocks)
+ erts_smp_proc_unlock(c_p, c_p_xlocks);
+ }
+
+ return 0;
+}
+
+int erts_is_tracer_enabled(const ErtsTracer tracer, ErtsPTabElementCommon *t_p)
+{
+ ErtsTracerNif *tnif = lookup_tracer_nif(tracer);
+ if (tnif) {
+ Eterm nif_result = call_enabled_tracer(tracer, &tnif,
+ TRACE_FUN_ENABLED,
+ am_trace_status,
+ t_p->id);
+ switch (nif_result) {
+ case am_discard:
+ case am_trace: return 1;
+ default:
+ break;
+ }
+ }
+ return 0;
+}
+
+int erts_is_tracer_proc_enabled(Process* c_p, ErtsProcLocks c_p_locks,
+ ErtsPTabElementCommon *t_p)
+{
+ return is_tracer_enabled(c_p, c_p_locks, t_p, NULL, TRACE_FUN_ENABLED,
+ am_trace_status);
+}
+
+int erts_is_tracer_proc_enabled_send(Process* c_p, ErtsProcLocks c_p_locks,
+ ErtsPTabElementCommon *t_p)
+{
+ return is_tracer_enabled(c_p, c_p_locks, t_p, NULL, TRACE_FUN_T_SEND, am_send);
+}
+
+
+void erts_tracer_replace(ErtsPTabElementCommon *t_p, const ErtsTracer tracer)
+{
+#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
+ if (is_internal_pid(t_p->id) && !erts_thr_progress_is_blocking()) {
+ erts_proc_lc_chk_have_proc_locks((Process*)t_p, ERTS_PROC_LOCKS_ALL);
+ } else if (is_internal_port(t_p->id)) {
+ ERTS_LC_ASSERT(erts_lc_is_port_locked((Port*)t_p)
+ || erts_thr_progress_is_blocking());
+ }
+#endif
+ if (ERTS_TRACER_COMPARE(t_p->tracer, tracer))
+ return;
+
+ erts_tracer_update(&t_p->tracer, tracer);
+}
+
+static void free_tracer(void *p)
+{
+ ErtsTracer tracer = (ErtsTracer)p;
+
+ if (is_immed(ERTS_TRACER_STATE(tracer))) {
+ erts_free(ERTS_ALC_T_HEAP_FRAG, ptr_val(tracer));
+ } else {
+ ErlHeapFragment *hf = (void*)((char*)(ptr_val(tracer)) - offsetof(ErlHeapFragment, mem));
+ free_message_buffer(hf);
+ }
+}
+
+/* un-define erts_tracer_update before implementation */
+#ifdef erts_tracer_update
+#undef erts_tracer_update
+#endif
+
+/*
+ * ErtsTracer is either NIL, 'true' or [Mod | State]
+ *
+ * - If State is immediate then the memory for
+ * the cons cell is just two words + sizeof(ErtsThrPrgrLaterOp) large.
+ * - If State is a complex term then the cons cell
+ * is allocated in an ErlHeapFragment where the cons
+ * ptr points to the mem field. So in order to get the
+ * ptr to the fragment you do this:
+ * (char*)(ptr_val(tracer)) - offsetof(ErlHeapFragment, mem)
+ * Normally you shouldn't have to care about this though
+ * as erts_tracer_update takes care of it for you.
+ *
+ * When ErtsTracer is stored in the stack as part of a
+ * return trace, the cons cell is stored on the heap of
+ * the process.
+ *
+ * The cons cell is not always stored on the heap as:
+ * 1) for port/meta tracing there is no heap
+ * 2) we would need the main lock in order to
+ * read the tracer which is undesirable.
+ *
+ * One way to optimize this (memory wise) is to keep an refc and only bump
+ * the refc when *tracer is NIL.
+ */
+void
+erts_tracer_update(ErtsTracer *tracer, const ErtsTracer new_tracer)
+{
+ ErlHeapFragment *hf;
+
+ if (is_not_nil(*tracer)) {
+ Uint offs = 2;
+ UWord size = 2 * sizeof(Eterm) + sizeof(ErtsThrPrgrLaterOp);
+ ErtsThrPrgrLaterOp *lop;
+ ASSERT(is_list(*tracer));
+ if (is_not_immed(ERTS_TRACER_STATE(*tracer))) {
+ hf = (void*)(((char*)(ptr_val(*tracer)) - offsetof(ErlHeapFragment, mem)));
+ offs = hf->used_size;
+ size = hf->alloc_size * sizeof(Eterm) + sizeof(ErlHeapFragment);
+ ASSERT(offs == size_object(*tracer));
+ }
+
+ /* sparc assumes that all structs are double word aligned, so we
+ have to align the ErtsThrPrgrLaterOp struct otherwise it may
+ segfault.*/
+ if ((UWord)(ptr_val(*tracer) + offs) % (sizeof(UWord)*2) == sizeof(UWord))
+ offs += 1;
+
+ lop = (ErtsThrPrgrLaterOp*)(ptr_val(*tracer) + offs);
+ ASSERT((UWord)lop % (sizeof(UWord)*2) == 0);
+
+ /* We schedule the free:ing of the tracer until after a thread progress
+ has been made so that we know that no schedulers have any references
+ to it. Because we do this, it is possible to release all locks of a
+ process/port and still use the ErtsTracer of that port/process
+ without having to worry if it is free'd.
+ */
+ erts_schedule_thr_prgr_later_cleanup_op(
+ free_tracer, (void*)(*tracer), lop, size);
+ }
+
+ if (is_nil(new_tracer)) {
+ *tracer = new_tracer;
+ } else if (is_immed(ERTS_TRACER_STATE(new_tracer))) {
+ /* If tracer state is an immediate we only allocate a 2 Eterm heap.
+ Not sure if it is worth it, we save 4 words (sizeof(ErlHeapFragment))
+ per tracer. */
+ Eterm *hp = erts_alloc(ERTS_ALC_T_HEAP_FRAG,
+ 3*sizeof(Eterm) + sizeof(ErtsThrPrgrLaterOp));
+ *tracer = CONS(hp, ERTS_TRACER_MODULE(new_tracer),
+ ERTS_TRACER_STATE(new_tracer));
+ } else {
+ Eterm *hp, tracer_state = ERTS_TRACER_STATE(new_tracer),
+ tracer_module = ERTS_TRACER_MODULE(new_tracer);
+ Uint sz = size_object(tracer_state);
+ hf = new_message_buffer(sz + 2 /* cons cell */ +
+ (sizeof(ErtsThrPrgrLaterOp)+sizeof(Eterm)-1)/sizeof(Eterm) + 1);
+ hp = hf->mem + 2;
+ hf->used_size -= (sizeof(ErtsThrPrgrLaterOp)+sizeof(Eterm)-1)/sizeof(Eterm) + 1;
+ *tracer = copy_struct(tracer_state, sz, &hp, &hf->off_heap);
+ *tracer = CONS(hf->mem, tracer_module, *tracer);
+ ASSERT((void*)(((char*)(ptr_val(*tracer)) - offsetof(ErlHeapFragment, mem))) == hf);
+ }
+}
+
+static void init_tracer_nif()
+{
+ erts_smp_rwmtx_opt_t rwmtx_opt = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER;
+ rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_EXTREMELY_FREQUENT_READ;
+ rwmtx_opt.lived = ERTS_SMP_RWMTX_LONG_LIVED;
+
+ erts_smp_rwmtx_init_opt(&tracer_mtx, &rwmtx_opt, "tracer_mtx", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
+
+ erts_tracer_nif_clear();
+
+}
+
+int erts_tracer_nif_clear()
+{
+
+ erts_smp_rwmtx_rlock(&tracer_mtx);
+ if (!tracer_hash || tracer_hash->nobjs) {
+
+ HashFunctions hf;
+ hf.hash = tracer_hash_fun;
+ hf.cmp = tracer_cmp_fun;
+ hf.alloc = tracer_alloc_fun;
+ hf.free = tracer_free_fun;
+ hf.meta_alloc = (HMALLOC_FUN) erts_alloc;
+ hf.meta_free = (HMFREE_FUN) erts_free;
+ hf.meta_print = (HMPRINT_FUN) erts_print;
+
+ erts_smp_rwmtx_runlock(&tracer_mtx);
+ erts_smp_rwmtx_rwlock(&tracer_mtx);
+
+ if (tracer_hash)
+ hash_delete(tracer_hash);
+
+ tracer_hash = hash_new(ERTS_ALC_T_TRACER_NIF, "tracer_hash", 10, hf);
+
+ erts_smp_rwmtx_rwunlock(&tracer_mtx);
+ return 1;
+ }
+
+ erts_smp_rwmtx_runlock(&tracer_mtx);
+ return 0;
+}
+
+static int tracer_cmp_fun(void* a, void* b)
+{
+ return ((ErtsTracerNif*)a)->module != ((ErtsTracerNif*)b)->module;
+}
+
+static HashValue tracer_hash_fun(void* obj)
+{
+ return make_internal_hash(((ErtsTracerNif*)obj)->module, 0);
+}
+
+static void *tracer_alloc_fun(void* tmpl)
+{
+ ErtsTracerNif *obj = erts_alloc(ERTS_ALC_T_TRACER_NIF,
+ sizeof(ErtsTracerNif) +
+ sizeof(ErtsThrPrgrLaterOp));
+ memcpy(obj, tmpl, sizeof(*obj));
+ return obj;
+}
+
+static void tracer_free_fun_cb(void* obj)
+{
+ erts_free(ERTS_ALC_T_TRACER_NIF, obj);
+}
+
+static void tracer_free_fun(void* obj)
+{
+ ErtsTracerNif *tnif = obj;
+ erts_schedule_thr_prgr_later_op(
+ tracer_free_fun_cb, obj,
+ (ErtsThrPrgrLaterOp*)(tnif + 1));
+
+}
diff --git a/erts/emulator/beam/erl_trace.h b/erts/emulator/beam/erl_trace.h
index 4f2c70d6e7..01fe1e5e23 100644
--- a/erts/emulator/beam/erl_trace.h
+++ b/erts/emulator/beam/erl_trace.h
@@ -1,28 +1,70 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2012-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2012-2016. 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/.
+ * 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
*
- * 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.
+ * 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_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)
-#ifndef ERL_TRACE_H__
+/*
+ * 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))
+#define ERTS_SEQTFLGS2TFLGS(SEQTFLGS) \
+ (ERTS_SEQTFLGS2TSTYPE(SEQTFLGS) << ERTS_TRACE_FLAGS_TS_TYPE_SHIFT)
+
+#endif /* ERL_TRACE_H__FLAGS__ */
+
+#if !defined(ERL_TRACE_H__) && !defined(ERTS_ONLY_INCLUDE_TRACE_FLAGS)
#define ERL_TRACE_H__
struct binary;
+typedef struct
+{
+ int on;
+ struct binary* match_spec;
+} ErtsTracingEvent;
+
+extern ErtsTracingEvent erts_send_tracing[];
+extern ErtsTracingEvent erts_receive_tracing[];
+
/* erl_bif_trace.c */
Eterm erl_seq_trace_info(Process *p, Eterm arg1);
void erts_system_monitor_clear(Process *c_p);
@@ -31,15 +73,19 @@ void erts_system_profile_clear(Process *c_p);
/* erl_trace.c */
void erts_init_trace(void);
void erts_trace_check_exiting(Eterm exiting);
-Eterm erts_set_system_seq_tracer(Process *c_p,
- ErtsProcLocks c_p_locks,
- Eterm new);
-Eterm erts_get_system_seq_tracer(void);
-void erts_change_default_tracing(int setflags, Uint *flagsp, Eterm *tracerp);
-void erts_get_default_tracing(Uint *flagsp, Eterm *tracerp);
+ErtsTracer erts_set_system_seq_tracer(Process *c_p,
+ ErtsProcLocks c_p_locks,
+ ErtsTracer new);
+ErtsTracer erts_get_system_seq_tracer(void);
+void erts_change_default_proc_tracing(int setflags, Uint flagsp,
+ const ErtsTracer tracerp);
+void erts_get_default_proc_tracing(Uint *flagsp, ErtsTracer *tracerp);
+void erts_change_default_port_tracing(int setflags, Uint flagsp,
+ const ErtsTracer tracerp);
+void erts_get_default_port_tracing(Uint *flagsp, ErtsTracer *tracerp);
void erts_set_system_monitor(Eterm monitor);
Eterm erts_get_system_monitor(void);
-int erts_is_tracer_proc_valid(Process* p);
+int erts_is_tracer_valid(Process* p);
#ifdef ERTS_SMP
void erts_check_my_tracer_proc(Process *);
@@ -50,28 +96,32 @@ void erts_foreach_sys_msg_in_q(void (*func)(Eterm,
Eterm,
ErlHeapFragment *));
void erts_queue_error_logger_message(Eterm, Eterm, ErlHeapFragment *);
+void erts_send_sys_msg_proc(Eterm, Eterm, Eterm, ErlHeapFragment *);
#endif
-void erts_send_sys_msg_proc(Eterm, Eterm, Eterm, ErlHeapFragment *);
void trace_send(Process*, Eterm, Eterm);
-void trace_receive(Process*, Eterm);
-Uint32 erts_call_trace(Process *p, BeamInstr mfa[], struct binary *match_spec, Eterm* args,
- int local, Eterm *tracer_pid);
-void erts_trace_return(Process* p, BeamInstr* fi, Eterm retval, Eterm *tracer_pid);
-void erts_trace_exception(Process* p, BeamInstr mfa[], Eterm class, Eterm value,
- Eterm *tracer);
+void trace_receive(Process*, Eterm, Eterm, ErtsTracingEvent*);
+Uint32 erts_call_trace(Process *p, ErtsCodeInfo *info, struct binary *match_spec,
+ Eterm* args, int local, ErtsTracer *tracer);
+void erts_trace_return(Process* p, ErtsCodeMFA *mfa, Eterm retval,
+ ErtsTracer *tracer);
+void erts_trace_exception(Process* p, ErtsCodeMFA *mfa, Eterm class, Eterm value,
+ ErtsTracer *tracer);
void erts_trace_return_to(Process *p, BeamInstr *pc);
-void trace_sched(Process*, Eterm);
-void trace_proc(Process*, Process*, Eterm, Eterm);
-void trace_proc_spawn(Process*, Eterm pid, Eterm mod, Eterm func, Eterm args);
+void trace_sched(Process*, ErtsProcLocks, Eterm);
+void trace_proc(Process*, ErtsProcLocks, Process*, Eterm, Eterm);
+void trace_proc_spawn(Process*, Eterm what, Eterm pid, Eterm mod, Eterm func, Eterm args);
void save_calls(Process *p, Export *);
-void trace_gc(Process *p, Eterm what);
+void trace_gc(Process *p, Eterm what, Uint size, Eterm msg);
/* port tracing */
-void trace_virtual_sched(Process*, Eterm);
+void trace_virtual_sched(Process*, ErtsProcLocks, Eterm);
void trace_sched_ports(Port *pp, Eterm);
void trace_sched_ports_where(Port *pp, Eterm, Eterm);
void trace_port(Port *, Eterm what, Eterm data);
void trace_port_open(Port *, Eterm calling_pid, Eterm drv_name);
+void trace_port_receive(Port *, Eterm calling_pid, Eterm tag, ...);
+void trace_port_send(Port *, Eterm to, Eterm msg, int exists);
+void trace_port_send_binary(Port *, Eterm to, Eterm what, char *bin, Sint sz);
/* system_profile */
void erts_set_system_profile(Eterm profile);
@@ -84,14 +134,20 @@ void erts_system_profile_setup_active_schedulers(void);
/* system_monitor */
void monitor_long_gc(Process *p, Uint time);
-void monitor_long_schedule_proc(Process *p, BeamInstr *in_i, BeamInstr *out_i, Uint time);
+void monitor_long_schedule_proc(Process *p, ErtsCodeMFA *in_i,
+ ErtsCodeMFA *out_i, Uint time);
void monitor_long_schedule_port(Port *pp, ErtsPortTaskType type, Uint time);
void monitor_large_heap(Process *p);
void monitor_generic(Process *p, Eterm type, Eterm spec);
Uint erts_trace_flag2bit(Eterm flag);
int erts_trace_flags(Eterm List,
- Uint *pMask, Eterm *pTracer, int *pCpuTimestamp);
+ Uint *pMask, ErtsTracer *pTracer, int *pCpuTimestamp);
Eterm erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr *I);
+Eterm
+erts_bif_trace_epilogue(Process *p, Eterm result, int applying,
+ Export* ep, BeamInstr *cp, Uint32 flags,
+ Uint32 flags_meta, BeamInstr* I,
+ ErtsTracer meta_tracer);
#ifdef ERTS_SMP
void erts_send_pending_trace_msgs(ErtsSchedulerData *esdp);
@@ -126,19 +182,54 @@ struct trace_pattern_flags {
};
extern const struct trace_pattern_flags erts_trace_pattern_flags_off;
extern int erts_call_time_breakpoint_tracing;
-int erts_set_trace_pattern(Process*p, Eterm* mfa, int specified,
+int erts_set_trace_pattern(Process*p, ErtsCodeMFA *mfa, int specified,
struct binary* match_prog_set,
struct binary *meta_match_prog_set,
int on, struct trace_pattern_flags,
- Eterm meta_tracer_pid, int is_blocking);
+ ErtsTracer meta_tracer, int is_blocking);
void
erts_get_default_trace_pattern(int *trace_pattern_is_on,
struct binary **match_spec,
struct binary **meta_match_spec,
struct trace_pattern_flags *trace_pattern_flags,
- Eterm *meta_tracer_pid);
+ ErtsTracer *meta_tracer);
int erts_is_default_trace_enabled(void);
void erts_bif_trace_init(void);
int erts_finish_breakpointing(void);
+/* Nif tracer functions */
+int erts_is_tracer_proc_enabled(Process *c_p, ErtsProcLocks c_p_locks,
+ ErtsPTabElementCommon *t_p);
+int erts_is_tracer_proc_enabled_send(Process* c_p, ErtsProcLocks c_p_locks,
+ ErtsPTabElementCommon *t_p);
+int erts_is_tracer_enabled(const ErtsTracer tracer, ErtsPTabElementCommon *t_p);
+Eterm erts_tracer_to_term(Process *p, ErtsTracer tracer);
+ErtsTracer erts_term_to_tracer(Eterm prefix, Eterm term);
+void erts_tracer_replace(ErtsPTabElementCommon *t_p,
+ const ErtsTracer new_tracer);
+void erts_tracer_update(ErtsTracer *tracer, const ErtsTracer new_tracer);
+int erts_tracer_nif_clear(void);
+
+#define erts_tracer_update(t,n) do { if (*(t) != (n)) erts_tracer_update(t,n); } while(0)
+#define ERTS_TRACER_CLEAR(t) erts_tracer_update(t, erts_tracer_nil)
+
+static const ErtsTracer
+ERTS_DECLARE_DUMMY(erts_tracer_true) = am_true;
+
+static const ErtsTracer
+ERTS_DECLARE_DUMMY(erts_tracer_nil) = NIL;
+
+#define ERTS_TRACER_COMPARE(t1, t2) \
+ (EQ((t1), (t2)))
+
+#define ERTS_TRACER_IS_NIL(t1) ERTS_TRACER_COMPARE(t1, erts_tracer_nil)
+
+#define IS_TRACER_VALID(tracer) \
+ (ERTS_TRACER_COMPARE(tracer,erts_tracer_true) \
+ || ERTS_TRACER_IS_NIL(tracer) \
+ || (is_list(tracer) && is_atom(CAR(list_val(tracer)))))
+
+#define ERTS_TRACER_FROM_ETERM(termp) \
+ ((ErtsTracer*)(termp))
+
#endif /* ERL_TRACE_H__ */
diff --git a/erts/emulator/beam/erl_unicode.c b/erts/emulator/beam/erl_unicode.c
index 3a968594f3..2d1d1443a7 100644
--- a/erts/emulator/beam/erl_unicode.c
+++ b/erts/emulator/beam/erl_unicode.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2008-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2008-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -54,7 +55,7 @@ static BIF_RETTYPE finalize_list_to_list(Process *p,
Uint num_processed_bytes,
Uint num_bytes_to_process,
Uint num_resulting_chars,
- int state, int left,
+ int state, Sint left,
Eterm tail);
static BIF_RETTYPE characters_to_utf8_trap(BIF_ALIST_3);
static BIF_RETTYPE characters_to_list_trap_1(BIF_ALIST_3);
@@ -122,19 +123,16 @@ static void cleanup_restart_context(RestartContext *rc)
}
}
-static void cleanup_restart_context_bin(Binary *bp)
+static int cleanup_restart_context_bin(Binary *bp)
{
RestartContext *rc = ERTS_MAGIC_BIN_DATA(bp);
cleanup_restart_context(rc);
+ return 1;
}
-static RestartContext *get_rc_from_bin(Eterm bin)
+static RestartContext *get_rc_from_bin(Eterm mref)
{
- Binary *mbp;
- ASSERT(ERTS_TERM_IS_MAGIC_BINARY(bin));
-
- mbp = ((ProcBin *) binary_val(bin))->val;
-
+ Binary *mbp = erts_magic_ref2bin(mref);
ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(mbp)
== cleanup_restart_context_bin);
return (RestartContext *) ERTS_MAGIC_BIN_DATA(mbp);
@@ -147,8 +145,8 @@ static Eterm make_magic_bin_for_restart(Process *p, RestartContext *rc)
RestartContext *restartp = ERTS_MAGIC_BIN_DATA(mbp);
Eterm *hp;
memcpy(restartp,rc,sizeof(RestartContext));
- hp = HAlloc(p, PROC_BIN_SIZE);
- return erts_mk_magic_binary_term(&hp, &MSO(p), mbp);
+ hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE);
+ return erts_mk_magic_ref(&hp, &MSO(p), mbp);
}
@@ -172,12 +170,13 @@ static ERTS_INLINE int allowed_iterations(Process *p)
else
return tmp;
}
-static ERTS_INLINE int cost_to_proc(Process *p, int cost)
+
+static ERTS_INLINE void cost_to_proc(Process *p, Sint cost)
{
- int x = (cost / LOOP_FACTOR);
+ Sint x = (cost / LOOP_FACTOR);
BUMP_REDS(p,x);
- return x;
}
+
static ERTS_INLINE int simple_loops_to_common(int cost)
{
int factor = (LOOP_FACTOR_SIMPLE / LOOP_FACTOR);
@@ -242,14 +241,15 @@ static int utf8_len(byte first)
return -1;
}
-static int copy_utf8_bin(byte *target, byte *source, Uint size,
- byte *leftover, int *num_leftovers,
- byte **err_pos, Uint *characters) {
- int copied = 0;
+static Uint copy_utf8_bin(byte *target, byte *source, Uint size,
+ byte *leftover, int *num_leftovers,
+ byte **err_pos, Uint *characters)
+{
+ Uint copied = 0;
if (leftover != NULL && *num_leftovers) {
int need = utf8_len(leftover[0]);
int from_source = need - (*num_leftovers);
- int c;
+ Uint c;
byte *tmp_err_pos = NULL;
ASSERT(need > 0);
ASSERT(from_source > 0);
@@ -501,8 +501,8 @@ L_Again: /* Restart with sublist, old listend was pushed on stack */
}
-static Eterm do_build_utf8(Process *p, Eterm ioterm, int *left, int latin1,
- byte *target, int *pos, Uint *characters, int *err,
+static Eterm do_build_utf8(Process *p, Eterm ioterm, Sint *left, int latin1,
+ byte *target, Uint *pos, Uint *characters, int *err,
byte *leftover, int *num_leftovers)
{
int c;
@@ -572,7 +572,7 @@ static Eterm do_build_utf8(Process *p, Eterm ioterm, int *left, int latin1,
}
if (!latin1) {
- int num;
+ Uint num;
byte *err_pos = NULL;
num = copy_utf8_bin(target + (*pos), bytes,
size, leftover, num_leftovers,&err_pos,characters);
@@ -803,7 +803,7 @@ static int check_leftovers(byte *source, int size)
-static BIF_RETTYPE build_utf8_return(Process *p,Eterm bin,int pos,
+static BIF_RETTYPE build_utf8_return(Process *p,Eterm bin,Uint pos,
Eterm rest_term,int err,
byte *leftover,int num_leftovers,Eterm latin1)
{
@@ -858,8 +858,8 @@ static BIF_RETTYPE characters_to_utf8_trap(BIF_ALIST_3)
#endif
byte* bytes;
Eterm rest_term;
- int left, sleft;
- int pos;
+ Sint left, sleft;
+ Uint pos;
int err;
byte leftover[4]; /* used for temp buffer too,
otherwise 3 bytes would have been enough */
@@ -873,7 +873,7 @@ static BIF_RETTYPE characters_to_utf8_trap(BIF_ALIST_3)
real_bin = binary_val(BIF_ARG_1);
ASSERT(*real_bin == HEADER_PROC_BIN);
#endif
- pos = (int) binary_size(BIF_ARG_1);
+ pos = binary_size(BIF_ARG_1);
bytes = binary_bytes(BIF_ARG_1);
sleft = left = allowed_iterations(BIF_P);
err = 0;
@@ -933,9 +933,9 @@ BIF_RETTYPE unicode_characters_to_binary_2(BIF_ALIST_2)
int latin1;
Eterm bin;
byte *bytes;
- int pos;
+ Uint pos;
int err;
- int left, sleft;
+ Sint left, sleft;
Eterm rest_term, subject;
byte leftover[4]; /* used for temp buffer too, o
therwise 3 bytes would have been enough */
@@ -998,7 +998,7 @@ BIF_RETTYPE unicode_characters_to_binary_2(BIF_ALIST_2)
byte *t = NULL;
Uint sz = binary_size(bin);
byte *by = erts_get_aligned_binary_bytes(bin,&t);
- int i;
+ Uint i;
erts_printf("<<");
for (i = 0;i < sz; ++i) {
erts_printf((i == sz -1) ? "0x%X" : "0x%X, ", (unsigned) by[i]);
@@ -1006,7 +1006,7 @@ BIF_RETTYPE unicode_characters_to_binary_2(BIF_ALIST_2)
erts_printf(">>: ");
erts_free_aligned_binary_bytes(t);
}
- erts_printf("%d - %d = %d\n",sleft,left,sleft - left);
+ erts_printf("%ld - %ld = %ld\n", sleft, left, sleft - left);
}
#endif
cost_to_proc(BIF_P, sleft - left);
@@ -1014,10 +1014,10 @@ BIF_RETTYPE unicode_characters_to_binary_2(BIF_ALIST_2)
leftover,num_leftovers,BIF_ARG_2);
}
-static BIF_RETTYPE build_list_return(Process *p, byte *bytes, int pos, Uint characters,
+static BIF_RETTYPE build_list_return(Process *p, byte *bytes, Uint pos, Uint characters,
Eterm rest_term, int err,
byte *leftover, int num_leftovers,
- Eterm latin1, int left)
+ Eterm latin1, Sint left)
{
Eterm *hp;
@@ -1069,11 +1069,11 @@ static BIF_RETTYPE characters_to_list_trap_1(BIF_ALIST_3)
{
RestartContext *rc;
byte* bytes;
- int pos;
+ Uint pos;
Uint characters;
int err;
Eterm rest_term;
- int left, sleft;
+ Sint left, sleft;
int latin1 = 0;
byte leftover[4]; /* used for temp buffer too,
@@ -1106,9 +1106,9 @@ BIF_RETTYPE unicode_characters_to_list_2(BIF_ALIST_2)
int latin1;
Uint characters = 0;
byte *bytes;
- int pos;
+ Uint pos;
int err;
- int left, sleft;
+ Sint left, sleft;
Eterm rest_term;
byte leftover[4]; /* used for temp buffer too, o
therwise 3 bytes would have been enough */
@@ -1540,7 +1540,7 @@ static BIF_RETTYPE finalize_list_to_list(Process *p,
Uint num_processed_bytes,
Uint num_bytes_to_process,
Uint num_resulting_chars,
- int state, int left,
+ int state, Sint left,
Eterm tail)
{
Uint num_built; /* characters */
@@ -1887,74 +1887,57 @@ binary_to_atom(Process* proc, Eterm bin, Eterm enc, int must_exist)
byte* bytes;
byte *temp_alloc = NULL;
Uint bin_size;
+ Eterm a;
if ((bytes = erts_get_aligned_binary_bytes(bin, &temp_alloc)) == 0) {
BIF_ERROR(proc, BADARG);
}
bin_size = binary_size(bin);
+
if (enc == am_latin1) {
- Eterm a;
- if (bin_size > MAX_ATOM_CHARACTERS) {
- system_limit:
- erts_free_aligned_binary_bytes(temp_alloc);
- BIF_ERROR(proc, SYSTEM_LIMIT);
- }
if (!must_exist) {
- a = erts_atom_put((byte *) bytes,
- bin_size,
- ERTS_ATOM_ENC_LATIN1,
- 0);
- erts_free_aligned_binary_bytes(temp_alloc);
- if (is_non_value(a))
- goto badarg;
- BIF_RET(a);
- } else if (erts_atom_get((char *)bytes, bin_size, &a, ERTS_ATOM_ENC_LATIN1)) {
- erts_free_aligned_binary_bytes(temp_alloc);
- BIF_RET(a);
- } else {
+ int lix = erts_atom_put_index((byte *) bytes,
+ bin_size,
+ ERTS_ATOM_ENC_LATIN1,
+ 0);
+ if (lix == ATOM_BAD_ENCODING_ERROR) {
+ badarg:
+ erts_free_aligned_binary_bytes(temp_alloc);
+ BIF_ERROR(proc, BADARG);
+ } else if (lix == ATOM_MAX_CHARS_ERROR) {
+ system_limit:
+ erts_free_aligned_binary_bytes(temp_alloc);
+ BIF_ERROR(proc, SYSTEM_LIMIT);
+ }
+
+ a = make_atom(lix);
+ } else if (!erts_atom_get((char *)bytes, bin_size, &a, ERTS_ATOM_ENC_LATIN1)) {
goto badarg;
}
- } else if (enc == am_utf8 || enc == am_unicode) {
- Eterm res;
- Uint num_chars = 0;
- const byte* p = bytes;
- Uint left = bin_size;
- while (left) {
- if (++num_chars > MAX_ATOM_CHARACTERS) {
+ } else if (enc == am_utf8 || enc == am_unicode) {
+ if (!must_exist) {
+ int uix = erts_atom_put_index((byte *) bytes,
+ bin_size,
+ ERTS_ATOM_ENC_UTF8,
+ 0);
+ if (uix == ATOM_BAD_ENCODING_ERROR) {
+ goto badarg;
+ } else if (uix == ATOM_MAX_CHARS_ERROR) {
goto system_limit;
}
- if ((p[0] & 0x80) == 0) {
- ++p;
- --left;
- }
- else if (left >= 2
- && (p[0] & 0xFE) == 0xC2 /* only allow latin1 subset */
- && (p[1] & 0xC0) == 0x80) {
- p += 2;
- left -= 2;
- }
- else goto badarg;
- }
- if (!must_exist) {
- res = erts_atom_put((byte *) bytes,
- bin_size,
- ERTS_ATOM_ENC_UTF8,
- 0);
+ a = make_atom(uix);
}
- else if (!erts_atom_get((char*)bytes, bin_size, &res, ERTS_ATOM_ENC_UTF8)) {
+ else if (!erts_atom_get((char*)bytes, bin_size, &a, ERTS_ATOM_ENC_UTF8)) {
goto badarg;
}
- erts_free_aligned_binary_bytes(temp_alloc);
- if (is_non_value(res))
- goto badarg;
- BIF_RET(res);
} else {
- badarg:
- erts_free_aligned_binary_bytes(temp_alloc);
- BIF_ERROR(proc, BADARG);
+ goto badarg;
}
+
+ erts_free_aligned_binary_bytes(temp_alloc);
+ BIF_RET(a);
}
BIF_RETTYPE binary_to_atom_2(BIF_ALIST_2)
@@ -2015,7 +1998,7 @@ char *erts_convert_filename_to_encoding(Eterm name, char *statbuf, size_t statbu
++need;
}
if (used)
- *used = (Sint) need;
+ *used = need;
if (need+extra > statbuf_size) {
name_buf = (char *) erts_alloc(alloc_type, need+extra);
} else {
@@ -2126,6 +2109,8 @@ Eterm erts_convert_native_to_filename(Process *p, byte *bytes)
mac = 1;
case ERL_FILENAME_UTF8:
size = strlen((char *) bytes);
+ if (size == 0)
+ return NIL;
if (erts_analyze_utf8(bytes,size,&err_pos,&num_chars,NULL) != ERTS_UTF8_OK) {
goto noconvert;
}
@@ -2504,7 +2489,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_unicode.h b/erts/emulator/beam/erl_unicode.h
index 1b63b797c2..e01eaa787e 100644
--- a/erts/emulator/beam/erl_unicode.h
+++ b/erts/emulator/beam/erl_unicode.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2008-2009. All Rights Reserved.
+ * Copyright Ericsson AB 2008-2016. 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.
+ * 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%
*/
diff --git a/erts/emulator/beam/erl_unicode_normalize.h b/erts/emulator/beam/erl_unicode_normalize.h
index fb0a111ca2..21e2a52544 100644
--- a/erts/emulator/beam/erl_unicode_normalize.h
+++ b/erts/emulator/beam/erl_unicode_normalize.h
@@ -1,21 +1,22 @@
/*
-* %CopyrightBegin%
-*
-* Copyright Ericsson AB 1999-2010. 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%
-*/
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 1999-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%
+ */
/*
* This file is automatically generated by dec.erl, do not edit manually
*/
diff --git a/erts/emulator/beam/erl_utils.h b/erts/emulator/beam/erl_utils.h
index 0807649ea1..3d28b05752 100644
--- a/erts/emulator/beam/erl_utils.h
+++ b/erts/emulator/beam/erl_utils.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2012-2014. All Rights Reserved.
+ * Copyright Ericsson AB 2012-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -32,11 +33,7 @@ typedef struct {
#endif
union {
Uint64 not_atomic;
-#ifdef ARCH_64
- erts_atomic_t atomic;
-#else
- erts_dw_atomic_t atomic;
-#endif
+ erts_atomic64_t atomic;
} counter;
} erts_interval_t;
@@ -50,9 +47,6 @@ Uint64 erts_ensure_later_interval_nob(erts_interval_t *, Uint64);
Uint64 erts_ensure_later_interval_acqb(erts_interval_t *, Uint64);
Uint64 erts_smp_ensure_later_interval_nob(erts_interval_t *, Uint64);
Uint64 erts_smp_ensure_later_interval_acqb(erts_interval_t *, Uint64);
-#ifdef ARCH_32
-ERTS_GLB_INLINE Uint64 erts_interval_dw_aint_to_val__(erts_dw_aint_t *);
-#endif
ERTS_GLB_INLINE Uint64 erts_current_interval_nob__(erts_interval_t *);
ERTS_GLB_INLINE Uint64 erts_current_interval_acqb__(erts_interval_t *);
ERTS_GLB_INLINE Uint64 erts_current_interval_nob(erts_interval_t *);
@@ -62,46 +56,16 @@ ERTS_GLB_INLINE Uint64 erts_smp_current_interval_acqb(erts_interval_t *);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
-#ifdef ARCH_32
-
-ERTS_GLB_INLINE Uint64
-erts_interval_dw_aint_to_val__(erts_dw_aint_t *dw)
-{
-#ifdef ETHR_SU_DW_NAINT_T__
- return (Uint64) dw->dw_sint;
-#else
- Uint64 res;
- res = (Uint64) ((Uint32) dw->sint[ERTS_DW_AINT_HIGH_WORD]);
- res <<= 32;
- res |= (Uint64) ((Uint32) dw->sint[ERTS_DW_AINT_LOW_WORD]);
- return res;
-#endif
-}
-
-#endif
-
ERTS_GLB_INLINE Uint64
erts_current_interval_nob__(erts_interval_t *icp)
{
-#ifdef ARCH_64
- return (Uint64) erts_atomic_read_nob(&icp->counter.atomic);
-#else
- erts_dw_aint_t dw;
- erts_dw_atomic_read_nob(&icp->counter.atomic, &dw);
- return erts_interval_dw_aint_to_val__(&dw);
-#endif
+ return (Uint64) erts_atomic64_read_nob(&icp->counter.atomic);
}
ERTS_GLB_INLINE Uint64
erts_current_interval_acqb__(erts_interval_t *icp)
{
-#ifdef ARCH_64
- return (Uint64) erts_atomic_read_acqb(&icp->counter.atomic);
-#else
- erts_dw_aint_t dw;
- erts_dw_atomic_read_acqb(&icp->counter.atomic, &dw);
- return erts_interval_dw_aint_to_val__(&dw);
-#endif
+ return (Uint64) erts_atomic64_read_acqb(&icp->counter.atomic);
}
ERTS_GLB_INLINE Uint64
@@ -150,12 +114,13 @@ void erts_silence_warn_unused_result(long unused);
int erts_fit_in_bits_int64(Sint64);
int erts_fit_in_bits_int32(Sint32);
-int erts_list_length(Eterm);
+int erts_fit_in_bits_uint(Uint);
+Sint erts_list_length(Eterm);
int erts_is_builtin(Eterm, Eterm, int);
-Uint32 make_broken_hash(Eterm);
Uint32 block_hash(byte *, unsigned, Uint32);
Uint32 make_hash2(Eterm);
Uint32 make_hash(Eterm);
+Uint32 make_internal_hash(Eterm, Uint32 salt);
void erts_save_emu_args(int argc, char **argv);
Eterm erts_get_emu_args(struct process *c_p);
@@ -166,6 +131,7 @@ Eterm erts_bld_uint(Uint **hpp, Uint *szp, Uint ui);
Eterm erts_bld_uword(Uint **hpp, Uint *szp, UWord uw);
Eterm erts_bld_uint64(Uint **hpp, Uint *szp, Uint64 ui64);
Eterm erts_bld_sint64(Uint **hpp, Uint *szp, Sint64 si64);
+#define erts_bld_monotonic_time erts_bld_sint64
Eterm erts_bld_cons(Uint **hpp, Uint *szp, Eterm car, Eterm cdr);
Eterm erts_bld_tuple(Uint **hpp, Uint *szp, Uint arity, ...);
#define erts_bld_tuple2(H,S,E1,E2) erts_bld_tuple(H,S,2,E1,E2)
@@ -191,49 +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);
-#define cmp_rel(A,A_BASE,B,B_BASE) erts_cmp_rel_opt(A,A_BASE,B,B_BASE,0)
-#define cmp_rel_term(A,A_BASE,B,B_BASE) erts_cmp_rel_opt(A,A_BASE,B,B_BASE,1)
-#define CMP(A,B) erts_cmp_rel_opt(A,NULL,B,NULL,0)
-#define CMP_TERM(A,B) erts_cmp_rel_opt(A,NULL,B,NULL,1)
-#else
-Sint cmp(Eterm, Eterm);
-Sint erts_cmp(Eterm, Eterm, int);
-#define cmp_rel(A,A_BASE,B,B_BASE) erts_cmp(A,B,0)
-#define cmp_rel_term(A,A_BASE,B,B_BASE) erts_cmp(A,B,1)
-#define CMP(A,B) erts_cmp(A,B,0)
-#define CMP_TERM(A,B) erts_cmp(A,B,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((a),(b)) == 0)
-#define cmp_ne(a,b) (CMP((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)))
+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(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)
+
+#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 b7de8208ad..0b8d78c469 100644
--- a/erts/emulator/beam/erl_vm.h
+++ b/erts/emulator/beam/erl_vm.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2014. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -20,8 +21,6 @@
#ifndef __ERL_VM_H__
#define __ERL_VM_H__
-/* #define ERTS_OPCODE_COUNTER_SUPPORT */
-
/* FORCE_HEAP_FRAGS:
* Debug provocation to make HAlloc always create heap fragments (if allowed)
* even if there is room on heap.
@@ -37,18 +36,10 @@
#define EMULATOR "BEAM"
#define SEQ_TRACE 1
-#define CONTEXT_REDS 2000 /* Swap process out after this number */
+#define CONTEXT_REDS 4000 /* Swap process out after this number */
#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).
@@ -59,6 +50,7 @@
#define H_DEFAULT_SIZE 233 /* default (heap + stack) min size */
#define VH_DEFAULT_SIZE 32768 /* default virtual (bin) heap min size (words) */
+#define H_DEFAULT_MAX_SIZE 0 /* default max heap size is off */
#define CP_SIZE 1
@@ -118,11 +110,20 @@
#define HeapWordsLeft(p) (HEAP_LIMIT(p) - HEAP_TOP(p))
#if defined(DEBUG) || defined(CHECK_FOR_HOLES)
-#if HALFWORD_HEAP
-# define ERTS_HOLE_MARKER (0xaf5e78ccU)
-#else
-# define ERTS_HOLE_MARKER (((0xaf5e78ccUL << 24) << 8) | 0xaf5e78ccUL)
-#endif
+
+/*
+ * ERTS_HOLE_MARKER must *not* be mistaken for a valid term
+ * on the heap...
+ */
+# ifdef ARCH_64
+# define ERTS_HOLE_MARKER \
+ make_catch(UWORD_CONSTANT(0xdeadbeaf00000000) >> _TAG_IMMED2_SIZE)
+/* Will (at the time of writing) appear as 0xdeadbeaf0000001b */
+# else
+# define ERTS_HOLE_MARKER \
+ make_catch(UWORD_CONSTANT(0xdead0000) >> _TAG_IMMED2_SIZE)
+/* Will (at the time of writing) appear as 0xdead001b */
+# endif
#endif
/*
@@ -154,14 +155,16 @@
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. */
- unsigned count; /* Number of times executed. */
} OpEntry;
-extern OpEntry opc[]; /* Description of all instructions. */
-extern int num_instructions; /* Number of instruction in opc[]. */
+extern const OpEntry opc[]; /* Description of all instructions. */
+extern const int num_instructions; /* Number of instruction in opc[]. */
+
+extern Uint erts_instr_count[];
/* some constants for various table sizes etc */
@@ -172,11 +175,13 @@ extern int num_instructions; /* Number of instruction in opc[]. */
extern int H_MIN_SIZE; /* minimum (heap + stack) */
extern int BIN_VH_MIN_SIZE; /* minimum virtual (bin) heap */
+extern int H_MAX_SIZE; /* maximum (heap + stack) */
+extern int H_MAX_FLAGS; /* maximum heap flags */
extern int erts_atom_table_size;/* Atom table size */
+extern int erts_pd_initial_size;/* Initial Process dictionary table size */
#define ORIG_CREATION 0
-#define INTERNAL_CREATION 255
/* macros for extracting bytes from uint16's */
@@ -194,4 +199,11 @@ extern int erts_atom_table_size;/* Atom table size */
#include "erl_term.h"
+#ifdef NO_JUMP_TABLE
+#define BeamOp(Op) (Op)
+#else
+extern void** beam_ops;
+#define BeamOp(Op) beam_ops[(Op)]
+#endif
+
#endif /* __ERL_VM_H__ */
diff --git a/erts/emulator/beam/erl_zlib.c b/erts/emulator/beam/erl_zlib.c
index 8e33144f96..944ff2e35f 100644
--- a/erts/emulator/beam/erl_zlib.c
+++ b/erts/emulator/beam/erl_zlib.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2009-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2009-2016. 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.
+ * 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%
*/
diff --git a/erts/emulator/beam/erl_zlib.h b/erts/emulator/beam/erl_zlib.h
index 160166c66b..c83c6f291f 100644
--- a/erts/emulator/beam/erl_zlib.h
+++ b/erts/emulator/beam/erl_zlib.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2009-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2009-2016. 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.
+ * 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%
*/
diff --git a/erts/emulator/beam/erlang_dtrace.d b/erts/emulator/beam/erlang_dtrace.d
index e3ebbb84f4..237889e0f5 100644
--- a/erts/emulator/beam/erlang_dtrace.d
+++ b/erts/emulator/beam/erlang_dtrace.d
@@ -1,19 +1,20 @@
/*
* %CopyrightBegin%
*
- * Copyright Dustin Sallings, Michal Ptaszek, Scott Lystig Fritchie 2011-2012.
+ * Copyright Dustin Sallings, Michal Ptaszek, Scott Lystig Fritchie 2011-2016.
* 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -699,6 +700,35 @@ provider erlang {
*/
probe efile_drv__return(int, int, char *, int, int, int);
+
+/*
+ * The set of probes called by the erlang tracer nif backend. In order
+ * to receive events on these you both have to enable tracing in erlang
+ * using the trace bifs and also from dtrace/systemtap.
+ */
+
+
+ /**
+ * A trace message of type `event` was triggered by process `p`.
+ *
+ *
+ * @param p the PID (string form) of the process
+ * @param event the event that was triggered (i.e. call or spawn)
+ * @param state the state of the tracer nif as a string
+ * @param arg1 first argument to the trace event
+ * @param arg2 second argument to the trace event
+ */
+ probe trace(char *p, char *event, char *state, char *arg1, char *arg2);
+
+ /**
+ * A sequence trace message of type `label` was triggered.
+ *
+ * @param state the state of the tracer nif as a string
+ * @param label the seq trace label
+ * @param seq_info the seq trace info tuple as a string
+ */
+ probe trace_seq(char *state, char *label, char *seq_info);
+
/*
* NOTE:
* For formatting int64_t arguments within a D script, see:
diff --git a/erts/emulator/beam/erlang_lttng.c b/erts/emulator/beam/erlang_lttng.c
new file mode 100644
index 0000000000..fce40eedc1
--- /dev/null
+++ b/erts/emulator/beam/erlang_lttng.c
@@ -0,0 +1,32 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 1996-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%
+ */
+
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#ifdef USE_LTTNG
+#define TRACEPOINT_CREATE_PROBES
+/*
+ * The header containing our TRACEPOINT_EVENTs.
+ */
+#define TRACEPOINT_DEFINE
+#include "erlang_lttng.h"
+#endif /* USE_LTTNG */
diff --git a/erts/emulator/beam/erlang_lttng.h b/erts/emulator/beam/erlang_lttng.h
new file mode 100644
index 0000000000..4e869671f7
--- /dev/null
+++ b/erts/emulator/beam/erlang_lttng.h
@@ -0,0 +1,424 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 1996-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%
+ */
+
+#ifdef USE_LTTNG
+#undef TRACEPOINT_PROVIDER
+#define TRACEPOINT_PROVIDER org_erlang_otp
+
+#undef TRACEPOINT_INCLUDE
+#define TRACEPOINT_INCLUDE "erlang_lttng.h"
+
+#if !defined(__ERLANG_LTTNG_H__) || defined(TRACEPOINT_HEADER_MULTI_READ)
+#define __ERLANG_LTTNG_H__
+
+#include <lttng/tracepoint.h>
+
+/* Schedulers */
+
+TRACEPOINT_EVENT(
+ org_erlang_otp,
+ scheduler_poll,
+ TP_ARGS(
+ int, id,
+ int, runnable
+ ),
+ TP_FIELDS(
+ ctf_integer(int, scheduler, id)
+ ctf_integer(int, runnable, runnable)
+ )
+)
+
+#ifndef LTTNG_CARRIER_STATS
+#define LTTNG_CARRIER_STATS
+typedef struct {
+ unsigned long no;
+ unsigned long size;
+} lttng_stat_values_t;
+
+typedef struct {
+ lttng_stat_values_t carriers;
+ lttng_stat_values_t blocks;
+} lttng_carrier_stats_t;
+#endif
+
+
+/* Port and Driver Scheduling */
+
+TRACEPOINT_EVENT(
+ org_erlang_otp,
+ driver_start,
+ TP_ARGS(
+ char*, pid,
+ char*, driver,
+ char*, port
+ ),
+ TP_FIELDS(
+ ctf_string(pid, pid)
+ ctf_string(driver, driver)
+ ctf_string(port, port)
+ )
+)
+
+TRACEPOINT_EVENT(
+ org_erlang_otp,
+ driver_init,
+ TP_ARGS(
+ char*, driver,
+ int, major,
+ int, minor,
+ int, flags
+ ),
+ TP_FIELDS(
+ ctf_string(driver, driver)
+ ctf_integer(int, major, major)
+ ctf_integer(int, minor, minor)
+ ctf_integer(int, flags, flags)
+ )
+)
+
+TRACEPOINT_EVENT(
+ org_erlang_otp,
+ driver_outputv,
+ TP_ARGS(
+ char*, pid,
+ char*, port,
+ char*, driver,
+ size_t, bytes
+ ),
+ TP_FIELDS(
+ ctf_string(pid, pid)
+ ctf_string(port, port)
+ ctf_string(driver, driver)
+ ctf_integer(size_t, bytes, bytes)
+ )
+)
+
+TRACEPOINT_EVENT(
+ org_erlang_otp,
+ driver_output,
+ TP_ARGS(
+ char*, pid,
+ char*, port,
+ char*, driver,
+ size_t, bytes
+ ),
+ TP_FIELDS(
+ ctf_string(pid, pid)
+ ctf_string(port, port)
+ ctf_string(driver, driver)
+ ctf_integer(size_t, bytes, bytes)
+ )
+)
+
+TRACEPOINT_EVENT(
+ org_erlang_otp,
+ driver_ready_input,
+ TP_ARGS(
+ char*, pid,
+ char*, port,
+ char*, driver
+ ),
+ TP_FIELDS(
+ ctf_string(pid, pid)
+ ctf_string(port, port)
+ ctf_string(driver, driver)
+ )
+)
+
+TRACEPOINT_EVENT(
+ org_erlang_otp,
+ driver_ready_output,
+ TP_ARGS(
+ char*, pid,
+ char*, port,
+ char*, driver
+ ),
+ TP_FIELDS(
+ ctf_string(pid, pid)
+ ctf_string(port, port)
+ ctf_string(driver, driver)
+ )
+)
+
+TRACEPOINT_EVENT(
+ org_erlang_otp,
+ driver_event,
+ TP_ARGS(
+ char*, pid,
+ char*, port,
+ char*, driver
+ ),
+ TP_FIELDS(
+ ctf_string(pid, pid)
+ ctf_string(port, port)
+ ctf_string(driver, driver)
+ )
+)
+
+TRACEPOINT_EVENT(
+ org_erlang_otp,
+ driver_timeout,
+ TP_ARGS(
+ char*, pid,
+ char*, port,
+ char*, driver
+ ),
+ TP_FIELDS(
+ ctf_string(pid, pid)
+ ctf_string(port, port)
+ ctf_string(driver, driver)
+ )
+)
+
+TRACEPOINT_EVENT(
+ org_erlang_otp,
+ driver_stop_select,
+ TP_ARGS(
+ char*, driver
+ ),
+ TP_FIELDS(
+ ctf_string(driver, driver)
+ )
+)
+
+TRACEPOINT_EVENT(
+ org_erlang_otp,
+ driver_flush,
+ TP_ARGS(
+ char*, pid,
+ char*, port,
+ char*, driver
+ ),
+ TP_FIELDS(
+ ctf_string(pid, pid)
+ ctf_string(port, port)
+ ctf_string(driver, driver)
+ )
+)
+
+TRACEPOINT_EVENT(
+ org_erlang_otp,
+ driver_stop,
+ TP_ARGS(
+ char*, pid,
+ char*, port,
+ char*, driver
+ ),
+ TP_FIELDS(
+ ctf_string(pid, pid)
+ ctf_string(port, port)
+ ctf_string(driver, driver)
+ )
+)
+
+TRACEPOINT_EVENT(
+ org_erlang_otp,
+ driver_process_exit,
+ TP_ARGS(
+ char*, pid,
+ char*, port,
+ char*, driver
+ ),
+ TP_FIELDS(
+ ctf_string(pid, pid)
+ ctf_string(port, port)
+ ctf_string(driver, driver)
+ )
+)
+
+TRACEPOINT_EVENT(
+ org_erlang_otp,
+ driver_ready_async,
+ TP_ARGS(
+ char*, pid,
+ char*, port,
+ char*, driver
+ ),
+ TP_FIELDS(
+ ctf_string(pid, pid)
+ ctf_string(port, port)
+ ctf_string(driver, driver)
+ )
+)
+
+TRACEPOINT_EVENT(
+ org_erlang_otp,
+ driver_finish,
+ TP_ARGS(
+ char*, driver
+ ),
+ TP_FIELDS(
+ ctf_string(driver, driver)
+ )
+)
+
+TRACEPOINT_EVENT(
+ org_erlang_otp,
+ driver_call,
+ TP_ARGS(
+ char*, pid,
+ char*, port,
+ char*, driver,
+ unsigned int, command,
+ size_t, bytes
+ ),
+ TP_FIELDS(
+ ctf_string(pid, pid)
+ ctf_string(port, port)
+ ctf_string(driver, driver)
+ ctf_integer(unsigned int, command, command)
+ ctf_integer(size_t, bytes, bytes)
+ )
+)
+
+TRACEPOINT_EVENT(
+ org_erlang_otp,
+ driver_control,
+ TP_ARGS(
+ char*, pid,
+ char*, port,
+ char*, driver,
+ unsigned int, command,
+ size_t, bytes
+ ),
+ TP_FIELDS(
+ ctf_string(pid, pid)
+ ctf_string(port, port)
+ ctf_string(driver, driver)
+ ctf_integer(unsigned int, command, command)
+ ctf_integer(size_t, bytes, bytes)
+ )
+)
+
+/* Async pool */
+
+TRACEPOINT_EVENT(
+ org_erlang_otp,
+ aio_pool_get,
+ TP_ARGS(
+ char*, port,
+ int, length
+ ),
+ TP_FIELDS(
+ ctf_string(port, port)
+ ctf_integer(int, length, length)
+ )
+)
+
+TRACEPOINT_EVENT(
+ org_erlang_otp,
+ aio_pool_put,
+ TP_ARGS(
+ char*, port,
+ int, length
+ ),
+ TP_FIELDS(
+ ctf_string(port, port)
+ ctf_integer(int, length, length)
+ )
+)
+
+
+/* Memory Allocator */
+
+TRACEPOINT_EVENT(
+ org_erlang_otp,
+ carrier_create,
+ TP_ARGS(
+ const char*, type,
+ int, instance,
+ unsigned long, size,
+ lttng_carrier_stats_t *, mbcs,
+ lttng_carrier_stats_t *, sbcs
+ ),
+ TP_FIELDS(
+ ctf_string(type, type)
+ ctf_integer(int, instance, instance)
+ ctf_integer(unsigned long, size, size)
+ ctf_integer(unsigned long, mbc_carriers, mbcs->carriers.no)
+ ctf_integer(unsigned long, mbc_carriers_size, mbcs->carriers.size)
+ ctf_integer(unsigned long, mbc_blocks, mbcs->blocks.no)
+ ctf_integer(unsigned long, mbc_blocks_size, mbcs->blocks.size)
+ ctf_integer(unsigned long, sbc_carriers, sbcs->carriers.no)
+ ctf_integer(unsigned long, sbc_carriers_size, sbcs->carriers.size)
+ ctf_integer(unsigned long, sbc_blocks, sbcs->blocks.no)
+ ctf_integer(unsigned long, sbc_blocks_size, sbcs->blocks.size)
+ )
+)
+
+
+TRACEPOINT_EVENT(
+ org_erlang_otp,
+ carrier_destroy,
+ TP_ARGS(
+ const char*, type,
+ int, instance,
+ unsigned long, size,
+ lttng_carrier_stats_t *, mbcs,
+ lttng_carrier_stats_t *, sbcs
+ ),
+ TP_FIELDS(
+ ctf_string(type, type)
+ ctf_integer(int, instance, instance)
+ ctf_integer(unsigned long, size, size)
+ ctf_integer(unsigned long, mbc_carriers, mbcs->carriers.no)
+ ctf_integer(unsigned long, mbc_carriers_size, mbcs->carriers.size)
+ ctf_integer(unsigned long, mbc_blocks, mbcs->blocks.no)
+ ctf_integer(unsigned long, mbc_blocks_size, mbcs->blocks.size)
+ ctf_integer(unsigned long, sbc_carriers, sbcs->carriers.no)
+ ctf_integer(unsigned long, sbc_carriers_size, sbcs->carriers.size)
+ ctf_integer(unsigned long, sbc_blocks, sbcs->blocks.no)
+ ctf_integer(unsigned long, sbc_blocks_size, sbcs->blocks.size)
+ )
+)
+
+TRACEPOINT_EVENT(
+ org_erlang_otp,
+ carrier_pool_put,
+ TP_ARGS(
+ const char*, name,
+ int, instance,
+ unsigned long, size
+ ),
+ TP_FIELDS(
+ ctf_string(type, name)
+ ctf_integer(int, instance, instance)
+ ctf_integer(unsigned long, size, size)
+ )
+)
+
+TRACEPOINT_EVENT(
+ org_erlang_otp,
+ carrier_pool_get,
+ TP_ARGS(
+ const char*, name,
+ int, instance,
+ unsigned long, size
+ ),
+ TP_FIELDS(
+ ctf_string(type, name)
+ ctf_integer(int, instance, instance)
+ ctf_integer(unsigned long, size, size)
+ )
+)
+
+#endif /* __ERLANG_LTTNG_H__ */
+#include <lttng/tracepoint-event.h>
+#endif /* USE_LTTNG */
diff --git a/erts/emulator/beam/error.h b/erts/emulator/beam/error.h
index ddc2c1396d..64c08b1570 100644
--- a/erts/emulator/beam/error.h
+++ b/erts/emulator/beam/error.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2010. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -20,6 +21,8 @@
#ifndef __ERROR_H__
#define __ERROR_H__
+#include "code_ix.h"
+
/*
* There are three primary exception classes:
*
@@ -36,14 +39,11 @@
*/
/*
- * Bits 0-1 index the 'exception class tag' table.
- */
-#define EXC_CLASSBITS 3
-#define GET_EXC_CLASS(x) ((x) & EXC_CLASSBITS)
-
-/*
* Exception class tags (indices into the 'exception_tag' array)
*/
+#define EXTAG_OFFSET 0
+#define EXTAG_BITS 2
+
#define EXTAG_ERROR 0
#define EXTAG_EXIT 1
#define EXTAG_THROWN 2
@@ -51,20 +51,31 @@
#define NUMBER_EXC_TAGS 3 /* The number of exception class tags */
/*
- * Exit code flags (bits 2-7)
+ * Index to the 'exception class tag' table.
+ */
+#define EXC_CLASSBITS ((1<<EXTAG_BITS)-1)
+#define GET_EXC_CLASS(x) ((x) & EXC_CLASSBITS)
+
+/*
+ * Exit code flags
*
* These flags make is easier and quicker to decide what to do with the
* exception in the early stages, before a handler is found, and also
* maintains some separation between the class tag and the actions.
*/
-#define EXF_PANIC (1<<2) /* ignore catches */
-#define EXF_THROWN (1<<3) /* nonlocal return */
-#define EXF_LOG (1<<4) /* write to logger on termination */
-#define EXF_NATIVE (1<<5) /* occurred in native code */
-#define EXF_SAVETRACE (1<<6) /* save stack trace in internal form */
-#define EXF_ARGLIST (1<<7) /* has arglist for top of trace */
+#define EXF_OFFSET EXTAG_BITS
+#define EXF_BITS 7
+
+#define EXF_PANIC (1<<(0+EXF_OFFSET)) /* ignore catches */
+#define EXF_THROWN (1<<(1+EXF_OFFSET)) /* nonlocal return */
+#define EXF_LOG (1<<(2+EXF_OFFSET)) /* write to logger on termination */
+#define EXF_NATIVE (1<<(3+EXF_OFFSET)) /* occurred in native code */
+#define EXF_SAVETRACE (1<<(4+EXF_OFFSET)) /* save stack trace in internal form */
+#define EXF_ARGLIST (1<<(5+EXF_OFFSET)) /* has arglist for top of trace */
+#define EXF_RESTORE_NIF (1<<(6+EXF_OFFSET)) /* restore original bif/nif */
-#define EXC_FLAGBITS 0x00fc
+#define EXC_FLAGBITS (((1<<(EXF_BITS+EXF_OFFSET))-1) \
+ & ~((1<<(EXF_OFFSET))-1))
/*
* The primary fields of an exception code
@@ -74,11 +85,16 @@
#define NATIVE_EXCEPTION(x) ((x) | EXF_NATIVE)
/*
- * Bits 8-12 of the error code are used for indexing into
+ * Error code used for indexing into
* the short-hand error descriptor table.
*/
-#define EXC_INDEXBITS 0x1f00
-#define GET_EXC_INDEX(x) (((x) & EXC_INDEXBITS) >> 8)
+#define EXC_OFFSET (EXF_OFFSET+EXF_BITS)
+#define EXC_BITS 5
+
+#define EXC_INDEXBITS (((1<<(EXC_BITS+EXC_OFFSET))-1) \
+ & ~((1<<(EXC_OFFSET))-1))
+
+#define GET_EXC_INDEX(x) (((x) & EXC_INDEXBITS) >> EXC_OFFSET)
/*
* Exit codes used for raising a fresh exception. The primary exceptions
@@ -104,54 +120,62 @@
/* Error with given arglist term
* (exit reason in p->fvalue) */
-#define EXC_NORMAL ((1 << 8) | EXC_EXIT)
+#define EXC_NORMAL ((1 << EXC_OFFSET) | EXC_EXIT)
/* Normal exit (reason 'normal') */
-#define EXC_INTERNAL_ERROR ((2 << 8) | EXC_ERROR | EXF_PANIC)
+#define EXC_INTERNAL_ERROR ((2 << EXC_OFFSET) | EXC_ERROR | EXF_PANIC)
/* Things that shouldn't happen */
-#define EXC_BADARG ((3 << 8) | EXC_ERROR)
+#define EXC_BADARG ((3 << EXC_OFFSET) | EXC_ERROR)
/* Bad argument to a BIF */
-#define EXC_BADARITH ((4 << 8) | EXC_ERROR)
+#define EXC_BADARITH ((4 << EXC_OFFSET) | EXC_ERROR)
/* Bad arithmetic */
-#define EXC_BADMATCH ((5 << 8) | EXC_ERROR)
+#define EXC_BADMATCH ((5 << EXC_OFFSET) | EXC_ERROR)
/* Bad match in function body */
-#define EXC_FUNCTION_CLAUSE ((6 << 8) | EXC_ERROR)
+#define EXC_FUNCTION_CLAUSE ((6 << EXC_OFFSET) | EXC_ERROR)
/* No matching function head */
-#define EXC_CASE_CLAUSE ((7 << 8) | EXC_ERROR)
+#define EXC_CASE_CLAUSE ((7 << EXC_OFFSET) | EXC_ERROR)
/* No matching case clause */
-#define EXC_IF_CLAUSE ((8 << 8) | EXC_ERROR)
+#define EXC_IF_CLAUSE ((8 << EXC_OFFSET) | EXC_ERROR)
/* No matching if clause */
-#define EXC_UNDEF ((9 << 8) | EXC_ERROR)
+#define EXC_UNDEF ((9 << EXC_OFFSET) | EXC_ERROR)
/* No farity that matches */
-#define EXC_BADFUN ((10 << 8) | EXC_ERROR)
+#define EXC_BADFUN ((10 << EXC_OFFSET) | EXC_ERROR)
/* Not an existing fun */
-#define EXC_BADARITY ((11 << 8) | EXC_ERROR)
+#define EXC_BADARITY ((11 << EXC_OFFSET) | EXC_ERROR)
/* Attempt to call fun with
* wrong number of arguments. */
-#define EXC_TIMEOUT_VALUE ((12 << 8) | EXC_ERROR)
+#define EXC_TIMEOUT_VALUE ((12 << EXC_OFFSET) | EXC_ERROR)
/* Bad time out value */
-#define EXC_NOPROC ((13 << 8) | EXC_ERROR)
+#define EXC_NOPROC ((13 << EXC_OFFSET) | EXC_ERROR)
/* No process or port */
-#define EXC_NOTALIVE ((14 << 8) | EXC_ERROR)
+#define EXC_NOTALIVE ((14 << EXC_OFFSET) | EXC_ERROR)
/* Not distributed */
-#define EXC_SYSTEM_LIMIT ((15 << 8) | EXC_ERROR)
+#define EXC_SYSTEM_LIMIT ((15 << EXC_OFFSET) | EXC_ERROR)
/* Ran out of something */
-#define EXC_TRY_CLAUSE ((16 << 8) | EXC_ERROR)
+#define EXC_TRY_CLAUSE ((16 << EXC_OFFSET) | EXC_ERROR)
/* No matching try clause */
-#define EXC_NOTSUP ((17 << 8) | EXC_ERROR)
+#define EXC_NOTSUP ((17 << EXC_OFFSET) | EXC_ERROR)
/* Not supported */
-#define NUMBER_EXIT_CODES 18 /* The number of exit code indices */
+#define EXC_BADMAP ((18 << EXC_OFFSET) | EXC_ERROR)
+ /* Bad map */
+
+#define EXC_BADKEY ((19 << EXC_OFFSET) | EXC_ERROR)
+ /* Bad key in map */
+
+#define NUMBER_EXIT_CODES 20 /* The number of exit code indices */
/*
* Internal pseudo-error codes.
*/
-#define TRAP (1 << 8) /* BIF Trap to erlang code */
+#define TRAP (1 << EXC_OFFSET) /* BIF Trap to erlang code */
/*
* Aliases for some common exit codes.
*/
#define BADARG EXC_BADARG
#define BADARITH EXC_BADARITH
+#define BADKEY EXC_BADKEY
+#define BADMAP EXC_BADMAP
#define BADMATCH EXC_BADMATCH
#define SYSTEM_LIMIT EXC_SYSTEM_LIMIT
@@ -188,7 +212,7 @@ struct StackTrace {
Eterm header; /* bignum header - must be first in struct */
Eterm freason; /* original exception reason is saved in the struct */
BeamInstr* pc;
- BeamInstr* current;
+ ErtsCodeMFA* current;
int depth; /* number of saved pointers in trace[] */
BeamInstr *trace[1]; /* varying size - must be last in struct */
};
diff --git a/erts/emulator/beam/export.c b/erts/emulator/beam/export.c
index b0f08d8245..828c833ffc 100644
--- a/erts/emulator/beam/export.c
+++ b/erts/emulator/beam/export.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -30,7 +31,7 @@
#define EXPORT_INITIAL_SIZE 4000
#define EXPORT_LIMIT (512*1024)
-#define EXPORT_HASH(m,f,a) ((m)*(f)+(a))
+#define EXPORT_HASH(m,f,a) ((atom_val(m) * atom_val(f)) ^ (a))
#ifdef DEBUG
# define IF_DEBUG(x) x
@@ -78,12 +79,11 @@ struct export_templ
static struct export_blob* entry_to_blob(struct export_entry* ee)
{
- return (struct export_blob*)
- ((char*)ee->ep - offsetof(struct export_blob,exp));
+ return ErtsContainerStruct(ee->ep, struct export_blob, exp);
}
void
-export_info(int to, void *to_arg)
+export_info(fmtfn_t to, void *to_arg)
{
#ifdef ERTS_SMP
int lock = !ERTS_IS_CRASH_DUMPING;
@@ -103,7 +103,8 @@ static HashValue
export_hash(struct export_entry* ee)
{
Export* x = ee->ep;
- return EXPORT_HASH(x->code[0], x->code[1], x->code[2]);
+ return EXPORT_HASH(x->info.mfa.module, x->info.mfa.function,
+ x->info.mfa.arity);
}
static int
@@ -111,9 +112,9 @@ export_cmp(struct export_entry* tmpl_e, struct export_entry* obj_e)
{
Export* tmpl = tmpl_e->ep;
Export* obj = obj_e->ep;
- return !(tmpl->code[0] == obj->code[0] &&
- tmpl->code[1] == obj->code[1] &&
- tmpl->code[2] == obj->code[2]);
+ return !(tmpl->info.mfa.module == obj->info.mfa.module &&
+ tmpl->info.mfa.function == obj->info.mfa.function &&
+ tmpl->info.mfa.arity == obj->info.mfa.arity);
}
@@ -130,21 +131,23 @@ export_alloc(struct export_entry* tmpl_e)
blob = (struct export_blob*) erts_alloc(ERTS_ALC_T_EXPORT, sizeof(*blob));
erts_smp_atomic_add_nob(&total_entries_bytes, sizeof(*blob));
obj = &blob->exp;
- obj->fake_op_func_info_for_hipe[0] = 0;
- obj->fake_op_func_info_for_hipe[1] = 0;
- obj->code[0] = tmpl->code[0];
- obj->code[1] = tmpl->code[1];
- obj->code[2] = tmpl->code[2];
- obj->code[3] = (BeamInstr) em_call_error_handler;
- obj->code[4] = 0;
+ obj->info.op = 0;
+ obj->info.u.gen_bp = NULL;
+ obj->info.mfa.module = tmpl->info.mfa.module;
+ obj->info.mfa.function = tmpl->info.mfa.function;
+ obj->info.mfa.arity = tmpl->info.mfa.arity;
+ obj->beam[0] = (BeamInstr) em_call_error_handler;
+ obj->beam[1] = 0;
for (ix=0; ix<ERTS_NUM_CODE_IX; ix++) {
- obj->addressv[ix] = obj->code+3;
+ obj->addressv[ix] = obj->beam;
blob->entryv[ix].slot.index = -1;
blob->entryv[ix].ep = &blob->exp;
}
ix = 0;
+
+ DBG_TRACE_MFA_P(&obj->info.mfa, "export allocation at %p", obj);
}
else { /* Existing entry in another table, use free entry in blob */
blob = entry_to_blob(tmpl_e);
@@ -163,9 +166,12 @@ export_free(struct export_entry* obj)
obj->slot.index = -1;
for (i=0; i < ERTS_NUM_CODE_IX; i++) {
if (blob->entryv[i].slot.index >= 0) {
+ DBG_TRACE_MFA_P(&blob->exp.info.mfa, "export entry slot %u freed for %p",
+ (obj - blob->entryv), &blob->exp);
return;
}
}
+ DBG_TRACE_MFA_P(&blob->exp.info.mfa, "export blob deallocation at %p", &blob->exp);
erts_free(ERTS_ALC_T_EXPORT, blob);
erts_smp_atomic_add_nob(&total_entries_bytes, -sizeof(*blob));
}
@@ -176,13 +182,17 @@ init_export_table(void)
HashFunctions f;
int i;
- erts_smp_mtx_init(&export_staging_lock, "export_tab");
+ erts_smp_mtx_init(&export_staging_lock, "export_tab", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
erts_smp_atomic_init_nob(&total_entries_bytes, 0);
f.hash = (H_FUN) export_hash;
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",
@@ -221,7 +231,9 @@ erts_find_export_entry(Eterm m, Eterm f, unsigned int a, ErtsCodeIndex code_ix)
while (b != (HashBucket*) 0) {
Export* ep = ((struct export_entry*) b)->ep;
- if (ep->code[0] == m && ep->code[1] == f && ep->code[2] == a) {
+ if (ep->info.mfa.module == m &&
+ ep->info.mfa.function == f &&
+ ep->info.mfa.arity == a) {
return ep;
}
b = b->next;
@@ -234,9 +246,9 @@ static struct export_entry* init_template(struct export_templ* templ,
{
templ->entry.ep = &templ->exp;
templ->entry.slot.index = -1;
- templ->exp.code[0] = m;
- templ->exp.code[1] = f;
- templ->exp.code[2] = a;
+ templ->exp.info.mfa.module = m;
+ templ->exp.info.mfa.function = f;
+ templ->exp.info.mfa.arity = a;
return &templ->entry;
}
@@ -260,8 +272,8 @@ erts_find_function(Eterm m, Eterm f, unsigned int a, ErtsCodeIndex code_ix)
ee = hash_get(&export_tables[code_ix].htable, init_template(&templ, m, f, a));
if (ee == NULL ||
- (ee->ep->addressv[code_ix] == ee->ep->code+3 &&
- ee->ep->code[3] != (BeamInstr) BeamOp(op_i_generic_breakpoint))) {
+ (ee->ep->addressv[code_ix] == ee->ep->beam &&
+ ee->ep->beam[0] != (BeamInstr) BeamOp(op_i_generic_breakpoint))) {
return NULL;
}
return ee->ep;
@@ -345,7 +357,7 @@ Export *export_list(int i, ErtsCodeIndex code_ix)
int export_list_size(ErtsCodeIndex code_ix)
{
- return export_tables[code_ix].entries;
+ return erts_index_num_entries(&export_tables[code_ix]);
}
int export_table_sz(void)
diff --git a/erts/emulator/beam/export.h b/erts/emulator/beam/export.h
index 61a54de59f..7c812b306c 100644
--- a/erts/emulator/beam/export.h
+++ b/erts/emulator/beam/export.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -20,14 +21,8 @@
#ifndef __EXPORT_H__
#define __EXPORT_H__
-#ifndef __SYS_H__
#include "sys.h"
-#endif
-
-#ifndef __INDEX_H__
#include "index.h"
-#endif
-
#include "code_ix.h"
/*
@@ -38,27 +33,25 @@ typedef struct export
{
void* addressv[ERTS_NUM_CODE_IX]; /* Pointer to code for function. */
- BeamInstr fake_op_func_info_for_hipe[2]; /* MUST be just before code[] */
+ ErtsCodeInfo info; /* MUST be just before beam[] */
+
/*
- * code[0]: Tagged atom for module.
- * code[1]: Tagged atom for function.
- * code[2]: Arity (untagged integer).
- * code[3]: This entry is 0 unless the 'address' field points to it.
+ * beam[0]: This entry is 0 unless the 'addressv' field points to it.
* Threaded code instruction to load function
* (em_call_error_handler), execute BIF (em_apply_bif),
* or a breakpoint instruction (op_i_generic_breakpoint).
- * code[4]: Function pointer to BIF function (for BIFs only),
+ * beam[1]: Function pointer to BIF function (for BIFs only),
* or pointer to threaded code if the module has an
* on_load function that has not been run yet, or pointer
- * to code for function code[3] is a breakpont instruction.
+ * to code if function beam[0] is a breakpoint instruction.
* Otherwise: 0.
*/
- BeamInstr code[5];
+ BeamInstr beam[2];
} Export;
void init_export_table(void);
-void export_info(int, void *);
+void export_info(fmtfn_t, void *);
ERTS_GLB_INLINE Export* erts_active_export_entry(Eterm m, Eterm f, unsigned a);
Export* erts_export_put(Eterm mod, Eterm func, unsigned int arity);
@@ -79,8 +72,8 @@ extern erts_smp_mtx_t export_staging_lock;
#include "beam_load.h" /* For em_* extern declarations */
#define ExportIsBuiltIn(EntryPtr) \
-(((EntryPtr)->addressv[erts_active_code_ix()] == (EntryPtr)->code + 3) && \
- ((EntryPtr)->code[3] == (BeamInstr) em_apply_bif))
+(((EntryPtr)->addressv[erts_active_code_ix()] == (EntryPtr)->beam) && \
+ ((EntryPtr)->beam[0] == (BeamInstr) em_apply_bif))
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c
index 656de7c49a..c0a3838d42 100644
--- a/erts/emulator/beam/external.c
+++ b/erts/emulator/beam/external.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2014. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -36,7 +37,9 @@
#include "erl_process.h"
#include "error.h"
#include "external.h"
+#define ERL_WANT_HIPE_BIF_WRAPPER__
#include "bif.h"
+#undef ERL_WANT_HIPE_BIF_WRAPPER__
#include "big.h"
#include "dist.h"
#include "erl_binary.h"
@@ -44,14 +47,22 @@
#include "erl_zlib.h"
#include "erl_map.h"
-#ifdef HIPE
-#include "hipe_mode_switch.h"
-#endif
#define in_area(ptr,start,nbytes) ((UWord)((char*)(ptr) - (char*)(start)) < (nbytes))
#define MAX_STRING_LEN 0xffff
-#define is_valid_creation(Cre) ((unsigned)(Cre) < MAX_CREATION || (Cre) == INTERNAL_CREATION)
+/* MAX value for the creation field in pid, port and reference
+ for the local node and for the current external format.
+
+ Larger creation values than this are allowed in external pid, port and refs
+ encoded with NEW_PID_EXT, NEW_PORT_EXT and NEWER_REFERENCE_EXT.
+ The point here is to prepare for future upgrade to 32-bit creation.
+ OTP-19 (erts-8.0) can handle big creation values from other (newer) nodes,
+ but do not use big creation values for the local node yet,
+ as we still may have to communicate with older nodes.
+*/
+#define ERTS_MAX_LOCAL_CREATION (3)
+#define is_valid_creation(Cre) ((unsigned)(Cre) <= ERTS_MAX_LOCAL_CREATION)
#undef ERTS_DEBUG_USE_DIST_SEP
#ifdef DEBUG
@@ -95,9 +106,9 @@ static Uint is_external_string(Eterm obj, int* p_is_string);
static byte* enc_atom(ErtsAtomCacheMap *, Eterm, byte*, Uint32);
static byte* enc_pid(ErtsAtomCacheMap *, Eterm, byte*, Uint32);
struct B2TContext_t;
-static byte* dec_term(ErtsDistExternal *, Eterm**, byte*, ErlOffHeap*, Eterm*, struct B2TContext_t*);
+static byte* dec_term(ErtsDistExternal*, ErtsHeapFactory*, byte*, Eterm*, struct B2TContext_t*);
static byte* dec_atom(ErtsDistExternal *, byte*, Eterm*);
-static byte* dec_pid(ErtsDistExternal *, Eterm**, byte*, ErlOffHeap*, Eterm*);
+static byte* dec_pid(ErtsDistExternal *, ErtsHeapFactory*, byte*, Eterm*, byte tag);
static Sint decoded_size(byte *ep, byte* endp, int internal_tags, struct B2TContext_t*);
static BIF_RETTYPE term_to_binary_trap_1(BIF_ALIST_1);
@@ -111,26 +122,17 @@ static int encode_size_struct_int(struct TTBSizeContext_*, ErtsAtomCacheMap *acm
static Export binary_to_term_trap_export;
static BIF_RETTYPE binary_to_term_trap_1(BIF_ALIST_1);
-static Eterm binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* context_b);
+static BIF_RETTYPE binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* context_b,
+ Export *bif, Eterm arg0, Eterm arg1);
void erts_init_external(void) {
-#if 1 /* In R16 */
erts_init_trap_export(&term_to_binary_trap_export,
- am_erlang, am_term_to_binary_trap, 1,
+ am_erts_internal, am_term_to_binary_trap, 1,
&term_to_binary_trap_1);
erts_init_trap_export(&binary_to_term_trap_export,
- am_erlang, am_binary_to_term_trap, 1,
+ am_erts_internal, am_binary_to_term_trap, 1,
&binary_to_term_trap_1);
-#else
- sys_memset((void *) &term_to_binary_trap_export, 0, sizeof(Export));
- term_to_binary_trap_export.address = &term_to_binary_trap_export.code[3];
- term_to_binary_trap_export.code[0] = am_erlang;
- term_to_binary_trap_export.code[1] = am_term_to_binary_trap;
- term_to_binary_trap_export.code[2] = 1;
- term_to_binary_trap_export.code[3] = (BeamInstr) em_apply_bif;
- term_to_binary_trap_export.code[4] = (BeamInstr) &term_to_binary_trap_1;
-#endif
return;
}
@@ -510,15 +512,37 @@ byte *erts_encode_ext_dist_header_finalize(byte *ext, ErtsAtomCache *cache, Uint
return ep;
}
-Uint erts_encode_dist_ext_size(Eterm term, Uint32 flags, ErtsAtomCacheMap *acmp)
+int erts_encode_dist_ext_size(Eterm term, Uint32 flags, ErtsAtomCacheMap *acmp,
+ Uint* szp)
{
- Uint sz = 0;
+ Uint sz;
+ if (encode_size_struct_int(NULL, acmp, term, flags, NULL, &sz)) {
+ return -1;
+ } else {
#ifndef ERTS_DEBUG_USE_DIST_SEP
- if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE))
+ if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE))
#endif
- sz++ /* VERSION_MAGIC */;
- sz += encode_size_struct2(acmp, term, flags);
- return sz;
+ sz++ /* VERSION_MAGIC */;
+
+ *szp += sz;
+ return 0;
+ }
+}
+
+int erts_encode_dist_ext_size_int(Eterm term, struct erts_dsig_send_context* ctx, Uint* szp)
+{
+ Uint sz;
+ if (encode_size_struct_int(&ctx->u.sc, ctx->acmp, term, ctx->flags, &ctx->reds, &sz)) {
+ return -1;
+ } else {
+#ifndef ERTS_DEBUG_USE_DIST_SEP
+ if (!(ctx->flags & DFLAG_DIST_HDR_ATOM_CACHE))
+#endif
+ sz++ /* VERSION_MAGIC */;
+
+ *szp += sz;
+ return 0;
+ }
}
Uint erts_encode_ext_size(Eterm term)
@@ -539,19 +563,16 @@ Uint erts_encode_ext_size_ets(Eterm term)
}
-void erts_encode_dist_ext(Eterm term, byte **ext, Uint32 flags, ErtsAtomCacheMap *acmp)
+int erts_encode_dist_ext(Eterm term, byte **ext, Uint32 flags, ErtsAtomCacheMap *acmp,
+ TTBEncodeContext* ctx, Sint* reds)
{
- byte *ep = *ext;
-#ifndef ERTS_DEBUG_USE_DIST_SEP
- if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE))
-#endif
- *ep++ = VERSION_MAGIC;
- ep = enc_term(acmp, term, ep, flags, NULL);
- if (!ep)
- erl_exit(ERTS_ABORT_EXIT,
- "%s:%d:erts_encode_dist_ext(): Internal data structure error\n",
- __FILE__, __LINE__);
- *ext = ep;
+ if (!ctx || !ctx->wstack.wstart) {
+ #ifndef ERTS_DEBUG_USE_DIST_SEP
+ if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE))
+ #endif
+ *(*ext)++ = VERSION_MAGIC;
+ }
+ return enc_term_int(ctx, acmp, term, *ext, flags, NULL, reds, ext);
}
void erts_encode_ext(Eterm term, byte **ext)
@@ -560,7 +581,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;
@@ -595,7 +616,7 @@ erts_make_dist_ext_copy(ErtsDistExternal *edep, Uint xsize)
sys_memcpy((void *) ep, (void *) edep, dist_ext_sz);
ep += dist_ext_sz;
if (new_edep->dep)
- erts_refc_inc(&new_edep->dep->refc, 1);
+ erts_smp_refc_inc(&new_edep->dep->refc, 1);
new_edep->extp = ep;
new_edep->ext_endp = ep + ext_sz;
new_edep->heap_size = -1;
@@ -921,8 +942,7 @@ Sint erts_decode_ext_size_ets(byte *ext, Uint size)
** on return hpp is updated to point after allocated data
*/
Eterm
-erts_decode_dist_ext(Eterm** hpp,
- ErlOffHeap* off_heap,
+erts_decode_dist_ext(ErtsHeapFactory* factory,
ErtsDistExternal *edep)
{
Eterm obj;
@@ -942,7 +962,7 @@ erts_decode_dist_ext(Eterm** hpp,
goto error;
ep++;
}
- ep = dec_term(edep, hpp, ep, off_heap, &obj, NULL);
+ ep = dec_term(edep, factory, ep, &obj, NULL);
if (!ep)
goto error;
@@ -951,33 +971,41 @@ erts_decode_dist_ext(Eterm** hpp,
return obj;
error:
+ erts_factory_undo(factory);
bad_dist_ext(edep);
return THE_NON_VALUE;
}
-Eterm erts_decode_ext(Eterm **hpp, ErlOffHeap *off_heap, byte **ext)
+Eterm erts_decode_ext(ErtsHeapFactory* factory, byte **ext, Uint32 flags)
{
+ ErtsDistExternal ede, *edep;
Eterm obj;
byte *ep = *ext;
- if (*ep++ != VERSION_MAGIC)
+ if (*ep++ != VERSION_MAGIC) {
+ erts_factory_undo(factory);
return THE_NON_VALUE;
- ep = dec_term(NULL, hpp, ep, off_heap, &obj, NULL);
+ }
+ if (flags) {
+ ASSERT(flags == ERTS_DIST_EXT_BTT_SAFE);
+ ede.flags = flags; /* a dummy struct just for the flags */
+ edep = &ede;
+ } else {
+ edep = NULL;
+ }
+ ep = dec_term(edep, factory, ep, &obj, NULL);
if (!ep) {
-#ifdef DEBUG
- bin_write(ERTS_PRINT_STDERR,NULL,*ext,500);
-#endif
return THE_NON_VALUE;
}
*ext = ep;
return obj;
}
-Eterm erts_decode_ext_ets(Eterm **hpp, ErlOffHeap *off_heap, byte *ext)
+Eterm erts_decode_ext_ets(ErtsHeapFactory* factory, byte *ext)
{
Eterm obj;
- ext = dec_term(NULL, hpp, ext, off_heap, &obj, NULL);
+ ext = dec_term(NULL, factory, ext, &obj, NULL);
ASSERT(ext);
return obj;
}
@@ -986,9 +1014,8 @@ Eterm erts_decode_ext_ets(Eterm **hpp, ErlOffHeap *off_heap, byte *ext)
BIF_RETTYPE erts_debug_dist_ext_to_term_2(BIF_ALIST_2)
{
+ ErtsHeapFactory factory;
Eterm res;
- Eterm *hp;
- Eterm *hendp;
Sint hsz;
ErtsDistExternal ede;
Eterm *tp;
@@ -1035,12 +1062,9 @@ BIF_RETTYPE erts_debug_dist_ext_to_term_2(BIF_ALIST_2)
if (hsz < 0)
goto badarg;
- hp = HAlloc(BIF_P, (Uint) hsz);
- hendp = hp + hsz;
-
- res = erts_decode_dist_ext(&hp, &MSO(BIF_P), &ede);
-
- HRelease(BIF_P, hendp, hp);
+ erts_factory_proc_prealloc_init(&factory, BIF_P, hsz);
+ res = erts_decode_dist_ext(&factory, &ede);
+ erts_factory_close(&factory);
if (is_value(res))
BIF_RET(res);
@@ -1055,7 +1079,7 @@ static BIF_RETTYPE term_to_binary_trap_1(BIF_ALIST_1)
Eterm *tp = tuple_val(BIF_ARG_1);
Eterm Term = tp[1];
Eterm bt = tp[2];
- Binary *bin = ((ProcBin *) binary_val(bt))->val;
+ Binary *bin = erts_magic_ref2bin(bt);
Eterm res = erts_term_to_binary_int(BIF_P, Term, 0, 0,bin);
if (is_tuple(res)) {
ASSERT(BIF_P->flags & F_DISABLE_GC);
@@ -1069,6 +1093,8 @@ static BIF_RETTYPE term_to_binary_trap_1(BIF_ALIST_1)
}
}
+HIPE_WRAPPER_BIF_DISABLE_GC(term_to_binary, 1)
+
BIF_RETTYPE term_to_binary_1(BIF_ALIST_1)
{
Eterm res = erts_term_to_binary_int(BIF_P, BIF_ARG_1, 0, TERM_TO_BINARY_DFLAGS, NULL);
@@ -1081,6 +1107,8 @@ BIF_RETTYPE term_to_binary_1(BIF_ALIST_1)
}
}
+HIPE_WRAPPER_BIF_DISABLE_GC(term_to_binary, 2)
+
BIF_RETTYPE term_to_binary_2(BIF_ALIST_2)
{
Process* p = BIF_P;
@@ -1101,8 +1129,11 @@ BIF_RETTYPE term_to_binary_2(BIF_ALIST_2)
case 0:
flags = TERM_TO_BINARY_DFLAGS & ~DFLAG_NEW_FLOATS;
break;
- case 1:
+ case 1: /* Current default... */
flags = TERM_TO_BINARY_DFLAGS;
+ break;
+ case 2:
+ flags = TERM_TO_BINARY_DFLAGS | DFLAG_UTF8_ATOMS;
break;
default:
goto error;
@@ -1164,12 +1195,11 @@ typedef struct {
byte* ep;
Eterm res;
Eterm* next;
- Eterm* hp_start;
- Eterm* hp;
- Eterm* hp_end;
+ ErtsHeapFactory factory;
int remaining_n;
char* remaining_bytes;
- Eterm* maps_head;
+ ErtsWStack flat_maps;
+ ErtsPStack hamt_array;
} B2TDecodeContext;
typedef struct {
@@ -1185,6 +1215,8 @@ typedef struct B2TContext_t {
Uint32 flags;
SWord reds;
Eterm trap_bin;
+ Export *bif;
+ Eterm arg[2];
enum B2TState state;
union {
B2TSizeContext sc;
@@ -1193,6 +1225,7 @@ typedef struct B2TContext_t {
} u;
} B2TContext;
+static B2TContext* b2t_export_context(Process*, B2TContext* src);
static uLongf binary2term_uncomp_size(byte* data, Sint size)
{
@@ -1225,7 +1258,7 @@ static uLongf binary2term_uncomp_size(byte* data, Sint size)
static ERTS_INLINE int
binary2term_prepare(ErtsBinary2TermState *state, byte *data, Sint data_size,
- B2TContext* ctx)
+ B2TContext** ctxp, Process* p)
{
byte *bytes = data;
Sint size = data_size;
@@ -1239,8 +1272,8 @@ binary2term_prepare(ErtsBinary2TermState *state, byte *data, Sint data_size,
size--;
if (size < 5 || *bytes != COMPRESSED) {
state->extp = bytes;
- if (ctx)
- ctx->state = B2TSizeInit;
+ if (ctxp)
+ (*ctxp)->state = B2TSizeInit;
}
else {
uLongf dest_len = (Uint32) get_int32(bytes+1);
@@ -1257,16 +1290,26 @@ binary2term_prepare(ErtsBinary2TermState *state, byte *data, Sint data_size,
return -1;
}
state->extp = erts_alloc(ERTS_ALC_T_EXT_TERM_DATA, dest_len);
- ctx->reds -= dest_len;
+ if (ctxp)
+ (*ctxp)->reds -= dest_len;
}
state->exttmp = 1;
- if (ctx) {
+ if (ctxp) {
+ /*
+ * Start decompression by exporting trap context
+ * so we don't have to deal with deep-copying z_stream.
+ */
+ B2TContext* ctx = b2t_export_context(p, *ctxp);
+ ASSERT(state = &(*ctxp)->b2ts);
+ state = &ctx->b2ts;
+
if (erl_zlib_inflate_start(&ctx->u.uc.stream, bytes, size) != Z_OK)
return -1;
ctx->u.uc.dbytes = state->extp;
ctx->u.uc.dleft = dest_len;
ctx->state = B2TUncompressChunk;
+ *ctxp = ctx;
}
else {
uLongf dlen = dest_len;
@@ -1291,10 +1334,12 @@ binary2term_abort(ErtsBinary2TermState *state)
}
static ERTS_INLINE Eterm
-binary2term_create(ErtsDistExternal *edep, ErtsBinary2TermState *state, Eterm **hpp, ErlOffHeap *ohp)
+binary2term_create(ErtsDistExternal *edep, ErtsBinary2TermState *state,
+ ErtsHeapFactory* factory)
{
Eterm res;
- if (!dec_term(edep, hpp, state->extp, ohp, &res, NULL))
+
+ if (!dec_term(edep, factory, state->extp, &res, NULL))
res = THE_NON_VALUE;
if (state->exttmp) {
state->exttmp = 0;
@@ -1308,7 +1353,7 @@ erts_binary2term_prepare(ErtsBinary2TermState *state, byte *data, Sint data_size
{
Sint res;
- if (binary2term_prepare(state, data, data_size, NULL) < 0 ||
+ if (binary2term_prepare(state, data, data_size, NULL, NULL) < 0 ||
(res=decoded_size(state->extp, state->extp + state->extsize, 0, NULL)) < 0) {
if (state->exttmp)
@@ -1327,9 +1372,9 @@ erts_binary2term_abort(ErtsBinary2TermState *state)
}
Eterm
-erts_binary2term_create(ErtsBinary2TermState *state, Eterm **hpp, ErlOffHeap *ohp)
+erts_binary2term_create(ErtsBinary2TermState *state, ErtsHeapFactory* factory)
{
- return binary2term_create(NULL,state, hpp, ohp);
+ return binary2term_create(NULL,state, factory);
}
static void b2t_destroy_context(B2TContext* context)
@@ -1338,25 +1383,40 @@ static void b2t_destroy_context(B2TContext* context)
ERTS_ALC_T_EXT_TERM_DATA);
context->aligned_alloc = NULL;
binary2term_abort(&context->b2ts);
- if (context->state == B2TUncompressChunk) {
+ switch (context->state) {
+ case B2TUncompressChunk:
erl_zlib_inflate_finish(&context->u.uc.stream);
+ break;
+ case B2TDecode:
+ case B2TDecodeList:
+ case B2TDecodeTuple:
+ case B2TDecodeString:
+ case B2TDecodeBinary:
+ if (context->u.dc.hamt_array.pstart) {
+ erts_free(context->u.dc.hamt_array.alloc_type,
+ context->u.dc.hamt_array.pstart);
+ }
+ break;
+ default:;
}
}
-static void b2t_context_destructor(Binary *context_bin)
+static int b2t_context_destructor(Binary *context_bin)
{
B2TContext* ctx = (B2TContext*) ERTS_MAGIC_BIN_DATA(context_bin);
ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(context_bin) == b2t_context_destructor);
b2t_destroy_context(ctx);
+ return 1;
}
static BIF_RETTYPE binary_to_term_trap_1(BIF_ALIST_1)
{
- Binary *context_bin = ((ProcBin *) binary_val(BIF_ARG_1))->val;
+ Binary *context_bin = erts_magic_ref2bin(BIF_ARG_1);
ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(context_bin) == b2t_context_destructor);
- return binary_to_term_int(BIF_P, 0, THE_NON_VALUE, context_bin);
+ return binary_to_term_int(BIF_P, 0, THE_NON_VALUE, context_bin, NULL,
+ THE_NON_VALUE, THE_NON_VALUE);
}
@@ -1386,13 +1446,15 @@ static B2TContext* b2t_export_context(Process* p, B2TContext* src)
if (ctx->state >= B2TDecode && ctx->u.dc.next == &src->u.dc.res) {
ctx->u.dc.next = &ctx->u.dc.res;
}
- hp = HAlloc(p, PROC_BIN_SIZE);
- ctx->trap_bin = erts_mk_magic_binary_term(&hp, &MSO(p), context_b);
+ hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE);
+ ctx->trap_bin = erts_mk_magic_ref(&hp, &MSO(p), context_b);
return ctx;
}
-static Eterm binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* context_b)
+static BIF_RETTYPE binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* context_b,
+ Export *bif_init, Eterm arg0, Eterm arg1)
{
+ BIF_RETTYPE ret_val;
#ifdef EXTREME_B2T_TRAPPING
SWord initial_reds = 1 + b2t_rand() % 4;
#else
@@ -1409,6 +1471,9 @@ static Eterm binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* con
ctx->state = B2TPrepare;
ctx->aligned_alloc = NULL;
ctx->flags = flags;
+ ctx->bif = bif_init;
+ ctx->arg[0] = arg0;
+ ctx->arg[1] = arg1;
IF_DEBUG(ctx->trap_bin = THE_NON_VALUE;)
} else {
is_first_call = 0;
@@ -1435,7 +1500,7 @@ static Eterm binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* con
if (ctx->aligned_alloc) {
ctx->reds -= bin_size / 8;
}
- if (binary2term_prepare(&ctx->b2ts, bytes, bin_size, ctx) < 0) {
+ if (binary2term_prepare(&ctx->b2ts, bytes, bin_size, &ctx, p) < 0) {
ctx->state = B2TBadArg;
}
break;
@@ -1484,10 +1549,9 @@ static Eterm binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* con
ctx->u.dc.ep = ctx->b2ts.extp;
ctx->u.dc.res = (Eterm) (UWord) NULL;
ctx->u.dc.next = &ctx->u.dc.res;
- ctx->u.dc.hp_start = HAlloc(p, ctx->heap_size);
- ctx->u.dc.hp = ctx->u.dc.hp_start;
- ctx->u.dc.hp_end = ctx->u.dc.hp_start + ctx->heap_size;
- ctx->u.dc.maps_head = NULL;
+ erts_factory_proc_prealloc_init(&ctx->u.dc.factory, p, ctx->heap_size);
+ ctx->u.dc.flat_maps.wstart = NULL;
+ ctx->u.dc.hamt_array.pstart = NULL;
ctx->state = B2TDecode;
/*fall through*/
case B2TDecode:
@@ -1497,34 +1561,46 @@ static Eterm binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* con
case B2TDecodeBinary: {
ErtsDistExternal fakedep;
fakedep.flags = ctx->flags;
- dec_term(&fakedep, NULL, NULL, &MSO(p), NULL, ctx);
+ dec_term(&fakedep, NULL, NULL, NULL, ctx);
break;
}
case B2TDecodeFail:
- HRelease(p, ctx->u.dc.hp_end, ctx->u.dc.hp_start);
/*fall through*/
case B2TBadArg:
- b2t_destroy_context(ctx);
- if (!is_first_call) {
- erts_set_gc_state(p, 1);
- }
BUMP_REDS(p, (initial_reds - ctx->reds) / B2T_BYTES_PER_REDUCTION);
- BIF_ERROR(p, BADARG & ~EXF_SAVETRACE);
+
+ ASSERT(ctx->bif == bif_export[BIF_binary_to_term_1]
+ || ctx->bif == bif_export[BIF_binary_to_term_2]);
+
+ if (is_first_call)
+ ERTS_BIF_PREP_ERROR(ret_val, p, BADARG);
+ else {
+ erts_set_gc_state(p, 1);
+ if (is_non_value(ctx->arg[1]))
+ ERTS_BIF_PREP_ERROR_TRAPPED1(ret_val, p, BADARG, ctx->bif,
+ ctx->arg[0]);
+ else
+ ERTS_BIF_PREP_ERROR_TRAPPED2(ret_val, p, BADARG, ctx->bif,
+ ctx->arg[0], ctx->arg[1]);
+ }
+ b2t_destroy_context(ctx);
+ return ret_val;
case B2TDone:
b2t_destroy_context(ctx);
- if (ctx->u.dc.hp > ctx->u.dc.hp_end) {
- erl_exit(1, ":%s, line %d: heap overrun by %d words(s)\n",
- __FILE__, __LINE__, ctx->u.dc.hp - ctx->u.dc.hp_end);
+ if (ctx->u.dc.factory.hp > ctx->u.dc.factory.hp_end) {
+ 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);
}
- HRelease(p, ctx->u.dc.hp_end, ctx->u.dc.hp);
+ erts_factory_close(&ctx->u.dc.factory);
if (!is_first_call) {
erts_set_gc_state(p, 1);
}
BUMP_REDS(p, (initial_reds - ctx->reds) / B2T_BYTES_PER_REDUCTION);
- return ctx->u.dc.res;
+ ERTS_BIF_PREP_RET(ret_val, ctx->u.dc.res);
+ return ret_val;
default:
ASSERT(!"Unknown state in binary_to_term");
@@ -1541,15 +1617,24 @@ static Eterm binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* con
erts_set_gc_state(p, 0);
}
BUMP_ALL_REDS(p);
- BIF_TRAP1(&binary_to_term_trap_export, p, ctx->trap_bin);
+
+ ERTS_BIF_PREP_TRAP1(ret_val, &binary_to_term_trap_export,
+ p, ctx->trap_bin);
+
+ return ret_val;
}
-BIF_RETTYPE erts_internal_binary_to_term_1(BIF_ALIST_1)
+HIPE_WRAPPER_BIF_DISABLE_GC(binary_to_term, 1)
+
+BIF_RETTYPE binary_to_term_1(BIF_ALIST_1)
{
- return binary_to_term_int(BIF_P, 0, BIF_ARG_1, NULL);
+ return binary_to_term_int(BIF_P, 0, BIF_ARG_1, NULL, bif_export[BIF_binary_to_term_1],
+ BIF_ARG_1, THE_NON_VALUE);
}
-BIF_RETTYPE erts_internal_binary_to_term_2(BIF_ALIST_2)
+HIPE_WRAPPER_BIF_DISABLE_GC(binary_to_term, 2)
+
+BIF_RETTYPE binary_to_term_2(BIF_ALIST_2)
{
Eterm opts;
Eterm opt;
@@ -1570,7 +1655,8 @@ BIF_RETTYPE erts_internal_binary_to_term_2(BIF_ALIST_2)
if (is_not_nil(opts))
goto error;
- return binary_to_term_int(BIF_P, flags, BIF_ARG_1, NULL);
+ return binary_to_term_int(BIF_P, flags, BIF_ARG_1, NULL, bif_export[BIF_binary_to_term_2],
+ BIF_ARG_1, BIF_ARG_2);
error:
BIF_ERROR(BIF_P, BADARG);
@@ -1653,12 +1739,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);
}
@@ -1698,12 +1784,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);
@@ -1717,68 +1803,28 @@ erts_term_to_binary(Process* p, Eterm Term, int level, Uint flags) {
return erts_term_to_binary_simple(p, Term, size, level, flags);
}
-/* Define for testing */
-/* #define EXTREME_TTB_TRAPPING 1 */
+/* Define EXTREME_TTB_TRAPPING for testing in dist.h */
#ifndef EXTREME_TTB_TRAPPING
-#define TERM_TO_BINARY_LOOP_FACTOR 32
#define TERM_TO_BINARY_COMPRESS_CHUNK (1 << 18)
#else
-#define TERM_TO_BINARY_LOOP_FACTOR 1
#define TERM_TO_BINARY_COMPRESS_CHUNK 10
#endif
+#define TERM_TO_BINARY_MEMCPY_FACTOR 8
-
-typedef enum { TTBSize, TTBEncode, TTBCompress } TTBState;
-typedef struct TTBSizeContext_ {
- Uint flags;
- int level;
- Uint result;
- Eterm obj;
- ErtsEStack estack;
-} TTBSizeContext;
-
-typedef struct TTBEncodeContext_ {
- Uint flags;
- int level;
- byte* ep;
- Eterm obj;
- ErtsWStack wstack;
- Binary *result_bin;
-} TTBEncodeContext;
-
-typedef struct {
- Uint real_size;
- Uint dest_len;
- byte *dbytes;
- Binary *result_bin;
- Binary *destination_bin;
- z_stream stream;
-} TTBCompressContext;
-
-typedef struct {
- int alive;
- TTBState state;
- union {
- TTBSizeContext sc;
- TTBEncodeContext ec;
- TTBCompressContext cc;
- } s;
-} TTBContext;
-
-static void ttb_context_destructor(Binary *context_bin)
+static int ttb_context_destructor(Binary *context_bin)
{
TTBContext *context = ERTS_MAGIC_BIN_DATA(context_bin);
if (context->alive) {
context->alive = 0;
switch (context->state) {
case TTBSize:
- DESTROY_SAVED_ESTACK(&context->s.sc.estack);
+ DESTROY_SAVED_WSTACK(&context->s.sc.wstack);
break;
case TTBEncode:
DESTROY_SAVED_WSTACK(&context->s.ec.wstack);
if (context->s.ec.result_bin != NULL) { /* Set to NULL if ever made alive! */
- ASSERT(erts_refc_read(&(context->s.ec.result_bin->refc),0) == 0);
+ ASSERT(erts_refc_read(&(context->s.ec.result_bin->intern.refc),1));
erts_bin_free(context->s.ec.result_bin);
context->s.ec.result_bin = NULL;
}
@@ -1787,19 +1833,20 @@ static void ttb_context_destructor(Binary *context_bin)
erl_zlib_deflate_finish(&(context->s.cc.stream));
if (context->s.cc.destination_bin != NULL) { /* Set to NULL if ever made alive! */
- ASSERT(erts_refc_read(&(context->s.cc.destination_bin->refc),0) == 0);
+ ASSERT(erts_refc_read(&(context->s.cc.destination_bin->intern.refc),1));
erts_bin_free(context->s.cc.destination_bin);
context->s.cc.destination_bin = NULL;
}
if (context->s.cc.result_bin != NULL) { /* Set to NULL if ever made alive! */
- ASSERT(erts_refc_read(&(context->s.cc.result_bin->refc),0) == 0);
+ ASSERT(erts_refc_read(&(context->s.cc.result_bin->intern.refc),1));
erts_bin_free(context->s.cc.result_bin);
context->s.cc.result_bin = NULL;
}
break;
}
}
+ return 1;
}
static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint flags,
@@ -1829,8 +1876,8 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla
#define RETURN_STATE() \
do { \
- hp = HAlloc(p, PROC_BIN_SIZE+3); \
- c_term = erts_mk_magic_binary_term(&hp, &MSO(p), context_b); \
+ hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE+3); \
+ c_term = erts_mk_magic_ref(&hp, &MSO(p), context_b); \
res = TUPLE2(hp, Term, c_term); \
BUMP_ALL_REDS(p); \
return res; \
@@ -1841,7 +1888,7 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla
/* Setup enough to get started */
context->state = TTBSize;
context->alive = 1;
- context->s.sc.estack.start = NULL;
+ context->s.sc.wstack.wstart = NULL;
context->s.sc.flags = flags;
context->s.sc.level = level;
} else {
@@ -1876,10 +1923,7 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla
}
result_bin = erts_bin_nrml_alloc(size);
- result_bin->flags = 0;
- result_bin->orig_size = size;
- erts_refc_init(&result_bin->refc, 0);
- result_bin->orig_bytes[0] = VERSION_MAGIC;
+ result_bin->orig_bytes[0] = (byte)VERSION_MAGIC;
/* Next state immediately, no need to export context */
context->state = TTBEncode;
context->s.ec.flags = flags;
@@ -1918,8 +1962,7 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla
pb->bytes = (byte*) result_bin->orig_bytes;
pb->flags = 0;
OH_OVERHEAD(&(MSO(p)), pb->size / sizeof(Eterm));
- erts_refc_inc(&result_bin->refc, 1);
- if (context_b && erts_refc_read(&context_b->refc,0) == 0) {
+ if (context_b && erts_refc_read(&context_b->intern.refc,0) == 0) {
erts_bin_free(context_b);
}
return make_binary(pb);
@@ -1938,10 +1981,7 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla
context->s.cc.result_bin = result_bin;
result_bin = erts_bin_nrml_alloc(real_size);
- result_bin->flags = 0;
- result_bin->orig_size = real_size;
- erts_refc_init(&result_bin->refc, 0);
- result_bin->orig_bytes[0] = VERSION_MAGIC;
+ result_bin->orig_bytes[0] = (byte) VERSION_MAGIC;
context->s.cc.destination_bin = result_bin;
context->s.cc.dest_len = 0;
@@ -1988,15 +2028,15 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla
pb->next = MSO(p).first;
MSO(p).first = (struct erl_off_heap_header*)pb;
pb->val = result_bin;
+ ASSERT(erts_refc_read(&result_bin->intern.refc, 1));
pb->bytes = (byte*) result_bin->orig_bytes;
pb->flags = 0;
OH_OVERHEAD(&(MSO(p)), pb->size / sizeof(Eterm));
- erts_refc_inc(&result_bin->refc, 1);
erts_bin_free(context->s.cc.result_bin);
context->s.cc.result_bin = NULL;
context->alive = 0;
BUMP_REDS(p, (this_time * CONTEXT_REDS) / TERM_TO_BINARY_COMPRESS_CHUNK);
- if (context_b && erts_refc_read(&context_b->refc,0) == 0) {
+ if (context_b && erts_refc_read(&context_b->intern.refc,0) == 0) {
erts_bin_free(context_b);
}
return make_binary(pb);
@@ -2015,13 +2055,13 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla
pb->bytes = (byte*) result_bin->orig_bytes;
pb->flags = 0;
OH_OVERHEAD(&(MSO(p)), pb->size / sizeof(Eterm));
- erts_refc_inc(&result_bin->refc, 1);
+ ASSERT(erts_refc_read(&result_bin->intern.refc, 1));
erl_zlib_deflate_finish(&(context->s.cc.stream));
erts_bin_free(context->s.cc.destination_bin);
context->s.cc.destination_bin = NULL;
context->alive = 0;
BUMP_REDS(p, (this_time * CONTEXT_REDS) / TERM_TO_BINARY_COMPRESS_CHUNK);
- if (context_b && erts_refc_read(&context_b->refc,0) == 0) {
+ if (context_b && erts_refc_read(&context_b->intern.refc,0) == 0) {
erts_bin_free(context_b);
}
return make_binary(pb);
@@ -2132,16 +2172,24 @@ enc_atom(ErtsAtomCacheMap *acmp, Eterm atom, byte *ep, Uint32 dflags)
return ep;
}
+/*
+ * We use this atom as sysname in local pid/port/refs
+ * for the ETS compressed format (DFLAG_INTERNAL_TAGS).
+ *
+ */
+#define INTERNAL_LOCAL_SYSNAME am_ErtsSecretAtom
+
static byte*
enc_pid(ErtsAtomCacheMap *acmp, Eterm pid, byte* ep, Uint32 dflags)
{
Uint on, os;
+ Eterm sysname = ((is_internal_pid(pid) && (dflags & DFLAG_INTERNAL_TAGS))
+ ? INTERNAL_LOCAL_SYSNAME : pid_node_name(pid));
+ Uint32 creation = pid_creation(pid);
+ byte* tagp = ep++;
- *ep++ = PID_EXT;
/* insert atom here containing host and sysname */
- ep = enc_atom(acmp, pid_node_name(pid), ep, dflags);
-
- /* two bytes for each number and serial */
+ ep = enc_atom(acmp, sysname, ep, dflags);
on = pid_number(pid);
os = pid_serial(pid);
@@ -2150,8 +2198,15 @@ enc_pid(ErtsAtomCacheMap *acmp, Eterm pid, byte* ep, Uint32 dflags)
ep += 4;
put_int32(os, ep);
ep += 4;
- *ep++ = (is_internal_pid(pid) && (dflags & DFLAG_INTERNAL_TAGS)) ?
- INTERNAL_CREATION : pid_creation(pid);
+ if (creation <= ERTS_MAX_LOCAL_CREATION) {
+ *tagp = PID_EXT;
+ *ep++ = creation;
+ } else {
+ ASSERT(is_external_pid(pid));
+ *tagp = NEW_PID_EXT;
+ put_int32(creation, ep);
+ ep += 4;
+ }
return ep;
}
@@ -2231,27 +2286,27 @@ dec_atom(ErtsDistExternal *edep, byte* ep, Eterm* objp)
return ep;
}
-static ERTS_INLINE ErlNode* dec_get_node(Eterm sysname, Uint creation)
+static ERTS_INLINE ErlNode* dec_get_node(Eterm sysname, Uint32 creation)
{
- switch (creation) {
- case INTERNAL_CREATION:
+ if (sysname == INTERNAL_LOCAL_SYSNAME) /* && DFLAG_INTERNAL_TAGS */
return erts_this_node;
- case ORIG_CREATION:
- if (sysname == erts_this_node->sysname) {
- creation = erts_this_node->creation;
- }
- }
+
+ if (sysname == erts_this_node->sysname
+ && (creation == erts_this_node->creation || creation == ORIG_CREATION))
+ return erts_this_node;
+
return erts_find_or_insert_node(sysname,creation);
}
static byte*
-dec_pid(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap, Eterm* objp)
+dec_pid(ErtsDistExternal *edep, ErtsHeapFactory* factory, byte* ep,
+ Eterm* objp, byte tag)
{
Eterm sysname;
Uint data;
Uint num;
Uint ser;
- Uint cre;
+ Uint32 cre;
ErlNode *node;
*objp = NIL; /* In case we fail, don't leave a hole in the heap */
@@ -2267,12 +2322,19 @@ dec_pid(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap, Ete
ep += 4;
if (ser > ERTS_MAX_PID_SERIAL)
return NULL;
- cre = get_int8(ep);
- ep += 1;
- if (!is_valid_creation(cre)) {
- return NULL;
+ if (tag == PID_EXT) {
+ cre = get_int8(ep);
+ ep += 1;
+ if (!is_valid_creation(cre)) {
+ return NULL;
+ }
+ } else {
+ ASSERT(tag == NEW_PID_EXT);
+ cre = get_int32(ep);
+ ep += 4;
}
+
data = make_pid_data(ser, num);
/*
@@ -2284,15 +2346,15 @@ dec_pid(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap, Ete
if(node == erts_this_node) {
*objp = make_internal_pid(data);
} else {
- ExternalThing *etp = (ExternalThing *) *hpp;
- *hpp += EXTERNAL_THING_HEAD_SIZE + 1;
+ ExternalThing *etp = (ExternalThing *) factory->hp;
+ factory->hp += EXTERNAL_THING_HEAD_SIZE + 1;
etp->header = make_external_pid_header(1);
- etp->next = off_heap->first;
+ etp->next = factory->off_heap->first;
etp->node = node;
etp->data.ui[0] = data;
- off_heap->first = (struct erl_off_heap_header*) etp;
+ factory->off_heap->first = (struct erl_off_heap_header*) etp;
*objp = make_external_pid(etp);
}
return ep;
@@ -2302,8 +2364,10 @@ dec_pid(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap, Ete
#define ENC_TERM ((Eterm) 0)
#define ENC_ONE_CONS ((Eterm) 1)
#define ENC_PATCH_FUN_SIZE ((Eterm) 2)
-#define ENC_LAST_ARRAY_ELEMENT ((Eterm) 3)
-
+#define ENC_BIN_COPY ((Eterm) 3)
+#define ENC_MAP_PAIR ((Eterm) 4)
+#define ENC_HASHMAP_NODE ((Eterm) 5)
+#define ENC_LAST_ARRAY_ELEMENT ((Eterm) 6)
static byte*
enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags,
@@ -2326,10 +2390,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);
@@ -2339,6 +2399,9 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
WSTACK_RESTORE(s, &ctx->wstack);
ep = ctx->ep;
obj = ctx->obj;
+ if (is_non_value(obj)) {
+ goto outer_loop;
+ }
}
}
@@ -2346,11 +2409,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;
@@ -2362,49 +2422,76 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
obj = CAR(cons);
tl = CDR(cons);
- WSTACK_PUSH(s, is_list(tl) ? ENC_ONE_CONS : ENC_TERM);
- WSTACK_PUSH(s, tl);
+ WSTACK_PUSH2(s, (is_list(tl) ? ENC_ONE_CONS : ENC_TERM),
+ tl);
}
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;
+ case ENC_BIN_COPY: {
+ Uint bits = (Uint)obj;
+ Uint bitoffs = WSTACK_POP(s);
+ byte* bytes = (byte*) WSTACK_POP(s);
+ byte* dst = (byte*) WSTACK_POP(s);
+ if (bits > r * (TERM_TO_BINARY_MEMCPY_FACTOR * 8)) {
+ Uint n = r * TERM_TO_BINARY_MEMCPY_FACTOR;
+ WSTACK_PUSH5(s, (UWord)(dst + n), (UWord)(bytes + n), bitoffs,
+ ENC_BIN_COPY, bits - 8*n);
+ bits = 8*n;
+ copy_binary_to_buffer(dst, 0, bytes, bitoffs, bits);
+ obj = THE_NON_VALUE;
+ r = 0; /* yield */
+ break;
+ } else {
+ copy_binary_to_buffer(dst, 0, bytes, bitoffs, bits);
+ r -= bits / (TERM_TO_BINARY_MEMCPY_FACTOR * 8);
+ goto outer_loop;
+ }
+ }
+ case ENC_MAP_PAIR: {
+ Uint pairs_left = obj;
+ Eterm *vptr = (Eterm*) WSTACK_POP(s);
+ Eterm *kptr = (Eterm*) WSTACK_POP(s);
+
+ obj = *kptr;
+ if (--pairs_left > 0) {
+ WSTACK_PUSH4(s, (UWord)(kptr+1), (UWord)(vptr+1),
+ ENC_MAP_PAIR, pairs_left);
+ }
+ WSTACK_PUSH2(s, ENC_TERM, *vptr);
+ break;
+ }
+ case ENC_HASHMAP_NODE:
+ if (is_list(obj)) { /* leaf node [K|V] */
+ ptr = list_val(obj);
+ WSTACK_PUSH2(s, ENC_TERM, CDR(ptr));
+ obj = CAR(ptr);
+ }
+ break;
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
- WSTACK_PUSH(s, val-1);
obj = *ptr++;
- WSTACK_PUSH(s, (UWord)ptr);
+ WSTACK_PUSH2(s, val-1, (UWord)ptr);
}
break;
}
L_jump_start:
- if (ctx && --r == 0) {
- *reds = r;
+ if (ctx && --r <= 0) {
+ *reds = 0;
ctx->obj = obj;
ctx->ep = ep;
WSTACK_SAVE(s, &ctx->wstack);
@@ -2487,16 +2574,28 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
case REF_DEF:
case EXTERNAL_REF_DEF: {
Uint32 *ref_num;
+ Eterm sysname = (((dflags & DFLAG_INTERNAL_TAGS) && is_internal_ref(obj))
+ ? INTERNAL_LOCAL_SYSNAME : ref_node_name(obj));
+ Uint32 creation = ref_creation(obj);
+ byte* tagp = ep++;
ASSERT(dflags & DFLAG_EXTENDED_REFERENCES);
- *ep++ = NEW_REFERENCE_EXT;
- i = ref_no_of_numbers(obj);
+ erts_magic_ref_save_bin(obj);
+
+ i = ref_no_numbers(obj);
put_int16(i, ep);
ep += 2;
- ep = enc_atom(acmp,ref_node_name(obj),ep,dflags);
- *ep++ = ((dflags & DFLAG_INTERNAL_TAGS) && is_internal_ref(obj)) ?
- INTERNAL_CREATION : ref_creation(obj);
+ ep = enc_atom(acmp, sysname, ep, dflags);
+ if (creation <= ERTS_MAX_LOCAL_CREATION) {
+ *tagp = NEW_REFERENCE_EXT;
+ *ep++ = creation;
+ } else {
+ ASSERT(is_external_ref(obj));
+ *tagp = NEWER_REFERENCE_EXT;
+ put_int32(creation, ep);
+ ep += 4;
+ }
ref_num = ref_numbers(obj);
for (j = 0; j < i; j++) {
put_int32(ref_num[j], ep);
@@ -2505,17 +2604,27 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
break;
}
case PORT_DEF:
- case EXTERNAL_PORT_DEF:
+ case EXTERNAL_PORT_DEF: {
+ Eterm sysname = (((dflags & DFLAG_INTERNAL_TAGS) && is_internal_port(obj))
+ ? INTERNAL_LOCAL_SYSNAME : port_node_name(obj));
+ Uint32 creation = port_creation(obj);
+ byte* tagp = ep++;
- *ep++ = PORT_EXT;
- ep = enc_atom(acmp,port_node_name(obj),ep,dflags);
+ ep = enc_atom(acmp, sysname, ep, dflags);
j = port_number(obj);
put_int32(j, ep);
ep += 4;
- *ep++ = ((dflags & DFLAG_INTERNAL_TAGS) && is_internal_port(obj)) ?
- INTERNAL_CREATION : port_creation(obj);
+ if (creation <= ERTS_MAX_LOCAL_CREATION) {
+ *tagp = PORT_EXT;
+ *ep++ = creation;
+ } else {
+ ASSERT(is_external_port(obj));
+ *tagp = NEW_PORT_EXT;
+ put_int32(creation, ep);
+ ep += 4;
+ }
break;
-
+ }
case LIST_DEF:
{
int is_str;
@@ -2553,39 +2662,59 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
ep += 4;
}
if (i > 0) {
- WSTACK_PUSH(s, ENC_LAST_ARRAY_ELEMENT+i-1);
- WSTACK_PUSH(s, (UWord)ptr);
+ WSTACK_PUSH2(s, ENC_LAST_ARRAY_ELEMENT+i-1, (UWord)ptr);
}
break;
case MAP_DEF:
- {
- map_t *mp = (map_t*)map_val(obj);
- Uint size = map_get_size(mp);
+ if (is_flatmap(obj)) {
+ flatmap_t *mp = (flatmap_t*)flatmap_val(obj);
+ Uint size = flatmap_get_size(mp);
*ep++ = MAP_EXT;
put_int32(size, ep); ep += 4;
if (size > 0) {
- Eterm *kptr = map_get_keys(mp);
- Eterm *vptr = map_get_values(mp);
-
- for (i = size-1; i >= 1; i--) {
- WSTACK_PUSH(s, ENC_TERM);
- WSTACK_PUSH(s, (UWord) vptr[i]);
- WSTACK_PUSH(s, ENC_TERM);
- WSTACK_PUSH(s, (UWord) kptr[i]);
- }
+ Eterm *kptr = flatmap_get_keys(mp);
+ Eterm *vptr = flatmap_get_values(mp);
- WSTACK_PUSH(s, ENC_TERM);
- WSTACK_PUSH(s, (UWord) vptr[0]);
+ WSTACK_PUSH4(s, (UWord)kptr, (UWord)vptr,
+ ENC_MAP_PAIR, size);
+ }
+ } else {
+ Eterm hdr;
+ Uint node_sz;
+ ptr = boxed_val(obj);
+ hdr = *ptr;
+ ASSERT(is_header(hdr));
+ switch(hdr & _HEADER_MAP_SUBTAG_MASK) {
+ case HAMT_SUBTAG_HEAD_ARRAY:
+ *ep++ = MAP_EXT;
+ ptr++;
+ put_int32(*ptr, ep); ep += 4;
+ node_sz = 16;
+ break;
+ case HAMT_SUBTAG_HEAD_BITMAP:
+ *ep++ = MAP_EXT;
+ ptr++;
+ put_int32(*ptr, ep); ep += 4;
+ /*fall through*/
+ case HAMT_SUBTAG_NODE_BITMAP:
+ node_sz = hashmap_bitcount(MAP_HEADER_VAL(hdr));
+ ASSERT(node_sz < 17);
+ break;
+ default:
+ erts_exit(ERTS_ERROR_EXIT, "bad header\r\n");
+ }
- obj = kptr[0];
- goto L_jump_start;
+ ptr++;
+ WSTACK_RESERVE(s, node_sz*2);
+ while(node_sz--) {
+ WSTACK_FAST_PUSH(s, ENC_HASHMAP_NODE);
+ WSTACK_FAST_PUSH(s, *ptr++);
}
}
break;
-
case FLOAT_DEF:
GET_DOUBLE(obj, f);
if (dflags & DFLAG_NEW_FLOATS) {
@@ -2619,6 +2748,7 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
Uint bitoffs;
Uint bitsize;
byte* bytes;
+ byte* data_dst;
ERTS_GET_BINARY_BYTES(obj, bytes, bitoffs, bitsize);
if (dflags & DFLAG_INTERNAL_TAGS) {
@@ -2646,7 +2776,7 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
erts_emasculate_writable_binary(pb);
bytes += (pb->val->orig_bytes - before_realloc);
}
- erts_refc_inc(&pb->val->refc, 2);
+ erts_refc_inc(&pb->val->intern.refc, 2);
sys_memcpy(&tmp, pb, sizeof(ProcBin));
tmp.next = *off_heap;
@@ -2664,7 +2794,7 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
j = binary_size(obj);
put_int32(j, ep);
ep += 4;
- copy_binary_to_buffer(ep, 0, bytes, bitoffs, 8*j);
+ data_dst = ep;
ep += j;
} else if (dflags & DFLAG_BIT_BINARIES) {
/* Bit-level binary. */
@@ -2674,7 +2804,7 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
ep += 4;
*ep++ = bitsize;
ep[j] = 0; /* Zero unused bits at end of binary */
- copy_binary_to_buffer(ep, 0, bytes, bitoffs, 8*j+bitsize);
+ data_dst = ep;
ep += j + 1;
} else {
/*
@@ -2688,11 +2818,18 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
put_int32((j+1), ep);
ep += 4;
ep[j] = 0; /* Zero unused bits at end of binary */
- copy_binary_to_buffer(ep, 0, bytes, bitoffs, 8*j+bitsize);
+ data_dst = ep;
ep += j+1;
*ep++ = SMALL_INTEGER_EXT;
*ep++ = bitsize;
}
+ if (ctx && j > r * TERM_TO_BINARY_MEMCPY_FACTOR) {
+ WSTACK_PUSH5(s, (UWord)data_dst, (UWord)bytes, bitoffs,
+ ENC_BIN_COPY, 8*j + bitsize);
+ } else {
+ copy_binary_to_buffer(data_dst, 0, bytes, bitoffs,
+ 8 * j + bitsize);
+ }
}
break;
case EXPORT_DEF:
@@ -2700,9 +2837,10 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
Export* exp = *((Export **) (export_val(obj) + 1));
if ((dflags & DFLAG_EXPORT_PTR_TAG) != 0) {
*ep++ = EXPORT_EXT;
- ep = enc_atom(acmp, exp->code[0], ep, dflags);
- ep = enc_atom(acmp, exp->code[1], ep, dflags);
- ep = enc_term(acmp, make_small(exp->code[2]), ep, dflags, off_heap);
+ ep = enc_atom(acmp, exp->info.mfa.module, ep, dflags);
+ ep = enc_atom(acmp, exp->info.mfa.function, ep, dflags);
+ ep = enc_term(acmp, make_small(exp->info.mfa.arity),
+ ep, dflags, off_heap);
} else {
/* Tag, arity */
*ep++ = SMALL_TUPLE_EXT;
@@ -2710,10 +2848,10 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
ep += 1;
/* Module name */
- ep = enc_atom(acmp, exp->code[0], ep, dflags);
+ ep = enc_atom(acmp, exp->info.mfa.module, ep, dflags);
/* Function name */
- ep = enc_atom(acmp, exp->code[1], ep, dflags);
+ ep = enc_atom(acmp, exp->info.mfa.function, ep, dflags);
}
break;
}
@@ -2721,13 +2859,12 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
case FUN_DEF:
{
ErlFunThing* funp = (ErlFunThing *) fun_val(obj);
+ int ei;
if ((dflags & DFLAG_NEW_FUN_TAGS) != 0) {
- int ei;
-
*ep++ = NEW_FUN_EXT;
- WSTACK_PUSH(s, ENC_PATCH_FUN_SIZE);
- WSTACK_PUSH(s, (UWord) ep); /* Position for patching in size */
+ WSTACK_PUSH2(s, ENC_PATCH_FUN_SIZE,
+ (UWord) ep); /* Position for patching in size */
ep += 4;
*ep = funp->arity;
ep += 1;
@@ -2741,16 +2878,6 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
ep = enc_term(acmp, make_small(funp->fe->old_index), ep, dflags, off_heap);
ep = enc_term(acmp, make_small(funp->fe->old_uniq), ep, dflags, off_heap);
ep = enc_pid(acmp, funp->creator, ep, dflags);
-
- fun_env:
- for (ei = funp->num_free-1; ei > 0; ei--) {
- WSTACK_PUSH(s, ENC_TERM);
- WSTACK_PUSH(s, (UWord) funp->env[ei]);
- }
- if (funp->num_free != 0) {
- obj = funp->env[0];
- goto L_jump_start;
- }
} else {
/*
* Communicating with an obsolete erl_interface or
@@ -2782,7 +2909,13 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
*ep++ = SMALL_TUPLE_EXT;
put_int8(funp->num_free, ep);
ep += 1;
- goto fun_env;
+ }
+ for (ei = funp->num_free-1; ei > 0; ei--) {
+ WSTACK_PUSH2(s, ENC_TERM, (UWord) funp->env[ei]);
+ }
+ if (funp->num_free != 0) {
+ obj = funp->env[0];
+ goto L_jump_start;
}
}
break;
@@ -2836,57 +2969,42 @@ is_external_string(Eterm list, int* p_is_string)
return len;
}
-/* Assumes that the ones to undo are preluding the list. */
-static void
-undo_offheap_in_area(ErlOffHeap* off_heap, Eterm* start, Eterm* end)
-{
- const Uint area_sz = (end - start) * sizeof(Eterm);
- struct erl_off_heap_header* hdr;
- struct erl_off_heap_header** hdr_nextp = NULL;
-
- for (hdr = off_heap->first; ; hdr=hdr->next) {
- if (!in_area(hdr, start, area_sz)) {
- if (hdr_nextp != NULL) {
- *hdr_nextp = NULL;
- erts_cleanup_offheap(off_heap);
- off_heap->first = hdr;
- }
- break;
- }
- hdr_nextp = &hdr->next;
- }
- /* Assert that the ones to undo were indeed preluding the list. */
-#ifdef DEBUG
- for (hdr = off_heap->first; hdr != NULL; hdr = hdr->next) {
- ASSERT(!in_area(hdr, start, area_sz));
- }
-#endif /* DEBUG */
-}
+struct dec_term_hamt
+{
+ Eterm* objp; /* write result here */
+ Uint size; /* nr of leafs */
+ Eterm* leaf_array;
+};
/* Decode term from external format into *objp.
-** On failure return NULL and (R13B04) *hpp will be unchanged.
+** On failure calls erts_factory_undo() and returns NULL
*/
static byte*
-dec_term(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap,
- Eterm* objp, B2TContext* ctx)
+dec_term(ErtsDistExternal *edep,
+ ErtsHeapFactory* factory,
+ byte* ep,
+ Eterm* objp,
+ B2TContext* ctx)
{
- Eterm* hp_saved;
+#define PSTACK_TYPE struct dec_term_hamt
+ PSTACK_DECLARE(hamt_array, 5);
int n;
ErtsAtomEncoding char_enc;
register Eterm* hp; /* Please don't take the address of hp */
- Eterm *maps_head; /* for validation of maps */
+ DECLARE_WSTACK(flat_maps); /* for preprocessing of small maps */
Eterm* next;
SWord reds;
+#ifdef DEBUG
+ Eterm* dbg_resultp = ctx ? &ctx->u.dc.res : objp;
+#endif
if (ctx) {
- hp_saved = ctx->u.dc.hp_start;
reds = ctx->reds;
next = ctx->u.dc.next;
ep = ctx->u.dc.ep;
- hpp = &ctx->u.dc.hp;
- maps_head = ctx->u.dc.maps_head;
+ factory = &ctx->u.dc.factory;
if (ctx->state != B2TDecode) {
int n_limit = reds;
@@ -2913,7 +3031,7 @@ dec_term(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap,
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;
@@ -2924,14 +3042,14 @@ dec_term(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap,
case B2TDecodeTuple:
objp = next - 1;
while (n-- > 0) {
- objp[0] = (Eterm) COMPRESS_POINTER(next);
+ objp[0] = (Eterm) next;
next = objp;
objp--;
}
break;
case B2TDecodeString:
- hp = *hpp;
+ hp = factory->hp;
hp[-1] = make_list(hp); /* overwrite the premature NIL */
while (n-- > 0) {
hp[0] = make_small(*ep++);
@@ -2939,7 +3057,7 @@ dec_term(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap,
hp += 2;
}
hp[-1] = NIL;
- *hpp = hp;
+ factory->hp = hp;
break;
case B2TDecodeBinary:
@@ -2961,20 +3079,26 @@ dec_term(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap,
return NULL;
}
}
+ 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 {
- hp_saved = *hpp;
reds = ERTS_SWORD_MAX;
next = objp;
*next = (Eterm) (UWord) NULL;
- maps_head = NULL;
}
- hp = *hpp;
+ hp = factory->hp;
while (next != NULL) {
objp = next;
- next = (Eterm *) EXPAND_POINTER(*objp);
+ next = (Eterm *) *objp;
switch (*ep++) {
case INTEGER_EXT:
@@ -2982,7 +3106,7 @@ dec_term(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap,
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)) {
@@ -3031,6 +3155,8 @@ dec_term(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap,
big = make_small(0);
} else {
big = bytes_to_big(first, n, neg, hp);
+ if (is_nil(big))
+ goto error;
if (is_big(big)) {
hp += big_arity(big) + 1;
}
@@ -3103,7 +3229,7 @@ dec_term_atom_common:
reds -= n;
}
while (n-- > 0) {
- objp[0] = (Eterm) COMPRESS_POINTER(next);
+ objp[0] = (Eterm) next;
next = objp;
objp--;
}
@@ -3121,8 +3247,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--;
@@ -3135,7 +3261,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;
@@ -3203,20 +3329,23 @@ dec_term_atom_common:
hp += FLOAT_SIZE_OBJECT;
break;
}
- case PID_EXT:
- *hpp = hp;
- ep = dec_pid(edep, hpp, ep, off_heap, objp);
- hp = *hpp;
+ case PID_EXT:
+ case NEW_PID_EXT:
+ factory->hp = hp;
+ ep = dec_pid(edep, factory, ep, objp, ep[-1]);
+ hp = factory->hp;
if (ep == NULL) {
goto error;
}
break;
- case PORT_EXT:
+ case PORT_EXT:
+ case NEW_PORT_EXT:
{
Eterm sysname;
ErlNode *node;
Uint num;
- Uint cre;
+ Uint32 cre;
+ byte tag = ep[-1];
if ((ep = dec_atom(edep, ep, &sysname)) == NULL) {
goto error;
@@ -3225,12 +3354,17 @@ dec_term_atom_common:
goto error;
}
ep += 4;
- cre = get_int8(ep);
- ep++;
- if (!is_valid_creation(cre)) {
- goto error;
- }
-
+ if (tag == PORT_EXT) {
+ cre = get_int8(ep);
+ ep++;
+ if (!is_valid_creation(cre)) {
+ goto error;
+ }
+ }
+ else {
+ cre = get_int32(ep);
+ ep += 4;
+ }
node = dec_get_node(sysname, cre);
if(node == erts_this_node) {
*objp = make_internal_port(num);
@@ -3240,11 +3374,11 @@ dec_term_atom_common:
hp += EXTERNAL_THING_HEAD_SIZE + 1;
etp->header = make_external_port_header(1);
- etp->next = off_heap->first;
+ etp->next = factory->off_heap->first;
etp->node = node;
etp->data.ui[0] = num;
- off_heap->first = (struct erl_off_heap_header*)etp;
+ factory->off_heap->first = (struct erl_off_heap_header*)etp;
*objp = make_external_port(etp);
}
@@ -3255,7 +3389,7 @@ dec_term_atom_common:
Eterm sysname;
ErlNode *node;
int i;
- Uint cre;
+ Uint32 cre;
Uint32 *ref_num;
Uint32 r0;
Uint ref_words;
@@ -3279,9 +3413,6 @@ dec_term_atom_common:
ref_words = get_int16(ep);
ep += 2;
- if (ref_words > ERTS_MAX_REF_NUMBERS)
- goto error;
-
if ((ep = dec_atom(edep, ep, &sysname)) == NULL)
goto error;
@@ -3294,58 +3425,101 @@ dec_term_atom_common:
ep += 4;
if (r0 >= MAX_REFERENCE)
goto error;
+ goto ref_ext_common;
+
+ case NEWER_REFERENCE_EXT:
+ ref_words = get_int16(ep);
+ ep += 2;
+
+ if ((ep = dec_atom(edep, ep, &sysname)) == NULL)
+ goto error;
+
+ cre = get_int32(ep);
+ ep += 4;
+ r0 = get_int32(ep); /* allow full word */
+ ep += 4;
+
+ ref_ext_common: {
+ ErtsORefThing *rtp;
- ref_ext_common:
+ if (ref_words > ERTS_MAX_REF_NUMBERS)
+ goto error;
node = dec_get_node(sysname, cre);
if(node == erts_this_node) {
- RefThing *rtp = (RefThing *) hp;
- ref_num = (Uint32 *) (hp + REF_THING_HEAD_SIZE);
+
+ rtp = (ErtsORefThing *) hp;
+ ref_num = &rtp->num[0];
+ if (ref_words != ERTS_REF_NUMBERS) {
+ int i;
+ if (ref_words > ERTS_REF_NUMBERS)
+ goto error; /* Not a ref that we created... */
+ for (i = ref_words; i < ERTS_REF_NUMBERS; i++)
+ ref_num[i] = 0;
+ }
-#if defined(ARCH_64) && !HALFWORD_HEAP
- hp += REF_THING_HEAD_SIZE + ref_words/2 + 1;
- rtp->header = make_ref_thing_header(ref_words/2 + 1);
-#else
- hp += REF_THING_HEAD_SIZE + ref_words;
- rtp->header = make_ref_thing_header(ref_words);
+#ifdef ERTS_ORDINARY_REF_MARKER
+ rtp->marker = ERTS_ORDINARY_REF_MARKER;
#endif
+ hp += ERTS_REF_THING_SIZE;
+ rtp->header = ERTS_REF_THING_HEADER;
*objp = make_internal_ref(rtp);
}
else {
ExternalThing *etp = (ExternalThing *) hp;
-#if defined(ARCH_64) && !HALFWORD_HEAP
+ rtp = NULL;
+#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);
#endif
- etp->next = off_heap->first;
+ etp->next = factory->off_heap->first;
etp->node = node;
- off_heap->first = (struct erl_off_heap_header*)etp;
+ factory->off_heap->first = (struct erl_off_heap_header*)etp;
*objp = make_external_ref(etp);
ref_num = &(etp->data.ui32[0]);
+#if defined(ARCH_64)
+ *(ref_num++) = ref_words /* 32-bit arity */;
+#endif
}
-#if defined(ARCH_64) && !HALFWORD_HEAP
- *(ref_num++) = ref_words /* 32-bit arity */;
-#endif
ref_num[0] = r0;
+
for(i = 1; i < ref_words; i++) {
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
+ if (node == erts_this_node) {
+ /* Check if it was a magic reference... */
+ ErtsMagicBinary *mb = erts_magic_ref_lookup_bin(ref_num);
+ if (mb) {
+ /*
+ * Was a magic ref; adjust it...
+ *
+ * Refc on binary was increased by lookup above...
+ */
+ ASSERT(rtp);
+ hp = (Eterm *) rtp;
+ write_magic_ref_thing(hp, factory->off_heap, mb);
+ OH_OVERHEAD(factory->off_heap,
+ mb->orig_size / sizeof(Eterm));
+ hp += ERTS_MAGIC_REF_THING_SIZE;
+ }
+ }
break;
}
+ }
case BINARY_EXT:
{
n = get_int32(ep);
@@ -3362,15 +3536,13 @@ dec_term_atom_common:
} else {
Binary* dbin = erts_bin_nrml_alloc(n);
ProcBin* pb;
- dbin->flags = 0;
- dbin->orig_size = n;
- erts_refc_init(&dbin->refc, 1);
pb = (ProcBin *) hp;
hp += PROC_BIN_SIZE;
pb->thing_word = HEADER_PROC_BIN;
pb->size = n;
- pb->next = off_heap->first;
- off_heap->first = (struct erl_off_heap_header*)pb;
+ pb->next = factory->off_heap->first;
+ factory->off_heap->first = (struct erl_off_heap_header*)pb;
+ OH_OVERHEAD(factory->off_heap, pb->size / sizeof(Eterm));
pb->val = dbin;
pb->bytes = (byte*) dbin->orig_bytes;
pb->flags = 0;
@@ -3416,14 +3588,12 @@ dec_term_atom_common:
Binary* dbin = erts_bin_nrml_alloc(n);
ProcBin* pb;
- dbin->flags = 0;
- dbin->orig_size = n;
- erts_refc_init(&dbin->refc, 1);
pb = (ProcBin *) hp;
pb->thing_word = HEADER_PROC_BIN;
pb->size = n;
- pb->next = off_heap->first;
- off_heap->first = (struct erl_off_heap_header*)pb;
+ pb->next = factory->off_heap->first;
+ factory->off_heap->first = (struct erl_off_heap_header*)pb;
+ OH_OVERHEAD(factory->off_heap, pb->size / sizeof(Eterm));
pb->val = dbin;
pb->bytes = (byte*) dbin->orig_bytes;
pb->flags = 0;
@@ -3475,9 +3645,9 @@ dec_term_atom_common:
if ((ep = dec_atom(edep, ep, &name)) == NULL) {
goto error;
}
- *hpp = hp;
- ep = dec_term(edep, hpp, ep, off_heap, &temp, NULL);
- hp = *hpp;
+ factory->hp = hp;
+ ep = dec_term(edep, factory, ep, &temp, NULL);
+ hp = factory->hp;
if (ep == NULL) {
goto error;
}
@@ -3494,57 +3664,63 @@ 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;
case MAP_EXT:
{
- map_t *mp;
Uint32 size,n;
Eterm *kptr,*vptr;
Eterm keys;
size = get_int32(ep); ep += 4;
- keys = make_tuple(hp);
- *hp++ = make_arityval(size);
- hp += size;
- kptr = hp - 1;
-
- mp = (map_t*)hp;
- hp += MAP_HEADER_SIZE;
- hp += size;
- vptr = hp - 1;
-
- /* kptr, last word for keys
- * 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_head);
- maps_head = (Eterm *) mp;
-
- mp->size = size;
- mp->keys = keys;
- *objp = make_map(mp);
-
- for (n = size; n; n--) {
- *vptr = (Eterm) COMPRESS_POINTER(next);
- *kptr = (Eterm) COMPRESS_POINTER(vptr);
- next = kptr;
- vptr--;
- kptr--;
- }
+ if (size <= MAP_SMALL_MAP_LIMIT) {
+ flatmap_t *mp;
+
+ keys = make_tuple(hp);
+ *hp++ = make_arityval(size);
+ hp += size;
+ kptr = hp - 1;
+
+ mp = (flatmap_t*)hp;
+ hp += MAP_HEADER_FLATMAP_SZ;
+ hp += size;
+ vptr = hp - 1;
+
+ /* kptr, last word for keys
+ * vptr, last word for values
+ */
+
+ 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) next;
+ *kptr = (Eterm) vptr;
+ next = kptr;
+ vptr--;
+ kptr--;
+ }
+ }
+ else { /* Make hamt */
+ struct dec_term_hamt* hamt = PSTACK_PUSH(hamt_array);
+
+ hamt->objp = objp;
+ hamt->size = size;
+ hamt->leaf_array = hp;
+
+ for (n = size; n; n--) {
+ CDR(hp) = (Eterm) next;
+ CAR(hp) = (Eterm) &CDR(hp);
+ next = &CAR(hp);
+ hp += 2;
+ }
+ }
}
break;
case NEW_FUN_EXT:
@@ -3578,9 +3754,9 @@ dec_term_atom_common:
if ((ep = dec_atom(edep, ep, &module)) == NULL) {
goto error;
}
- *hpp = hp;
+ factory->hp = hp;
/* Index */
- if ((ep = dec_term(edep, hpp, ep, off_heap, &temp, NULL)) == NULL) {
+ if ((ep = dec_term(edep, factory, ep, &temp, NULL)) == NULL) {
goto error;
}
if (!is_small(temp)) {
@@ -3589,7 +3765,7 @@ dec_term_atom_common:
old_index = unsigned_val(temp);
/* Uniq */
- if ((ep = dec_term(edep, hpp, ep, off_heap, &temp, NULL)) == NULL) {
+ if ((ep = dec_term(edep, factory, ep, &temp, NULL)) == NULL) {
goto error;
}
if (!is_small(temp)) {
@@ -3601,27 +3777,26 @@ dec_term_atom_common:
* It is safe to link the fun into the fun list only when
* no more validity tests can fail.
*/
- funp->next = off_heap->first;
- off_heap->first = (struct erl_off_heap_header*)funp;
+ funp->next = factory->off_heap->first;
+ factory->off_heap->first = (struct erl_off_heap_header*)funp;
funp->fe = erts_put_fun_entry2(module, old_uniq, old_index,
uniq, index, arity);
funp->arity = arity;
#ifdef HIPE
if (funp->fe->native_address == NULL) {
- hipe_set_closure_stub(funp->fe, num_free);
+ hipe_set_closure_stub(funp->fe);
}
- funp->native_address = funp->fe->native_address;
#endif
- hp = *hpp;
+ hp = factory->hp;
/* 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;
}
@@ -3639,15 +3814,15 @@ dec_term_atom_common:
ep += 4;
hp += ERL_FUN_SIZE;
hp += num_free;
- *hpp = hp;
+ factory->hp = hp;
funp->thing_word = HEADER_FUN;
funp->num_free = num_free;
*objp = make_fun(funp);
/* Creator pid */
- if (*ep != PID_EXT
- || (ep = dec_pid(edep, hpp, ++ep, off_heap,
- &funp->creator))==NULL) {
+ if ((*ep != PID_EXT && *ep != NEW_PID_EXT)
+ || (ep = dec_pid(edep, factory, ep+1,
+ &funp->creator, *ep))==NULL) {
goto error;
}
@@ -3657,7 +3832,7 @@ dec_term_atom_common:
}
/* Index */
- if ((ep = dec_term(edep, hpp, ep, off_heap, &temp, NULL)) == NULL) {
+ if ((ep = dec_term(edep, factory, ep, &temp, NULL)) == NULL) {
goto error;
}
if (!is_small(temp)) {
@@ -3666,7 +3841,7 @@ dec_term_atom_common:
old_index = unsigned_val(temp);
/* Uniq */
- if ((ep = dec_term(edep, hpp, ep, off_heap, &temp, NULL)) == NULL) {
+ if ((ep = dec_term(edep, factory, ep, &temp, NULL)) == NULL) {
goto error;
}
if (!is_small(temp)) {
@@ -3677,20 +3852,17 @@ dec_term_atom_common:
* It is safe to link the fun into the fun list only when
* no more validity tests can fail.
*/
- funp->next = off_heap->first;
- off_heap->first = (struct erl_off_heap_header*)funp;
+ funp->next = factory->off_heap->first;
+ factory->off_heap->first = (struct erl_off_heap_header*)funp;
old_uniq = unsigned_val(temp);
funp->fe = erts_put_fun_entry(module, old_uniq, old_index);
funp->arity = funp->fe->address[-1] - num_free;
-#ifdef HIPE
- funp->native_address = funp->fe->native_address;
-#endif
- hp = *hpp;
+ hp = factory->hp;
/* 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;
@@ -3718,10 +3890,11 @@ dec_term_atom_common:
sys_memcpy(pb, ep, sizeof(ProcBin));
ep += sizeof(ProcBin);
- erts_refc_inc(&pb->val->refc, 1);
+ erts_refc_inc(&pb->val->intern.refc, 1);
hp += PROC_BIN_SIZE;
- pb->next = off_heap->first;
- off_heap->first = (struct erl_off_heap_header*)pb;
+ pb->next = factory->off_heap->first;
+ factory->off_heap->first = (struct erl_off_heap_header*)pb;
+ OH_OVERHEAD(factory->off_heap, pb->size / sizeof(Eterm));
pb->flags = 0;
*objp = make_binary(pb);
break;
@@ -3735,10 +3908,11 @@ dec_term_atom_common:
sys_memcpy(pb, ep, sizeof(ProcBin));
ep += sizeof(ProcBin);
- erts_refc_inc(&pb->val->refc, 1);
+ erts_refc_inc(&pb->val->intern.refc, 1);
hp += PROC_BIN_SIZE;
- pb->next = off_heap->first;
- off_heap->first = (struct erl_off_heap_header*)pb;
+ pb->next = factory->off_heap->first;
+ factory->off_heap->first = (struct erl_off_heap_header*)pb;
+ OH_OVERHEAD(factory->off_heap, pb->size / sizeof(Eterm));
pb->flags = 0;
sub = (ErlSubBin*)hp;
@@ -3764,8 +3938,13 @@ dec_term_atom_common:
if (next || ctx->state != B2TDecode) {
ctx->u.dc.ep = ep;
ctx->u.dc.next = next;
- ctx->u.dc.hp = hp;
- ctx->u.dc.maps_head = maps_head;
+ ctx->u.dc.factory.hp = hp;
+ 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);
+ }
ctx->reds = 0;
return NULL;
}
@@ -3776,24 +3955,47 @@ dec_term_atom_common:
}
}
- /* Iterate through all the maps and check for validity and sort keys
+ ASSERT(hp <= factory->hp_end
+ || (factory->mode == FACTORY_CLOSED && is_immed(*dbg_resultp)));
+ factory->hp = hp;
+ /*
+ * From here on factory may produce (more) heap fragments
+ */
+
+ 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);
+ }
+
+ /* Iterate through all the (flat)maps and check for validity and sort keys
* - done here for when we know it is complete.
*/
- while (maps_head) {
- next = (Eterm *)(EXPAND_POINTER(*maps_head));
- *maps_head = MAP_HEADER;
- if (!erts_validate_and_sort_map((map_t*)maps_head))
- goto error;
- maps_head = next;
+ 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*)*dbg_resultp != NULL);
if (ctx) {
ctx->state = B2TDone;
ctx->reds = reds;
}
- *hpp = hp;
return ep;
error:
@@ -3801,15 +4003,21 @@ error:
* Must unlink all off-heap objects that may have been
* linked into the process.
*/
- if (hp < *hpp) { /* Sometimes we used hp and sometimes *hpp */
- hp = *hpp; /* the largest must be the freshest */
+ if (factory->mode != FACTORY_CLOSED) {
+ if (factory->hp < hp) { /* Sometimes we used hp and sometimes factory->hp */
+ factory->hp = hp; /* the largest must be the freshest */
+ }
}
- undo_offheap_in_area(off_heap, hp_saved, hp);
- *hpp = hp_saved;
+ else ASSERT(!factory->hp || factory->hp == hp);
+
+error_hamt:
+ erts_factory_undo(factory);
+ PSTACK_DESTROY(hamt_array);
if (ctx) {
ctx->state = B2TDecodeFail;
ctx->reds = reds;
}
+ WSTACK_DESTROY(flat_maps);
return NULL;
}
@@ -3828,51 +4036,35 @@ static int
encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj,
unsigned dflags, Sint *reds, Uint *res)
{
- DECLARE_ESTACK(s);
+ DECLARE_WSTACK(s);
Uint m, i, arity;
Uint result = 0;
Sint r = 0;
if (ctx) {
- ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK);
+ WSTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK);
r = *reds;
- if (ctx->estack.start) { /* restore saved stack */
- ESTACK_RESTORE(s, &ctx->estack);
+ if (ctx->wstack.wstart) { /* restore saved stack */
+ WSTACK_RESTORE(s, &ctx->wstack);
result = ctx->result;
obj = ctx->obj;
}
}
- goto L_jump_start;
+#define LIST_TAIL_OP ((0 << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER)
+#define TERM_ARRAY_OP(N) (((N) << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER)
+#define TERM_ARRAY_OP_DEC(OP) ((OP) - (1 << _TAG_PRIMARY_SIZE))
+
+
+ for (;;) {
+ ASSERT(!is_header(obj));
- outer_loop:
- while (!ESTACK_ISEMPTY(s)) {
- obj = ESTACK_POP(s);
- handle_popped_obj:
- if (is_list(obj)) {
- Eterm* cons = list_val(obj);
- Eterm tl;
-
- tl = CDR(cons);
- obj = CAR(cons);
- ESTACK_PUSH(s, tl);
- } else if (is_nil(obj)) {
- result++;
- goto outer_loop;
- } else {
- /*
- * Other term (in the tail of a non-proper list or
- * in a fun's environment).
- */
- }
-
- L_jump_start:
if (ctx && --r == 0) {
*reds = r;
ctx->obj = obj;
ctx->result = result;
- ESTACK_SAVE(s, &ctx->estack);
+ WSTACK_SAVE(s, &ctx->wstack);
return -1;
}
switch (tag_val_def(obj)) {
@@ -3933,20 +4125,29 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj,
else
result += 1 + 4 + 1 + i; /* tag,size,sign,digits */
break;
+ case EXTERNAL_PID_DEF:
+ if (external_pid_creation(obj) > ERTS_MAX_LOCAL_CREATION)
+ result += 3;
+ /*fall through*/
case PID_DEF:
- case EXTERNAL_PID_DEF:
result += (1 + encode_size_struct2(acmp, pid_node_name(obj), dflags) +
4 + 4 + 1);
break;
+ case EXTERNAL_REF_DEF:
+ if (external_ref_creation(obj) > ERTS_MAX_LOCAL_CREATION)
+ result += 3;
+ /*fall through*/
case REF_DEF:
- case EXTERNAL_REF_DEF:
ASSERT(dflags & DFLAG_EXTENDED_REFERENCES);
- i = ref_no_of_numbers(obj);
+ i = ref_no_numbers(obj);
result += (1 + 2 + encode_size_struct2(acmp, ref_node_name(obj), dflags) +
1 + 4*i);
break;
- case PORT_DEF:
- case EXTERNAL_PORT_DEF:
+ case EXTERNAL_PORT_DEF:
+ if (external_port_creation(obj) > ERTS_MAX_LOCAL_CREATION)
+ result += 3;
+ /*fall through*/
+ case PORT_DEF:
result += (1 + encode_size_struct2(acmp, port_node_name(obj), dflags) +
4 + 1);
break;
@@ -3955,70 +4156,79 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj,
result += m + 2 + 1;
} else {
result += 5;
- goto handle_popped_obj;
+ WSTACK_PUSH2(s, (UWord)CDR(list_val(obj)), (UWord)LIST_TAIL_OP);
+ obj = CAR(list_val(obj));
+ continue; /* big loop */
}
break;
case TUPLE_DEF:
{
Eterm* ptr = tuple_val(obj);
- Uint i;
arity = arityval(*ptr);
if (arity <= 0xff) {
result += 1 + 1;
} else {
result += 1 + 4;
}
- for (i = 1; i <= arity; ++i) {
- if (is_list(ptr[i])) {
- if ((m = is_string(obj)) && (m < MAX_STRING_LEN)) {
- result += m + 2 + 1;
- } else {
- result += 5;
- }
- }
- ESTACK_PUSH(s,ptr[i]);
+ if (arity > 1) {
+ WSTACK_PUSH2(s, (UWord) (ptr + 2),
+ (UWord) TERM_ARRAY_OP(arity-1));
}
- goto outer_loop;
+ else if (arity == 0) {
+ break;
+ }
+ obj = ptr[1];
+ continue; /* big loop */
}
- break;
case MAP_DEF:
- {
- map_t *mp = (map_t*)map_val(obj);
- Uint size = map_get_size(mp);
- Uint i;
- Eterm *ptr;
+ if (is_flatmap(obj)) {
+ flatmap_t *mp = (flatmap_t*)flatmap_val(obj);
+ Uint size = flatmap_get_size(mp);
result += 1 + 4; /* tag + 4 bytes size */
- /* push values first */
- ptr = map_get_values(mp);
- i = size;
- while(i--) {
- if (is_list(*ptr)) {
- if ((m = is_string(*ptr)) && (m < MAX_STRING_LEN)) {
- result += m + 2 + 1;
- } else {
- result += 5;
- }
- }
- ESTACK_PUSH(s,*ptr);
- ++ptr;
+ if (size) {
+ WSTACK_PUSH4(s, (UWord) flatmap_get_values(mp),
+ (UWord) TERM_ARRAY_OP(size),
+ (UWord) flatmap_get_keys(mp),
+ (UWord) TERM_ARRAY_OP(size));
+ }
+ } else {
+ Eterm *ptr;
+ Eterm hdr;
+ Uint node_sz;
+ ptr = boxed_val(obj);
+ hdr = *ptr;
+ ASSERT(is_header(hdr));
+ switch(hdr & _HEADER_MAP_SUBTAG_MASK) {
+ case HAMT_SUBTAG_HEAD_ARRAY:
+ ptr++;
+ node_sz = 16;
+ result += 1 + 4; /* tag + 4 bytes size */
+ break;
+ case HAMT_SUBTAG_HEAD_BITMAP:
+ ptr++;
+ result += 1 + 4; /* tag + 4 bytes size */
+ /*fall through*/
+ case HAMT_SUBTAG_NODE_BITMAP:
+ node_sz = hashmap_bitcount(MAP_HEADER_VAL(hdr));
+ ASSERT(node_sz < 17);
+ break;
+ default:
+ erts_exit(ERTS_ERROR_EXIT, "bad header\r\n");
}
- ptr = map_get_keys(mp);
- i = size;
- while(i--) {
- if (is_list(*ptr)) {
- if ((m = is_string(*ptr)) && (m < MAX_STRING_LEN)) {
- result += m + 2 + 1;
- } else {
- result += 5;
- }
+ ptr++;
+ WSTACK_RESERVE(s, node_sz*2);
+ while(node_sz--) {
+ if (is_list(*ptr)) {
+ WSTACK_FAST_PUSH(s, CAR(list_val(*ptr)));
+ WSTACK_FAST_PUSH(s, CDR(list_val(*ptr)));
+ } else {
+ WSTACK_FAST_PUSH(s, *ptr);
}
- ESTACK_PUSH(s,*ptr);
- ++ptr;
+ ptr++;
}
- goto outer_loop;
}
break;
case FLOAT_DEF:
@@ -4071,25 +4281,13 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj,
result += 2 * (1 + 4); /* Index + Uniq */
result += 1 + (funp->num_free < 0x100 ? 1 : 4);
}
- for (i = 1; i < funp->num_free; i++) {
- obj = funp->env[i];
-
- if (is_not_list(obj)) {
- /* Push any non-list terms on the stack */
- ESTACK_PUSH(s, obj);
- } else {
- /* Lists must be handled specially. */
- if ((m = is_string(obj)) && (m < MAX_STRING_LEN)) {
- result += m + 2 + 1;
- } else {
- result += 5;
- ESTACK_PUSH(s, obj);
- }
- }
+ if (funp->num_free > 1) {
+ WSTACK_PUSH2(s, (UWord) (funp->env + 1),
+ (UWord) TERM_ARRAY_OP(funp->num_free-1));
}
if (funp->num_free != 0) {
obj = funp->env[0];
- goto L_jump_start;
+ continue; /* big loop */
}
break;
}
@@ -4097,32 +4295,59 @@ 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);
+ result += encode_size_struct2(acmp, ep->info.mfa.module, dflags);
+ result += encode_size_struct2(acmp, ep->info.mfa.function, dflags);
+ result += encode_size_struct2(acmp, make_small(ep->info.mfa.arity), dflags);
}
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);
}
+
+ if (WSTACK_ISEMPTY(s)) {
+ break;
+ }
+ obj = (Eterm) WSTACK_POP(s);
+
+ if (is_header(obj)) {
+ switch (obj) {
+ case LIST_TAIL_OP:
+ obj = (Eterm) WSTACK_POP(s);
+ if (is_list(obj)) {
+ Eterm* cons = list_val(obj);
+
+ WSTACK_PUSH2(s, (UWord)CDR(cons), (UWord)LIST_TAIL_OP);
+ obj = CAR(cons);
+ }
+ break;
+
+ case TERM_ARRAY_OP(1):
+ obj = *(Eterm*)WSTACK_POP(s);
+ break;
+ default: { /* TERM_ARRAY_OP(N) when N > 1 */
+ Eterm* ptr = (Eterm*) WSTACK_POP(s);
+ WSTACK_PUSH2(s, (UWord) (ptr+1),
+ (UWord) TERM_ARRAY_OP_DEC(obj));
+ obj = *ptr;
+ }
+ }
+ }
}
- DESTROY_ESTACK(s);
+ WSTACK_DESTROY(s);
if (ctx) {
- ASSERT(ctx->estack.start == NULL);
+ ASSERT(ctx->wstack.wstart == NULL);
*reds = r;
}
*res = result;
return 0;
}
+
+
static Sint
decoded_size(byte *ep, byte* endp, int internal_tags, B2TContext* ctx)
{
@@ -4185,7 +4410,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;
@@ -4249,19 +4474,32 @@ init_done:
SKIP(1+atom_extra_skip);
atom_extra_skip = 0;
break;
- case PID_EXT:
+ case NEW_PID_EXT:
+ atom_extra_skip = 12;
+ goto case_PID;
+ case PID_EXT:
atom_extra_skip = 9;
+ case_PID:
/* In case it is an external pid */
heap_size += EXTERNAL_THING_HEAD_SIZE + 1;
terms++;
break;
- case PORT_EXT:
+ case NEW_PORT_EXT:
+ atom_extra_skip = 8;
+ goto case_PORT;
+ case PORT_EXT:
atom_extra_skip = 5;
+ case_PORT:
/* In case it is an external port */
heap_size += EXTERNAL_THING_HEAD_SIZE + 1;
terms++;
break;
- case NEW_REFERENCE_EXT:
+ case NEWER_REFERENCE_EXT:
+ atom_extra_skip = 4;
+ goto case_NEW_REFERENCE;
+ case NEW_REFERENCE_EXT:
+ atom_extra_skip = 1;
+ case_NEW_REFERENCE:
{
int id_words;
@@ -4272,9 +4510,9 @@ init_done:
goto error;
ep += 2;
- atom_extra_skip = 1 + 4*id_words;
+ atom_extra_skip += 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;
@@ -4316,7 +4554,11 @@ init_done:
n = get_int32(ep);
ep += 4;
ADDTERMS(2*n);
- heap_size += 3 + n + 1 + n;
+ if (n <= MAP_SMALL_MAP_LIMIT) {
+ heap_size += 3 + n + 1 + n;
+ } else {
+ heap_size += HASHMAP_ESTIMATED_HEAP_SIZE(n);
+ }
break;
case STRING_EXT:
CHKSIZE(2);
@@ -4356,11 +4598,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:
{
@@ -4440,66 +4678,3 @@ error:
#undef SKIP2
#undef CHKSIZE
}
-
-
-#ifdef HIPE
-BIF_RETTYPE hipe_wrapper_term_to_binary_1(BIF_ALIST_1);
-BIF_RETTYPE hipe_wrapper_term_to_binary_2(BIF_ALIST_2);
-BIF_RETTYPE hipe_wrapper_erts_internal_binary_to_term_1(BIF_ALIST_1);
-BIF_RETTYPE hipe_wrapper_erts_internal_binary_to_term_2(BIF_ALIST_2);
-
-/* Hipe wrappers used by native code for BIFs that disable GC while trapping.
- *
- * Problem:
- * When native code calls a BIF that traps, hipe_mode_switch will push a
- * "trap frame" on the Erlang stack in order to find its way back from beam_emu
- * back to native caller when finally done. If GC is disabled and stack/heap
- * is full there is no place to push the "trap frame".
- *
- * Solution:
- * We reserve space on stack for the "trap frame" here before the BIF is called.
- * If the BIF does not trap, the space is reclaimed here before returning.
- * If the BIF traps, hipe_push_beam_trap_frame() will detect that a "trap frame"
- * already is reserved and use it.
- */
-BIF_RETTYPE hipe_wrapper_term_to_binary_1(BIF_ALIST_1)
-{
- Eterm res;
- hipe_reserve_beam_trap_frame(BIF_P, BIF__ARGS, 1);
- res = term_to_binary_1(BIF_P, BIF__ARGS);
- if (is_value(res) || BIF_P->freason != TRAP) {
- hipe_unreserve_beam_trap_frame(BIF_P);
- }
- return res;
-}
-BIF_RETTYPE hipe_wrapper_term_to_binary_2(BIF_ALIST_2)
-{
- Eterm res;
- hipe_reserve_beam_trap_frame(BIF_P, BIF__ARGS, 2);
- res = term_to_binary_2(BIF_P, BIF__ARGS);
- if (is_value(res) || BIF_P->freason != TRAP) {
- hipe_unreserve_beam_trap_frame(BIF_P);
- }
- return res;
-}
-BIF_RETTYPE hipe_wrapper_erts_internal_binary_to_term_1(BIF_ALIST_1)
-{
- Eterm res;
- hipe_reserve_beam_trap_frame(BIF_P, BIF__ARGS, 1);
- res = erts_internal_binary_to_term_1(BIF_P, BIF__ARGS);
- if (is_value(res) || BIF_P->freason != TRAP) {
- hipe_unreserve_beam_trap_frame(BIF_P);
- }
- return res;
-}
-BIF_RETTYPE hipe_wrapper_erts_internal_binary_to_term_2(BIF_ALIST_2)
-{
- Eterm res;
- hipe_reserve_beam_trap_frame(BIF_P, BIF__ARGS, 2);
- res = erts_internal_binary_to_term_2(BIF_P, BIF__ARGS);
- if (is_value(res) || BIF_P->freason != TRAP) {
- hipe_unreserve_beam_trap_frame(BIF_P);
- }
- return res;
-}
-#endif /*HIPE*/
diff --git a/erts/emulator/beam/external.h b/erts/emulator/beam/external.h
index bf00958eb1..f00426cc16 100644
--- a/erts/emulator/beam/external.h
+++ b/erts/emulator/beam/external.h
@@ -1,24 +1,23 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
-/* Same order as the ordering of terms in erlang */
-
/* Since there are 255 different External tag values to choose from
There is no reason to not be extravagant.
Hence, the different tags for large/small tuple e.t.c
@@ -36,9 +35,12 @@
#define SMALL_ATOM_EXT 's'
#define REFERENCE_EXT 'e'
#define NEW_REFERENCE_EXT 'r'
+#define NEWER_REFERENCE_EXT 'Z'
#define PORT_EXT 'f'
+#define NEW_PORT_EXT 'Y'
#define NEW_FLOAT_EXT 'F'
#define PID_EXT 'g'
+#define NEW_PID_EXT 'X'
#define SMALL_TUPLE_EXT 'h'
#define LARGE_TUPLE_EXT 'i'
#define NIL_EXT 'j'
@@ -148,21 +150,26 @@ typedef struct {
byte *extp;
int exttmp;
Uint extsize;
+ Uint heap_size;
} ErtsBinary2TermState;
+
/* -------------------------------------------------------------------------- */
void erts_init_atom_cache_map(ErtsAtomCacheMap *);
void erts_reset_atom_cache_map(ErtsAtomCacheMap *);
void erts_destroy_atom_cache_map(ErtsAtomCacheMap *);
void erts_finalize_atom_cache_map(ErtsAtomCacheMap *, Uint32);
-Uint erts_encode_ext_dist_header_size(ErtsAtomCacheMap *);
Uint erts_encode_ext_dist_header_size(ErtsAtomCacheMap *);
byte *erts_encode_ext_dist_header_setup(byte *, ErtsAtomCacheMap *);
byte *erts_encode_ext_dist_header_finalize(byte *, ErtsAtomCache *, Uint32);
-Uint erts_encode_dist_ext_size(Eterm, Uint32, ErtsAtomCacheMap *);
-void erts_encode_dist_ext(Eterm, byte **, Uint32, ErtsAtomCacheMap *);
+struct erts_dsig_send_context;
+int erts_encode_dist_ext_size(Eterm, Uint32, ErtsAtomCacheMap*, Uint* szp);
+int erts_encode_dist_ext_size_int(Eterm term, struct erts_dsig_send_context* ctx, Uint* szp);
+struct TTBEncodeContext_;
+int erts_encode_dist_ext(Eterm, byte **, Uint32, ErtsAtomCacheMap *,
+ struct TTBEncodeContext_ *, Sint* reds);
Uint erts_encode_ext_size(Eterm);
Uint erts_encode_ext_size_2(Eterm, unsigned);
@@ -181,18 +188,18 @@ void erts_destroy_dist_ext_copy(ErtsDistExternal *);
int erts_prepare_dist_ext(ErtsDistExternal *, byte *, Uint,
DistEntry *, ErtsAtomCache *);
Sint erts_decode_dist_ext_size(ErtsDistExternal *);
-Eterm erts_decode_dist_ext(Eterm **, ErlOffHeap *, ErtsDistExternal *);
+Eterm erts_decode_dist_ext(ErtsHeapFactory* factory, ErtsDistExternal *);
Sint erts_decode_ext_size(byte*, Uint);
Sint erts_decode_ext_size_ets(byte*, Uint);
-Eterm erts_decode_ext(Eterm **, ErlOffHeap *, byte**);
-Eterm erts_decode_ext_ets(Eterm **, ErlOffHeap *, byte*);
+Eterm erts_decode_ext(ErtsHeapFactory*, byte**, Uint32 flags);
+Eterm erts_decode_ext_ets(ErtsHeapFactory*, byte*);
Eterm erts_term_to_binary(Process* p, Eterm Term, int level, Uint flags);
Sint erts_binary2term_prepare(ErtsBinary2TermState *, byte *, Sint);
void erts_binary2term_abort(ErtsBinary2TermState *);
-Eterm erts_binary2term_create(ErtsBinary2TermState *, Eterm **hpp, ErlOffHeap *);
+Eterm erts_binary2term_create(ErtsBinary2TermState *, ErtsHeapFactory*);
int erts_debug_max_atom_out_cache_index(void);
int erts_debug_atom_to_out_cache_index(Eterm);
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index 8fcb95d0e2..440723aea6 100755..100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2014. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -34,14 +35,23 @@
#include "register.h"
#include "erl_fun.h"
#include "erl_node_tables.h"
-#include "benchmark.h"
#include "erl_process.h"
#include "erl_sys_driver.h"
#include "erl_debug.h"
#include "error.h"
#include "erl_utils.h"
#include "erl_port.h"
+#include "erl_gc.h"
+#include "erl_nif.h"
+#define ERTS_BINARY_TYPES_ONLY__
+#include "erl_binary.h"
+#undef ERTS_BINARY_TYPES_ONLY__
+
+struct enif_func_t;
+#ifdef DEBUG
+# define ERTS_NIF_ASSERT_IN_ENV
+#endif
struct enif_environment_t /* ErlNifEnv */
{
struct erl_module_nif* mod_nif;
@@ -51,14 +61,78 @@ struct enif_environment_t /* ErlNifEnv */
ErlHeapFragment* heap_frag;
int fpe_was_unmasked;
struct enif_tmp_obj_t* tmp_obj_list;
+ int exception_thrown; /* boolean */
+ Process *tracee;
+ int exiting; /* boolean (dirty nifs might return in exiting state) */
+
+#ifdef ERTS_NIF_ASSERT_IN_ENV
+ int dbg_disable_assert_in_env;
+#endif
};
+struct enif_resource_type_t
+{
+ struct enif_resource_type_t* next; /* list of all resource types */
+ struct enif_resource_type_t* prev;
+ struct erl_module_nif* owner; /* that created this type and thus implements the destructor*/
+ ErlNifResourceDtor* dtor; /* user destructor function */
+ ErlNifResourceStop* stop;
+ ErlNifResourceDown* down;
+ erts_refc_t refc; /* num of resources of this type (HOTSPOT warning)
+ +1 for active erl_module_nif */
+ Eterm module;
+ Eterm name;
+};
+
+typedef struct
+{
+ erts_smp_mtx_t lock;
+ ErtsMonitor* root;
+ int pending_failed_fire;
+ int is_dying;
+
+ size_t user_data_sz;
+} ErtsResourceMonitors;
+
+typedef struct ErtsResource_
+{
+ struct enif_resource_type_t* type;
+ ErtsResourceMonitors* monitors;
+#ifdef DEBUG
+ erts_refc_t nif_refc;
+#else
+# ifdef ARCH_32
+ byte align__[4];
+# endif
+#endif
+ char data[1];
+}ErtsResource;
+
+#define DATA_TO_RESOURCE(PTR) ErtsContainerStruct(PTR, ErtsResource, data)
+#define erts_resource_ref_size(P) ERTS_MAGIC_REF_THING_SIZE
+
+extern Eterm erts_bld_resource_ref(Eterm** hp, ErlOffHeap*, ErtsResource*);
+
extern void erts_pre_nif(struct enif_environment_t*, Process*,
- struct erl_module_nif*);
+ struct erl_module_nif*, Process* tracee);
extern void erts_post_nif(struct enif_environment_t* env);
+extern void erts_resource_stop(ErtsResource*, ErlNifEvent, int is_direct_call);
+void erts_fire_nif_monitor(ErtsResource*, Eterm pid, Eterm ref);
extern Eterm erts_nif_taints(Process* p);
-extern void erts_print_nif_taints(int to, void* to_arg);
+extern void erts_print_nif_taints(fmtfn_t to, void* to_arg);
void erts_unload_nif(struct erl_module_nif* nif);
extern void erl_nif_init(void);
+extern int erts_nif_get_funcs(struct erl_module_nif*,
+ struct enif_func_t **funcs);
+extern Eterm erts_nif_call_function(Process *p, Process *tracee,
+ struct erl_module_nif*,
+ struct enif_func_t *,
+ int argc, Eterm *argv);
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+int erts_call_dirty_nif(ErtsSchedulerData *esdp, Process *c_p,
+ BeamInstr *I, Eterm *reg);
+#endif /* ERTS_DIRTY_SCHEDULERS */
+
/* Driver handle (wrapper for old plain handle) */
#define ERL_DE_OK 0
@@ -101,7 +175,7 @@ typedef struct de_proc_entry {
PROC_AWAIT_LOAD == Wants to be notified when we
reloaded the driver (old was locked) */
Uint flags; /* ERL_FL_DE_DEREFERENCED when reload in progress */
- Eterm heap[REF_THING_SIZE]; /* "ref heap" */
+ Eterm heap[ERTS_REF_THING_SIZE]; /* "ref heap" */
struct de_proc_entry *next;
} DE_ProcEntry;
@@ -109,7 +183,7 @@ typedef struct {
void *handle; /* Handle for DLL or SO (for dyn. drivers). */
DE_ProcEntry *procs; /* List of pids that have loaded this driver,
or that wait for it to change state */
- erts_refc_t refc; /* Number of ports/processes having
+ erts_smp_refc_t refc; /* Number of ports/processes having
references to the driver */
erts_smp_atomic32_t port_count; /* Number of ports using the driver */
Uint flags; /* ERL_DE_FL_KILL_PORTS */
@@ -160,6 +234,7 @@ struct erts_driver_t_ {
void (*ready_async)(ErlDrvData drv_data, ErlDrvThreadData thread_data); /* Might be NULL */
void (*process_exit)(ErlDrvData drv_data, ErlDrvMonitor *monitor);
void (*stop_select)(ErlDrvEvent event, void*); /* Might be NULL */
+ void (*emergency_close)(ErlDrvData drv_data); /* Might be NULL */
};
extern erts_driver_t *driver_list;
@@ -188,98 +263,12 @@ extern Eterm erts_ddll_monitor_driver(Process *p,
ErtsProcLocks plocks);
/*
-** Just like the driver binary but with initial flags
-** Note that the two structures Binary and ErlDrvBinary HAVE to
-** be equal except for extra fields in the beginning of the struct.
-** ErlDrvBinary is defined in erl_driver.h.
-** When driver_alloc_binary is called, a Binary is allocated, but
-** the pointer returned is to the address of the first element that
-** also occurs in the ErlDrvBinary struct (driver.*binary takes care if this).
-** The driver need never know about additions to the internal Binary of the
-** emulator. One should however NEVER be sloppy when mixing ErlDrvBinary
-** and Binary, the macros below can convert one type to the other, as they both
-** in reality are equal.
-*/
-
-#ifdef ARCH_32
- /* *DO NOT USE* only for alignment. */
-#define ERTS_BINARY_STRUCT_ALIGNMENT Uint32 align__;
-#else
-#define ERTS_BINARY_STRUCT_ALIGNMENT
-#endif
-
-/* Add fields in ERTS_INTERNAL_BINARY_FIELDS, otherwise the drivers crash */
-#define ERTS_INTERNAL_BINARY_FIELDS \
- UWord flags; \
- erts_refc_t refc; \
- ERTS_BINARY_STRUCT_ALIGNMENT
-
-typedef struct binary {
- ERTS_INTERNAL_BINARY_FIELDS
- SWord orig_size;
- char orig_bytes[1]; /* to be continued */
-} Binary;
-
-#define ERTS_SIZEOF_Binary(Sz) \
- (offsetof(Binary,orig_bytes) + (Sz))
-
-typedef struct {
- ERTS_INTERNAL_BINARY_FIELDS
- SWord orig_size;
- void (*destructor)(Binary *);
- char magic_bin_data[1];
-} ErtsMagicBinary;
-
-typedef union {
- Binary binary;
- ErtsMagicBinary magic_binary;
- struct {
- ERTS_INTERNAL_BINARY_FIELDS
- ErlDrvBinary binary;
- } driver;
-} ErtsBinary;
-
-/*
- * 'Binary' alignment:
- * Address of orig_bytes[0] of a Binary should always be 8-byte aligned.
- * It is assumed that the flags, refc, and orig_size fields are 4 bytes on
- * 32-bits architectures and 8 bytes on 64-bits architectures.
- */
-
-#define ERTS_MAGIC_BIN_DESTRUCTOR(BP) \
- ((ErtsBinary *) (BP))->magic_binary.destructor
-#define ERTS_MAGIC_BIN_DATA(BP) \
- ((void *) ((ErtsBinary *) (BP))->magic_binary.magic_bin_data)
-#define ERTS_MAGIC_BIN_DATA_SIZE(BP) \
- ((BP)->orig_size - sizeof(void (*)(Binary *)))
-#define ERTS_MAGIC_BIN_ORIG_SIZE(Sz) \
- (sizeof(void (*)(Binary *)) + (Sz))
-#define ERTS_MAGIC_BIN_SIZE(Sz) \
- (offsetof(ErtsMagicBinary,magic_bin_data) + (Sz))
-#define ERTS_MAGIC_BIN_FROM_DATA(DATA) \
- ((ErtsBinary*)((char*)(DATA) - offsetof(ErtsMagicBinary,magic_bin_data)))
-
-#define Binary2ErlDrvBinary(B) (&((ErtsBinary *) (B))->driver.binary)
-#define ErlDrvBinary2Binary(D) ((Binary *) \
- (((char *) (D)) \
- - offsetof(ErtsBinary, driver.binary)))
-
-/* A "magic" binary flag */
-#define BIN_FLAG_MAGIC 1
-#define BIN_FLAG_USR1 2 /* Reserved for use by different modules too mark */
-#define BIN_FLAG_USR2 4 /* certain binaries as special (used by ets) */
-#define BIN_FLAG_DRV 8
-
-/*
* This structure represents one type of a binary in a process.
*/
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. */
@@ -294,46 +283,12 @@ typedef struct proc_bin {
*/
#define PROC_BIN_SIZE (sizeof(ProcBin)/sizeof(Eterm))
-ERTS_GLB_INLINE Eterm erts_mk_magic_binary_term(Eterm **hpp,
- ErlOffHeap *ohp,
- Binary *mbp);
-
-#if ERTS_GLB_INLINE_INCL_FUNC_DEF
-
-ERTS_GLB_INLINE Eterm
-erts_mk_magic_binary_term(Eterm **hpp, ErlOffHeap *ohp, Binary *mbp)
-{
- ProcBin *pb = (ProcBin *) *hpp;
- *hpp += PROC_BIN_SIZE;
-
- ASSERT(mbp->flags & BIN_FLAG_MAGIC);
-
- pb->thing_word = HEADER_PROC_BIN;
- pb->size = 0;
- pb->next = ohp->first;
- ohp->first = (struct erl_off_heap_header*) pb;
- pb->val = mbp;
- pb->bytes = (byte *) mbp->orig_bytes;
- pb->flags = 0;
-
- erts_refc_inc(&mbp->refc, 1);
-
- return make_binary(pb);
-}
-
-#endif
-
-#define ERTS_TERM_IS_MAGIC_BINARY(T) \
- (is_binary((T)) \
- && (thing_subtag(*binary_val((T))) == REFC_BINARY_SUBTAG) \
- && (((ProcBin *) binary_val((T)))->val->flags & BIN_FLAG_MAGIC))
-
-
union erl_off_heap_ptr {
struct erl_off_heap_header* hdr;
ProcBin *pb;
struct erl_fun_thing* fun;
struct external_thing_* ext;
+ ErtsMRefThing *mref;
Eterm* ep;
void* voidp;
};
@@ -346,13 +301,11 @@ extern Uint display_items; /* no of items to display in traces etc */
extern int erts_backtrace_depth;
extern erts_smp_atomic32_t erts_max_gen_gcs;
-extern int erts_disable_tolerant_timeofday;
-
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:
*
@@ -370,16 +323,17 @@ extern int stackdump_on_exit;
* DESTROY_ESTACK(Stack)
*/
-typedef struct {
+typedef struct ErtsEStack_ {
Eterm* start;
Eterm* sp;
Eterm* end;
+ Eterm* edefault;
ErtsAlcType_t alloc_type;
}ErtsEStack;
#define DEF_ESTACK_SIZE (16)
-void erl_grow_estack(ErtsEStack*, Eterm* def_stack);
+void erl_grow_estack(ErtsEStack*, Uint need);
#define ESTK_CONCAT(a,b) a##b
#define ESTK_DEF_STACK(s) ESTK_CONCAT(s,_default_estack)
@@ -389,22 +343,23 @@ void erl_grow_estack(ErtsEStack*, Eterm* def_stack);
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 */ \
}
#define ESTACK_CHANGE_ALLOCATOR(s,t) \
do { \
- if (s.start != ESTK_DEF_STACK(s)) { \
- erl_exit(1, "Internal error - trying to change allocator " \
+ if ((s).start != ESTK_DEF_STACK(s)) { \
+ erts_exit(ERTS_ERROR_EXIT, "Internal error - trying to change allocator " \
"type of active estack\n"); \
} \
- s.alloc_type = (t); \
+ (s).alloc_type = (t); \
} while (0)
#define DESTROY_ESTACK(s) \
do { \
- if (s.start != ESTK_DEF_STACK(s)) { \
- erts_free(s.alloc_type, s.start); \
+ if ((s).start != ESTK_DEF_STACK(s)) { \
+ erts_free((s).alloc_type, (s).start); \
} \
} while(0)
@@ -415,16 +370,17 @@ do { \
*/
#define ESTACK_SAVE(s,dst)\
do {\
- if (s.start == ESTK_DEF_STACK(s)) {\
+ if ((s).start == ESTK_DEF_STACK(s)) {\
UWord _wsz = ESTACK_COUNT(s);\
- (dst)->start = erts_alloc(s.alloc_type,\
+ (dst)->start = erts_alloc((s).alloc_type,\
DEF_ESTACK_SIZE * sizeof(Eterm));\
- memcpy((dst)->start, s.start,_wsz*sizeof(Eterm));\
+ memcpy((dst)->start, (s).start,_wsz*sizeof(Eterm));\
(dst)->sp = (dst)->start + _wsz;\
(dst)->end = (dst)->start + DEF_ESTACK_SIZE;\
- (dst)->alloc_type = s.alloc_type;\
+ (dst)->edefault = NULL;\
+ (dst)->alloc_type = (s).alloc_type;\
} else\
- *(dst) = s;\
+ *(dst) = (s);\
} while (0)
#define DESTROY_SAVED_ESTACK(estack)\
@@ -435,95 +391,146 @@ do {\
}\
} while(0)
+#define CLEAR_SAVED_ESTACK(estack) ((void) ((estack)->start = NULL))
+
/*
* Use on empty stack, only the allocator can be changed before this.
* The src stack is reset to NULL.
*/
#define ESTACK_RESTORE(s, src) \
do { \
- ASSERT(s.start == ESTK_DEF_STACK(s)); \
- s = *(src); /* struct copy */ \
+ ASSERT((s).start == ESTK_DEF_STACK(s)); \
+ (s) = *(src); /* struct copy */ \
(src)->start = NULL; \
- ASSERT(s.sp >= s.start); \
- ASSERT(s.sp <= s.end); \
+ ASSERT((s).sp >= (s).start); \
+ ASSERT((s).sp <= (s).end); \
} while (0)
-#define ESTACK_IS_STATIC(s) (s.start == ESTK_DEF_STACK(s)))
+#define ESTACK_IS_STATIC(s) ((s).start == ESTK_DEF_STACK(s))
-#define ESTACK_PUSH(s, x) \
-do { \
- if (s.sp == s.end) { \
- erl_grow_estack(&s, ESTK_DEF_STACK(s)); \
- } \
- *s.sp++ = (x); \
+#define ESTACK_PUSH(s, x) \
+do { \
+ if ((s).sp == (s).end) { \
+ erl_grow_estack(&(s), 1); \
+ } \
+ *(s).sp++ = (x); \
} while(0)
#define ESTACK_PUSH2(s, x, y) \
do { \
- if (s.sp > s.end - 2) { \
- erl_grow_estack(&s, ESTK_DEF_STACK(s)); \
+ if ((s).sp > (s).end - 2) { \
+ erl_grow_estack(&(s), 2); \
} \
- *s.sp++ = (x); \
- *s.sp++ = (y); \
+ *(s).sp++ = (x); \
+ *(s).sp++ = (y); \
} while(0)
#define ESTACK_PUSH3(s, x, y, z) \
do { \
- if (s.sp > s.end - 3) { \
- erl_grow_estack(&s, ESTK_DEF_STACK(s)); \
+ if ((s).sp > (s).end - 3) { \
+ erl_grow_estack(&s, 3); \
} \
- *s.sp++ = (x); \
- *s.sp++ = (y); \
- *s.sp++ = (z); \
+ *(s).sp++ = (x); \
+ *(s).sp++ = (y); \
+ *(s).sp++ = (z); \
} while(0)
-#define ESTACK_COUNT(s) (s.sp - s.start)
-#define ESTACK_ISEMPTY(s) (s.sp == s.start)
-#define ESTACK_POP(s) (*(--s.sp))
+#define ESTACK_PUSH4(s, E1, E2, E3, E4) \
+do { \
+ if ((s).sp > (s).end - 4) { \
+ erl_grow_estack(&s, 4); \
+ } \
+ *(s).sp++ = (E1); \
+ *(s).sp++ = (E2); \
+ *(s).sp++ = (E3); \
+ *(s).sp++ = (E4); \
+} while(0)
+
+#define ESTACK_RESERVE(s, push_cnt) \
+do { \
+ if ((s).sp > (s).end - (push_cnt)) { \
+ erl_grow_estack(&(s), (push_cnt)); \
+ } \
+} while(0)
+
+/* Must be preceded by ESTACK_RESERVE */
+#define ESTACK_FAST_PUSH(s, x) \
+do { \
+ ASSERT((s).sp < (s).end); \
+ *s.sp++ = (x); \
+} while(0)
+
+#define ESTACK_COUNT(s) ((s).sp - (s).start)
+#define ESTACK_ISEMPTY(s) ((s).sp == (s).start)
+#define ESTACK_POP(s) (*(--(s).sp))
/*
* WSTACK: same as ESTACK but with UWord instead of Eterm
*/
-typedef struct {
+typedef struct ErtsWStack_ {
UWord* wstart;
UWord* wsp;
UWord* wend;
+ UWord* wdefault;
ErtsAlcType_t alloc_type;
}ErtsWStack;
#define DEF_WSTACK_SIZE (16)
-void erl_grow_wstack(ErtsWStack*, UWord* def_stack);
+void erl_grow_wstack(ErtsWStack*, Uint need);
#define WSTK_CONCAT(a,b) a##b
#define WSTK_DEF_STACK(s) WSTK_CONCAT(s,_default_wstack)
-#define DECLARE_WSTACK(s) \
+#define WSTACK_DECLARE(s) \
UWord WSTK_DEF_STACK(s)[DEF_WSTACK_SIZE]; \
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 */ \
}
+#define DECLARE_WSTACK WSTACK_DECLARE
+
+typedef struct ErtsDynamicWStack_ {
+ UWord default_stack[DEF_WSTACK_SIZE];
+ ErtsWStack ws;
+}ErtsDynamicWStack;
+
+#define WSTACK_INIT(dwsp, ALC_TYPE) \
+do { \
+ (dwsp)->ws.wstart = (dwsp)->default_stack; \
+ (dwsp)->ws.wsp = (dwsp)->default_stack; \
+ (dwsp)->ws.wend = (dwsp)->default_stack + DEF_WSTACK_SIZE;\
+ (dwsp)->ws.wdefault = (dwsp)->default_stack; \
+ (dwsp)->ws.alloc_type = ALC_TYPE; \
+} while (0)
#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); \
} while (0)
-#define DESTROY_WSTACK(s) \
+#define WSTACK_DESTROY(s) \
do { \
- if (s.wstart != WSTK_DEF_STACK(s)) { \
+ if (s.wstart != s.wdefault) { \
erts_free(s.alloc_type, s.wstart); \
} \
} while(0)
+#define DESTROY_WSTACK WSTACK_DESTROY
+#define WSTACK_DEBUG(s) \
+ do { \
+ fprintf(stderr, "wstack size = %ld\r\n", s.wsp - s.wstart); \
+ fprintf(stderr, "wstack wstart = %p\r\n", s.wstart); \
+ fprintf(stderr, "wstack wsp = %p\r\n", s.wsp); \
+ } while(0)
/*
* Do not free the stack after this, it may have pointers into what
@@ -538,6 +545,7 @@ do {\
memcpy((dst)->wstart, s.wstart,_wsz*sizeof(UWord));\
(dst)->wsp = (dst)->wstart + _wsz;\
(dst)->wend = (dst)->wstart + DEF_WSTACK_SIZE;\
+ (dst)->wdefault = NULL;\
(dst)->alloc_type = s.alloc_type;\
} else\
*(dst) = s;\
@@ -551,6 +559,8 @@ do {\
}\
} while(0)
+#define CLEAR_SAVED_WSTACK(wstack) ((void) ((wstack)->wstart = NULL))
+
/*
* Use on empty stack, only the allocator can be changed before this.
* The src stack is reset to NULL.
@@ -564,12 +574,12 @@ do { \
ASSERT(s.wsp <= s.wend); \
} while (0)
-#define WSTACK_IS_STATIC(s) (s.wstart == WSTK_DEF_STACK(s)))
+#define WSTACK_IS_STATIC(s) (s.wstart == WSTK_DEF_STACK(s))
#define WSTACK_PUSH(s, x) \
do { \
if (s.wsp == s.wend) { \
- erl_grow_wstack(&s, WSTK_DEF_STACK(s)); \
+ erl_grow_wstack(&s, 1); \
} \
*s.wsp++ = (x); \
} while(0)
@@ -577,7 +587,7 @@ do { \
#define WSTACK_PUSH2(s, x, y) \
do { \
if (s.wsp > s.wend - 2) { \
- erl_grow_wstack(&s, WSTK_DEF_STACK(s)); \
+ erl_grow_wstack(&s, 2); \
} \
*s.wsp++ = (x); \
*s.wsp++ = (y); \
@@ -585,24 +595,276 @@ do { \
#define WSTACK_PUSH3(s, x, y, z) \
do { \
- if (s.wsp > s.wend - 3) { \
- erl_grow_wstack(&s, WSTK_DEF_STACK(s)); \
+ if (s.wsp > s.wend - 3) { \
+ erl_grow_wstack(&s, 3); \
} \
*s.wsp++ = (x); \
*s.wsp++ = (y); \
*s.wsp++ = (z); \
} while(0)
+#define WSTACK_PUSH4(s, A1, A2, A3, A4) \
+do { \
+ if (s.wsp > s.wend - 4) { \
+ erl_grow_wstack(&s, 4); \
+ } \
+ *s.wsp++ = (A1); \
+ *s.wsp++ = (A2); \
+ *s.wsp++ = (A3); \
+ *s.wsp++ = (A4); \
+} while(0)
+
+#define WSTACK_PUSH5(s, A1, A2, A3, A4, A5) \
+do { \
+ if (s.wsp > s.wend - 5) { \
+ erl_grow_wstack(&s, 5); \
+ } \
+ *s.wsp++ = (A1); \
+ *s.wsp++ = (A2); \
+ *s.wsp++ = (A3); \
+ *s.wsp++ = (A4); \
+ *s.wsp++ = (A5); \
+} while(0)
+
+#define WSTACK_PUSH6(s, A1, A2, A3, A4, A5, A6) \
+do { \
+ if (s.wsp > s.wend - 6) { \
+ erl_grow_wstack(&s, 6); \
+ } \
+ *s.wsp++ = (A1); \
+ *s.wsp++ = (A2); \
+ *s.wsp++ = (A3); \
+ *s.wsp++ = (A4); \
+ *s.wsp++ = (A5); \
+ *s.wsp++ = (A6); \
+} while(0)
+
+#define WSTACK_RESERVE(s, push_cnt) \
+do { \
+ if (s.wsp > s.wend - (push_cnt)) { \
+ erl_grow_wstack(&s, (push_cnt)); \
+ } \
+} while(0)
+
+/* Must be preceded by WSTACK_RESERVE */
+#define WSTACK_FAST_PUSH(s, x) \
+do { \
+ ASSERT(s.wsp < s.wend); \
+ *s.wsp++ = (x); \
+} while(0)
+
#define WSTACK_COUNT(s) (s.wsp - s.wstart)
#define WSTACK_ISEMPTY(s) (s.wsp == s.wstart)
-#define WSTACK_POP(s) (*(--s.wsp))
+#define WSTACK_POP(s) ((ASSERT(s.wsp > s.wstart)),*(--s.wsp))
+
+#define WSTACK_ROLLBACK(s, count) (ASSERT(WSTACK_COUNT(s) >= (count)), \
+ s.wsp = s.wstart + (count))
+
+/* PSTACK - Stack of any type.
+ * Usage:
+ * {
+ * #define PSTACK_TYPE MyType
+ * PSTACK_DECLARE(s,16);
+ * MyType *sp = PSTACK_PUSH(s);
+ *
+ * sp->x = ....
+ * sp->y = ....
+ * sp = PSTACK_PUSH(s);
+ * ...
+ * sp = PSTACK_POP(s);
+ * if (PSTACK_IS_EMPTY(s)) {
+ * // sp is invalid when stack is empty after pop
+ * }
+ *
+ * PSTACK_DESTROY(s);
+ * }
+ */
+
+
+typedef struct ErtsPStack_ {
+ byte* pstart;
+ int offs; /* "stack pointer" as byte offset from pstart */
+ int size; /* allocated size in bytes */
+ ErtsAlcType_t alloc_type;
+}ErtsPStack;
+
+void erl_grow_pstack(ErtsPStack* s, void* default_pstack, unsigned need_bytes);
+#define PSTK_CONCAT(a,b) a##b
+#define PSTK_DEF_STACK(s) PSTK_CONCAT(s,_default_pstack)
+
+#define PSTACK_DECLARE(s, DEF_PSTACK_SIZE) \
+PSTACK_TYPE PSTK_DEF_STACK(s)[DEF_PSTACK_SIZE]; \
+ErtsPStack s = { (byte*)PSTK_DEF_STACK(s), /* pstart */ \
+ -(int)sizeof(PSTACK_TYPE), /* offs */ \
+ DEF_PSTACK_SIZE*sizeof(PSTACK_TYPE), /* size */ \
+ ERTS_ALC_T_ESTACK /* alloc_type */ \
+}
+
+#define PSTACK_CHANGE_ALLOCATOR(s,t) \
+do { \
+ if (s.pstart != (byte*)PSTK_DEF_STACK(s)) { \
+ erts_exit(ERTS_ERROR_EXIT, "Internal error - trying to change allocator " \
+ "type of active pstack\n"); \
+ } \
+ s.alloc_type = (t); \
+ } while (0)
+
+#define PSTACK_DESTROY(s) \
+do { \
+ if (s.pstart != (byte*)PSTK_DEF_STACK(s)) { \
+ erts_free(s.alloc_type, s.pstart); \
+ } \
+} while(0)
+
+#define PSTACK_IS_EMPTY(s) (s.offs < 0)
+#define PSTACK_COUNT(s) ((s.offs + sizeof(PSTACK_TYPE)) / sizeof(PSTACK_TYPE))
+
+#define PSTACK_TOP(s) (ASSERT(!PSTACK_IS_EMPTY(s)), \
+ (PSTACK_TYPE*)(s.pstart + s.offs))
+
+#define PSTACK_PUSH(s) \
+ (s.offs += sizeof(PSTACK_TYPE), \
+ ((s.offs == s.size) ? erl_grow_pstack(&s, PSTK_DEF_STACK(s), \
+ sizeof(PSTACK_TYPE)) : (void)0), \
+ ((PSTACK_TYPE*) (s.pstart + s.offs)))
+
+#define PSTACK_POP(s) ((s.offs -= sizeof(PSTACK_TYPE)), \
+ (PSTACK_TYPE*)(s.pstart + s.offs))
+
+/*
+ * Do not free the stack after this, it may have pointers into what
+ * was saved in 'dst'.
+ */
+#define PSTACK_SAVE(s,dst)\
+do {\
+ if (s.pstart == (byte*)PSTK_DEF_STACK(s)) {\
+ UWord _pbytes = PSTACK_COUNT(s) * sizeof(PSTACK_TYPE);\
+ (dst)->pstart = erts_alloc(s.alloc_type,\
+ sizeof(PSTK_DEF_STACK(s)));\
+ sys_memcpy((dst)->pstart, s.pstart, _pbytes);\
+ (dst)->offs = s.offs;\
+ (dst)->size = s.size;\
+ (dst)->alloc_type = s.alloc_type;\
+ } else\
+ *(dst) = s;\
+ } while (0)
+
+/*
+ * Use on empty stack, only the allocator can be changed before this.
+ * The src stack is reset to NULL.
+ */
+#define PSTACK_RESTORE(s, src) \
+do { \
+ ASSERT(s.pstart == (byte*)PSTK_DEF_STACK(s)); \
+ s = *(src); /* struct copy */ \
+ (src)->pstart = NULL; \
+ ASSERT(s.offs >= -(int)sizeof(PSTACK_TYPE)); \
+ ASSERT(s.offs < s.size); \
+} while (0)
+
+#define PSTACK_DESTROY_SAVED(pstack)\
+do {\
+ if ((pstack)->pstart) {\
+ erts_free((pstack)->alloc_type, (pstack)->pstart);\
+ (pstack)->pstart = NULL;\
+ }\
+} 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);
Eterm erts_new_heap_binary(Process *p, byte *buf, int len, byte** datap);
-Eterm erts_new_mso_binary(Process*, byte*, int);
+Eterm erts_new_mso_binary(Process*, byte*, Uint);
Eterm new_binary(Process*, byte*, Uint);
Eterm erts_realloc_binary(Eterm bin, size_t size);
@@ -618,24 +880,6 @@ erts_bld_port_info(Eterm **hpp,
void erts_bif_info_init(void);
/* bif.c */
-Eterm erts_make_ref(Process *);
-Eterm erts_make_ref_in_buffer(Eterm buffer[REF_THING_SIZE]);
-void erts_make_ref_in_array(Uint32 ref[ERTS_MAX_REF_NUMBERS]);
-
-ERTS_GLB_INLINE Eterm
-erts_proc_store_ref(Process *c_p, Uint32 ref[ERTS_MAX_REF_NUMBERS]);
-
-#if ERTS_GLB_INLINE_INCL_FUNC_DEF
-
-ERTS_GLB_INLINE Eterm
-erts_proc_store_ref(Process *c_p, Uint32 ref[ERTS_MAX_REF_NUMBERS])
-{
- Eterm *hp = HAlloc(c_p, REF_THING_SIZE);
- write_ref_thing(hp, ref[0], ref[1], ref[2]);
- return make_internal_ref(hp);
-}
-
-#endif
void erts_queue_monitor_message(Process *,
ErtsProcLocks*,
@@ -644,7 +888,7 @@ void erts_queue_monitor_message(Process *,
Eterm,
Eterm);
void erts_init_trap_export(Export* ep, Eterm m, Eterm f, Uint a,
- Eterm (*bif)(Process*,Eterm*));
+ Eterm (*bif)(Process*, Eterm*, BeamInstr*));
void erts_init_bif(void);
Eterm erl_send(Process *p, Eterm to, Eterm msg);
@@ -653,12 +897,31 @@ 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);
+Eterm erts_check_process_code(Process *c_p, Eterm module, int *redsp, int fcalls);
+Eterm erts_proc_copy_literal_area(Process *c_p, int *redsp, int fcalls, int gc_allowed);
+
+typedef struct ErtsLiteralArea_ {
+ struct erl_off_heap_header *off_heap;
+ Eterm *end;
+ Eterm start[1]; /* beginning of area */
+} ErtsLiteralArea;
+
+#define ERTS_LITERAL_AREA_ALLOC_SIZE(N) \
+ (sizeof(ErtsLiteralArea) + sizeof(Eterm)*((N) - 1))
+
+extern erts_smp_atomic_t erts_copy_literal_area__;
+#define ERTS_COPY_LITERAL_AREA() \
+ ((ErtsLiteralArea *) erts_smp_atomic_read_nob(&erts_copy_literal_area__))
+extern Process *erts_literal_area_collector;
+#ifdef ERTS_DIRTY_SCHEDULERS
+extern Process *erts_dirty_process_code_checker;
+#endif
+extern Process *erts_code_purger;
/* beam_load.c */
typedef struct {
- BeamInstr* current; /* Pointer to: Mod, Name, Arity */
+ ErtsCodeMFA* mfa; /* Pointer to: Mod, Name, Arity */
Uint needed; /* Heap space needed for entire tuple */
Uint32 loc; /* Location in source code */
Eterm* fname_ptr; /* Pointer to fname table */
@@ -666,6 +929,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);
@@ -674,74 +938,151 @@ Eterm erts_finish_loading(Binary* loader_state, Process* c_p,
Eterm erts_preload_module(Process *c_p, ErtsProcLocks c_p_locks,
Eterm group_leader, Eterm* mod, byte* code, Uint size);
void init_load(void);
-BeamInstr* find_function_from_pc(BeamInstr* pc);
+ErtsCodeMFA* find_function_from_pc(BeamInstr* pc);
Eterm* erts_build_mfa_item(FunctionInfo* fi, Eterm* hp,
Eterm args, Eterm* mfa_p);
-void erts_set_current_function(FunctionInfo* fi, BeamInstr* current);
+void erts_set_current_function(FunctionInfo* fi, ErtsCodeMFA* mfa);
Eterm erts_module_info_0(Process* p, Eterm module);
Eterm erts_module_info_1(Process* p, Eterm module, Eterm what);
Eterm erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info);
+int erts_commit_hipe_patch_load(Eterm hipe_magic_bin);
/* 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);
UWord erts_ranges_sz(void);
void erts_lookup_function_info(FunctionInfo* fi, BeamInstr* pc, int full_info);
+ErtsLiteralArea** erts_dump_lit_areas;
+Uint erts_dump_num_lit_areas;
/* break.c */
void init_break_handler(void);
void erts_set_ignore_break(void);
void erts_replace_intr(void);
-void process_info(int, void *);
-void print_process_info(int, void *, Process*);
-void info(int, void *);
-void loaded(int, void *);
+void process_info(fmtfn_t, void *);
+void print_process_info(fmtfn_t, void *, Process*);
+void info(fmtfn_t, void *);
+void loaded(fmtfn_t, void *);
-/* config.c */
+/* sighandler sys.c */
+int erts_set_signal(Eterm signal, Eterm type);
-__decl_noreturn void __noreturn erl_exit(int n, char*, ...);
-__decl_noreturn void __noreturn erl_exit_flush_async(int n, char*, ...);
-void erl_error(char*, va_list);
+/* erl_arith.c */
+double erts_get_positive_zero_float(void);
-/* copy.c */
-Eterm copy_object(Eterm, Process*);
+/* config.c */
-#if HALFWORD_HEAP
-Uint size_object_rel(Eterm, Eterm*);
-# define size_object(A) size_object_rel(A,NULL)
+__decl_noreturn void __noreturn erts_exit_epilogue(void);
+__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);
-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)
+/* This controls whether sharing-preserving copy is used by Erlang */
-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)
+#ifdef SHCOPY
+#define SHCOPY_SEND
+#define SHCOPY_SPAWN
+#endif
-#else /* !HALFWORD_HEAP */
+/* The persistent state while the sharing-preserving copier works */
-Uint size_object(Eterm);
-# define size_object_rel(A,B) size_object(A)
+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 *lit_purge_ptr;
+ Uint lit_purge_sz;
+} erts_shcopy_t;
+
+#define INITIALIZE_SHCOPY(info) \
+ do { \
+ ErtsLiteralArea *larea__ = ERTS_COPY_LITERAL_AREA(); \
+ info.queue_start = info.queue_default; \
+ info.bitstore_start = info.bitstore_default; \
+ info.shtable_start = info.shtable_default; \
+ info.literal_size = 0; \
+ if (larea__) { \
+ info.lit_purge_ptr = &larea__->start[0]; \
+ info.lit_purge_sz = larea__->end - info.lit_purge_ptr; \
+ } \
+ else { \
+ info.lit_purge_ptr = NULL; \
+ info.lit_purge_sz = 0; \
+ } \
+ } while(0)
+
+#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)
-Eterm copy_struct(Eterm, Uint, Eterm**, ErlOffHeap*);
-# define copy_struct_rel(OBJ,SZ,HPP,OH, SB,DB) copy_struct(OBJ,SZ,HPP,OH)
+/* copy.c */
+typedef struct {
+ Eterm *lit_purge_ptr;
+ Uint lit_purge_sz;
+} erts_literal_area_t;
+
+#define INITIALIZE_LITERAL_PURGE_AREA(Area) \
+ do { \
+ ErtsLiteralArea *larea__ = ERTS_COPY_LITERAL_AREA(); \
+ if (larea__) { \
+ (Area).lit_purge_ptr = &larea__->start[0]; \
+ (Area).lit_purge_sz = larea__->end - (Area).lit_purge_ptr; \
+ } \
+ else { \
+ (Area).lit_purge_ptr = NULL; \
+ (Area).lit_purge_sz = 0; \
+ } \
+ } while(0)
+
+Eterm copy_object_x(Eterm, Process*, Uint);
+#define copy_object(Term, Proc) copy_object_x(Term,Proc,0)
+
+Uint size_object_x(Eterm, erts_literal_area_t*);
+#define size_object(Term) size_object_x(Term,NULL)
+#define size_object_litopt(Term,LitArea) size_object_x(Term,LitArea)
+
+Uint copy_shared_calculate(Eterm, erts_shcopy_t*);
+Eterm copy_shared_perform(Eterm, Uint, erts_shcopy_t*, Eterm**, ErlOffHeap*);
+
+Uint size_shared(Eterm);
+
+Eterm copy_struct_x(Eterm, Uint, Eterm**, ErlOffHeap*, Uint*, erts_literal_area_t*);
+#define copy_struct(Obj,Sz,HPP,OH) \
+ copy_struct_x(Obj,Sz,HPP,OH,NULL,NULL)
+#define copy_struct_litopt(Obj,Sz,HPP,OH,LitArea) \
+ copy_struct_x(Obj,Sz,HPP,OH,NULL,LitArea)
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);
extern Eterm erts_monitor_nodes(Process *, Eterm, Eterm);
extern Eterm erts_processes_monitoring_nodes(Process *);
extern int erts_do_net_exits(DistEntry*, Eterm);
-extern int distribution_info(int, void *);
+extern int distribution_info(fmtfn_t, void *);
extern int is_node_name_atom(Eterm a);
extern int erts_net_message(Port *, DistEntry *,
@@ -759,7 +1100,8 @@ void print_pass_through(int, byte*, int);
/* beam_emu.c */
int catchlevel(Process*);
void init_emulator(void);
-void process_main(void);
+void process_main(Eterm* x_reg_array, FloatDef* f_reg_array);
+void erts_dirty_process_main(ErtsSchedulerData *);
Eterm build_stacktrace(Process* c_p, Eterm exc);
Eterm expand_error_value(Process* c_p, Uint freason, Eterm Value);
void erts_save_stacktrace(Process* p, struct StackTrace* s, int depth);
@@ -787,12 +1129,19 @@ 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);
void erl_start(int, char**);
void erts_usage(void);
Eterm erts_preloaded(Process* p);
+
+#ifndef ERTS_SMP
+extern void *erts_scheduler_stack_limit;
+#endif
+
/* erl_md5.c */
typedef struct {
@@ -805,23 +1154,6 @@ void MD5Init(MD5_CTX *);
void MD5Update(MD5_CTX *, unsigned char *, unsigned int);
void MD5Final(unsigned char [16], MD5_CTX *);
-/* ggc.c */
-
-void erts_gc_info(ErtsGCInfo *gcip);
-void erts_init_gc(void);
-int erts_garbage_collect(Process*, int, Eterm*, int);
-void erts_garbage_collect_hibernate(Process* p);
-Eterm erts_gc_after_bif_call(Process* p, Eterm result, Eterm* regs, Uint arity);
-void erts_garbage_collect_literals(Process* p, Eterm* literals,
- Uint lit_size,
- struct erl_off_heap_header* oh);
-Uint erts_next_heap_size(Uint, Uint);
-Eterm erts_heap_sizes(Process* p);
-
-void erts_offset_off_heap(ErlOffHeap *, Sint, Eterm*, Eterm*);
-void erts_offset_heap_ptr(Eterm*, Uint, Sint, Eterm*, Eterm*);
-void erts_offset_heap(Eterm*, Uint, Sint, Eterm*, Eterm*);
-void erts_free_heap_frags(Process* p);
/* io.c */
@@ -848,9 +1180,13 @@ Uint erts_port_ioq_size(Port *pp);
void erts_stale_drv_select(Eterm, ErlDrvPort, ErlDrvEvent, int, int);
Port *erts_get_heart_port(void);
+void erts_emergency_close_ports(void);
+void erts_ref_to_driver_monitor(Eterm ref, ErlDrvMonitor *mon);
+Eterm erts_driver_monitor_to_ref(Eterm* hp, const ErlDrvMonitor *mon);
#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_COUNT)
-void erts_lcnt_enable_io_lock_count(int enable);
+void erts_lcnt_update_driver_locks(int enable);
+void erts_lcnt_update_port_locks(int enable);
#endif
/* driver_tab.c */
@@ -869,6 +1205,11 @@ Uint64 erts_timestamp_millis(void);
Export* erts_find_function(Eterm, Eterm, unsigned int, ErtsCodeIndex);
+void *erts_calc_stacklimit(char *prev_c, UWord stacksize);
+int erts_check_below_limit(char *ptr, char *limit);
+int erts_check_above_limit(char *ptr, char *limit);
+void *erts_ptr_id(void *ptr);
+
Eterm store_external_or_ref_in_proc_(Process *, Eterm);
Eterm store_external_or_ref_(Uint **, ErlOffHeap*, Eterm);
@@ -901,6 +1242,14 @@ Sint erts_binary_set_loop_limit(Sint limit);
/* external.c */
void erts_init_external(void);
+/* erl_map.c */
+void erts_init_map(void);
+
+/* beam_debug.c */
+UWord erts_check_stack_recursion_downwards(char *start_c);
+UWord erts_check_stack_recursion_upwards(char *start_c);
+int erts_is_above_stack_limit(char *ptr);
+
/* erl_unicode.c */
void erts_init_unicode(void);
Sint erts_unicode_set_loop_limit(Sint limit);
@@ -939,11 +1288,13 @@ int erts_utf8_to_latin1(byte* dest, const byte* source, int slen);
#define ERTS_UTF8_ANALYZE_MORE 3
#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 */
+void bin_write(fmtfn_t, void*, byte*, size_t);
+Sint intlist_to_buf(Eterm, char*, Sint); /* most callers pass plain char*'s */
+int erts_unicode_list_to_buf(Eterm list, byte *buf, Sint len, Sint* written);
+Sint erts_unicode_list_to_buf_len(Eterm list);
struct Sint_buf {
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
char s[22];
#else
char s[12];
@@ -951,22 +1302,69 @@ struct Sint_buf {
};
char* Sint_to_buf(Sint, struct Sint_buf*);
+#define ERTS_IOLIST_STATE_INITER(C_P, OBJ) \
+ {(C_P), 0, 0, (OBJ), {NULL, NULL, NULL, ERTS_ALC_T_INVALID}, 0, 0}
+
+#define ERTS_IOLIST_STATE_MOVE(TO, FROM) \
+ sys_memcpy((void *) (TO), (void *) (FROM), sizeof(ErtsIOListState))
+
+#define ERTS_IOLIST_SIZE_YIELDS_COUNT_PER_RED 8
+
+typedef struct {
+ Process *c_p;
+ ErlDrvSizeT size;
+ Uint offs;
+ Eterm obj;
+ ErtsEStack estack;
+ int reds_left;
+ int have_size;
+} ErtsIOListState;
+
+#define ERTS_IOLIST2BUF_STATE_INITER(C_P, OBJ) \
+ {ERTS_IOLIST_STATE_INITER((C_P), (OBJ)), {NULL, 0, 0, 0}, NULL, 0, NULL, 0}
+
+#define ERTS_IOLIST2BUF_STATE_MOVE(TO, FROM) \
+ sys_memcpy((void *) (TO), (void *) (FROM), sizeof(ErtsIOList2BufState))
+
+#define ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT 32
+#define ERTS_IOLIST_TO_BUF_YIELD_COUNT_PER_RED 8
+#define ERTS_IOLIST_TO_BUF_BYTES_PER_RED \
+ (ERTS_IOLIST_TO_BUF_YIELD_COUNT_PER_RED*ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT)
+
+typedef struct {
+ ErtsIOListState iolist;
+ struct {
+ byte *bptr;
+ size_t size;
+ Uint bitoffs;
+ Uint bitsize;
+ } bcopy;
+ char *buf;
+ ErlDrvSizeT len;
+ Eterm *objp;
+ int offset;
+} ErtsIOList2BufState;
+
#define ERTS_IOLIST_OK 0
#define ERTS_IOLIST_OVERFLOW 1
#define ERTS_IOLIST_TYPE 2
+#define ERTS_IOLIST_YIELD 3
Eterm buf_to_intlist(Eterm**, const char*, size_t, Eterm); /* most callers pass plain char*'s */
#define ERTS_IOLIST_TO_BUF_OVERFLOW (~((ErlDrvSizeT) 0))
#define ERTS_IOLIST_TO_BUF_TYPE_ERROR (~((ErlDrvSizeT) 1))
+#define ERTS_IOLIST_TO_BUF_YIELD (~((ErlDrvSizeT) 2))
#define ERTS_IOLIST_TO_BUF_FAILED(R) \
- (((R) & (~((ErlDrvSizeT) 1))) == (~((ErlDrvSizeT) 1)))
+ (((R) & (~((ErlDrvSizeT) 3))) == (~((ErlDrvSizeT) 3)))
#define ERTS_IOLIST_TO_BUF_SUCCEEDED(R) \
(!ERTS_IOLIST_TO_BUF_FAILED((R)))
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);
@@ -994,24 +1392,35 @@ Eterm erts_gc_bor(Process* p, Eterm* reg, Uint live);
Eterm erts_gc_bxor(Process* p, Eterm* reg, Uint live);
Eterm erts_gc_bnot(Process* p, Eterm* reg, Uint live);
-Eterm erts_gc_length_1(Process* p, Eterm* reg, Uint live);
-Eterm erts_gc_size_1(Process* p, Eterm* reg, Uint live);
-Eterm erts_gc_bit_size_1(Process* p, Eterm* reg, Uint live);
-Eterm erts_gc_byte_size_1(Process* p, Eterm* reg, Uint live);
-Eterm erts_gc_map_size_1(Process* p, Eterm* reg, Uint live);
-Eterm erts_gc_abs_1(Process* p, Eterm* reg, Uint live);
-Eterm erts_gc_float_1(Process* p, Eterm* reg, Uint live);
-Eterm erts_gc_round_1(Process* p, Eterm* reg, Uint live);
-Eterm erts_gc_trunc_1(Process* p, Eterm* reg, Uint live);
-Eterm erts_gc_binary_part_3(Process* p, Eterm* reg, Uint live);
-Eterm erts_gc_binary_part_2(Process* p, Eterm* reg, Uint live);
-
Uint erts_current_reductions(Process* current, Process *p);
-int erts_print_system_version(int to, void *arg, Process *c_p);
+int erts_print_system_version(fmtfn_t 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
*/
@@ -1019,22 +1428,31 @@ int erts_hibernate(Process* c_p, Eterm module, Eterm function, Eterm args, Eterm
#define MatchSetRef(MPSP) \
do { \
if ((MPSP) != NULL) { \
- erts_refc_inc(&(MPSP)->refc, 1); \
+ erts_refc_inc(&(MPSP)->intern.refc, 1); \
} \
} while (0)
#define MatchSetUnref(MPSP) \
do { \
- if (((MPSP) != NULL) && erts_refc_dectest(&(MPSP)->refc, 0) <= 0) { \
- erts_bin_free(MPSP); \
+ if (((MPSP) != NULL)) { \
+ erts_bin_release(MPSP); \
} \
} while(0)
#define MatchSetGetSource(MPSP) erts_match_set_get_source(MPSP)
-extern Binary *erts_match_set_compile(Process *p, Eterm matchexpr);
-Eterm erts_match_set_lint(Process *p, Eterm matchexpr);
+extern Binary *erts_match_set_compile(Process *p, Eterm matchexpr, Eterm MFA);
extern void erts_match_set_release_result(Process* p);
+ERTS_GLB_INLINE void erts_match_set_release_result_trace(Process* p, Eterm);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+ERTS_GLB_INLINE
+void erts_match_set_release_result_trace(Process* p, Eterm pam_result)
+{
+ if (is_not_immed(pam_result))
+ erts_match_set_release_result(p);
+}
+#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
enum erts_pam_run_flags {
ERTS_PAM_TMP_RESULT=1,
@@ -1042,10 +1460,12 @@ enum erts_pam_run_flags {
ERTS_PAM_CONTIGUOUS_TUPLE=4,
ERTS_PAM_IGNORE_TRACE_SILENT=8
};
-extern Eterm erts_match_set_run(Process *p, Binary *mpsp,
- Eterm *args, int num_args,
- enum erts_pam_run_flags in_flags,
- Uint32 *return_flags);
+extern Eterm erts_match_set_run_trace(Process *p,
+ Process *self,
+ Binary *mpsp,
+ Eterm *args, int num_args,
+ enum erts_pam_run_flags in_flags,
+ Uint32 *return_flags);
extern Eterm erts_match_set_get_source(Binary *mpsp);
extern void erts_match_prog_foreach_offheap(Binary *b,
void (*)(ErlOffHeap *, void *),
@@ -1060,195 +1480,26 @@ 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);
ERTS_GLB_INLINE void dtrace_port_str(Port *port, char *port_buf);
-ERTS_GLB_INLINE void dtrace_fun_decode(Process *process,
- Eterm module, Eterm function, int arity,
+ERTS_GLB_INLINE void dtrace_fun_decode(Process *process, ErtsCodeMFA *mfa,
char *process_buf, char *mfa_buf);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
@@ -1258,10 +1509,15 @@ ERTS_GLB_INLINE void dtrace_fun_decode(Process *process,
ERTS_GLB_INLINE void
dtrace_pid_str(Eterm pid, char *process_buf)
{
- erts_snprintf(process_buf, DTRACE_TERM_BUF_SIZE, "<%lu.%lu.%lu>",
- pid_channel_no(pid),
- pid_number(pid),
- pid_serial(pid));
+ if (is_pid(pid))
+ erts_snprintf(process_buf, DTRACE_TERM_BUF_SIZE, "<%lu.%lu.%lu>",
+ pid_channel_no(pid),
+ pid_number(pid),
+ pid_serial(pid));
+ else if (is_port(pid))
+ erts_snprintf(process_buf, DTRACE_TERM_BUF_SIZE, "#Port<%lu.%lu>",
+ port_channel_no(pid),
+ port_number(pid));
}
ERTS_GLB_INLINE void
@@ -1273,14 +1529,11 @@ dtrace_proc_str(Process *process, char *process_buf)
ERTS_GLB_INLINE void
dtrace_port_str(Port *port, char *port_buf)
{
- erts_snprintf(port_buf, DTRACE_TERM_BUF_SIZE, "#Port<%lu.%lu>",
- port_channel_no(port->common.id),
- port_number(port->common.id));
+ dtrace_pid_str(port->common.id, port_buf);
}
ERTS_GLB_INLINE void
-dtrace_fun_decode(Process *process,
- Eterm module, Eterm function, int arity,
+dtrace_fun_decode(Process *process, ErtsCodeMFA *mfa,
char *process_buf, char *mfa_buf)
{
if (process_buf) {
@@ -1288,8 +1541,9 @@ dtrace_fun_decode(Process *process,
}
erts_snprintf(mfa_buf, DTRACE_TERM_BUF_SIZE, "%T:%T/%d",
- module, function, arity);
+ mfa->module, mfa->function, mfa->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 afaf32f8ce..8548e30e8b 100644
--- a/erts/emulator/beam/hash.c
+++ b/erts/emulator/beam/hash.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2009. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2016. 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.
+ * 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%
*/
@@ -26,8 +27,6 @@
#endif
#include "sys.h"
-#include "erl_vm.h"
-#include "global.h"
#include "hash.h"
/*
@@ -36,9 +35,9 @@
static const int h_size_table[] = {
2, 5, 11, 23, 47, 97, 197, 397, 797, /* double upto here */
1201, 1597,
- 2411, 3203,
+ 2411, 3203,
4813, 6421,
- 9643, 12853,
+ 9643, 12853,
19289, 25717,
51437,
102877,
@@ -50,8 +49,8 @@ static const int h_size_table[] = {
6584983,
13169977,
26339969,
- 52679969,
- -1
+ 52679969,
+ -1
};
/*
@@ -65,24 +64,29 @@ 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;
HashBucket* b = h->bucket[i];
-
+
while (b != (HashBucket*) 0) {
objects++;
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;
}
@@ -91,24 +95,24 @@ void hash_get_info(HashInfo *hi, Hash *h)
**
*/
-void hash_info(int to, void *arg, Hash* h)
+void hash_info(fmtfn_t to, void *arg, Hash* h)
{
HashInfo hi;
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);
}
/*
* Returns size of table in bytes. Stored objects not included.
*/
-int
+int
hash_table_sz(Hash *h)
{
int i;
@@ -118,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;
@@ -177,14 +190,14 @@ void hash_delete(Hash* h)
HashBucket* b = h->bucket[i];
while (b != (HashBucket*) 0) {
HashBucket* b_next = b->next;
-
+
h->fun.free((void*) b);
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);
}
/*
@@ -198,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);
}
/*
@@ -242,7 +250,7 @@ void* hash_get(Hash* h, void* tmpl)
HashValue hval = h->fun.hash(tmpl);
int ix = hval % h->size;
HashBucket* b = h->bucket[ix];
-
+
while(b != (HashBucket*) 0) {
if ((b->hvalue == hval) && (h->fun.cmp(tmpl, (void*)b) == 0))
return (void*) b;
@@ -267,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
@@ -339,7 +294,7 @@ void* hash_erase(Hash* h, void* tmpl)
int ix = hval % h->size;
HashBucket* b = h->bucket[ix];
HashBucket* prev = 0;
-
+
while(b != 0) {
if ((b->hvalue == hval) && (h->fun.cmp(tmpl, (void*)b) == 0)) {
if (prev != 0)
@@ -347,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;
}
@@ -373,16 +326,14 @@ hash_remove(Hash *h, void *tmpl)
int ix = hval % h->size;
HashBucket *b = h->bucket[ix];
HashBucket *prev = NULL;
-
+
while (b) {
if ((b->hvalue == hval) && (h->fun.cmp(tmpl, (void*)b) == 0)) {
if (prev)
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;
}
@@ -404,4 +355,3 @@ void hash_foreach(Hash* h, void (*func)(void *, void *), void *func_arg2)
}
}
}
-
diff --git a/erts/emulator/beam/hash.h b/erts/emulator/beam/hash.h
index 6dd66fc9b3..d319aaca83 100644
--- a/erts/emulator/beam/hash.h
+++ b/erts/emulator/beam/hash.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2009. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2016. 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.
+ * 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%
*/
@@ -24,18 +25,19 @@
#ifndef __HASH_H__
#define __HASH_H__
-#ifndef __SYS_H__
#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)(fmtfn_t,void*,char*, ...);
/*
** This bucket must be placed in top of
@@ -54,6 +56,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 {
@@ -64,26 +69,27 @@ 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*);
-void hash_info(int, void *, Hash*);
+void hash_info(fmtfn_t, void *, Hash*);
int hash_table_sz(Hash *);
void* hash_get(Hash*, void*);
@@ -92,6 +98,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 79c3ecf1b3..a1f6f54543 100644
--- a/erts/emulator/beam/index.c
+++ b/erts/emulator/beam/index.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2012. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2017. 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.
+ * 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%
*/
@@ -26,7 +27,7 @@
#include "global.h"
#include "index.h"
-void index_info(int to, void *arg, IndexTable *t)
+void index_info(fmtfn_t to, void *arg, IndexTable *t)
{
hash_info(to, arg, &t->htable);
erts_print(to, arg, "=index_table:%s\n", t->htable.name);
@@ -83,16 +84,23 @@ 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*);
t->seg_table[ix>>INDEX_PAGE_SHIFT] = erts_alloc(t->type, sz);
t->size += INDEX_PAGE_SIZE;
}
- t->entries++;
p->index = ix;
t->seg_table[ix>>INDEX_PAGE_SHIFT][ix&INDEX_PAGE_MASK] = p;
+
+ /*
+ * Do a write barrier here to allow readers to do lock free iteration.
+ * erts_index_num_entries() does matching read barrier.
+ */
+ ERTS_SMP_WRITE_MEMORY_BARRIER;
+ t->entries++;
+
return p;
}
@@ -122,7 +130,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 537bc11056..6c07571df6 100644
--- a/erts/emulator/beam/index.h
+++ b/erts/emulator/beam/index.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2017. 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.
+ * 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%
*/
@@ -25,9 +26,8 @@
#ifndef __INDEX_H__
#define __INDEX_H__
-#ifndef __HASH_H__
#include "hash.h"
-#endif
+#include "erl_alloc.h"
typedef struct index_slot
{
@@ -51,7 +51,7 @@ typedef struct index_table
#define INDEX_PAGE_MASK ((1 << INDEX_PAGE_SHIFT)-1)
IndexTable *erts_index_init(ErtsAlcType_t,IndexTable*,char*,int,int,HashFunctions);
-void index_info(int, void *, IndexTable*);
+void index_info(fmtfn_t, void *, IndexTable*);
int index_table_sz(IndexTable *);
int index_get(IndexTable*, void*);
@@ -65,6 +65,7 @@ void index_erase_latest_from(IndexTable*, Uint ix);
ERTS_GLB_INLINE int index_put(IndexTable*, void*);
ERTS_GLB_INLINE IndexSlot* erts_index_lookup(IndexTable*, Uint);
+ERTS_GLB_INLINE int erts_index_num_entries(IndexTable* t);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
@@ -78,6 +79,19 @@ erts_index_lookup(IndexTable* t, Uint ix)
{
return t->seg_table[ix>>INDEX_PAGE_SHIFT][ix&INDEX_PAGE_MASK];
}
+
+ERTS_GLB_INLINE int erts_index_num_entries(IndexTable* t)
+{
+ int ret = t->entries;
+ /*
+ * Do a read barrier here to allow lock free iteration
+ * on tables where entries are never erased.
+ * index_put_entry() does matching write barrier.
+ */
+ ERTS_SMP_READ_MEMORY_BARRIER;
+ return ret;
+}
+
#endif
#endif
diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c
index edf4a28784..3a5ddde5f4 100644
--- a/erts/emulator/beam/io.c
+++ b/erts/emulator/beam/io.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2014. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -46,13 +47,19 @@
#define ERTS_WANT_EXTERNAL_TAGS
#include "external.h"
#include "dtrace-wrapper.h"
+#include "lttng-wrapper.h"
#include "erl_map.h"
+#include "erl_bif_unique.h"
+#include "erl_hl_timer.h"
+#include "erl_time.h"
+#include "erl_io_queue.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. */
@@ -63,8 +70,6 @@ static erts_smp_tsd_key_t driver_list_last_error_key; /* Save last DDLL error o
per thread basis (for BC interfaces) */
ErtsPTab erts_port erts_align_attribute(ERTS_CACHE_LINE_SIZE); /* The port table */
-erts_smp_atomic_t erts_bytes_out; /* No bytes sent out of the system */
-erts_smp_atomic_t erts_bytes_in; /* No bytes gotten into the system */
const ErlDrvTermData driver_term_nil = (ErlDrvTermData)NIL;
@@ -72,16 +77,23 @@ 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;
int erts_port_schedule_all_ops = 0;
int erts_port_parallelism = 0;
-static void deliver_result(Eterm sender, Eterm pid, Eterm res);
+static erts_atomic64_t bytes_in;
+static erts_atomic64_t bytes_out;
+
+static void deliver_result(Port *p, 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);
@@ -97,7 +109,7 @@ static void driver_monitor_unlock_pdl(Port *p);
#define ERL_SMALL_IO_BIN_LIMIT (4*ERL_ONHEAP_BIN_LIMIT)
#define SMALL_WRITE_VEC 16
-static ERTS_INLINE ErlIOQueue*
+static ERTS_INLINE ErlPortIOQueue*
drvport2ioq(ErlDrvPort drvport)
{
Port *prt = erts_thr_drvport2port(drvport, 0);
@@ -112,11 +124,11 @@ is_port_ioq_empty(Port *pp)
int res;
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(pp));
if (!pp->port_data_lock)
- res = (pp->ioq.size == 0);
+ res = (erts_ioq_size(&pp->ioq) == 0);
else {
ErlDrvPDL pdl = pp->port_data_lock;
erts_mtx_lock(&pdl->mtx);
- res = (pp->ioq.size == 0);
+ res = (erts_ioq_size(&pp->ioq) == 0);
erts_mtx_unlock(&pdl->mtx);
}
return res;
@@ -131,14 +143,14 @@ erts_is_port_ioq_empty(Port *pp)
Uint
erts_port_ioq_size(Port *pp)
{
- int res;
+ ErlDrvSizeT res;
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(pp));
if (!pp->port_data_lock)
- res = pp->ioq.size;
+ res = erts_ioq_size(&pp->ioq);
else {
ErlDrvPDL pdl = pp->port_data_lock;
erts_mtx_lock(&pdl->mtx);
- res = pp->ioq.size;
+ res = erts_ioq_size(&pp->ioq);
erts_mtx_unlock(&pdl->mtx);
}
return (Uint) res;
@@ -201,6 +213,7 @@ static ERTS_INLINE void
kill_port(Port *pp)
{
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(pp));
+ ERTS_TRACER_CLEAR(&ERTS_TRACER(pp));
erts_ptab_delete_element(&erts_port, &pp->common); /* Time of death */
erts_port_task_free_port(pp);
/* In non-smp case the port structure may have been deallocated now */
@@ -246,14 +259,7 @@ static ERTS_INLINE void port_init_instr(Port *prt
#ifdef ERTS_SMP
ASSERT(prt->drv_ptr && prt->lock);
if (!prt->drv_ptr->lock) {
- char *lock_str = "port_lock";
- erts_mtx_init_locked_x(prt->lock, lock_str, id,
-#ifdef ERTS_ENABLE_LOCK_COUNT
- (erts_lcnt_rt_options & ERTS_LCNT_OPT_PORTLOCK)
-#else
- 0
-#endif
- );
+ erts_mtx_init_locked(prt->lock, "port_lock", id, ERTS_LOCK_FLAGS_CATEGORY_IO);
}
#endif
erts_port_task_init_sched(&prt->sched, id);
@@ -303,12 +309,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));
@@ -318,6 +321,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
@@ -353,8 +362,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);
@@ -378,20 +391,17 @@ static Port *create_port(char *name,
prt->dist_entry = NULL;
ERTS_PORT_INIT_CONNECTED(prt, pid);
prt->common.u.alive.reg = NULL;
-#ifdef ERTS_SMP
- prt->common.u.alive.ptimer = NULL;
-#else
- sys_memset(&prt->common.u.alive.tm, 0, sizeof(ErlTimer));
-#endif
+ ERTS_PTMR_INIT(prt);
erts_port_task_handle_init(&prt->timeout_task);
- prt->psd = NULL;
+ erts_smp_atomic_init_nob(&prt->psd, (erts_aint_t) NULL);
+ prt->async_open_port = NULL;
prt->drv_data = (SWord) 0;
prt->os_pid = -1;
/* Set default tracing */
- erts_get_default_tracing(&ERTS_TRACE_FLAGS(prt), &ERTS_TRACER_PROC(prt));
+ erts_get_default_port_tracing(&ERTS_TRACE_FLAGS(prt), &ERTS_TRACER(prt));
- ASSERT(((char *) prt) == ((char *) &prt->common));
+ ERTS_CT_ASSERT(offsetof(Port,common) == 0);
#if !ERTS_PORT_INIT_INSTR_NEED_ID
/*
@@ -462,14 +472,15 @@ erts_port_free(Port *prt)
| ERTS_PORT_SFLG_FREE));
ASSERT(state & ERTS_PORT_SFLG_PORT_DEBUG);
-#ifdef ERTS_SMP
- ERTS_LC_ASSERT(erts_atomic32_read_nob(&prt->common.refc) == 0);
-#else
- ERTS_LC_ASSERT(erts_atomic32_read_nob(&prt->refc) == 0);
-#endif
+ ERTS_LC_ASSERT(erts_atomic_read_nob(&prt->common.refc.atmc) == 0);
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)
@@ -498,41 +509,17 @@ erts_port_free(Port *prt)
*/
static void initq(Port* prt)
{
- ErlIOQueue* q = &prt->ioq;
-
ERTS_LC_ASSERT(!prt->port_data_lock);
-
- q->size = 0;
- q->v_head = q->v_tail = q->v_start = q->v_small;
- q->v_end = q->v_small + SMALL_IO_QUEUE;
- q->b_head = q->b_tail = q->b_start = q->b_small;
- q->b_end = q->b_small + SMALL_IO_QUEUE;
+ erts_ioq_init(&prt->ioq, ERTS_ALC_T_IOQ, 1);
}
static void stopq(Port* prt)
{
- ErlIOQueue* q;
- ErlDrvBinary** binp;
if (prt->port_data_lock)
driver_pdl_lock(prt->port_data_lock);
- q = &prt->ioq;
- binp = q->b_head;
-
- if (q->v_start != q->v_small)
- erts_free(ERTS_ALC_T_IOQ, (void *) q->v_start);
-
- while(binp < q->b_tail) {
- if (*binp != NULL)
- driver_free_binary(*binp);
- binp++;
- }
- if (q->b_start != q->b_small)
- erts_free(ERTS_ALC_T_IOQ, (void *) q->b_start);
- q->v_start = q->v_end = q->v_head = q->v_tail = NULL;
- q->b_start = q->b_end = q->b_head = q->b_tail = NULL;
- q->size = 0;
+ erts_ioq_clear(&prt->ioq);
if (prt->port_data_lock) {
driver_pdl_unlock(prt->port_data_lock);
@@ -691,8 +678,9 @@ 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);
+ trace_sched_ports_where(port, am_in, am_open);
}
port->caller = pid;
#ifdef USE_VM_PROBES
@@ -701,6 +689,19 @@ 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);
+
+#ifdef USE_LTTNG_VM_TRACEPOINTS
+ if (LTTNG_ENABLED(driver_start)) {
+ lttng_decl_portbuf(port_str);
+ lttng_decl_procbuf(proc_str);
+ lttng_pid_to_str(pid, proc_str);
+ lttng_port_to_str(port, port_str);
+ LTTNG3(driver_start, proc_str, driver->name, port_str);
+ }
+#endif
+
fpe_was_unmasked = erts_block_fpe();
drv_data = (*driver->start)(ERTS_Port2ErlDrvPort(port), name, opts);
if (((SWord) drv_data) == -1)
@@ -720,9 +721,10 @@ 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);
+ trace_sched_ports_where(port, am_out, am_open);
}
#ifdef ERTS_SMP
if (port->xports)
@@ -735,11 +737,7 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */
/*
* Must clean up the port.
*/
-#ifdef ERTS_SMP
- erts_cancel_smp_ptimer(port->common.u.alive.ptimer);
-#else
- erts_cancel_timer(&(port->common.u.alive.tm));
-#endif
+ erts_cancel_port_timer(port);
stopq(port);
if (port->linebuf != NULL) {
erts_free(ERTS_ALC_T_LINEBUF,
@@ -902,292 +900,6 @@ int erts_port_handle_xports(Port *prt)
}
#endif
-/* Fills a possibly deep list of chars and binaries into vec
-** Small characters are first stored in the buffer buf of length ln
-** binaries found are copied and linked into msoh
-** Return vector length on succsess,
-** -1 on overflow
-** -2 on type error
-*/
-
-#define SET_VEC(iov, bv, bin, ptr, len, vlen) do { \
- (iov)->iov_base = (ptr); \
- (iov)->iov_len = (len); \
- if (sizeof((iov)->iov_len) < sizeof(len) \
- /* Check if (len) overflowed (iov)->iov_len */ \
- && (iov)->iov_len != (len)) { \
- goto L_overflow; \
- } \
- *(bv)++ = (bin); \
- (iov)++; \
- (vlen)++; \
-} while(0)
-
-static int
-io_list_to_vec(Eterm obj, /* io-list */
- SysIOVec* iov, /* io vector */
- ErlDrvBinary** binv, /* binary reference vector */
- ErlDrvBinary* cbin, /* binary to store characters */
- ErlDrvSizeT bin_limit) /* small binaries limit */
-{
- DECLARE_ESTACK(s);
- Eterm* objp;
- char *buf = cbin->orig_bytes;
- Uint len = cbin->orig_size;
- Uint csize = 0;
- int vlen = 0;
- char* cptr = buf;
-
- goto L_jump_start; /* avoid push */
-
- while (!ESTACK_ISEMPTY(s)) {
- obj = ESTACK_POP(s);
- L_jump_start:
- if (is_list(obj)) {
- L_iter_list:
- objp = list_val(obj);
- obj = CAR(objp);
- if (is_byte(obj)) {
- if (len == 0)
- goto L_overflow;
- *buf++ = unsigned_val(obj);
- csize++;
- len--;
- } else if (is_binary(obj)) {
- ESTACK_PUSH(s, CDR(objp));
- goto handle_binary;
- } else if (is_list(obj)) {
- ESTACK_PUSH(s, CDR(objp));
- goto L_iter_list; /* on head */
- } else if (!is_nil(obj)) {
- goto L_type_error;
- }
- obj = CDR(objp);
- if (is_list(obj))
- goto L_iter_list; /* on tail */
- else if (is_binary(obj)) {
- goto handle_binary;
- } else if (!is_nil(obj)) {
- goto L_type_error;
- }
- } else if (is_binary(obj)) {
- Eterm real_bin;
- Uint offset;
- Eterm* bptr;
- ErlDrvSizeT size;
- int bitoffs;
- int bitsize;
-
- handle_binary:
- size = binary_size(obj);
- ERTS_GET_REAL_BIN(obj, real_bin, offset, bitoffs, bitsize);
- ASSERT(bitsize == 0);
- bptr = binary_val(real_bin);
- if (*bptr == HEADER_PROC_BIN) {
- ProcBin* pb = (ProcBin *) bptr;
- if (bitoffs != 0) {
- if (len < size) {
- goto L_overflow;
- }
- erts_copy_bits(pb->bytes+offset, bitoffs, 1,
- (byte *) buf, 0, 1, size*8);
- csize += size;
- buf += size;
- len -= size;
- } else if (bin_limit && size < bin_limit) {
- if (len < size) {
- goto L_overflow;
- }
- sys_memcpy(buf, pb->bytes+offset, size);
- csize += size;
- buf += size;
- len -= size;
- } else {
- if (csize != 0) {
- SET_VEC(iov, binv, cbin, cptr, csize, vlen);
- cptr = buf;
- csize = 0;
- }
- if (pb->flags) {
- erts_emasculate_writable_binary(pb);
- }
- SET_VEC(iov, binv, Binary2ErlDrvBinary(pb->val),
- pb->bytes+offset, size, vlen);
- }
- } else {
- ErlHeapBin* hb = (ErlHeapBin *) bptr;
- if (len < size) {
- goto L_overflow;
- }
- copy_binary_to_buffer(buf, 0,
- ((byte *) hb->data)+offset, bitoffs,
- 8*size);
- csize += size;
- buf += size;
- len -= size;
- }
- } else if (!is_nil(obj)) {
- goto L_type_error;
- }
- }
-
- if (csize != 0) {
- SET_VEC(iov, binv, cbin, cptr, csize, vlen);
- }
-
- DESTROY_ESTACK(s);
- return vlen;
-
- L_type_error:
- DESTROY_ESTACK(s);
- return -2;
-
- L_overflow:
- DESTROY_ESTACK(s);
- return -1;
-}
-
-#define IO_LIST_VEC_COUNT(obj) \
-do { \
- Uint _size = binary_size(obj); \
- Eterm _real; \
- ERTS_DECLARE_DUMMY(Uint _offset); \
- int _bitoffs; \
- int _bitsize; \
- ERTS_GET_REAL_BIN(obj, _real, _offset, _bitoffs, _bitsize); \
- if (_bitsize != 0) goto L_type_error; \
- if (thing_subtag(*binary_val(_real)) == REFC_BINARY_SUBTAG && \
- _bitoffs == 0) { \
- b_size += _size; \
- if (b_size < _size) goto L_overflow_error; \
- in_clist = 0; \
- v_size++; \
- if (_size >= ERL_SMALL_IO_BIN_LIMIT) { \
- p_in_clist = 0; \
- p_v_size++; \
- } else { \
- p_c_size += _size; \
- if (!p_in_clist) { \
- p_in_clist = 1; \
- p_v_size++; \
- } \
- } \
- } else { \
- c_size += _size; \
- if (c_size < _size) goto L_overflow_error; \
- if (!in_clist) { \
- in_clist = 1; \
- v_size++; \
- } \
- p_c_size += _size; \
- if (!p_in_clist) { \
- p_in_clist = 1; \
- p_v_size++; \
- } \
- } \
-} while (0)
-
-
-/*
- * Returns 0 if successful and a non-zero value otherwise.
- *
- * Return values through pointers:
- * *vsize - SysIOVec size needed for a writev
- * *csize - Number of bytes not in binary (in the common binary)
- * *pvsize - SysIOVec size needed if packing small binaries
- * *pcsize - Number of bytes in the common binary if packing
- * *total_size - Total size of iolist in bytes
- */
-
-static int
-io_list_vec_len(Eterm obj, int* vsize, Uint* csize,
- Uint* pvsize, Uint* pcsize,
- ErlDrvSizeT* total_size)
-{
- DECLARE_ESTACK(s);
- Eterm* objp;
- Uint v_size = 0;
- Uint c_size = 0;
- Uint b_size = 0;
- Uint in_clist = 0;
- Uint p_v_size = 0;
- Uint p_c_size = 0;
- Uint p_in_clist = 0;
- Uint total; /* Uint due to halfword emulator */
-
- goto L_jump_start; /* avoid a push */
-
- while (!ESTACK_ISEMPTY(s)) {
- obj = ESTACK_POP(s);
- L_jump_start:
- if (is_list(obj)) {
- L_iter_list:
- objp = list_val(obj);
- obj = CAR(objp);
-
- if (is_byte(obj)) {
- c_size++;
- if (c_size == 0) {
- goto L_overflow_error;
- }
- if (!in_clist) {
- in_clist = 1;
- v_size++;
- }
- p_c_size++;
- if (!p_in_clist) {
- p_in_clist = 1;
- p_v_size++;
- }
- }
- else if (is_binary(obj)) {
- IO_LIST_VEC_COUNT(obj);
- }
- else if (is_list(obj)) {
- ESTACK_PUSH(s, CDR(objp));
- goto L_iter_list; /* on head */
- }
- else if (!is_nil(obj)) {
- goto L_type_error;
- }
-
- obj = CDR(objp);
- if (is_list(obj))
- goto L_iter_list; /* on tail */
- else if (is_binary(obj)) { /* binary tail is OK */
- IO_LIST_VEC_COUNT(obj);
- }
- else if (!is_nil(obj)) {
- goto L_type_error;
- }
- }
- else if (is_binary(obj)) {
- IO_LIST_VEC_COUNT(obj);
- }
- else if (!is_nil(obj)) {
- goto L_type_error;
- }
- }
-
- total = c_size + b_size;
- if (total < c_size) {
- goto L_overflow_error;
- }
- *total_size = (ErlDrvSizeT) total;
-
- DESTROY_ESTACK(s);
- *vsize = v_size;
- *csize = c_size;
- *pvsize = p_v_size;
- *pcsize = p_c_size;
- return 0;
-
- L_type_error:
- L_overflow_error:
- DESTROY_ESTACK(s);
- return 1;
-}
-
typedef enum {
ERTS_TRY_IMM_DRV_CALL_OK,
ERTS_TRY_IMM_DRV_CALL_BUSY_LOCK,
@@ -1213,14 +925,15 @@ typedef struct {
/*
* Try doing an immediate driver callback call from a process. If
* this fail, the operation should be scheduled in the normal case...
- *
+ * Returns: ok to do the call, or error (lock busy, does not exist, etc)
*/
static ERTS_INLINE ErtsTryImmDrvCallResult
try_imm_drv_call(ErtsTryImmDrvCallState *sp)
{
+ unsigned int prof_runnable_ports;
ErtsTryImmDrvCallResult res;
int reds_left_in;
- erts_aint32_t invalid_state, invalid_sched_flags;
+ erts_aint32_t act, exp, invalid_state, invalid_sched_flags;
Port *prt = sp->port;
Process *c_p = sp->c_p;
@@ -1247,18 +960,39 @@ try_imm_drv_call(ErtsTryImmDrvCallState *sp)
goto locked_fail;
}
- sp->sched_flags = erts_smp_atomic32_read_nob(&prt->sched.flags);
- if (sp->sched_flags & invalid_sched_flags) {
- res = ERTS_TRY_IMM_DRV_CALL_INVALID_SCHED_FLAGS;
- goto locked_fail;
- }
+ prof_runnable_ports = erts_system_profile_flags.runnable_ports;
+ if (prof_runnable_ports)
+ erts_port_task_sched_lock(&prt->sched);
+ act = erts_smp_atomic32_read_nob(&prt->sched.flags);
+
+ do {
+ erts_aint32_t new;
+
+ if (act & invalid_sched_flags) {
+ res = ERTS_TRY_IMM_DRV_CALL_INVALID_SCHED_FLAGS;
+ sp->sched_flags = act;
+ goto locked_fail;
+ }
+ exp = act;
+ new = act | ERTS_PTS_FLG_EXEC_IMM;
+ act = erts_smp_atomic32_cmpxchg_mb(&prt->sched.flags, new, exp);
+ } while (act != exp);
+
+ sp->sched_flags = act;
if (!c_p)
reds_left_in = CONTEXT_REDS/10;
else {
if (IS_TRACED_FL(c_p, F_TRACE_SCHED_PROCS))
- trace_virtual_sched(c_p, am_out);
+ trace_sched(c_p, ERTS_PROC_LOCK_MAIN, am_out);
+ /*
+ * No status lock held while sending runnable
+ * proc trace messages. It is however not needed
+ * in this case, since only this thread can send
+ * such messages for this process until the process
+ * has been scheduled out.
+ */
if (erts_system_profile_flags.runnable_procs
&& erts_system_profile_flags.exclusive)
profile_runnable_proc(c_p, am_inactive);
@@ -1273,11 +1007,14 @@ try_imm_drv_call(ErtsTryImmDrvCallState *sp)
ERTS_SMP_CHK_NO_PROC_LOCKS;
- if (IS_TRACED_FL(prt, F_TRACE_SCHED_PORTS))
- trace_sched_ports_where(prt, am_in, sp->port_op);
- if (erts_system_profile_flags.runnable_ports
- && !erts_port_is_scheduled(prt))
- profile_runnable_port(prt, am_active);
+ if (prof_runnable_ports | IS_TRACED_FL(prt, F_TRACE_SCHED_PORTS)) {
+ if (prof_runnable_ports && !(act & (ERTS_PTS_FLG_IN_RUNQ|ERTS_PTS_FLG_EXEC)))
+ profile_runnable_port(prt, am_active);
+ if (IS_TRACED_FL(prt, F_TRACE_SCHED_PORTS))
+ trace_sched_ports_where(prt, am_in, sp->port_op);
+ if (prof_runnable_ports)
+ erts_port_task_sched_unlock(&prt->sched);
+ }
sp->fpe_was_unmasked = erts_block_fpe();
@@ -1294,17 +1031,31 @@ finalize_imm_drv_call(ErtsTryImmDrvCallState *sp)
int reds;
Port *prt = sp->port;
Process *c_p = sp->c_p;
+ erts_aint32_t act;
+ unsigned int prof_runnable_ports;
reds = prt->reds;
reds += erts_port_driver_callback_epilogue(prt, NULL);
erts_unblock_fpe(sp->fpe_was_unmasked);
- if (IS_TRACED_FL(prt, F_TRACE_SCHED_PORTS))
- trace_sched_ports_where(prt, am_out, sp->port_op);
- if (erts_system_profile_flags.runnable_ports
- && !erts_port_is_scheduled(prt))
- profile_runnable_port(prt, am_inactive);
+ prof_runnable_ports = erts_system_profile_flags.runnable_ports;
+ if (prof_runnable_ports)
+ erts_port_task_sched_lock(&prt->sched);
+
+ act = erts_smp_atomic32_read_band_mb(&prt->sched.flags,
+ ~ERTS_PTS_FLG_EXEC_IMM);
+ ERTS_SMP_LC_ASSERT(act & ERTS_PTS_FLG_EXEC_IMM);
+
+ if (prof_runnable_ports | IS_TRACED_FL(prt, F_TRACE_SCHED_PORTS)) {
+ if (IS_TRACED_FL(prt, F_TRACE_SCHED_PORTS))
+ trace_sched_ports_where(prt, am_out, sp->port_op);
+ if (prof_runnable_ports) {
+ if (!(act & (ERTS_PTS_FLG_IN_RUNQ|ERTS_PTS_FLG_EXEC)))
+ profile_runnable_port(prt, am_inactive);
+ erts_port_task_sched_unlock(&prt->sched);
+ }
+ }
erts_port_release(prt);
@@ -1318,7 +1069,14 @@ finalize_imm_drv_call(ErtsTryImmDrvCallState *sp)
}
if (IS_TRACED_FL(c_p, F_TRACE_SCHED_PROCS))
- trace_virtual_sched(c_p, am_in);
+ trace_sched(c_p, ERTS_PROC_LOCK_MAIN, am_in);
+ /*
+ * No status lock held while sending runnable
+ * proc trace messages. It is however not needed
+ * in this case, since only this thread can send
+ * such messages for this process until the process
+ * has been scheduled out.
+ */
if (erts_system_profile_flags.runnable_procs
&& erts_system_profile_flags.exclusive)
profile_runnable_proc(c_p, am_active);
@@ -1354,56 +1112,39 @@ finalize_force_imm_drv_call(ErtsTryImmDrvCallState *sp)
erts_unblock_fpe(sp->fpe_was_unmasked);
}
-#define ERTS_QUEUE_PORT_SCHED_OP_REPLY_SIZE (REF_THING_SIZE + 3)
+#define ERTS_QUEUE_PORT_SCHED_OP_REPLY_SIZE (ERTS_REF_THING_SIZE + 3)
static ERTS_INLINE void
queue_port_sched_op_reply(Process *rp,
- ErtsProcLocks *rp_locksp,
- Eterm *hp_start,
- Eterm *hp,
- Uint h_size,
- ErlHeapFragment* bp,
+ ErtsProcLocks rp_locks,
+ ErtsHeapFactory* factory,
Uint32 *ref_num,
- Eterm msg)
+ Eterm msg,
+ Port* prt)
{
- Eterm ref = make_internal_ref(hp);
+ Eterm* hp = erts_produce_heap(factory, ERTS_QUEUE_PORT_SCHED_OP_REPLY_SIZE, 0);
+ Eterm ref;
+
+ ref= make_internal_ref(hp);
write_ref_thing(hp, ref_num[0], ref_num[1], ref_num[2]);
- hp += REF_THING_SIZE;
+ hp += ERTS_REF_THING_SIZE;
msg = TUPLE2(hp, ref, msg);
- hp += 3;
- if (!bp) {
- HRelease(rp, hp_start + h_size, hp);
- }
- else {
- Uint used_h_size = hp - hp_start;
- ASSERT(h_size >= used_h_size);
- if (h_size > used_h_size)
- bp = erts_resize_message_buffer(bp, used_h_size, &msg, 1);
- }
+ erts_factory_trim_and_close(factory, &msg, 1);
- erts_queue_message(rp,
- rp_locksp,
- bp,
- msg,
- NIL
-#ifdef USE_VM_PROBES
- , NIL
-#endif
- );
+ erts_queue_message(rp, rp_locks, factory->message, msg,
+ prt ? prt->common.id : am_undefined);
}
static void
-port_sched_op_reply(Eterm to, Uint32 *ref_num, Eterm msg)
+port_sched_op_reply(Eterm to, Uint32 *ref_num, Eterm msg, Port* prt)
{
Process *rp = erts_proc_lookup_raw(to);
if (rp) {
- ErlOffHeap *ohp;
- ErlHeapFragment* bp;
+ ErtsHeapFactory factory;
Eterm msg_copy;
Uint hsz, msg_sz;
- Eterm *hp, *hp_start;
ErtsProcLocks rp_locks = 0;
hsz = ERTS_QUEUE_PORT_SCHED_OP_REPLY_SIZE;
@@ -1414,24 +1155,20 @@ port_sched_op_reply(Eterm to, Uint32 *ref_num, Eterm msg)
hsz += msg_sz;
}
- hp_start = hp = erts_alloc_message_heap(hsz,
- &bp,
- &ohp,
- rp,
- &rp_locks);
- if (is_immed(msg))
- msg_copy = msg;
- else
- msg_copy = copy_struct(msg, msg_sz, &hp, ohp);
+ (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,
- hp_start,
- hp,
- hsz,
- bp,
+ rp_locks,
+ &factory,
ref_num,
- msg_copy);
+ msg_copy,
+ prt);
if (rp_locks)
erts_smp_proc_unlock(rp, rp_locks);
@@ -1439,7 +1176,7 @@ port_sched_op_reply(Eterm to, Uint32 *ref_num, Eterm msg)
}
-ErtsPortOpResult
+static ErtsPortOpResult
erts_schedule_proc2port_signal(Process *c_p,
Port *prt,
Eterm caller,
@@ -1486,9 +1223,8 @@ erts_schedule_proc2port_signal(Process *c_p,
ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p);
c_p->msg.save = c_p->msg.last;
- erts_smp_proc_unlock(c_p,
- (ERTS_PROC_LOCK_MAIN
- | ERTS_PROC_LOCKS_MSG_RECEIVE));
+ erts_smp_proc_unlock(c_p, (ERTS_PROC_LOCKS_MSG_RECEIVE
+ | ERTS_PROC_LOCK_MAIN));
}
@@ -1506,20 +1242,49 @@ erts_schedule_proc2port_signal(Process *c_p,
erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
if (sched_res != 0) {
- if (refp)
+ if (refp) {
+ /*
+ * We need to restore the message queue save
+ * pointer to the beginning of the message queue
+ * since the caller now wont wait for a message
+ * containing the reference created above...
+ */
+ ASSERT(c_p);
+ erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
+ JOIN_MESSAGE(c_p);
+ erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
*refp = NIL;
+ }
return ERTS_PORT_OP_DROPPED;
}
return ERTS_PORT_OP_SCHEDULED;
}
-static ERTS_INLINE void
-send_badsig(Port *prt)
+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;
Process* rp;
Eterm connected = ERTS_PORT_GET_CONNECTED(prt);
-
ERTS_SMP_CHK_NO_PROC_LOCKS;
ERTS_LC_ASSERT(erts_get_scheduler_id());
@@ -1539,15 +1304,13 @@ send_badsig(Port *prt)
0);
if (rp_locks)
erts_smp_proc_unlock(rp, rp_locks);
- }
-}
+ } /* exit sent */
+} /* send_badsig */
static void
-badsig_received(int bang_op,
- Port *prt,
+badsig_received(int bang_op, Port *prt,
erts_aint32_t state,
- int bad_output_value)
-{
+ int bad_output_value) {
/*
* if (bang_op)
* we are part of a "Prt ! Something" operation
@@ -1563,30 +1326,28 @@ badsig_received(int bang_op,
}
if (bang_op)
send_badsig(prt);
- }
-}
+ } /* not invalid */
+} /* behaved accordingly */
static int
-port_badsig(Port *prt, erts_aint32_t state, int op, ErtsProc2PortSigData *sigdp)
-{
+port_badsig(Port *prt, erts_aint32_t state, int op,
+ ErtsProc2PortSigData *sigdp) {
if (op == ERTS_PROC2PORT_SIG_EXEC)
badsig_received(sigdp->flags & ERTS_P2P_SIG_DATA_FLG_BANG_OP,
prt,
state,
sigdp->flags & ERTS_P2P_SIG_DATA_FLG_BAD_OUTPUT);
if (sigdp->flags & ERTS_P2P_SIG_DATA_FLG_REPLY)
- port_sched_op_reply(sigdp->caller, sigdp->ref, am_badarg);
+ port_sched_op_reply(sigdp->caller, sigdp->ref, am_badarg, prt);
return ERTS_PORT_REDS_BADSIG;
-}
-
-
-/*
- * bad_port_signal() will
+} /* port_badsig */
+/* bad_port_signal() will
* - preserve signal order of signals.
* - send a 'badsig' exit signal to connected process if 'from' is an
* internal pid and the port is alive when the bad signal reaches
* it.
*/
+
static ErtsPortOpResult
bad_port_signal(Process *c_p,
int flags,
@@ -1661,24 +1422,44 @@ call_driver_outputv(int bang_op,
if (bang_op && from != ERTS_PORT_GET_CONNECTED(prt))
send_badsig(prt);
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);
+
+ if (IS_TRACED_FL(prt, F_TRACE_RECEIVE))
+ trace_port_receive(prt, caller, am_commandv, evp);
+
#ifdef USE_VM_PROBES
if (DTRACE_ENABLED(driver_outputv)) {
DTRACE_FORMAT_COMMON_PID_AND_PORT(caller, prt);
DTRACE4(driver_outputv, process_str, port_str, prt->name, size);
}
#endif
+#ifdef USE_LTTNG_VM_TRACEPOINTS
+ if (LTTNG_ENABLED(driver_outputv)) {
+ lttng_decl_portbuf(port_str);
+ lttng_decl_procbuf(proc_str);
+ lttng_pid_to_str(caller, proc_str);
+ lttng_port_to_str(prt, port_str);
+ LTTNG4(driver_outputv, proc_str, port_str, prt->name, size);
+ }
+#endif
prt->caller = caller;
(*drv->outputv)((ErlDrvData) prt->drv_data, evp);
prt->caller = NIL;
prt->bytes_out += size;
- erts_smp_atomic_add_nob(&erts_bytes_out, size);
+ if (esdp)
+ esdp->io.out += (Uint64) size;
+ else
+ erts_atomic64_add_nob(&bytes_out, (erts_aint64_t) size);
+
+ ERTS_MSACC_POP_STATE_M();
}
}
@@ -1688,11 +1469,9 @@ cleanup_scheduled_outputv(ErlIOVec *ev, ErlDrvBinary *cbinp)
int i;
/* Need to free all binaries */
for (i = 1; i < ev->vsize; i++)
- if (ev->binv[i])
- driver_free_binary(ev->binv[i]);
+ driver_free_binary(ev->binv[i]);
if (cbinp)
driver_free_binary(cbinp);
- erts_free(ERTS_ALC_T_DRV_CMD_DATA, ev);
}
static int
@@ -1727,7 +1506,7 @@ port_sig_outputv(Port *prt, erts_aint32_t state, int op, ErtsProc2PortSigData *s
}
if (sigdp->flags & ERTS_P2P_SIG_DATA_FLG_REPLY)
- port_sched_op_reply(sigdp->caller, sigdp->ref, reply);
+ port_sched_op_reply(sigdp->caller, sigdp->ref, reply, prt);
cleanup_scheduled_outputv(sigdp->u.outputv.evp,
sigdp->u.outputv.cbinp);
@@ -1758,7 +1537,8 @@ call_driver_output(int bang_op,
if (bang_op && from != ERTS_PORT_GET_CONNECTED(prt))
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);
@@ -1768,13 +1548,30 @@ call_driver_output(int bang_op,
DTRACE4(driver_output, process_str, port_str, prt->name, size);
}
#endif
+#ifdef USE_LTTNG_VM_TRACEPOINTS
+ if (LTTNG_ENABLED(driver_output)) {
+ lttng_decl_portbuf(port_str);
+ lttng_decl_procbuf(proc_str);
+ lttng_pid_to_str(caller, proc_str);
+ lttng_port_to_str(prt, port_str);
+ LTTNG4(driver_output, proc_str, port_str, prt->name, size);
+ }
+#endif
+
+ if (IS_TRACED_FL(prt, F_TRACE_RECEIVE))
+ trace_port_receive(prt, caller, am_command, bufp, size);
prt->caller = caller;
(*drv->output)((ErlDrvData) prt->drv_data, bufp, size);
prt->caller = NIL;
prt->bytes_out += size;
- erts_smp_atomic_add_nob(&erts_bytes_out, size);
+ if (esdp)
+ esdp->io.out += (Uint64) size;
+ else
+ erts_atomic64_add_nob(&bytes_out, (erts_aint64_t) size);
+
+ ERTS_MSACC_POP_STATE_M();
}
}
@@ -1817,13 +1614,157 @@ port_sig_output(Port *prt, erts_aint32_t state, int op, ErtsProc2PortSigData *si
}
if (sigdp->flags & ERTS_P2P_SIG_DATA_FLG_REPLY)
- port_sched_op_reply(sigdp->caller, sigdp->ref, reply);
+ port_sched_op_reply(sigdp->caller, sigdp->ref, reply, prt);
cleanup_scheduled_output(sigdp->u.output.bufp);
return ERTS_PORT_REDS_CMD_OUTPUT;
}
+
+/*
+ * This erts_port_output will always create a port task.
+ * The call is treated as a port_command call, i.e. no
+ * badsig i generated if the input in invalid. However
+ * an error_logger message is generated.
+ */
+int
+erts_port_output_async(Port *prt, Eterm from, Eterm list)
+{
+
+ ErtsProc2PortSigData *sigdp;
+ erts_driver_t *drv = prt->drv_ptr;
+ size_t size;
+ int task_flags;
+ ErtsProc2PortSigCallback port_sig_callback;
+ ErtsIOQBinary *cbin = NULL;
+ ErtsIOVec *evp = NULL;
+ char *buf = NULL;
+ ErtsPortTaskHandle *ns_pthp;
+
+ if (drv->outputv) {
+ SysIOVec* ivp;
+ ErtsIOQBinary** bvp;
+ int vsize;
+ Uint csize;
+ Uint pvsize;
+ Uint pcsize;
+ size_t iov_offset, binv_offset, alloc_size;
+ Uint blimit = 0;
+ char *ptr;
+ int i;
+
+ if (erts_ioq_iodata_vec_len(list, &vsize, &csize, &pvsize, &pcsize,
+ &size, ERL_SMALL_IO_BIN_LIMIT))
+ goto bad_value;
+
+ /* To pack or not to pack (small binaries) ...? */
+ if (vsize >= SMALL_WRITE_VEC) {
+ /* Do pack */
+ vsize = pvsize + 1;
+ csize = pcsize;
+ blimit = ERL_SMALL_IO_BIN_LIMIT;
+ }
+ if (csize) {
+ cbin = (ErtsIOQBinary *)driver_alloc_binary(csize);
+ if (!cbin)
+ erts_alloc_enomem(ERTS_ALC_T_DRV_BINARY, ERTS_SIZEOF_Binary(csize));
+ }
+
+ iov_offset = ERTS_ALC_DATA_ALIGN_SIZE(sizeof(ErlIOVec));
+ binv_offset = iov_offset;
+ binv_offset += ERTS_ALC_DATA_ALIGN_SIZE((vsize+1)*sizeof(SysIOVec));
+ alloc_size = binv_offset;
+ alloc_size += (vsize+1)*sizeof(ErtsIOQBinary *);
+
+ sigdp = erts_port_task_alloc_p2p_sig_data_extra(alloc_size, (void**)&ptr);
+
+ evp = (ErtsIOVec *) ptr;
+ ivp = evp->driver.iov = (SysIOVec *) (ptr + iov_offset);
+ bvp = evp->common.binv = (ErtsIOQBinary **) (ptr + binv_offset);
+
+ ivp[0].iov_base = NULL;
+ ivp[0].iov_len = 0;
+ bvp[0] = NULL;
+
+ evp->driver.vsize = erts_ioq_iodata_to_vec(list, ivp+1, bvp+1, cbin,
+ blimit, 1);
+ if (evp->driver.vsize < 0) {
+ erts_free(ERTS_ALC_T_DRV_CMD_DATA, evp);
+ driver_free_binary(&cbin->driver);
+ goto bad_value;
+ }
+#if 0
+ /* This assertion may say something useful, but it can
+ be falsified during the emulator test suites. */
+ ASSERT(evp->vsize == vsize);
+#endif
+ evp->driver.vsize++;
+ evp->driver.size = size; /* total size */
+
+ /* Need to increase refc on all binaries */
+ for (i = 1; i < evp->driver.vsize; i++)
+ if (bvp[i])
+ driver_binary_inc_refc(&bvp[i]->driver);
+
+ sigdp->flags = ERTS_P2P_SIG_TYPE_OUTPUTV;
+ sigdp->u.outputv.from = from;
+ sigdp->u.outputv.evp = &evp->driver;
+ sigdp->u.outputv.cbinp = &cbin->driver;
+ port_sig_callback = port_sig_outputv;
+ } else {
+ ErlDrvSizeT ERTS_DECLARE_DUMMY(r);
+
+ /*
+ * Apperently there exist code that write 1 byte to
+ * much in buffer. Where it resides I don't know, but
+ * we can live with one byte extra allocated...
+ */
+
+ if (erts_iolist_size(list, &size))
+ goto bad_value;
+
+ buf = erts_alloc(ERTS_ALC_T_DRV_CMD_DATA, size + 1);
+
+ r = erts_iolist_to_buf(list, buf, size);
+ ASSERT(ERTS_IOLIST_TO_BUF_SUCCEEDED(r));
+
+ sigdp = erts_port_task_alloc_p2p_sig_data();
+ sigdp->flags = ERTS_P2P_SIG_TYPE_OUTPUT;
+ sigdp->u.output.from = from;
+ sigdp->u.output.bufp = buf;
+ sigdp->u.output.size = size;
+ port_sig_callback = port_sig_output;
+ }
+ ns_pthp = NULL;
+ task_flags = 0;
+
+ erts_schedule_proc2port_signal(NULL,
+ prt,
+ ERTS_INVALID_PID,
+ NULL,
+ sigdp,
+ task_flags,
+ ns_pthp,
+ port_sig_callback);
+
+ return 1;
+
+bad_value:
+
+ /*
+ * We call badsig directly here as this function is called with
+ * the main lock of the calling process still held.
+ * At the moment this operation is always not a bang_op, so
+ * only an error_logger message should be generated, no badsig.
+ */
+
+ badsig_received(0, prt, erts_atomic32_read_nob(&prt->state), 1);
+
+ return 0;
+
+}
+
ErtsPortOpResult
erts_port_output(Process *c_p,
int flags,
@@ -1833,15 +1774,15 @@ erts_port_output(Process *c_p,
Eterm *refp)
{
ErtsPortOpResult res;
- ErtsProc2PortSigData *sigdp;
+ ErtsProc2PortSigData *sigdp = NULL;
erts_driver_t *drv = prt->drv_ptr;
size_t size;
int try_call;
erts_aint32_t sched_flags, busy_flgs, invalid_flags;
int task_flags;
ErtsProc2PortSigCallback port_sig_callback;
- ErlDrvBinary *cbin = NULL;
- ErlIOVec *evp = NULL;
+ ErtsIOQBinary *cbin = NULL;
+ ErtsIOVec *evp = NULL;
char *buf = NULL;
int force_immediate_call = (flags & ERTS_PORT_SIG_FLG_FORCE_IMM_CALL);
int async_nosuspend;
@@ -1886,13 +1827,12 @@ erts_port_output(Process *c_p,
DTRACE4(port_command, process_str, port_str, prt->name, "command");
}
#endif
-
if (drv->outputv) {
- ErlIOVec ev;
+ ErtsIOVec ev;
SysIOVec iv[SMALL_WRITE_VEC];
- ErlDrvBinary* bv[SMALL_WRITE_VEC];
+ ErtsIOQBinary* bv[SMALL_WRITE_VEC];
SysIOVec* ivp;
- ErlDrvBinary** bvp;
+ ErtsIOQBinary** bvp;
int vsize;
Uint csize;
Uint pvsize;
@@ -1900,28 +1840,32 @@ erts_port_output(Process *c_p,
Uint blimit;
size_t iov_offset, binv_offset, alloc_size;
- if (io_list_vec_len(list, &vsize, &csize, &pvsize, &pcsize, &size))
+ if (erts_ioq_iodata_vec_len(list, &vsize, &csize, &pvsize, &pcsize,
+ &size, ERL_SMALL_IO_BIN_LIMIT))
goto bad_value;
iov_offset = ERTS_ALC_DATA_ALIGN_SIZE(sizeof(ErlIOVec));
binv_offset = iov_offset;
binv_offset += ERTS_ALC_DATA_ALIGN_SIZE((vsize+1)*sizeof(SysIOVec));
alloc_size = binv_offset;
- alloc_size += (vsize+1)*sizeof(ErlDrvBinary *);
+ alloc_size += (vsize+1)*sizeof(ErtsIOQBinary *);
if (try_call && vsize < SMALL_WRITE_VEC) {
- ivp = ev.iov = iv;
- bvp = ev.binv = bv;
+ ivp = ev.common.iov = iv;
+ bvp = ev.common.binv = bv;
evp = &ev;
}
else {
- char *ptr = erts_alloc((try_call
- ? ERTS_ALC_T_TMP
- : ERTS_ALC_T_DRV_CMD_DATA), alloc_size);
-
- evp = (ErlIOVec *) ptr;
- ivp = evp->iov = (SysIOVec *) (ptr + iov_offset);
- bvp = evp->binv = (ErlDrvBinary **) (ptr + binv_offset);
+ char *ptr;
+ if (try_call) {
+ ptr = erts_alloc(ERTS_ALC_T_TMP, alloc_size);
+ } else {
+ sigdp = erts_port_task_alloc_p2p_sig_data_extra(
+ alloc_size, (void**)&ptr);
+ }
+ evp = (ErtsIOVec *) ptr;
+ ivp = evp->driver.iov = (SysIOVec *) (ptr + iov_offset);
+ bvp = evp->common.binv = (ErtsIOQBinary **) (ptr + binv_offset);
}
/* To pack or not to pack (small binaries) ...? */
@@ -1937,20 +1881,26 @@ erts_port_output(Process *c_p,
}
/* Use vsize and csize from now on */
- cbin = driver_alloc_binary(csize);
- if (!cbin)
- erts_alloc_enomem(ERTS_ALC_T_DRV_BINARY, ERTS_SIZEOF_Binary(csize));
+ if (csize) {
+ cbin = (ErtsIOQBinary *)driver_alloc_binary(csize);
+ if (!cbin)
+ erts_alloc_enomem(ERTS_ALC_T_DRV_BINARY, ERTS_SIZEOF_Binary(csize));
+ }
/* Element 0 is for driver usage to add header block */
ivp[0].iov_base = NULL;
ivp[0].iov_len = 0;
bvp[0] = NULL;
- evp->vsize = io_list_to_vec(list, ivp+1, bvp+1, cbin, blimit);
- if (evp->vsize < 0) {
- if (evp != &ev)
- erts_free(try_call ? ERTS_ALC_T_TMP : ERTS_ALC_T_DRV_CMD_DATA,
- evp);
- driver_free_binary(cbin);
+ evp->driver.vsize = erts_ioq_iodata_to_vec(list, ivp+1, bvp+1,
+ cbin, blimit, 1);
+ if (evp->driver.vsize < 0) {
+ if (evp != &ev) {
+ if (try_call)
+ erts_free(ERTS_ALC_T_TMP, evp);
+ else
+ erts_port_task_free_p2p_sig_data(sigdp);
+ }
+ driver_free_binary(&cbin->driver);
goto bad_value;
}
#if 0
@@ -1958,19 +1908,19 @@ erts_port_output(Process *c_p,
be falsified during the emulator test suites. */
ASSERT(evp->vsize == vsize);
#endif
- evp->vsize++;
- evp->size = size; /* total size */
+ evp->driver.vsize++;
+ evp->driver.size = size; /* total size */
if (!try_call) {
int i;
/* Need to increase refc on all binaries */
- for (i = 1; i < evp->vsize; i++)
- if (bvp[i])
- driver_binary_inc_refc(bvp[i]);
+ for (i = 1; i < evp->driver.vsize; i++)
+ if (bvp[i])
+ driver_binary_inc_refc(&bvp[i]->driver);
}
else {
int i;
- ErlIOVec *new_evp;
+ ErtsIOVec *new_evp;
ErtsTryImmDrvCallResult try_call_res;
ErtsTryImmDrvCallState try_call_state
= ERTS_INIT_TRY_IMM_DRV_CALL_STATE(
@@ -1993,16 +1943,18 @@ erts_port_output(Process *c_p,
from,
prt,
drv,
- evp);
+ &evp->driver);
if (force_immediate_call)
finalize_force_imm_drv_call(&try_call_state);
else
finalize_imm_drv_call(&try_call_state);
/* Fall through... */
case ERTS_TRY_IMM_DRV_CALL_INVALID_PORT:
- driver_free_binary(cbin);
- if (evp != &ev)
+ driver_free_binary(&cbin->driver);
+ if (evp != &ev) {
+ ASSERT(!sigdp);
erts_free(ERTS_ALC_T_TMP, evp);
+ }
if (try_call_res != ERTS_TRY_IMM_DRV_CALL_OK)
return ERTS_PORT_OP_DROPPED;
if (c_p)
@@ -2012,9 +1964,11 @@ erts_port_output(Process *c_p,
sched_flags = try_call_state.sched_flags;
if (async_nosuspend
&& (sched_flags & (busy_flgs|ERTS_PTS_FLG_EXIT))) {
- driver_free_binary(cbin);
- if (evp != &ev)
+ driver_free_binary(&cbin->driver);
+ if (evp != &ev) {
+ ASSERT(!sigdp);
erts_free(ERTS_ALC_T_TMP, evp);
+ }
return ((sched_flags & ERTS_PTS_FLG_EXIT)
? ERTS_PORT_OP_DROPPED
: ERTS_PORT_OP_BUSY);
@@ -2025,26 +1979,33 @@ erts_port_output(Process *c_p,
}
/* Need to increase refc on all binaries */
- for (i = 1; i < evp->vsize; i++)
+ for (i = 1; i < evp->driver.vsize; i++)
if (bvp[i])
- driver_binary_inc_refc(bvp[i]);
+ driver_binary_inc_refc(&bvp[i]->driver);
- new_evp = erts_alloc(ERTS_ALC_T_DRV_CMD_DATA, alloc_size);
+ /* The port task and iovec is allocated in the
+ same structure as an optimization. This
+ is especially important in erts_port_output_async
+ of when !try_call */
+ ASSERT(sigdp == NULL);
+ sigdp = erts_port_task_alloc_p2p_sig_data_extra(
+ alloc_size, (void**)&new_evp);
if (evp != &ev) {
+ /* Copy from TMP alloc to port task */
sys_memcpy((void *) new_evp, (void *) evp, alloc_size);
- new_evp->iov = (SysIOVec *) (((char *) new_evp)
- + iov_offset);
- bvp = new_evp->binv = (ErlDrvBinary **) (((char *) new_evp)
- + binv_offset);
+ new_evp->driver.iov = (SysIOVec *) (((char *) new_evp)
+ + iov_offset);
+ bvp = new_evp->common.binv = (ErtsIOQBinary **) (((char *) new_evp)
+ + binv_offset);
#ifdef DEBUG
- ASSERT(new_evp->vsize == evp->vsize);
- ASSERT(new_evp->size == evp->size);
- for (i = 0; i < evp->vsize; i++) {
- ASSERT(new_evp->iov[i].iov_len == evp->iov[i].iov_len);
- ASSERT(new_evp->iov[i].iov_base == evp->iov[i].iov_base);
- ASSERT(new_evp->binv[i] == evp->binv[i]);
+ ASSERT(new_evp->driver.vsize == evp->driver.vsize);
+ ASSERT(new_evp->driver.size == evp->driver.size);
+ for (i = 0; i < evp->driver.vsize; i++) {
+ ASSERT(new_evp->driver.iov[i].iov_len == evp->driver.iov[i].iov_len);
+ ASSERT(new_evp->driver.iov[i].iov_base == evp->driver.iov[i].iov_base);
+ ASSERT(new_evp->driver.binv[i] == evp->driver.binv[i]);
}
#endif
@@ -2053,24 +2014,24 @@ erts_port_output(Process *c_p,
else { /* from stack allocated structure; offsets may differ */
sys_memcpy((void *) new_evp, (void *) evp, sizeof(ErlIOVec));
- new_evp->iov = (SysIOVec *) (((char *) new_evp)
- + iov_offset);
- sys_memcpy((void *) new_evp->iov,
- (void *) evp->iov,
- evp->vsize * sizeof(SysIOVec));
- new_evp->binv = (ErlDrvBinary **) (((char *) new_evp)
- + binv_offset);
- sys_memcpy((void *) new_evp->binv,
- (void *) evp->binv,
- evp->vsize * sizeof(ErlDrvBinary *));
+ new_evp->driver.iov = (SysIOVec *) (((char *) new_evp)
+ + iov_offset);
+ sys_memcpy((void *) new_evp->driver.iov,
+ (void *) evp->driver.iov,
+ evp->driver.vsize * sizeof(SysIOVec));
+ new_evp->common.binv = (ErtsIOQBinary **) (((char *) new_evp)
+ + binv_offset);
+ sys_memcpy((void *) new_evp->common.binv,
+ (void *) evp->common.binv,
+ evp->driver.vsize * sizeof(ErtsIOQBinary *));
#ifdef DEBUG
- ASSERT(new_evp->vsize == evp->vsize);
- ASSERT(new_evp->size == evp->size);
- for (i = 0; i < evp->vsize; i++) {
- ASSERT(new_evp->iov[i].iov_len == evp->iov[i].iov_len);
- ASSERT(new_evp->iov[i].iov_base == evp->iov[i].iov_base);
- ASSERT(new_evp->binv[i] == evp->binv[i]);
+ ASSERT(new_evp->driver.vsize == evp->driver.vsize);
+ ASSERT(new_evp->driver.size == evp->driver.size);
+ for (i = 0; i < evp->driver.vsize; i++) {
+ ASSERT(new_evp->driver.iov[i].iov_len == evp->driver.iov[i].iov_len);
+ ASSERT(new_evp->driver.iov[i].iov_base == evp->driver.iov[i].iov_base);
+ ASSERT(new_evp->driver.binv[i] == evp->driver.binv[i]);
}
#endif
@@ -2079,11 +2040,10 @@ erts_port_output(Process *c_p,
evp = new_evp;
}
- sigdp = erts_port_task_alloc_p2p_sig_data();
sigdp->flags = ERTS_P2P_SIG_TYPE_OUTPUTV;
sigdp->u.outputv.from = from;
- sigdp->u.outputv.evp = evp;
- sigdp->u.outputv.cbinp = cbin;
+ sigdp->u.outputv.evp = &evp->driver;
+ sigdp->u.outputv.cbinp = &cbin->driver;
port_sig_callback = port_sig_outputv;
}
else {
@@ -2201,7 +2161,7 @@ erts_port_output(Process *c_p,
sigdp->flags &= ~ERTS_P2P_SIG_DATA_FLG_NOSUSPEND;
else if (async_nosuspend) {
ErtsSchedulerData *esdp = (c_p
- ? ERTS_PROC_GET_SCHDATA(c_p)
+ ? erts_proc_sched_data(c_p)
: erts_get_scheduler_data());
ASSERT(esdp);
ns_pthp = &esdp->nosuspend_port_task_handle;
@@ -2224,10 +2184,6 @@ erts_port_output(Process *c_p,
port_sig_callback);
if (res != ERTS_PORT_OP_SCHEDULED) {
- if (drv->outputv)
- cleanup_scheduled_outputv(evp, cbin);
- else
- cleanup_scheduled_output(buf);
return res;
}
@@ -2288,7 +2244,10 @@ call_deliver_port_exit(int bang_op,
return ERTS_PORT_OP_DROPPED;
}
- if (!erts_deliver_port_exit(prt, from, reason, bang_op))
+ if (IS_TRACED_FL(prt, F_TRACE_RECEIVE))
+ trace_port_receive(prt, from, am_close);
+
+ if (!erts_deliver_port_exit(prt, from, reason, bang_op, broken_link))
return ERTS_PORT_OP_DROPPED;
#ifdef USE_VM_PROBES
@@ -2325,7 +2284,7 @@ port_sig_exit(Port *prt,
if (sigdp->u.exit.bp)
free_message_buffer(sigdp->u.exit.bp);
if (sigdp->flags & ERTS_P2P_SIG_DATA_FLG_REPLY)
- port_sched_op_reply(sigdp->caller, sigdp->ref, msg);
+ port_sched_op_reply(sigdp->caller, sigdp->ref, msg, prt);
return ERTS_PORT_REDS_EXIT;
}
@@ -2347,6 +2306,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,
@@ -2354,13 +2318,13 @@ erts_port_exit(Process *c_p,
ERTS_PORT_SFLGS_INVALID_LOOKUP,
0,
!refp,
- am_exit);
+ am_close);
switch (try_imm_drv_call(&try_call_state)) {
case ERTS_TRY_IMM_DRV_CALL_OK: {
res = call_deliver_port_exit(flags & ERTS_PORT_SIG_FLG_BANG_OP,
- from,
+ c_p ? c_p->common.id : from,
prt,
try_call_state.state,
reason,
@@ -2398,21 +2362,14 @@ erts_port_exit(Process *c_p,
&bp->off_heap);
}
- res = erts_schedule_proc2port_signal(c_p,
- prt,
- c_p ? c_p->common.id : from,
- refp,
- sigdp,
- 0,
- NULL,
- port_sig_exit);
-
- if (res == ERTS_PORT_OP_DROPPED) {
- if (bp)
- free_message_buffer(bp);
- }
-
- return res;
+ return erts_schedule_proc2port_signal(c_p,
+ prt,
+ c_p ? c_p->common.id : from,
+ refp,
+ sigdp,
+ 0,
+ NULL,
+ port_sig_exit);
}
static ErtsPortOpResult
@@ -2439,8 +2396,11 @@ set_port_connected(int bang_op,
return ERTS_PORT_OP_DROPPED;
}
+ if (IS_TRACED_FL(prt, F_TRACE_RECEIVE))
+ trace_port_receive(prt, from, am_connect, connect);
+
ERTS_PORT_SET_CONNECTED(prt, connect);
- deliver_result(prt->common.id, from, am_connected);
+ deliver_result(prt, prt->common.id, from, am_connected);
#ifdef USE_VM_PROBES
if(DTRACE_ENABLED(port_command)) {
@@ -2462,10 +2422,22 @@ set_port_connected(int bang_op,
erts_add_link(&ERTS_P_LINKS(rp), LINK_PID, prt->common.id);
erts_add_link(&ERTS_P_LINKS(prt), LINK_PID, connect);
+ if (IS_TRACED_FL(rp, F_TRACE_PROCS))
+ trace_proc(NULL, 0, rp, am_getting_linked, prt->common.id);
+
ERTS_PORT_SET_CONNECTED(prt, connect);
erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
+ if (IS_TRACED_FL(prt, F_TRACE_PORTS))
+ trace_port(prt, am_getting_linked, connect);
+ if (IS_TRACED_FL(prt, F_TRACE_RECEIVE))
+ trace_port_receive(prt, from, am_connect, connect);
+ if (IS_TRACED_FL(prt, F_TRACE_SEND)) {
+ Eterm hp[3];
+ trace_port_send(prt, from, TUPLE2(hp, prt->common.id, am_connected), 1);
+ }
+
#ifdef USE_VM_PROBES
if (DTRACE_ENABLED(port_connect)) {
DTRACE_CHARBUF(process_str, DTRACE_TERM_BUF_SIZE);
@@ -2498,7 +2470,7 @@ port_sig_connect(Port *prt, erts_aint32_t state, int op, ErtsProc2PortSigData *s
msg = am_true;
}
if (sigdp->flags & ERTS_P2P_SIG_DATA_FLG_REPLY)
- port_sched_op_reply(sigdp->caller, sigdp->ref, msg);
+ port_sched_op_reply(sigdp->caller, sigdp->ref, msg, prt);
return ERTS_PORT_REDS_CONNECT;
}
@@ -2568,8 +2540,11 @@ static void
port_unlink(Port *prt, Eterm from)
{
ErtsLink *lnk = erts_remove_link(&ERTS_P_LINKS(prt), from);
- if (lnk)
+ if (lnk) {
+ if (IS_TRACED_FL(prt, F_TRACE_PORTS))
+ trace_port(prt, am_getting_unlinked, from);
erts_destroy_link(lnk);
+ }
}
static int
@@ -2578,7 +2553,7 @@ port_sig_unlink(Port *prt, erts_aint32_t state, int op, ErtsProc2PortSigData *si
if (op == ERTS_PROC2PORT_SIG_EXEC)
port_unlink(prt, sigdp->u.unlink.from);
if (sigdp->flags & ERTS_P2P_SIG_DATA_FLG_REPLY)
- port_sched_op_reply(sigdp->caller, sigdp->ref, am_true);
+ port_sched_op_reply(sigdp->caller, sigdp->ref, am_true, prt);
return ERTS_PORT_REDS_UNLINK;
}
@@ -2639,10 +2614,10 @@ port_link_failure(Eterm port_id, Eterm linker)
NIL,
NULL,
0);
- if (xres >= 0 && IS_TRACED_FL(rp, F_TRACE_PROCS)) {
+ if (xres >= 0) {
/* We didn't exit the process and it is traced */
if (IS_TRACED_FL(rp, F_TRACE_PROCS))
- trace_proc(NULL, rp, am_getting_unlinked, port_id);
+ trace_proc(NULL, 0, rp, am_getting_unlinked, port_id);
}
if (rp_locks)
erts_smp_proc_unlock(rp, rp_locks);
@@ -2653,10 +2628,15 @@ port_link_failure(Eterm port_id, Eterm linker)
static void
port_link(Port *prt, erts_aint32_t state, Eterm to)
{
- if (!(state & ERTS_PORT_SFLGS_INVALID_LOOKUP))
+ if (IS_TRACED_FL(prt, F_TRACE_PORTS))
+ trace_port(prt, am_getting_linked, to);
+ if (!(state & ERTS_PORT_SFLGS_INVALID_LOOKUP)) {
erts_add_link(&ERTS_P_LINKS(prt), LINK_PID, to);
- else
+ } else {
port_link_failure(prt->common.id, to);
+ if (IS_TRACED_FL(prt, F_TRACE_PORTS))
+ trace_port(prt, am_unlink, to);
+ }
}
static int
@@ -2664,10 +2644,11 @@ port_sig_link(Port *prt, erts_aint32_t state, int op, ErtsProc2PortSigData *sigd
{
if (op == ERTS_PROC2PORT_SIG_EXEC)
port_link(prt, state, sigdp->u.link.to);
- else
+ else {
port_link_failure(sigdp->u.link.port, sigdp->u.link.to);
+ }
if (sigdp->flags & ERTS_P2P_SIG_DATA_FLG_REPLY)
- port_sched_op_reply(sigdp->caller, sigdp->ref, am_true);
+ port_sched_op_reply(sigdp->caller, sigdp->ref, am_true, prt);
return ERTS_PORT_REDS_LINK;
}
@@ -2711,6 +2692,317 @@ erts_port_link(Process *c_p, Port *prt, Eterm to, Eterm *refp)
port_sig_link);
}
+static void
+port_monitor_failure(Eterm port_id, Eterm origin, Eterm ref_DOWN)
+{
+ Process *origin_p;
+ ErtsProcLocks p_locks = ERTS_PROC_LOCK_LINK;
+ ASSERT(is_internal_pid(origin));
+
+ origin_p = erts_pid2proc(NULL, 0, origin, p_locks);
+ if (! origin_p) { return; }
+
+ /* Send the DOWN message immediately. Ref is made on the fly because
+ * caller has never seen it yet. */
+ erts_queue_monitor_message(origin_p, &p_locks, ref_DOWN,
+ am_port, port_id, am_noproc);
+ erts_smp_proc_unlock(origin_p, p_locks);
+}
+
+/* Origin wants to monitor port Prt. State contains possible error, which has
+ * happened just before. Name is either NIL or an atom, if user monitors
+ * a port by name. Ref is premade reference that will be returned to user */
+static void
+port_monitor(Port *prt, erts_aint32_t state, Eterm origin,
+ Eterm name, Eterm ref)
+{
+ Eterm name_or_nil = is_atom(name) ? name : NIL;
+
+ ASSERT(is_pid(origin));
+ ASSERT(is_atom(name) || is_port(name) || name == NIL);
+ ASSERT(is_internal_ordinary_ref(ref));
+
+ if (!(state & ERTS_PORT_SFLGS_INVALID_LOOKUP)) {
+ ErtsProcLocks p_locks = ERTS_PROC_LOCK_LINK;
+
+ Process *origin_p = erts_pid2proc(NULL, 0, origin, p_locks);
+ if (! origin_p) {
+ goto failure;
+ }
+ erts_add_monitor(&ERTS_P_MONITORS(origin_p), MON_ORIGIN, ref,
+ prt->common.id, name_or_nil);
+ erts_add_monitor(&ERTS_P_MONITORS(prt), MON_TARGET, ref,
+ origin, name_or_nil);
+
+ erts_smp_proc_unlock(origin_p, p_locks);
+ } else {
+failure:
+ port_monitor_failure(prt->common.id, origin, ref);
+ }
+}
+
+static int
+port_sig_monitor(Port *prt, erts_aint32_t state, int op,
+ ErtsProc2PortSigData *sigdp)
+{
+ Eterm hp[ERTS_REF_THING_SIZE];
+ Eterm ref = make_internal_ref(&hp);
+ write_ref_thing(hp, sigdp->ref[0], sigdp->ref[1], sigdp->ref[2]);
+
+ if (op == ERTS_PROC2PORT_SIG_EXEC) {
+ /* erts_add_monitor call inside port_monitor will copy ref from hp */
+ port_monitor(prt, state,
+ sigdp->u.monitor.origin,
+ sigdp->u.monitor.name,
+ ref);
+ } else {
+ port_monitor_failure(sigdp->u.monitor.name,
+ sigdp->u.monitor.origin,
+ ref);
+ }
+ if (sigdp->flags & ERTS_P2P_SIG_DATA_FLG_REPLY) {
+ port_sched_op_reply(sigdp->caller, sigdp->ref, am_true, prt);
+ }
+ return ERTS_PORT_REDS_MONITOR;
+}
+
+/* Creates monitor between Origin and Target. Ref must be initialized to
+ * a reference (ref may be rewritten to be used to serve additionally as a
+ * signal id). Name is atom if user monitors port by name or NIL */
+ErtsPortOpResult
+erts_port_monitor(Process *origin, Port *port, Eterm name, Eterm *refp)
+{
+ ErtsProc2PortSigData *sigdp;
+ ErtsTryImmDrvCallState try_call_state
+ = ERTS_INIT_TRY_IMM_DRV_CALL_STATE(
+ origin, port, ERTS_PORT_SFLGS_INVALID_LOOKUP,
+ 0,
+ 0, /* trap_ref is always set so !trap_ref always is false */
+ am_monitor);
+
+ ASSERT(origin);
+ ASSERT(port);
+ ASSERT(is_atom(name) || is_port(name));
+ ASSERT(refp);
+
+ switch (try_imm_drv_call(&try_call_state)) {
+ case ERTS_TRY_IMM_DRV_CALL_OK:
+ port_monitor(port, try_call_state.state, origin->common.id, name, *refp);
+ finalize_imm_drv_call(&try_call_state);
+ BUMP_REDS(origin, ERTS_PORT_REDS_MONITOR);
+ return ERTS_PORT_OP_DONE;
+ case ERTS_TRY_IMM_DRV_CALL_INVALID_PORT:
+ return ERTS_PORT_OP_BADARG;
+ default:
+ break; /* Schedule call instead... */
+ }
+
+ sigdp = erts_port_task_alloc_p2p_sig_data();
+ sigdp->flags = ERTS_P2P_SIG_TYPE_MONITOR;
+ sigdp->u.monitor.origin = origin->common.id;
+ sigdp->u.monitor.name = name; /* either named monitor, or port id */
+
+ /* Ref contents will be initialized here */
+ return erts_schedule_proc2port_signal(origin, port, origin->common.id,
+ refp, sigdp, 0, NULL,
+ port_sig_monitor);
+}
+
+static void
+port_demonitor_failure(Eterm port_id, Eterm origin, Eterm ref)
+{
+ Process *origin_p;
+ ErtsProcLocks rp_locks = ERTS_PROC_LOCK_LINK;
+ ErtsMonitor *mon1;
+ ASSERT(is_internal_pid(origin));
+
+ origin_p = erts_pid2proc(NULL, 0, origin, rp_locks);
+ if (! origin_p) { return; }
+
+ /* do not send any DOWN messages, drop monitors on process */
+ mon1 = erts_remove_monitor(&ERTS_P_MONITORS(origin_p), ref);
+ if (mon1 != NULL) {
+ erts_destroy_monitor(mon1);
+ }
+
+ erts_smp_proc_unlock(origin_p, rp_locks);
+}
+
+/* Origin wants to demonitor port Prt. State contains possible error, which has
+ * happened just before. Ref is reference to monitor */
+static void
+port_demonitor(Port *port, erts_aint32_t state, Eterm origin, Eterm ref)
+{
+ ASSERT(port);
+ ASSERT(is_pid(origin));
+ ASSERT(is_internal_ref(ref));
+
+ if (!(state & ERTS_PORT_SFLGS_INVALID_LOOKUP)) {
+ ErtsProcLocks p_locks = ERTS_PROC_LOCK_LINK;
+ Process *origin_p = erts_pid2proc(NULL, 0, origin, p_locks);
+ if (origin_p) {
+ ErtsMonitor *mon1 = erts_remove_monitor(&ERTS_P_MONITORS(origin_p),
+ ref);
+ if (mon1 != NULL) {
+ erts_destroy_monitor(mon1);
+ }
+ }
+ if (1) {
+ ErtsMonitor *mon2 = erts_remove_monitor(&ERTS_P_MONITORS(port),
+ ref);
+ if (mon2 != NULL) {
+ erts_destroy_monitor(mon2);
+ }
+ }
+ if (origin_p) { /* when origin is dying, it won't be found */
+ erts_smp_proc_unlock(origin_p, p_locks);
+ }
+ } else {
+ port_demonitor_failure(port->common.id, origin, ref);
+ }
+}
+
+static int
+port_sig_demonitor(Port *prt, erts_aint32_t state, int op,
+ ErtsProc2PortSigData *sigdp)
+{
+ Eterm hp[ERTS_REF_THING_SIZE];
+ Eterm ref = make_internal_ref(&hp);
+ write_ref_thing(hp, sigdp->u.demonitor.ref[0],
+ sigdp->u.demonitor.ref[1],
+ sigdp->u.demonitor.ref[2]);
+ if (op == ERTS_PROC2PORT_SIG_EXEC) {
+ port_demonitor(prt, state, sigdp->u.demonitor.origin, ref);
+ } else {
+ port_demonitor_failure(sigdp->u.demonitor.name,
+ sigdp->u.demonitor.origin,
+ ref);
+ }
+ if (sigdp->flags & ERTS_P2P_SIG_DATA_FLG_REPLY) {
+ port_sched_op_reply(sigdp->caller, sigdp->ref, am_true, prt);
+ }
+ return ERTS_PORT_REDS_DEMONITOR;
+}
+
+/* Removes monitor between origin and target, identified by ref.
+ * Mode defines normal or relaxed demonitor rules (process is at death) */
+ErtsPortOpResult erts_port_demonitor(Process *origin, ErtsDemonitorMode mode,
+ Port *target, Eterm ref,
+ Eterm *trap_ref)
+{
+ Process *c_p = mode == ERTS_PORT_DEMONITOR_NORMAL ? origin : NULL;
+ ErtsProc2PortSigData *sigdp;
+ ErtsTryImmDrvCallState try_call_state
+ = ERTS_INIT_TRY_IMM_DRV_CALL_STATE(
+ c_p,
+ target, ERTS_PORT_SFLGS_INVALID_LOOKUP,
+ 0,
+ !trap_ref,
+ am_demonitor);
+
+ ASSERT(origin);
+ ASSERT(target);
+ ASSERT(is_internal_ref(ref));
+
+ switch (try_imm_drv_call(&try_call_state)) {
+ case ERTS_TRY_IMM_DRV_CALL_OK:
+ port_demonitor(target, try_call_state.state, origin->common.id, ref);
+ finalize_imm_drv_call(&try_call_state);
+ if (mode == ERTS_PORT_DEMONITOR_NORMAL) {
+ BUMP_REDS(origin, ERTS_PORT_REDS_DEMONITOR);
+ }
+ return ERTS_PORT_OP_DONE;
+ case ERTS_TRY_IMM_DRV_CALL_INVALID_PORT:
+ return ERTS_PORT_OP_BADARG;
+ default:
+ break; /* Schedule call instead... */
+ }
+
+ sigdp = erts_port_task_alloc_p2p_sig_data();
+ sigdp->flags = ERTS_P2P_SIG_TYPE_DEMONITOR;
+ sigdp->u.demonitor.origin = origin->common.id;
+ sigdp->u.demonitor.name = target->common.id;
+ {
+ Uint32 *nums = internal_ref_numbers(ref);
+ /* Start from 1 skip ref arity */
+ sys_memcpy(sigdp->u.demonitor.ref,
+ nums,
+ sizeof(sigdp->u.demonitor.ref));
+ }
+
+ /* Ref contents will be initialized here */
+ return erts_schedule_proc2port_signal(c_p, target, origin->common.id,
+ trap_ref, sigdp, 0, NULL,
+ port_sig_demonitor);
+}
+
+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,
+ port);
+
+ 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)
@@ -2721,6 +3013,9 @@ void erts_init_io(int port_tab_size,
drv_list_rwmtx_opts.type = ERTS_SMP_RWMTX_TYPE_EXTREMELY_FREQUENT_READ;
drv_list_rwmtx_opts.lived = ERTS_SMP_RWMTX_LONG_LIVED;
+ erts_atomic64_init_nob(&bytes_in, 0);
+ erts_atomic64_init_nob(&bytes_out, 0);
+
common_element_size = ERTS_ALC_DATA_ALIGN_SIZE(sizeof(Port));
common_element_size += ERTS_ALC_DATA_ALIGN_SIZE(sizeof(ErtsPortTaskBusyPortQ));
common_element_size += 10; /* name */
@@ -2743,9 +3038,8 @@ void erts_init_io(int port_tab_size,
else if (port_tab_size < ERTS_MIN_PORTS)
port_tab_size = ERTS_MIN_PORTS;
- erts_smp_rwmtx_init_opt(&erts_driver_list_lock,
- &drv_list_rwmtx_opts,
- "driver_list");
+ erts_smp_rwmtx_init_opt(&erts_driver_list_lock, &drv_list_rwmtx_opts, "driver_list", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_IO);
driver_list = NULL;
erts_smp_tsd_key_create(&driver_list_lock_status_key,
"erts_driver_list_lock_status_key");
@@ -2757,12 +3051,10 @@ void erts_init_io(int port_tab_size,
NULL,
(ErtsPTabElementCommon *) &erts_invalid_port.common,
port_tab_size,
- common_element_size, /* Doesn't need to be excact */
+ common_element_size, /* Doesn't need to be exact */
"port_table",
- legacy_port_tab);
-
- erts_smp_atomic_init_nob(&erts_bytes_out, 0);
- erts_smp_atomic_init_nob(&erts_bytes_in, 0);
+ legacy_port_tab,
+ 1);
sys_init_io();
@@ -2770,10 +3062,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);
@@ -2783,65 +3076,95 @@ void erts_init_io(int port_tab_size,
}
#if defined(ERTS_ENABLE_LOCK_COUNT) && defined(ERTS_SMP)
-
-static ERTS_INLINE void lcnt_enable_drv_lock_count(erts_driver_t *dp, int enable)
+static void lcnt_enable_driver_lock_count(erts_driver_t *dp, int enable)
{
if (dp->lock) {
- if (enable)
- erts_lcnt_init_lock_x(&dp->lock->lcnt,
- "driver_lock",
- ERTS_LCNT_LT_MUTEX,
- erts_atom_put((byte*)dp->name,
- sys_strlen(dp->name),
- ERTS_ATOM_ENC_LATIN1,
- 1));
-
- else
- erts_lcnt_destroy_lock(&dp->lock->lcnt);
-
+ if (enable) {
+ Eterm name_as_atom = erts_atom_put((byte*)dp->name, sys_strlen(dp->name),
+ ERTS_ATOM_ENC_LATIN1, 1);
+
+ erts_lcnt_install_new_lock_info(&dp->lock->lcnt, "driver_lock", name_as_atom,
+ ERTS_LOCK_TYPE_MUTEX | ERTS_LOCK_FLAGS_CATEGORY_IO);
+ } else {
+ erts_lcnt_uninstall(&dp->lock->lcnt);
+ }
}
}
-static ERTS_INLINE void lcnt_enable_port_lock_count(Port *prt, int enable)
+static void lcnt_enable_port_lock_count(Port *prt, int enable)
{
erts_aint32_t state = erts_atomic32_read_nob(&prt->state);
- if (!enable) {
- erts_lcnt_destroy_lock(&prt->sched.mtx.lcnt);
- if (state & ERTS_PORT_SFLG_PORT_SPECIFIC_LOCK)
- erts_lcnt_destroy_lock(&prt->lock->lcnt);
- }
- else {
- erts_lcnt_init_lock_x(&prt->sched.mtx.lcnt,
- "port_sched_lock",
- ERTS_LCNT_LT_MUTEX,
- prt->common.id);
- if (state & ERTS_PORT_SFLG_PORT_SPECIFIC_LOCK)
- erts_lcnt_init_lock_x(&prt->lock->lcnt,
- "port_lock",
- ERTS_LCNT_LT_MUTEX,
- prt->common.id);
+
+ if(enable) {
+ ErlDrvPDL pdl = prt->port_data_lock;
+
+ erts_lcnt_install_new_lock_info(&prt->sched.mtx.lcnt, "port_sched_lock",
+ prt->common.id, ERTS_LOCK_TYPE_MUTEX | ERTS_LOCK_FLAGS_CATEGORY_IO);
+
+ if(pdl) {
+ erts_lcnt_install_new_lock_info(&pdl->mtx.lcnt, "port_data_lock",
+ prt->common.id, ERTS_LOCK_TYPE_MUTEX | ERTS_LOCK_FLAGS_CATEGORY_IO);
+ }
+
+ if(state & ERTS_PORT_SFLG_PORT_SPECIFIC_LOCK) {
+ erts_lcnt_install_new_lock_info(&prt->lock->lcnt, "port_lock",
+ prt->common.id, ERTS_LOCK_TYPE_MUTEX | ERTS_LOCK_FLAGS_CATEGORY_IO);
+ }
+ } else {
+ erts_lcnt_uninstall(&prt->sched.mtx.lcnt);
+
+ if(prt->port_data_lock) {
+ erts_lcnt_uninstall(&prt->port_data_lock->mtx.lcnt);
+ }
+
+ if(state & ERTS_PORT_SFLG_PORT_SPECIFIC_LOCK) {
+ erts_lcnt_uninstall(&prt->lock->lcnt);
+ }
}
}
-void erts_lcnt_enable_io_lock_count(int enable)
-{
- erts_driver_t *dp;
- int i, max = erts_ptab_max(&erts_port);
+void erts_lcnt_update_driver_locks(int enable) {
+ erts_driver_t *driver;
- for (i = 0; i < max; i++) {
- Port *prt = erts_pix2port(i);
- if (prt)
- lcnt_enable_port_lock_count(prt, enable);
+ lcnt_enable_driver_lock_count(&vanilla_driver, enable);
+ lcnt_enable_driver_lock_count(&spawn_driver, enable);
+#ifndef __WIN32__
+ lcnt_enable_driver_lock_count(&forker_driver, enable);
+#endif
+ lcnt_enable_driver_lock_count(&fd_driver, enable);
+
+ erts_rwmtx_rlock(&erts_driver_list_lock);
+
+ for (driver = driver_list; driver; driver = driver->next) {
+ lcnt_enable_driver_lock_count(driver, enable);
}
- lcnt_enable_drv_lock_count(&vanilla_driver, enable);
- lcnt_enable_drv_lock_count(&spawn_driver, enable);
- lcnt_enable_drv_lock_count(&fd_driver, enable);
- for (dp = driver_list; dp; dp = dp->next)
- lcnt_enable_drv_lock_count(dp, enable);
+ erts_rwmtx_runlock(&erts_driver_list_lock);
}
-#endif
+void erts_lcnt_update_port_locks(int enable) {
+ int i, max;
+
+ max = erts_ptab_max(&erts_port);
+
+ for(i = 0; i < max; i++) {
+ int delay_handle;
+ Port *port;
+
+ delay_handle = erts_thr_progress_unmanaged_delay();
+ port = erts_pix2port(i);
+
+ if(port != NULL) {
+ lcnt_enable_port_lock_count(port, enable);
+ }
+
+ if(delay_handle != ERTS_THR_PRGR_DHANDLE_MANAGED) {
+ erts_thr_progress_unmanaged_continue(delay_handle);
+ }
+ }
+}
+
+#endif /* defined(ERTS_ENABLE_LOCK_COUNT) && defined(ERTS_SMP) */
/*
* Buffering of data when using line oriented I/O on ports
*/
@@ -3014,7 +3337,7 @@ static int read_linebuf(LineBufContext *bp)
}
static void
-deliver_result(Eterm sender, Eterm pid, Eterm res)
+deliver_result(Port *prt, Eterm sender, Eterm pid, Eterm res)
{
Process *rp;
ErtsProcLocks rp_locks = 0;
@@ -3022,33 +3345,40 @@ deliver_result(Eterm sender, Eterm pid, Eterm res)
ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ASSERT(!prt || prt->common.id == sender);
+#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
+ ASSERT(!prt || erts_lc_is_port_locked(prt));
+#endif
+
ASSERT(is_internal_port(sender) && is_internal_pid(pid));
rp = (scheduler
? erts_proc_lookup(pid)
- : erts_pid2proc_opt(NULL, 0, pid, 0, ERTS_P2P_FLG_SMP_INC_REFC));
+ : erts_pid2proc_opt(NULL, 0, pid, 0, ERTS_P2P_FLG_INC_REFC));
+
+ if (prt && IS_TRACED_FL(prt, F_TRACE_SEND)) {
+ Eterm hp[3];
+ trace_port_send(prt, pid, TUPLE2(hp, sender, res), !!rp);
+ }
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
-#ifdef USE_VM_PROBES
- , NIL
-#endif
- );
+ erts_queue_message(rp, rp_locks, mp, tuple, sender);
if (rp_locks)
erts_smp_proc_unlock(rp, rp_locks);
if (!scheduler)
- erts_smp_proc_dec_refc(rp);
+ erts_proc_dec_refc(rp);
}
}
@@ -3071,10 +3401,11 @@ 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;
+ int trace_send = IS_TRACED_FL(prt, F_TRACE_SEND);
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
ERTS_SMP_CHK_NO_PROC_LOCKS;
@@ -3092,12 +3423,12 @@ static void deliver_read_message(Port* prt, erts_aint32_t state, Eterm to,
rp = (scheduler
? erts_proc_lookup(to)
- : erts_pid2proc_opt(NULL, 0, to, 0, ERTS_P2P_FLG_SMP_INC_REFC));
+ : erts_pid2proc_opt(NULL, 0, to, 0, ERTS_P2P_FLG_INC_REFC));
if (!rp)
return;
- hp = erts_alloc_message_heap(need, &bp, &ohp, rp, &rp_locks);
+ mp = erts_alloc_message_heap(trace_send ? NULL : rp, &rp_locks, need, &hp, &ohp);
listp = NIL;
if ((state & ERTS_PORT_SFLG_BINARY_IO) == 0) {
@@ -3107,9 +3438,6 @@ static void deliver_read_message(Port* prt, erts_aint32_t state, Eterm to,
Binary* bptr;
bptr = erts_bin_nrml_alloc(len);
- bptr->flags = 0;
- bptr->orig_size = len;
- erts_refc_init(&bptr->refc, 1);
sys_memcpy(bptr->orig_bytes, buf, len);
pb = (ProcBin *) hp;
@@ -3141,15 +3469,15 @@ 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
-#ifdef USE_VM_PROBES
- , NIL
-#endif
- );
+ if (trace_send)
+ trace_port_send(prt, to, tuple, 1);
+
+ ERL_MESSAGE_TOKEN(mp) = am_undefined;
+ erts_queue_message(rp, rp_locks, mp, tuple, prt->common.id);
if (rp_locks)
erts_smp_proc_unlock(rp, rp_locks);
if (!scheduler)
- erts_smp_proc_dec_refc(rp);
+ erts_proc_dec_refc(rp);
}
/*
@@ -3219,11 +3547,12 @@ 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;
erts_aint32_t state;
+ int trace_send = IS_TRACED_FL(prt, F_TRACE_SEND);
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
ERTS_SMP_CHK_NO_PROC_LOCKS;
@@ -3235,7 +3564,7 @@ deliver_vec_message(Port* prt, /* Port */
rp = (scheduler
? erts_proc_lookup(to)
- : erts_pid2proc_opt(NULL, 0, to, 0, ERTS_P2P_FLG_SMP_INC_REFC));
+ : erts_pid2proc_opt(NULL, 0, to, 0, ERTS_P2P_FLG_INC_REFC));
if (!rp)
return;
@@ -3251,7 +3580,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(trace_send ? NULL : rp, &rp_locks, need, &hp, &ohp);
listp = NIL;
iov += vsize;
@@ -3312,14 +3641,14 @@ 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
-#ifdef USE_VM_PROBES
- , NIL
-#endif
- );
+ if (IS_TRACED_FL(prt, F_TRACE_SEND))
+ trace_port_send(prt, to, tuple, 1);
+
+ ERL_MESSAGE_TOKEN(mp) = am_undefined;
+ erts_queue_message(rp, rp_locks, mp, tuple, prt->common.id);
erts_smp_proc_unlock(rp, rp_locks);
if (!scheduler)
- erts_smp_proc_dec_refc(rp);
+ erts_proc_dec_refc(rp);
}
@@ -3356,18 +3685,32 @@ 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)
DTRACE3(driver_flush, process_str, port_str, p->name);
}
#endif
+#ifdef USE_LTTNG_VM_TRACEPOINTS
+ if (LTTNG_ENABLED(driver_flush)) {
+ lttng_decl_portbuf(port_str);
+ lttng_decl_procbuf(proc_str);
+ lttng_pid_to_str(ERTS_PORT_GET_CONNECTED(p), proc_str);
+ lttng_port_to_str(p, port_str);
+ LTTNG3(driver_flush, proc_str, port_str, p->name);
+ }
+#endif
+
+
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);
}
@@ -3391,6 +3734,7 @@ terminate_port(Port *prt)
Eterm connected_id = NIL /* Initialize to silence compiler */;
erts_driver_t *drv;
erts_aint32_t state;
+ ErtsPrtSD *psd;
ERTS_SMP_CHK_NO_PROC_LOCKS;
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
@@ -3409,29 +3753,43 @@ terminate_port(Port *prt)
send_closed_port_id = NIL;
}
-#ifdef ERTS_SMP
- erts_cancel_smp_ptimer(prt->common.u.alive.ptimer);
-#else
- erts_cancel_timer(&prt->common.u.alive.tm);
-#endif
+ if (ERTS_PTMR_IS_SET(prt))
+ erts_cancel_port_timer(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)
DTRACE3(driver_stop, process_str, drv->name, port_str);
}
#endif
+#ifdef USE_LTTNG_VM_TRACEPOINTS
+ if (LTTNG_ENABLED(driver_stop)) {
+ lttng_decl_portbuf(port_str);
+ lttng_decl_procbuf(proc_str);
+ lttng_pid_to_str(connected_id, proc_str);
+ lttng_port_to_str(prt, port_str);
+ LTTNG3(driver_stop, proc_str, port_str, drv->name);
+ }
+#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);
ASSERT(!prt->xports);
#endif
}
+
+ if (is_internal_port(send_closed_port_id)
+ && IS_TRACED_FL(prt, F_TRACE_SEND))
+ trace_port_send(prt, connected_id, am_closed, 1);
+
if(drv->handle != NULL) {
erts_smp_rwmtx_rlock(&erts_driver_list_lock);
erts_ddll_decrement_port_count(drv->handle);
@@ -3445,8 +3803,9 @@ terminate_port(Port *prt)
erts_cleanup_port_data(prt);
- if (prt->psd)
- erts_free(ERTS_ALC_T_PRTSD, prt->psd);
+ psd = (ErtsPrtSD *) erts_smp_atomic_read_nob(&prt->psd);
+ if (psd)
+ erts_free(ERTS_ALC_T_PRTSD, psd);
ASSERT(prt->dist_entry == NULL);
@@ -3459,10 +3818,10 @@ 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);
+ deliver_result(NULL, send_closed_port_id, connected_id, am_closed);
}
void
@@ -3471,23 +3830,30 @@ erts_terminate_port(Port *pp)
terminate_port(pp);
}
+static void port_fire_one_monitor(ErtsMonitor *mon, void *ctx0);
static void sweep_one_monitor(ErtsMonitor *mon, void *vpsc)
{
- ErtsMonitor *rmon;
- Process *rp;
+ switch (mon->type) {
+ case MON_ORIGIN: {
+ ErtsMonitor *rmon;
+ Process *rp;
- ASSERT(mon->type == MON_ORIGIN);
- ASSERT(is_internal_pid(mon->pid));
- rp = erts_pid2proc(NULL, 0, mon->pid, ERTS_PROC_LOCK_LINK);
- if (!rp) {
- goto done;
- }
- rmon = erts_remove_monitor(&ERTS_P_MONITORS(rp), mon->ref);
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
- if (rmon == NULL) {
- goto done;
+ ASSERT(is_internal_pid(mon->u.pid));
+ rp = erts_pid2proc(NULL, 0, mon->u.pid, ERTS_PROC_LOCK_LINK);
+ if (!rp) {
+ goto done;
+ }
+ rmon = erts_remove_monitor(&ERTS_P_MONITORS(rp), mon->ref);
+ erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
+ if (rmon == NULL) {
+ goto done;
+ }
+ erts_destroy_monitor(rmon);
+ } break;
+ case MON_TARGET: {
+ port_fire_one_monitor(mon, vpsc); /* forward call */
+ } break;
}
- erts_destroy_monitor(rmon);
done:
erts_destroy_monitor(mon);
}
@@ -3495,7 +3861,7 @@ static void sweep_one_monitor(ErtsMonitor *mon, void *vpsc)
typedef struct {
- Eterm port;
+ Port *port;
Eterm reason;
} SweepContext;
@@ -3504,10 +3870,13 @@ static void sweep_one_link(ErtsLink *lnk, void *vpsc)
SweepContext *psc = vpsc;
DistEntry *dep;
Process *rp;
-
+ Eterm port_id = psc->port->common.id;
ASSERT(lnk->type == LINK_PID);
-
+
+ if (IS_TRACED_FL(psc->port, F_TRACE_PORTS))
+ trace_port(psc->port, am_unlink, lnk->pid);
+
if (is_external_pid(lnk->pid)) {
dep = external_pid_dist_entry(lnk->pid);
if(dep != erts_this_dist_entry) {
@@ -3520,9 +3889,9 @@ static void sweep_one_link(ErtsLink *lnk, void *vpsc)
case ERTS_DSIG_PREP_NOT_CONNECTED:
break;
case ERTS_DSIG_PREP_CONNECTED:
- erts_remove_dist_link(&dld, psc->port, lnk->pid, dep);
+ erts_remove_dist_link(&dld, port_id, lnk->pid, dep);
erts_destroy_dist_link(&dld);
- code = erts_dsig_send_exit(&dsd, psc->port, lnk->pid,
+ code = erts_dsig_send_exit(&dsd, port_id, lnk->pid,
psc->reason);
ASSERT(code == ERTS_DSIG_SEND_OK);
break;
@@ -3536,23 +3905,25 @@ static void sweep_one_link(ErtsLink *lnk, void *vpsc)
ASSERT(is_internal_pid(lnk->pid));
rp = erts_pid2proc(NULL, 0, lnk->pid, rp_locks);
if (rp) {
- ErtsLink *rlnk = erts_remove_link(&ERTS_P_LINKS(rp), psc->port);
+ ErtsLink *rlnk = erts_remove_link(&ERTS_P_LINKS(rp), port_id);
if (rlnk) {
int xres = erts_send_exit_signal(NULL,
- psc->port,
+ port_id,
rp,
&rp_locks,
psc->reason,
NIL,
NULL,
0);
- if (xres >= 0 && IS_TRACED_FL(rp, F_TRACE_PROCS)) {
+ if (xres >= 0) {
+ if (rp_locks & ERTS_PROC_LOCKS_XSIG_SEND) {
+ erts_smp_proc_unlock(rp, ERTS_PROC_LOCKS_XSIG_SEND);
+ rp_locks &= ~ERTS_PROC_LOCKS_XSIG_SEND;
+ }
/* We didn't exit the process and it is traced */
- if (IS_TRACED_FL(rp, F_TRACE_PROCS)) {
- trace_proc(NULL, rp, am_getting_unlinked,
- psc->port);
- }
+ if (IS_TRACED_FL(rp, F_TRACE_PROCS))
+ trace_proc(NULL, 0, rp, am_getting_unlinked, port_id);
}
erts_destroy_link(rlnk);
}
@@ -3563,6 +3934,43 @@ static void sweep_one_link(ErtsLink *lnk, void *vpsc)
erts_destroy_link(lnk);
}
+static void
+port_fire_one_monitor(ErtsMonitor *mon, void *ctx0)
+{
+ Process *origin;
+ ErtsProcLocks origin_locks;
+
+ if (mon->type != MON_TARGET || ! is_pid(mon->u.pid)) {
+ return;
+ }
+ /*
+ * Proceed here if someone monitors us, we (port) are the target and
+ * origin is some process
+ */
+ origin_locks = ERTS_PROC_LOCKS_MSG_SEND | ERTS_PROC_LOCK_LINK;
+
+ origin = erts_pid2proc(NULL, 0, mon->u.pid, origin_locks);
+ if (origin) {
+ DeclareTmpHeapNoproc(lhp,3);
+ SweepContext *ctx = (SweepContext *)ctx0;
+ ErtsMonitor *rmon;
+ Eterm watched = (is_atom(mon->name)
+ ? TUPLE2(lhp, mon->name, erts_this_dist_entry->sysname)
+ : ctx->port->common.id);
+
+ erts_queue_monitor_message(origin, &origin_locks, mon->ref, am_port,
+ watched, ctx->reason);
+ UnUseTmpHeapNoproc(3);
+
+ rmon = erts_remove_monitor(&ERTS_P_MONITORS(origin), mon->ref);
+ erts_smp_proc_unlock(origin, origin_locks);
+
+ if (rmon) {
+ erts_destroy_monitor(rmon);
+ }
+ }
+}
+
/* 'from' is sending 'this_port' an exit signal, (this_port must be internal).
* If reason is normal we don't do anything, *unless* from is our connected
* process in which case we close the port. Any other reason kills the port.
@@ -3574,91 +3982,95 @@ static void sweep_one_link(ErtsLink *lnk, void *vpsc)
*/
int
-erts_deliver_port_exit(Port *p, Eterm from, Eterm reason, int send_closed)
+erts_deliver_port_exit(Port *prt, Eterm from, Eterm reason, int send_closed,
+ int drop_normal)
{
ErtsLink *lnk;
- Eterm rreason;
+ Eterm modified_reason;
erts_aint32_t state, set_state_flags;
ERTS_SMP_CHK_NO_PROC_LOCKS;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(p));
+ ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
- rreason = (reason == am_kill) ? am_killed : reason;
+ modified_reason = (reason == am_kill) ? am_killed : reason;
#ifdef USE_VM_PROBES
if (DTRACE_ENABLED(port_exit)) {
DTRACE_CHARBUF(from_str, DTRACE_TERM_BUF_SIZE);
DTRACE_CHARBUF(port_str, DTRACE_TERM_BUF_SIZE);
- DTRACE_CHARBUF(rreason_str, 64);
+ DTRACE_CHARBUF(reason_str, 64);
erts_snprintf(from_str, sizeof(DTRACE_CHARBUF_NAME(from_str)), "%T", from);
- dtrace_port_str(p, port_str);
- erts_snprintf(rreason_str, sizeof(DTRACE_CHARBUF_NAME(rreason_str)), "%T", rreason);
- DTRACE4(port_exit, from_str, port_str, p->name, rreason_str);
+ dtrace_port_str(prt, port_str);
+ erts_snprintf(reason_str, sizeof(DTRACE_CHARBUF_NAME(reason_str)), "%T",
+ modified_reason);
+ DTRACE4(port_exit, from_str, port_str, prt->name, reason_str);
}
#endif
- state = erts_atomic32_read_nob(&p->state);
+ state = erts_atomic32_read_nob(&prt->state);
if (state & (ERTS_PORT_SFLGS_DEAD
| ERTS_PORT_SFLG_EXITING
| ERTS_PORT_SFLG_CLOSING))
return 0;
- if (reason == am_normal && from != ERTS_PORT_GET_CONNECTED(p) && from != p->common.id)
+ if (reason == am_normal && from != ERTS_PORT_GET_CONNECTED(prt)
+ && from != prt->common.id && drop_normal) {
return 0;
+ }
set_state_flags = ERTS_PORT_SFLG_EXITING;
if (send_closed)
set_state_flags |= ERTS_PORT_SFLG_SEND_CLOSED;
- erts_port_task_sched_enter_exiting_state(&p->sched);
+ erts_port_task_sched_enter_exiting_state(&prt->sched);
- state = erts_atomic32_read_bor_mb(&p->state, set_state_flags);
+ state = erts_atomic32_read_bor_mb(&prt->state, set_state_flags);
state |= set_state_flags;
- if (IS_TRACED_FL(p, F_TRACE_PORTS)) {
- trace_port(p, am_closed, reason);
- }
+ if (IS_TRACED_FL(prt, F_TRACE_PORTS))
+ trace_port(prt, am_closed, reason);
- erts_trace_check_exiting(p->common.id);
+ erts_trace_check_exiting(prt->common.id);
- set_busy_port(ERTS_Port2ErlDrvPort(p), 0);
+ set_busy_port(ERTS_Port2ErlDrvPort(prt), 0);
- if (p->common.u.alive.reg != NULL)
- (void) erts_unregister_name(NULL, 0, p, p->common.u.alive.reg->name);
+ if (prt->common.u.alive.reg != NULL)
+ (void) erts_unregister_name(NULL, 0, prt, prt->common.u.alive.reg->name);
{
- SweepContext sc = {p->common.id, rreason};
- lnk = ERTS_P_LINKS(p);
- ERTS_P_LINKS(p) = NULL;
+ SweepContext sc = {prt, modified_reason};
+ lnk = ERTS_P_LINKS(prt);
+ ERTS_P_LINKS(prt) = NULL;
erts_sweep_links(lnk, &sweep_one_link, &sc);
}
- DRV_MONITOR_LOCK_PDL(p);
+ DRV_MONITOR_LOCK_PDL(prt);
{
- ErtsMonitor *moni = ERTS_P_MONITORS(p);
- ERTS_P_MONITORS(p) = NULL;
- erts_sweep_monitors(moni, &sweep_one_monitor, NULL);
+ SweepContext ctx = {prt, modified_reason};
+ ErtsMonitor *moni = ERTS_P_MONITORS(prt);
+ ERTS_P_MONITORS(prt) = NULL;
+ erts_sweep_monitors(moni, &sweep_one_monitor, &ctx);
}
- DRV_MONITOR_UNLOCK_PDL(p);
+ DRV_MONITOR_UNLOCK_PDL(prt);
- if ((state & ERTS_PORT_SFLG_DISTRIBUTION) && p->dist_entry) {
- erts_do_net_exits(p->dist_entry, rreason);
- erts_deref_dist_entry(p->dist_entry);
- p->dist_entry = NULL;
- erts_atomic32_read_band_relb(&p->state,
+ if ((state & ERTS_PORT_SFLG_DISTRIBUTION) && prt->dist_entry) {
+ erts_do_net_exits(prt->dist_entry, modified_reason);
+ erts_deref_dist_entry(prt->dist_entry);
+ prt->dist_entry = NULL;
+ erts_atomic32_read_band_relb(&prt->state,
~ERTS_PORT_SFLG_DISTRIBUTION);
}
- if ((reason != am_kill) && !is_port_ioq_empty(p)) {
+ if ((reason != am_kill) && !is_port_ioq_empty(prt)) {
/* must turn exiting flag off */
- erts_atomic32_read_bset_relb(&p->state,
+ erts_atomic32_read_bset_relb(&prt->state,
(ERTS_PORT_SFLG_EXITING
| ERTS_PORT_SFLG_CLOSING),
ERTS_PORT_SFLG_CLOSING);
- flush_port(p);
+ flush_port(prt);
}
else {
- terminate_port(p);
+ terminate_port(prt);
}
return 1;
@@ -3736,6 +4148,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;
@@ -3750,6 +4163,21 @@ call_driver_control(Eterm caller,
}
#endif
+ if (IS_TRACED_FL(prt, F_TRACE_RECEIVE))
+ trace_port_receive(prt, caller, am_control, command, bufp, size);
+
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT);
+
+#ifdef USE_LTTNG_VM_TRACEPOINTS
+ if (LTTNG_ENABLED(driver_control)) {
+ lttng_decl_procbuf(proc_str);
+ lttng_decl_portbuf(port_str);
+ lttng_pid_to_str(caller, proc_str);
+ lttng_port_to_str(prt, port_str);
+ LTTNG5(driver_control, proc_str, port_str, prt->name, command, size);
+ }
+#endif
+
prt->caller = caller;
cres = prt->drv_ptr->control((ErlDrvData) prt->drv_data,
command,
@@ -3759,9 +4187,14 @@ call_driver_control(Eterm caller,
*from_size);
prt->caller = NIL;
+ ERTS_MSACC_POP_STATE_M();
+
if (cres < 0)
return ERTS_PORT_OP_BADARG;
+ if (IS_TRACED_FL(prt, F_TRACE_SEND))
+ trace_port_send_binary(prt, caller, am_control, *resp_bufp, cres);
+
*from_size = (ErlDrvSizeT) cres;
return ERTS_PORT_OP_DONE;
@@ -3771,8 +4204,7 @@ static void
cleanup_scheduled_control(Binary *binp, char *bufp)
{
if (binp) {
- if (erts_refc_dectest(&binp->refc, 0) == 0)
- erts_bin_free(binp);
+ erts_bin_release(binp);
}
else {
if (bufp)
@@ -3810,7 +4242,6 @@ write_port_control_result(int control_flags,
ErlDrvSizeT resp_size,
char *pre_alloc_buf,
Eterm **hpp,
- ErlHeapFragment *bp,
ErlOffHeap *ohp)
{
Eterm res;
@@ -3884,48 +4315,40 @@ port_sig_control(Port *prt,
if (res == ERTS_PORT_OP_DONE) {
Eterm msg;
- Eterm *hp, *hp_start;
- ErlHeapFragment *bp;
- ErlOffHeap *ohp;
+ ErtsHeapFactory factory;
Process *rp;
ErtsProcLocks rp_locks = 0;
- Uint hsz;
+ 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;
control_flags = prt->control_flags;
- hsz = ERTS_QUEUE_PORT_SCHED_OP_REPLY_SIZE;
- hsz += port_control_result_size(control_flags,
+ rsz = port_control_result_size(control_flags,
resp_bufp,
&resp_size,
&resp_buf[0]);
+ hsz = rsz + ERTS_QUEUE_PORT_SCHED_OP_REPLY_SIZE;
+
- hp_start = hp = erts_alloc_message_heap(hsz,
- &bp,
- &ohp,
- rp,
- &rp_locks);
+ (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,
+ factory.off_heap);
queue_port_sched_op_reply(rp,
- &rp_locks,
- hp_start,
- hp,
- hsz,
- bp,
+ rp_locks,
+ &factory,
sigdp->ref,
- msg);
+ msg,
+ prt);
if (rp_locks)
erts_smp_proc_unlock(rp, rp_locks);
@@ -3935,7 +4358,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, prt);
done:
@@ -3945,6 +4369,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,
@@ -4041,6 +4482,9 @@ erts_port_control(Process* c_p,
size,
&resp_bufp,
&resp_size);
+
+ control_flags = prt->control_flags;
+
finalize_imm_drv_call(&try_call_state);
if (tmp_alloced)
erts_free(ERTS_ALC_T_TMP, bufp);
@@ -4048,8 +4492,6 @@ erts_port_control(Process* c_p,
return ERTS_PORT_OP_BADARG;
}
- control_flags = prt->control_flags;
-
hsz = port_control_result_size(control_flags,
resp_bufp,
&resp_size,
@@ -4060,7 +4502,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;
@@ -4082,18 +4523,32 @@ 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 {
- binp = ((ProcBin *) ebinp)->val;
+ ProcBin *pb = (ProcBin *) ebinp;
+ int offset = bufp - pb->val->orig_bytes;
+
+ ASSERT(pb->val->orig_bytes <= bufp
+ && bufp + size <= pb->val->orig_bytes + pb->val->orig_size);
+
+ if (pb->flags) {
+ erts_emasculate_writable_binary(pb);
+
+ /* The procbin may have been reallocated, so update bufp */
+ bufp = pb->val->orig_bytes + offset;
+ }
+
+ binp = pb->val;
ASSERT(bufp <= bufp + size);
ASSERT(binp->orig_bytes <= bufp
&& bufp + size <= binp->orig_bytes + binp->orig_size);
- erts_refc_inc(&binp->refc, 1);
+ erts_refc_inc(&binp->intern.refc, 1);
}
}
@@ -4120,10 +4575,9 @@ erts_port_control(Process* c_p,
0,
NULL,
port_sig_control);
- if (res != ERTS_PORT_OP_SCHEDULED) {
- cleanup_scheduled_control(binp, bufp);
+ if (res != ERTS_PORT_OP_SCHEDULED)
return ERTS_PORT_OP_BADARG;
- }
+
return res;
}
@@ -4138,6 +4592,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;
@@ -4152,6 +4607,20 @@ call_driver_call(Eterm caller,
DTRACE5(driver_call, process_str, port_str, prt->name, command, size);
}
#endif
+#ifdef USE_LTTNG_VM_TRACEPOINTS
+ if (LTTNG_ENABLED(driver_call)) {
+ lttng_decl_procbuf(proc_str);
+ lttng_decl_portbuf(port_str);
+ lttng_pid_to_str(caller,proc_str);
+ lttng_port_to_str(prt, port_str);
+ LTTNG5(driver_call, proc_str, port_str, prt->name, command, size);
+ }
+#endif
+
+ if (IS_TRACED_FL(prt, F_TRACE_RECEIVE))
+ trace_port_receive(prt, caller, am_call, command, bufp, size);
+
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT);
prt->caller = caller;
cres = prt->drv_ptr->call((ErlDrvData) prt->drv_data,
@@ -4163,10 +4632,15 @@ 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;
+ if (IS_TRACED_FL(prt, F_TRACE_SEND))
+ trace_port_send_binary(prt, caller, am_call, *resp_bufp, cres);
+
*from_size = (ErlDrvSizeT) cres;
return ERTS_PORT_OP_DONE;
@@ -4209,8 +4683,6 @@ port_sig_call(Port *prt,
if (res == ERTS_PORT_OP_DONE) {
Eterm msg;
Eterm *hp;
- ErlHeapFragment *bp;
- ErlOffHeap *ohp;
Process *rp;
ErtsProcLocks rp_locks = 0;
Sint hsz;
@@ -4221,45 +4693,39 @@ port_sig_call(Port *prt,
hsz = erts_decode_ext_size((byte *) resp_bufp, resp_size);
if (hsz >= 0) {
- Eterm *hp_start;
+ ErtsHeapFactory factory;
byte *endp;
hsz += 3; /* ok tuple */
hsz += ERTS_QUEUE_PORT_SCHED_OP_REPLY_SIZE;
- hp_start = 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;
- msg = erts_decode_ext(&hp, ohp, &endp);
+ msg = erts_decode_ext(&factory, &endp, 0);
if (is_value(msg)) {
+ hp = erts_produce_heap(&factory,
+ 3,
+ ERTS_QUEUE_PORT_SCHED_OP_REPLY_SIZE);
msg = TUPLE2(hp, am_ok, msg);
- hp += 3;
queue_port_sched_op_reply(rp,
- &rp_locks,
- hp_start,
- hp,
- hsz,
- bp,
+ rp_locks,
+ &factory,
sigdp->ref,
- msg);
+ msg,
+ prt);
if (rp_locks)
erts_smp_proc_unlock(rp, rp_locks);
goto done;
}
- if (bp)
- free_message_buffer(bp);
if (rp_locks)
erts_smp_proc_unlock(rp, rp_locks);
}
}
}
- port_sched_op_reply(sigdp->caller, sigdp->ref, am_badarg);
+ port_sched_op_reply(sigdp->caller, sigdp->ref, am_badarg, prt);
done:
@@ -4329,10 +4795,11 @@ erts_port_call(Process* c_p,
try_call_res = try_imm_drv_call(&try_call_state);
switch (try_call_res) {
case ERTS_TRY_IMM_DRV_CALL_OK: {
- Eterm *hp, *hp_end;
+ ErtsHeapFactory factory;
Sint hsz;
unsigned ret_flags = 0U;
Eterm term;
+ Eterm* hp;
res = call_driver_call(c_p->common.id,
prt,
@@ -4352,15 +4819,14 @@ erts_port_call(Process* c_p,
if (hsz < 0)
return ERTS_PORT_OP_BADARG;
hsz += 3;
- hp = HAlloc(c_p, hsz);
- hp_end = hp + hsz;
+ erts_factory_proc_prealloc_init(&factory, c_p, hsz);
endp = (byte *) resp_bufp;
- term = erts_decode_ext(&hp, &MSO(c_p), &endp);
+ term = erts_decode_ext(&factory, &endp, 0);
if (term == THE_NON_VALUE)
return ERTS_PORT_OP_BADARG;
+ hp = erts_produce_heap(&factory,3,0);
*retvalp = TUPLE2(hp, am_ok, term);
- hp += 3;
- HRelease(c_p, hp_end, hp);
+ erts_factory_close(&factory);
if (resp_bufp != &resp_buf[0]
&& !(ret_flags & DRIVER_CALL_KEEP_BUFFER))
driver_free(resp_bufp);
@@ -4401,10 +4867,9 @@ erts_port_call(Process* c_p,
0,
NULL,
port_sig_call);
- if (res != ERTS_PORT_OP_SCHEDULED) {
- cleanup_scheduled_call(bufp);
+ if (res != ERTS_PORT_OP_SCHEDULED)
return ERTS_PORT_OP_BADARG;
- }
+
return res;
}
@@ -4438,7 +4903,7 @@ make_port_info_term(Eterm **hpp_start,
int len;
int start;
static Eterm item[] = ERTS_PORT_INFO_1_ITEMS;
- static Eterm value[sizeof(item)/sizeof(item[0])];
+ Eterm value[sizeof(item)/sizeof(item[0])];
start = 0;
len = sizeof(item)/sizeof(item[0]);
@@ -4474,7 +4939,7 @@ port_sig_info(Port *prt,
{
ASSERT(sigdp->flags & ERTS_P2P_SIG_DATA_FLG_REPLY);
if (op != ERTS_PROC2PORT_SIG_EXEC)
- port_sched_op_reply(sigdp->caller, sigdp->ref, am_undefined);
+ port_sched_op_reply(sigdp->caller, sigdp->ref, am_undefined, prt);
else {
Eterm *hp, *hp_start;
Uint hsz;
@@ -4495,14 +4960,16 @@ port_sig_info(Port *prt,
prt,
sigdp->u.info.item);
if (is_value(value)) {
+ ErtsHeapFactory factory;
+ 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,
- hp_start,
- hp,
- hsz,
- bp,
+ rp_locks,
+ &factory,
sigdp->ref,
- value);
+ value,
+ prt);
}
if (rp_locks)
erts_smp_proc_unlock(rp, rp_locks);
@@ -4571,14 +5038,111 @@ erts_port_info(Process* c_p,
}
typedef struct {
- int to;
+ Uint sched_id;
+ Eterm pid;
+ Uint32 refn[ERTS_REF_NUMBERS];
+ erts_smp_atomic32_t refc;
+} ErtsIOBytesReq;
+
+static void
+reply_io_bytes(void *vreq)
+{
+ ErtsIOBytesReq *req = (ErtsIOBytesReq *) vreq;
+ Process *rp;
+
+ rp = erts_proc_lookup(req->pid);
+ if (rp) {
+ ErlOffHeap *ohp;
+ ErtsMessage *mp;
+ ErtsProcLocks rp_locks;
+ Eterm ref, msg, ein, eout, *hp;
+ Uint64 in, out;
+ Uint hsz;
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
+ Uint sched_id = esdp->no;
+ in = esdp->io.in;
+ out = esdp->io.out;
+ if (req->sched_id != sched_id)
+ rp_locks = 0;
+ else {
+ in += (Uint64) erts_atomic64_read_nob(&bytes_in);
+ out += (Uint64) erts_atomic64_read_nob(&bytes_out);
+ rp_locks = ERTS_PROC_LOCK_MAIN;
+ }
+
+ hsz = 5 /* 4-tuple */ + ERTS_REF_THING_SIZE;
+
+ erts_bld_uint64(NULL, &hsz, in);
+ erts_bld_uint64(NULL, &hsz, out);
+
+ 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]);
+ hp += ERTS_REF_THING_SIZE;
+
+ ein = erts_bld_uint64(&hp, NULL, in);
+ eout = erts_bld_uint64(&hp, NULL, out);
+
+ msg = TUPLE4(hp, ref, make_small(sched_id), ein, eout);
+
+ erts_queue_message(rp, rp_locks, mp, msg, am_system);
+
+ if (req->sched_id == sched_id)
+ rp_locks &= ~ERTS_PROC_LOCK_MAIN;
+ if (rp_locks)
+ erts_smp_proc_unlock(rp, rp_locks);
+ }
+
+ if (erts_smp_atomic32_dec_read_nob(&req->refc) == 0)
+ erts_free(ERTS_ALC_T_IOB_REQ, req);
+}
+
+Eterm
+erts_request_io_bytes(Process *c_p)
+{
+ Uint *hp;
+ Eterm ref;
+ Uint32 *refn;
+ ErtsSchedulerData *esdp = erts_proc_sched_data(c_p);
+ ErtsIOBytesReq *req = erts_alloc(ERTS_ALC_T_IOB_REQ,
+ sizeof(ErtsIOBytesReq));
+
+ hp = HAlloc(c_p, ERTS_REF_THING_SIZE);
+ ref = erts_sched_make_ref_in_buffer(esdp, hp);
+ refn = internal_ref_numbers(ref);
+
+ req->sched_id = esdp->no;
+ req->pid = c_p->common.id;
+ req->refn[0] = refn[0];
+ req->refn[1] = refn[1];
+ req->refn[2] = refn[2];
+ erts_smp_atomic32_init_nob(&req->refc,
+ (erts_aint32_t) erts_no_schedulers);
+
+#ifdef ERTS_SMP
+ if (erts_no_schedulers > 1)
+ erts_schedule_multi_misc_aux_work(1,
+ erts_no_schedulers,
+ reply_io_bytes,
+ (void *) req);
+#endif
+
+ reply_io_bytes((void *) req);
+
+ return ref;
+}
+
+
+typedef struct {
+ fmtfn_t to;
void *arg;
} prt_one_lnk_data;
static void prt_one_monitor(ErtsMonitor *mon, void *vprtd)
{
prt_one_lnk_data *prtd = (prt_one_lnk_data *) vprtd;
- erts_print(prtd->to, prtd->arg, "(%T,%T)", mon->pid,mon->ref);
+ erts_print(prtd->to, prtd->arg, "(%T,%T)", mon->u.pid, mon->ref);
}
static void prt_one_lnk(ErtsLink *lnk, void *vprtd)
@@ -4588,7 +5152,7 @@ static void prt_one_lnk(ErtsLink *lnk, void *vprtd)
}
void
-print_port_info(Port *p, int to, void *arg)
+print_port_info(Port *p, fmtfn_t to, void *arg)
{
erts_aint32_t state = erts_atomic32_read_nob(&p->state);
@@ -4628,6 +5192,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);
}
@@ -4774,12 +5342,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,
@@ -4794,9 +5363,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)
@@ -4808,14 +5379,25 @@ 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)
DTRACE3(driver_ready_async, process_str, port_str, p->name);
}
#endif
+#ifdef USE_LTTNG_VM_TRACEPOINTS
+ if (LTTNG_ENABLED(driver_ready_async)) {
+ lttng_decl_portbuf(port_str);
+ lttng_decl_procbuf(proc_str);
+ lttng_pid_to_str(ERTS_PORT_GET_CONNECTED(p), proc_str);
+ lttng_port_to_str(p, port_str);
+ LTTNG3(driver_ready_async, proc_str, port_str, p->name);
+ }
+#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);
@@ -4959,24 +5541,6 @@ erts_free_port_names(ErtsPortNames *pnp)
erts_free(ERTS_ALC_T_PORT_NAMES, pnp);
}
-static void schedule_port_timeout(Port *p)
-{
- /*
- * Scheduling of port timeouts can be done without port locking, but
- * since the task handle is stored in the port structure and the ptimer
- * structure is protected by the port lock we require the port to be
- * locked for now...
- *
- * TODO: Implement scheduling of port timeouts without locking
- * the port.
- * /Rickard
- */
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(p));
- erts_port_task_schedule(p->common.id,
- &p->timeout_task,
- ERTS_PORT_TASK_TIMEOUT);
-}
-
ErlDrvTermData driver_mk_term_nil(void)
{
return driver_term_nil;
@@ -4985,14 +5549,15 @@ 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);
+ int trace_send = IS_TRACED_FL(prt, F_TRACE_SEND);
if (prt == ERTS_INVALID_ERL_DRV_PORT)
return;
@@ -5005,25 +5570,25 @@ void driver_report_exit(ErlDrvPort ix, int status)
rp = (scheduler
? erts_proc_lookup(pid)
- : erts_pid2proc_opt(NULL, 0, pid, 0, ERTS_P2P_FLG_SMP_INC_REFC));
+ : erts_pid2proc_opt(NULL, 0, pid, 0, ERTS_P2P_FLG_INC_REFC));
if (!rp)
return;
- hp = erts_alloc_message_heap(3+3, &bp, &ohp, rp, &rp_locks);
+ mp = erts_alloc_message_heap(trace_send ? NULL : 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
-#ifdef USE_VM_PROBES
- , NIL
-#endif
- );
+ if (IS_TRACED_FL(prt, F_TRACE_SEND))
+ trace_port_send(prt, pid, tuple, 1);
+
+ ERL_MESSAGE_TOKEN(mp) = am_undefined;
+ erts_queue_message(rp, rp_locks, mp, tuple, prt->common.id);
erts_smp_proc_unlock(rp, rp_locks);
if (!scheduler)
- erts_smp_proc_dec_refc(rp);
+ erts_proc_dec_refc(rp);
}
#define ERTS_B2T_STATES_DEF_STATES_SZ 5
@@ -5113,24 +5678,28 @@ cleanup_b2t_states(struct b2t_states__ *b2tsp)
*/
static int
-driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
+driver_deliver_term(Port *prt, Eterm to, ErlDrvTermData* data, int len)
{
+#define HEAP_EXTRA 200
#define ERTS_DDT_FAIL do { res = -1; goto done; } while (0)
Uint need = 0;
int depth = 0;
- int res;
- Eterm *hp = NULL, *hp_start = NULL, *hp_end = NULL;
+ int res = 0;
ErlDrvTermData* ptr;
ErlDrvTermData* ptr_end;
DECLARE_ESTACK(stack);
- Eterm mess = NIL; /* keeps compiler happy */
+ Eterm mess;
Process* rp = NULL;
- ErlHeapFragment *bp = NULL;
- ErlOffHeap *ohp;
+ ErtsHeapFactory factory;
ErtsProcLocks rp_locks = 0;
struct b2t_states__ b2t;
- int scheduler = 1; /* Silence erroneous warning... */
+ int scheduler;
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
+ ERTS_UNDEF(mess,NIL);
+ ERTS_UNDEF(scheduler,1);
+
+ factory.mode = FACTORY_CLOSED;
init_b2t_states(&b2t);
/*
@@ -5163,25 +5732,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;
@@ -5294,9 +5855,10 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
#ifdef DEBUG
b2t.org_ext[b2t.ix] = ext;
#endif
- hsz = erts_binary2term_prepare(&b2t.state[b2t.ix++], ext, size);
+ hsz = erts_binary2term_prepare(&b2t.state[b2t.ix], ext, size);
if (hsz < 0)
ERTS_DDT_FAIL; /* Invalid data */
+ b2t.state[b2t.ix++].heap_size = hsz;
need += hsz;
ptr += 2;
depth++;
@@ -5305,7 +5867,11 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
case ERL_DRV_MAP: { /* int */
ERTS_DDT_CHK_ENOUGH_ARGS(1);
if ((int) ptr[0] < 0) ERTS_DDT_FAIL;
- need += MAP_HEADER_SIZE + 1 + 2*ptr[0];
+ if (ptr[0] > MAP_SMALL_MAP_LIMIT) {
+ need += HASHMAP_ESTIMATED_HEAP_SIZE(ptr[0]);
+ } else {
+ need += MAP_HEADER_FLATMAP_SZ + 1 + 2*ptr[0];
+ }
depth -= 2*ptr[0];
if (depth < 0) ERTS_DDT_FAIL;
ptr++;
@@ -5335,14 +5901,28 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
scheduler = erts_get_scheduler_id() != 0;
rp = (scheduler
? erts_proc_lookup(to)
- : erts_pid2proc_opt(NULL, 0, to, 0, ERTS_P2P_FLG_SMP_INC_REFC));
+ : erts_pid2proc_opt(NULL, 0, to, 0, ERTS_P2P_FLG_INC_REFC));
if (!rp) {
- res = 0;
- goto done;
- }
+ if (!prt || !IS_TRACED_FL(prt, F_TRACE_SEND))
+ goto done;
+ if (!erts_is_tracer_proc_enabled_send(NULL, 0, &prt->common))
+ goto done;
+
+ res = -2;
- hp_start = hp = erts_alloc_message_heap(need, &bp, &ohp, rp, &rp_locks);
- hp_end = hp + need;
+ /* We allocate a temporary heap to be used to create
+ the message that may be sent using tracing */
+ erts_factory_tmp_init(&factory, erts_alloc(ERTS_ALC_T_DRIVER, need*sizeof(Eterm)),
+ need, ERTS_ALC_T_DRIVER);
+
+ } else {
+ /* We force the creation of a heap fragment (rp == NULL) when send
+ tracing so that we don't have the main lock of the process while
+ tracing */
+ Process *trace_rp = prt && IS_TRACED_FL(prt, F_TRACE_SEND) ? NULL : rp;
+ (void) erts_factory_message_create(&factory, trace_rp, &rp_locks, need);
+ res = 1;
+ }
/*
* Interpret the instructions and build the term.
@@ -5362,40 +5942,36 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
break;
case ERL_DRV_INT: /* signed int argument */
-#if HALFWORD_HEAP
- mess = erts_bld_sint64(&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]);
else {
- mess = small_to_big((Sint)ptr[0], hp);
- hp += BIG_UINT_HEAP_SIZE;
+ 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
- mess = erts_bld_uint64(&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]);
else {
- mess = uint_to_big((Uint)ptr[0], hp);
- hp += BIG_UINT_HEAP_SIZE;
+ mess = uint_to_big((Uint)ptr[0], factory.hp);
+ factory.hp += BIG_UINT_HEAP_SIZE;
}
-#endif
ptr++;
break;
case ERL_DRV_INT64: /* pointer to unsigned 64-bit int argument */
- mess = erts_bld_sint64(&hp, NULL, *((Sint64 *) ptr[0]));
+ erts_reserve_heap(&factory, BIG_NEED_FOR_BITS(64));
+ mess = erts_bld_sint64(&factory.hp, NULL, *((Sint64 *) ptr[0]));
ptr++;
break;
case ERL_DRV_UINT64: /* pointer to unsigned 64-bit int argument */
- mess = erts_bld_uint64(&hp, NULL, *((Uint64 *) ptr[0]));
+ erts_reserve_heap(&factory, BIG_NEED_FOR_BITS(64));
+ mess = erts_bld_uint64(&factory.hp, NULL, *((Uint64 *) ptr[0]));
ptr++;
break;
@@ -5409,11 +5985,14 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
Uint size = ptr[1];
Uint offset = ptr[2];
- erts_smp_atomic_add_nob(&erts_bytes_in, (erts_aint_t) size);
+ if (esdp)
+ esdp->io.in += (Uint64) size;
+ else
+ erts_atomic64_add_nob(&bytes_in, (erts_aint64_t) size);
if (size <= ERL_ONHEAP_BIN_LIMIT) {
- ErlHeapBin* hbp = (ErlHeapBin *) hp;
- hp += heap_bin_size(size);
+ ErlHeapBin* hbp = (ErlHeapBin *) erts_produce_heap(&factory,
+ heap_bin_size(size), HEAP_EXTRA);
hbp->thing_word = header_heap_bin(size);
hbp->size = size;
if (size > 0) {
@@ -5422,18 +6001,18 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
mess = make_binary(hbp);
}
else {
- ProcBin* pb = (ProcBin *) hp;
+ ProcBin* pb = (ProcBin *) erts_produce_heap(&factory,
+ PROC_BIN_SIZE, HEAP_EXTRA);
driver_binary_inc_refc(b); /* caller will free binary */
pb->thing_word = HEADER_PROC_BIN;
pb->size = size;
- pb->next = ohp->first;
- ohp->first = (struct erl_off_heap_header*)pb;
+ pb->next = factory.off_heap->first;
+ factory.off_heap->first = (struct erl_off_heap_header*)pb;
pb->val = ErlDrvBinary2Binary(b);
pb->bytes = ((byte*) b->orig_bytes) + offset;
pb->flags = 0;
mess = make_binary(pb);
- hp += PROC_BIN_SIZE;
- OH_OVERHEAD(ohp, pb->size / sizeof(Eterm));
+ OH_OVERHEAD(factory.off_heap, pb->size / sizeof(Eterm));
}
ptr += 3;
break;
@@ -5443,11 +6022,15 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
byte *bufp = (byte *) ptr[0];
Uint size = (Uint) ptr[1];
- erts_smp_atomic_add_nob(&erts_bytes_in, (erts_aint_t) size);
+ if (esdp)
+ esdp->io.in += (Uint64) size;
+ else
+ erts_atomic64_add_nob(&bytes_in, (erts_aint64_t) size);
if (size <= ERL_ONHEAP_BIN_LIMIT) {
- ErlHeapBin* hbp = (ErlHeapBin *) hp;
- hp += heap_bin_size(size);
+ ErlHeapBin* hbp = (ErlHeapBin *) erts_produce_heap(&factory,
+ heap_bin_size(size),
+ HEAP_EXTRA);
hbp->thing_word = header_heap_bin(size);
hbp->size = size;
if (size > 0) {
@@ -5460,20 +6043,17 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
ProcBin* pbp;
Binary* bp = erts_bin_nrml_alloc(size);
ASSERT(bufp);
- bp->flags = 0;
- bp->orig_size = (SWord) size;
- erts_refc_init(&bp->refc, 1);
sys_memcpy((void *) bp->orig_bytes, (void *) bufp, size);
- pbp = (ProcBin *) hp;
- hp += PROC_BIN_SIZE;
+ pbp = (ProcBin *) erts_produce_heap(&factory,
+ PROC_BIN_SIZE, HEAP_EXTRA);
pbp->thing_word = HEADER_PROC_BIN;
pbp->size = size;
- pbp->next = ohp->first;
- ohp->first = (struct erl_off_heap_header*)pbp;
+ pbp->next = factory.off_heap->first;
+ factory.off_heap->first = (struct erl_off_heap_header*)pbp;
pbp->val = bp;
pbp->bytes = (byte*) bp->orig_bytes;
pbp->flags = 0;
- OH_OVERHEAD(ohp, pbp->size / sizeof(Eterm));
+ OH_OVERHEAD(factory.off_heap, pbp->size / sizeof(Eterm));
mess = make_binary(pbp);
}
ptr += 2;
@@ -5481,14 +6061,19 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
}
case ERL_DRV_STRING: /* char*, length */
- erts_smp_atomic_add_nob(&erts_bytes_in, (erts_aint_t) ptr[1]);
- mess = buf_to_intlist(&hp, (char*)ptr[0], ptr[1], NIL);
+ if (esdp)
+ esdp->io.in += (Uint64) ptr[1];
+ else
+ erts_atomic64_add_nob(&bytes_in, (erts_aint64_t) ptr[1]);
+ erts_reserve_heap(&factory, 2*ptr[1]);
+ mess = buf_to_intlist(&factory.hp, (char*)ptr[0], ptr[1], NIL);
ptr += 2;
break;
case ERL_DRV_STRING_CONS: /* char*, length */
mess = ESTACK_POP(stack);
- mess = buf_to_intlist(&hp, (char*)ptr[0], ptr[1], mess);
+ erts_reserve_heap(&factory, 2*ptr[1]);
+ mess = buf_to_intlist(&factory.hp, (char*)ptr[0], ptr[1], mess);
ptr += 2;
break;
@@ -5497,11 +6082,12 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
mess = ESTACK_POP(stack);
i--;
+ erts_reserve_heap(&factory, 2*i);
while(i > 0) {
Eterm hd = ESTACK_POP(stack);
- mess = CONS(hp, hd, mess);
- hp += 2;
+ mess = CONS(factory.hp, hd, mess);
+ factory.hp += 2;
i--;
}
ptr++;
@@ -5510,13 +6096,12 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
case ERL_DRV_TUPLE: { /* int */
int size = (int)ptr[0];
- Eterm* tp = hp;
+ Eterm* tp = erts_produce_heap(&factory, size+1, HEAP_EXTRA);
*tp = make_arityval(size);
mess = make_tuple(tp);
tp += size; /* point at last element */
- hp = tp+1; /* advance "heap" pointer */
while(size--) {
*tp-- = ESTACK_POP(stack);
@@ -5532,18 +6117,22 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
case ERL_DRV_FLOAT: { /* double * */
FloatDef f;
+ Eterm* fp = erts_produce_heap(&factory, FLOAT_SIZE_OBJECT, HEAP_EXTRA);
- mess = make_float(hp);
+ mess = make_float(fp);
f.fd = *((double *) ptr[0]);
- PUT_DOUBLE(f, hp);
- hp += FLOAT_SIZE_OBJECT;
+ if (!erts_isfinite(f.fd))
+ ERTS_DDT_FAIL;
+ PUT_DOUBLE(f, fp);
ptr++;
break;
}
case ERL_DRV_EXT2TERM: /* char *ext, int size */
ASSERT(b2t.org_ext[b2t.ix] == (byte *) ptr[0]);
- mess = erts_binary2term_create(&b2t.state[b2t.ix++], &hp, ohp);
+
+ erts_reserve_heap(&factory, b2t.state[b2t.ix].heap_size);
+ mess = erts_binary2term_create(&b2t.state[b2t.ix++], &factory);
if (mess == THE_NON_VALUE)
ERTS_DDT_FAIL;
ptr += 2;
@@ -5551,31 +6140,43 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
case ERL_DRV_MAP: { /* int */
int size = (int)ptr[0];
- Eterm* tp = hp;
- Eterm* vp;
- map_t *mp;
-
- *tp = make_arityval(size);
-
- hp += 1 + size;
- mp = (map_t*)hp;
- mp->thing_word = MAP_HEADER;
- mp->size = size;
- mp->keys = make_tuple(tp);
- mess = make_map(mp);
-
- hp += MAP_HEADER_SIZE + size; /* advance "heap" pointer */
-
- tp += size; /* point at last key */
- vp = hp - 1; /* point at last value */
-
- while(size--) {
- *vp-- = ESTACK_POP(stack);
- *tp-- = ESTACK_POP(stack);
- }
- if (!erts_validate_and_sort_map(mp))
- ERTS_DDT_FAIL;
- ptr++;
+ if (size > MAP_SMALL_MAP_LIMIT) {
+ int ix = 2*size;
+ Eterm* leafs;
+
+ erts_produce_heap(&factory, ix, HEAP_EXTRA);
+ leafs = factory.hp;
+ while(ix--) { *--leafs = ESTACK_POP(stack); }
+
+ mess = erts_hashmap_from_array(&factory, leafs, size, 1);
+ if (is_non_value(mess))
+ ERTS_DDT_FAIL;
+ } else {
+ Eterm* vp;
+ flatmap_t *mp;
+ Eterm* tp = erts_produce_heap(&factory,
+ 2*size + 1 + MAP_HEADER_FLATMAP_SZ,
+ HEAP_EXTRA);
+
+ *tp = make_arityval(size);
+
+ mp = (flatmap_t*) (tp + 1 + size);
+ mp->thing_word = MAP_HEADER_FLATMAP;
+ mp->size = size;
+ mp->keys = make_tuple(tp);
+ mess = make_flatmap(mp);
+
+ tp += size; /* point at last key */
+ vp = factory.hp - 1; /* point at last value */
+
+ while(size--) {
+ *vp-- = ESTACK_POP(stack);
+ *tp-- = ESTACK_POP(stack);
+ }
+ if (!erts_validate_and_sort_flatmap(mp))
+ ERTS_DDT_FAIL;
+ }
+ ptr++;
break;
}
@@ -5583,67 +6184,81 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
ESTACK_PUSH(stack, mess);
}
- res = 1;
-
done:
if (res > 0) {
+ Eterm from = am_undefined;
mess = ESTACK_POP(stack); /* get resulting value */
- if (bp)
- bp = erts_resize_message_buffer(bp, hp - hp_start, &mess, 1);
- else {
- ASSERT(hp);
- HRelease(rp, hp_end, hp);
+ erts_factory_trim_and_close(&factory, &mess, 1);
+
+ if (prt) {
+ if (IS_TRACED_FL(prt, F_TRACE_SEND)) {
+ trace_port_send(prt, to, mess, 1);
+ }
+ from = prt->common.id;
}
+
/* send message */
- erts_queue_message(rp, &rp_locks, bp, mess, am_undefined
-#ifdef USE_VM_PROBES
- , NIL
-#endif
- );
+ ERL_MESSAGE_TOKEN(factory.message) = am_undefined;
+ erts_queue_message(rp, rp_locks, factory.message, mess, from);
+ }
+ else if (res == -2) {
+ /* this clause only happens when we were requested to
+ generate a send trace, but the process to send to
+ did not exist any more */
+ mess = ESTACK_POP(stack); /* get resulting value */
+
+ trace_port_send(prt, to, mess, 0);
+
+ erts_factory_trim_and_close(&factory, &mess, 1);
+ erts_free(ERTS_ALC_T_DRIVER, factory.hp_start);
+ res = 0;
}
else {
if (b2t.ix > b2t.used)
b2t.used = b2t.ix;
for (b2t.ix = 0; b2t.ix < b2t.used; b2t.ix++)
erts_binary2term_abort(&b2t.state[b2t.ix]);
- if (bp)
- free_message_buffer(bp);
- else if (hp) {
- HRelease(rp, hp_end, hp);
- }
+ if (factory.mode != FACTORY_CLOSED) {
+ ERL_MESSAGE_TERM(factory.message) = am_undefined;
+ erts_factory_undo(&factory);
+ }
}
-#ifdef ERTS_SMP
if (rp) {
if (rp_locks)
erts_smp_proc_unlock(rp, rp_locks);
if (!scheduler)
- erts_smp_proc_dec_refc(rp);
+ erts_proc_dec_refc(rp);
}
-#endif
cleanup_b2t_states(&b2t);
DESTROY_ESTACK(stack);
return res;
#undef ERTS_DDT_FAIL
+#undef HEAP_EXTRA
}
static ERTS_INLINE int
-deliver_term_check_port(ErlDrvTermData port_id, Eterm *connected_p)
+deliver_term_check_port(ErlDrvTermData port_id, Eterm *connected_p,
+ Port **trace_prt)
{
#ifdef ERTS_SMP
ErtsThrPrgrDelayHandle dhndl = erts_thr_progress_unmanaged_delay();
#endif
erts_aint32_t state;
+ int res = 1;
Port *prt = erts_port_lookup_raw((Eterm) port_id);
- if (!prt)
- return -1;
+ if (!prt) {
+ res = -1;
+ goto done;
+ }
state = erts_atomic32_read_nob(&prt->state);
if (state & (ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP
| ERTS_PORT_SFLG_CLOSING)) {
if (state & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP)
- return -1;
+ res = -1;
else
- return 0;
+ res = 0;
+ goto done;
}
if (connected_p) {
#ifdef ERTS_SMP
@@ -5652,26 +6267,32 @@ deliver_term_check_port(ErlDrvTermData port_id, Eterm *connected_p)
#endif
*connected_p = ERTS_PORT_GET_CONNECTED(prt);
}
+
+done:
+
#ifdef ERTS_SMP
if (dhndl != ERTS_THR_PRGR_DHANDLE_MANAGED) {
+ ERTS_SMP_LC_ASSERT(!prt || !erts_lc_is_port_locked(prt));
erts_thr_progress_unmanaged_continue(dhndl);
ETHR_MEMBAR(ETHR_LoadLoad|ETHR_LoadStore);
- }
+ } else
#endif
- ERTS_SMP_LC_ASSERT(dhndl == ERTS_THR_PRGR_DHANDLE_MANAGED
- ? erts_lc_is_port_locked(prt)
- : !erts_lc_is_port_locked(prt));
- return 1;
+ if (res == 1) {
+ ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+ *trace_prt = prt;
+ }
+ return res;
}
int erl_drv_output_term(ErlDrvTermData port_id, ErlDrvTermData* data, int len)
{
/* May be called from arbitrary thread */
- Eterm connected;
- int res = deliver_term_check_port(port_id, &connected);
+ Eterm connected = NIL; /* Shut up faulty warning... */
+ Port *prt = NULL;
+ int res = deliver_term_check_port(port_id, &connected, &prt);
if (res <= 0)
return res;
- return driver_deliver_term(connected, data, len);
+ return driver_deliver_term(prt, connected, data, len);
}
/*
@@ -5695,7 +6316,7 @@ driver_output_term(ErlDrvPort drvport, ErlDrvTermData* data, int len)
if (state & ERTS_PORT_SFLG_CLOSING)
return 0;
- return driver_deliver_term(ERTS_PORT_GET_CONNECTED(prt), data, len);
+ return driver_deliver_term(prt, ERTS_PORT_GET_CONNECTED(prt), data, len);
}
int erl_drv_send_term(ErlDrvTermData port_id,
@@ -5704,10 +6325,11 @@ int erl_drv_send_term(ErlDrvTermData port_id,
int len)
{
/* May be called from arbitrary thread */
- int res = deliver_term_check_port(port_id, NULL);
+ Port *prt = NULL;
+ int res = deliver_term_check_port(port_id, NULL, &prt);
if (res <= 0)
return res;
- return driver_deliver_term(to, data, len);
+ return driver_deliver_term(prt, to, data, len);
}
/*
@@ -5726,20 +6348,21 @@ driver_send_term(ErlDrvPort drvport,
* to make this access safe without using a less efficient
* internal data representation for ErlDrvPort.
*/
+ Port* prt = NULL;
ERTS_SMP_CHK_NO_PROC_LOCKS;
#ifdef ERTS_SMP
if (erts_thr_progress_is_managed_thread())
#endif
{
erts_aint32_t state;
- Port* prt = erts_drvport2port_state(drvport, &state);
+ prt = erts_drvport2port_state(drvport, &state);
if (prt == ERTS_INVALID_ERL_DRV_PORT)
return -1; /* invalid (dead) */
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
if (state & ERTS_PORT_SFLG_CLOSING)
return 0;
}
- return driver_deliver_term(to, data, len);
+ return driver_deliver_term(prt, to, data, len);
}
@@ -5753,6 +6376,7 @@ int driver_output_binary(ErlDrvPort ix, char* hbuf, ErlDrvSizeT hlen,
{
erts_aint32_t state;
Port* prt = erts_drvport2port_state(ix, &state);
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
ERTS_SMP_CHK_NO_PROC_LOCKS;
@@ -5763,7 +6387,10 @@ int driver_output_binary(ErlDrvPort ix, char* hbuf, ErlDrvSizeT hlen,
return 0;
prt->bytes_in += (hlen + len);
- erts_smp_atomic_add_nob(&erts_bytes_in, (erts_aint_t) (hlen + len));
+ if (esdp)
+ esdp->io.in += (Uint64) (hlen + len);
+ else
+ erts_atomic64_add_nob(&bytes_in, (erts_aint64_t) (hlen + len));
if (state & ERTS_PORT_SFLG_DISTRIBUTION) {
return erts_net_message(prt,
prt->dist_entry,
@@ -5788,6 +6415,7 @@ int driver_output2(ErlDrvPort ix, char* hbuf, ErlDrvSizeT hlen,
{
erts_aint32_t state;
Port* prt = erts_drvport2port_state(ix, &state);
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
ERTS_SMP_CHK_NO_PROC_LOCKS;
@@ -5799,7 +6427,10 @@ int driver_output2(ErlDrvPort ix, char* hbuf, ErlDrvSizeT hlen,
return 0;
prt->bytes_in += (hlen + len);
- erts_smp_atomic_add_nob(&erts_bytes_in, (erts_aint_t) (hlen + len));
+ if (esdp)
+ esdp->io.in += (Uint64) (hlen + len);
+ else
+ erts_atomic64_add_nob(&bytes_in, (erts_aint64_t) (hlen + len));
if (state & ERTS_PORT_SFLG_DISTRIBUTION) {
if (len == 0)
return erts_net_message(prt,
@@ -5839,6 +6470,7 @@ int driver_outputv(ErlDrvPort ix, char* hbuf, ErlDrvSizeT hlen,
ErlDrvBinary** binv;
Port* prt;
erts_aint32_t state;
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
ERTS_SMP_CHK_NO_PROC_LOCKS;
@@ -5877,7 +6509,10 @@ int driver_outputv(ErlDrvPort ix, char* hbuf, ErlDrvSizeT hlen,
/* XXX handle distribution !!! */
prt->bytes_in += (hlen + size);
- erts_smp_atomic_add_nob(&erts_bytes_in, (erts_aint_t) (hlen + size));
+ if (esdp)
+ esdp->io.in += (Uint64) (hlen + size);
+ else
+ erts_atomic64_add_nob(&bytes_in, (erts_aint64_t) (hlen + size));
deliver_vec_message(prt, ERTS_PORT_GET_CONNECTED(prt), hbuf, hlen,
binv, iov, n, size);
return 0;
@@ -5909,12 +6544,6 @@ ErlDrvSizeT driver_vec_to_buf(ErlIOVec *vec, char *buf, ErlDrvSizeT len)
return (orig_len - len);
}
-
-/*
- * - driver_alloc_binary() is thread safe (efile driver depend on it).
- * - driver_realloc_binary(), and driver_free_binary() are *not* thread safe.
- */
-
/*
* reference count on driver binaries...
*/
@@ -5923,21 +6552,21 @@ ErlDrvSInt
driver_binary_get_refc(ErlDrvBinary *dbp)
{
Binary* bp = ErlDrvBinary2Binary(dbp);
- return (ErlDrvSInt) erts_refc_read(&bp->refc, 1);
+ return (ErlDrvSInt) erts_refc_read(&bp->intern.refc, 1);
}
ErlDrvSInt
driver_binary_inc_refc(ErlDrvBinary *dbp)
{
Binary* bp = ErlDrvBinary2Binary(dbp);
- return (ErlDrvSInt) erts_refc_inctest(&bp->refc, 2);
+ return (ErlDrvSInt) erts_refc_inctest(&bp->intern.refc, 2);
}
ErlDrvSInt
driver_binary_dec_refc(ErlDrvBinary *dbp)
{
Binary* bp = ErlDrvBinary2Binary(dbp);
- return (ErlDrvSInt) erts_refc_dectest(&bp->refc, 1);
+ return (ErlDrvSInt) erts_refc_dectest(&bp->intern.refc, 1);
}
@@ -5953,39 +6582,24 @@ driver_alloc_binary(ErlDrvSizeT size)
bin = erts_bin_drv_alloc_fnf((Uint) size);
if (!bin)
return NULL; /* The driver write must take action */
- bin->flags = BIN_FLAG_DRV;
- erts_refc_init(&bin->refc, 1);
- bin->orig_size = (SWord) size;
return Binary2ErlDrvBinary(bin);
}
-/* Reallocate space hold by binary */
+/* Reallocate space held by binary */
ErlDrvBinary* driver_realloc_binary(ErlDrvBinary* bin, ErlDrvSizeT size)
{
Binary* oldbin;
Binary* newbin;
- if (!bin) {
- erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
- erts_dsprintf(dsbufp,
- "Bad use of driver_realloc_binary(%p, %lu): "
- "called with ",
- bin, (unsigned long)size);
- if (!bin) {
- erts_dsprintf(dsbufp, "NULL pointer as first argument");
- }
- erts_send_warning_to_logger_nogl(dsbufp);
- if (!bin)
- return driver_alloc_binary(size);
- }
+ if (!bin)
+ return driver_alloc_binary(size);
oldbin = ErlDrvBinary2Binary(bin);
newbin = (Binary *) erts_bin_realloc_fnf(oldbin, size);
if (!newbin)
return NULL;
- newbin->orig_size = size;
return Binary2ErlDrvBinary(newbin);
}
@@ -5993,18 +6607,11 @@ ErlDrvBinary* driver_realloc_binary(ErlDrvBinary* bin, ErlDrvSizeT size)
void driver_free_binary(ErlDrvBinary* dbin)
{
Binary *bin;
- if (!dbin) {
- erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
- erts_dsprintf(dsbufp,
- "Bad use of driver_free_binary(%p): called with "
- "NULL pointer as argument", dbin);
- erts_send_warning_to_logger_nogl(dsbufp);
+ if (!dbin)
return;
- }
bin = ErlDrvBinary2Binary(dbin);
- if (erts_refc_dectest(&bin->refc, 0) == 0)
- erts_bin_free(bin);
+ erts_bin_release(bin);
}
@@ -6129,7 +6736,7 @@ driver_pdl_create(ErlDrvPort dp)
return NULL;
pdl = erts_alloc(ERTS_ALC_T_PORT_DATA_LOCK,
sizeof(struct erl_drv_port_data_lock));
- erts_mtx_init(&pdl->mtx, "port_data_lock");
+ erts_mtx_init(&pdl->mtx, "port_data_lock", pp->common.id, ERTS_LOCK_FLAGS_CATEGORY_IO);
pdl_init_refc(pdl);
erts_port_inc_refc(pp);
pdl->prt = pp;
@@ -6193,307 +6800,51 @@ driver_pdl_dec_refc(ErlDrvPDL pdl)
return refc;
}
-/* expand queue to hold n elements in tail or head */
-static int expandq(ErlIOQueue* q, int n, int tail)
-/* tail: 0 if make room in head, make room in tail otherwise */
-{
- int h_sz; /* room before header */
- int t_sz; /* room after tail */
- int q_sz; /* occupied */
- int nvsz;
- SysIOVec* niov;
- ErlDrvBinary** nbinv;
-
- h_sz = q->v_head - q->v_start;
- t_sz = q->v_end - q->v_tail;
- q_sz = q->v_tail - q->v_head;
-
- if (tail && (n <= t_sz)) /* do we need to expand tail? */
- return 0;
- else if (!tail && (n <= h_sz)) /* do we need to expand head? */
- return 0;
- else if (n > (h_sz + t_sz)) { /* need to allocate */
- /* we may get little extra but it ok */
- nvsz = (q->v_end - q->v_start) + n;
-
- niov = erts_alloc_fnf(ERTS_ALC_T_IOQ, nvsz * sizeof(SysIOVec));
- if (!niov)
- return -1;
- nbinv = erts_alloc_fnf(ERTS_ALC_T_IOQ, nvsz * sizeof(ErlDrvBinary**));
- if (!nbinv) {
- erts_free(ERTS_ALC_T_IOQ, (void *) niov);
- return -1;
- }
- if (tail) {
- sys_memcpy(niov, q->v_head, q_sz*sizeof(SysIOVec));
- if (q->v_start != q->v_small)
- erts_free(ERTS_ALC_T_IOQ, (void *) q->v_start);
- q->v_start = niov;
- q->v_end = niov + nvsz;
- q->v_head = q->v_start;
- q->v_tail = q->v_head + q_sz;
-
- sys_memcpy(nbinv, q->b_head, q_sz*sizeof(ErlDrvBinary*));
- if (q->b_start != q->b_small)
- erts_free(ERTS_ALC_T_IOQ, (void *) q->b_start);
- q->b_start = nbinv;
- q->b_end = nbinv + nvsz;
- q->b_head = q->b_start;
- q->b_tail = q->b_head + q_sz;
- }
- else {
- sys_memcpy(niov+nvsz-q_sz, q->v_head, q_sz*sizeof(SysIOVec));
- if (q->v_start != q->v_small)
- erts_free(ERTS_ALC_T_IOQ, (void *) q->v_start);
- q->v_start = niov;
- q->v_end = niov + nvsz;
- q->v_tail = q->v_end;
- q->v_head = q->v_tail - q_sz;
-
- sys_memcpy(nbinv+nvsz-q_sz, q->b_head, q_sz*sizeof(ErlDrvBinary*));
- if (q->b_start != q->b_small)
- erts_free(ERTS_ALC_T_IOQ, (void *) q->b_start);
- q->b_start = nbinv;
- q->b_end = nbinv + nvsz;
- q->b_tail = q->b_end;
- q->b_head = q->b_tail - q_sz;
- }
- }
- else if (tail) { /* move to beginning to make room in tail */
- sys_memmove(q->v_start, q->v_head, q_sz*sizeof(SysIOVec));
- q->v_head = q->v_start;
- q->v_tail = q->v_head + q_sz;
- sys_memmove(q->b_start, q->b_head, q_sz*sizeof(ErlDrvBinary*));
- q->b_head = q->b_start;
- q->b_tail = q->b_head + q_sz;
- }
- else { /* move to end to make room */
- sys_memmove(q->v_end-q_sz, q->v_head, q_sz*sizeof(SysIOVec));
- q->v_tail = q->v_end;
- q->v_head = q->v_tail-q_sz;
- sys_memmove(q->b_end-q_sz, q->b_head, q_sz*sizeof(ErlDrvBinary*));
- q->b_tail = q->b_end;
- q->b_head = q->b_tail-q_sz;
- }
-
- return 0;
-}
-
-
-
/* Put elements from vec at q tail */
int driver_enqv(ErlDrvPort ix, ErlIOVec* vec, ErlDrvSizeT skip)
{
- int n;
- size_t len;
- ErlDrvSizeT size;
- SysIOVec* iov;
- ErlDrvBinary** binv;
- ErlDrvBinary* b;
- ErlIOQueue* q = drvport2ioq(ix);
-
- if (q == NULL)
- return -1;
-
- ASSERT(vec->size >= skip); /* debug only */
- if (vec->size <= skip)
- return 0;
- size = vec->size - skip;
-
- iov = vec->iov;
- binv = vec->binv;
- n = vec->vsize;
-
- /* we use do here to strip iov_len=0 from beginning */
- do {
- len = iov->iov_len;
- if (len <= skip) {
- skip -= len;
- iov++;
- binv++;
- n--;
- }
- else {
- iov->iov_base = ((char *)(iov->iov_base)) + skip;
- iov->iov_len -= skip;
- skip = 0;
- }
- } while(skip > 0);
-
- if (q->v_tail + n >= q->v_end)
- expandq(q, n, 1);
-
- /* Queue and reference all binaries (remove zero length items) */
- while(n--) {
- if ((len = iov->iov_len) > 0) {
- if ((b = *binv) == NULL) { /* speical case create binary ! */
- b = driver_alloc_binary(len);
- sys_memcpy(b->orig_bytes, iov->iov_base, len);
- *q->b_tail++ = b;
- q->v_tail->iov_len = len;
- q->v_tail->iov_base = b->orig_bytes;
- q->v_tail++;
- }
- else {
- driver_binary_inc_refc(b);
- *q->b_tail++ = b;
- *q->v_tail++ = *iov;
- }
- }
- iov++;
- binv++;
- }
- q->size += size; /* update total size in queue */
- return 0;
+ ASSERT(vec->size >= skip);
+ return erts_ioq_enqv(drvport2ioq(ix), (ErtsIOVec*)vec, skip);
}
/* Put elements from vec at q head */
int driver_pushqv(ErlDrvPort ix, ErlIOVec* vec, ErlDrvSizeT skip)
{
- int n;
- size_t len;
- ErlDrvSizeT size;
- SysIOVec* iov;
- ErlDrvBinary** binv;
- ErlDrvBinary* b;
- ErlIOQueue* q = drvport2ioq(ix);
-
- if (q == NULL)
- return -1;
-
- if (vec->size <= skip)
- return 0;
- size = vec->size - skip;
-
- iov = vec->iov;
- binv = vec->binv;
- n = vec->vsize;
-
- /* we use do here to strip iov_len=0 from beginning */
- do {
- len = iov->iov_len;
- if (len <= skip) {
- skip -= len;
- iov++;
- binv++;
- n--;
- }
- else {
- iov->iov_base = ((char *)(iov->iov_base)) + skip;
- iov->iov_len -= skip;
- skip = 0;
- }
- } while(skip > 0);
-
- if (q->v_head - n < q->v_start)
- expandq(q, n, 0);
-
- /* Queue and reference all binaries (remove zero length items) */
- iov += (n-1); /* move to end */
- binv += (n-1); /* move to end */
- while(n--) {
- if ((len = iov->iov_len) > 0) {
- if ((b = *binv) == NULL) { /* speical case create binary ! */
- b = driver_alloc_binary(len);
- sys_memcpy(b->orig_bytes, iov->iov_base, len);
- *--q->b_head = b;
- q->v_head--;
- q->v_head->iov_len = len;
- q->v_head->iov_base = b->orig_bytes;
- }
- else {
- driver_binary_inc_refc(b);
- *--q->b_head = b;
- *--q->v_head = *iov;
- }
- }
- iov--;
- binv--;
- }
- q->size += size; /* update total size in queue */
- return 0;
+ ASSERT(vec->size >= skip);
+ return erts_ioq_pushqv(drvport2ioq(ix), (ErtsIOVec*)vec, skip);
}
-
/*
** Remove size bytes from queue head
** Return number of bytes that remain in queue
*/
ErlDrvSizeT driver_deq(ErlDrvPort ix, ErlDrvSizeT size)
{
- ErlIOQueue* q = drvport2ioq(ix);
- ErlDrvSizeT len;
-
- if ((q == NULL) || (q->size < size))
- return -1;
- q->size -= size;
- while (size > 0) {
- ASSERT(q->v_head != q->v_tail);
-
- len = q->v_head->iov_len;
- if (len <= size) {
- size -= len;
- driver_free_binary(*q->b_head);
- *q->b_head++ = NULL;
- q->v_head++;
- }
- else {
- q->v_head->iov_base = ((char *)(q->v_head->iov_base)) + size;
- q->v_head->iov_len -= size;
- size = 0;
- }
- }
-
- /* restart pointers (optimised for enq) */
- if (q->v_head == q->v_tail) {
- q->v_head = q->v_tail = q->v_start;
- q->b_head = q->b_tail = q->b_start;
- }
- return q->size;
+ ErlPortIOQueue *q = drvport2ioq(ix);
+ if (erts_ioq_deq(q, size) == -1)
+ return -1;
+ return erts_ioq_size(q);
}
-ErlDrvSizeT driver_peekqv(ErlDrvPort ix, ErlIOVec *ev) {
- ErlIOQueue *q = drvport2ioq(ix);
- ASSERT(ev);
-
- if (! q) {
- return (ErlDrvSizeT) -1;
- } else {
- if ((ev->vsize = q->v_tail - q->v_head) == 0) {
- ev->size = 0;
- ev->iov = NULL;
- ev->binv = NULL;
- } else {
- ev->size = q->size;
- ev->iov = q->v_head;
- ev->binv = q->b_head;
- }
- return q->size;
- }
+ErlDrvSizeT driver_peekqv(ErlDrvPort ix, ErlIOVec *ev)
+{
+ return erts_ioq_peekqv(drvport2ioq(ix), (ErtsIOVec*)ev);
}
SysIOVec* driver_peekq(ErlDrvPort ix, int* vlenp) /* length of io-vector */
{
- ErlIOQueue* q = drvport2ioq(ix);
-
- if (q == NULL) {
- *vlenp = -1;
- return NULL;
- }
- if ((*vlenp = (q->v_tail - q->v_head)) == 0)
- return NULL;
- return q->v_head;
+ return erts_ioq_peekq(drvport2ioq(ix), vlenp);
}
ErlDrvSizeT driver_sizeq(ErlDrvPort ix)
{
- ErlIOQueue* q = drvport2ioq(ix);
+ ErlPortIOQueue *q = drvport2ioq(ix);
if (q == NULL)
- return (size_t) -1;
- return q->size;
+ return (ErlDrvSizeT) -1;
+ return erts_ioq_size(q);
}
@@ -6569,18 +6920,6 @@ int driver_pushq(ErlDrvPort ix, char* buffer, ErlDrvSizeT len)
return code;
}
-static ERTS_INLINE void
-drv_cancel_timer(Port *prt)
-{
-#ifdef ERTS_SMP
- erts_cancel_smp_ptimer(prt->common.u.alive.ptimer);
-#else
- erts_cancel_timer(&prt->common.u.alive.tm);
-#endif
- if (erts_port_task_is_scheduled(&prt->timeout_task))
- erts_port_task_abort(&prt->timeout_task);
-}
-
int driver_set_timer(ErlDrvPort ix, unsigned long t)
{
Port* prt = erts_drvport2port(ix);
@@ -6592,19 +6931,8 @@ int driver_set_timer(ErlDrvPort ix, unsigned long t)
if (prt->drv_ptr->timeout == NULL)
return -1;
- drv_cancel_timer(prt);
-#ifdef ERTS_SMP
- erts_create_smp_ptimer(&prt->common.u.alive.ptimer,
- prt->common.id,
- (ErlTimeoutProc) schedule_port_timeout,
- t);
-#else
- erts_set_timer(&prt->common.u.alive.tm,
- (ErlTimeoutProc) schedule_port_timeout,
- NULL,
- prt,
- t);
-#endif
+
+ erts_set_port_timer(prt, (Sint64) t);
return 0;
}
@@ -6614,28 +6942,28 @@ int driver_cancel_timer(ErlDrvPort ix)
if (prt == ERTS_INVALID_ERL_DRV_PORT)
return -1;
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
- drv_cancel_timer(prt);
+ erts_cancel_port_timer(prt);
return 0;
}
-
int
driver_read_timer(ErlDrvPort ix, unsigned long* t)
{
Port* prt = erts_drvport2port(ix);
+ Sint64 left;
ERTS_SMP_CHK_NO_PROC_LOCKS;
if (prt == ERTS_INVALID_ERL_DRV_PORT)
return -1;
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
-#ifdef ERTS_SMP
- *t = (prt->common.u.alive.ptimer
- ? erts_time_left(&prt->common.u.alive.ptimer->timer.tm)
- : 0);
-#else
- *t = erts_time_left(&prt->common.u.alive.tm);
-#endif
+
+ left = erts_read_port_timer(prt);
+ if (left < 0)
+ left = 0;
+
+ *t = (unsigned long) left;
+
return 0;
}
@@ -6655,22 +6983,51 @@ driver_get_now(ErlDrvNowData *now_data)
return 0;
}
-static void ref_to_driver_monitor(Eterm ref, ErlDrvMonitor *mon)
+ErlDrvTime
+erl_drv_monotonic_time(ErlDrvTimeUnit time_unit)
{
- RefThing *refp;
- ASSERT(is_internal_ref(ref));
- ASSERT(sizeof(RefThing) <= sizeof(ErlDrvMonitor));
- refp = ref_thing_ptr(ref);
- memset(mon,0,sizeof(ErlDrvMonitor));
- memcpy(mon,refp,sizeof(RefThing));
+ 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);
+}
+
+void erts_ref_to_driver_monitor(Eterm ref, ErlDrvMonitor *mon)
+{
+ ERTS_CT_ASSERT(ERTS_REF_THING_SIZE*sizeof(Uint) <= sizeof(ErlDrvMonitor));
+ ASSERT(is_internal_ordinary_ref(ref));
+ sys_memcpy((void *) mon, (void *) internal_ref_val(ref),
+ ERTS_REF_THING_SIZE*sizeof(Uint));
+}
+
+Eterm erts_driver_monitor_to_ref(Eterm *hp, const ErlDrvMonitor *mon)
+{
+ Eterm ref;
+ ERTS_CT_ASSERT(ERTS_REF_THING_SIZE*sizeof(Uint) <= sizeof(ErlDrvMonitor));
+ sys_memcpy((void *) hp, (void *) mon, ERTS_REF_THING_SIZE*sizeof(Uint));
+ ref = make_internal_ref(hp);
+ ASSERT(is_internal_ordinary_ref(ref));
+ return ref;
+}
static int do_driver_monitor_process(Port *prt,
- Eterm *buf,
ErlDrvTermData process,
ErlDrvMonitor *monitor)
{
+ Eterm buf[ERTS_REF_THING_SIZE];
Process *rp;
Eterm ref;
@@ -6689,7 +7046,7 @@ static int do_driver_monitor_process(Port *prt,
erts_add_monitor(&ERTS_P_MONITORS(rp), MON_TARGET, ref, prt->common.id, NIL);
erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
- ref_to_driver_monitor(ref,monitor);
+ erts_ref_to_driver_monitor(ref,monitor);
return 0;
}
@@ -6702,7 +7059,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
@@ -6713,42 +7070,27 @@ 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);
- ret = do_driver_monitor_process(prt,buf,process,monitor);
- UnUseTmpHeapNoproc(REF_THING_SIZE);
- }
+ ret = do_driver_monitor_process(prt,process,monitor);
DRV_MONITOR_UNLOCK_PDL(prt);
return ret;
}
-static int do_driver_demonitor_process(Port *prt, Eterm *buf,
- const ErlDrvMonitor *monitor)
+static int do_driver_demonitor_process(Port *prt, const ErlDrvMonitor *monitor)
{
+ Eterm heap[ERTS_REF_THING_SIZE];
Process *rp;
Eterm ref;
ErtsMonitor *mon;
Eterm to;
- memcpy(buf,monitor,sizeof(Eterm)*REF_THING_SIZE);
- ref = make_internal_ref(buf);
+ ref = erts_driver_monitor_to_ref(heap, monitor);
+
mon = erts_lookup_monitor(ERTS_P_MONITORS(prt), ref);
if (mon == NULL) {
return 1;
}
ASSERT(mon->type == MON_ORIGIN);
- to = mon->pid;
+ to = mon->u.pid;
ASSERT(is_internal_pid(to));
rp = erts_pid2proc_opt(NULL,
0,
@@ -6775,7 +7117,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
@@ -6786,40 +7128,26 @@ 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);
- ret = do_driver_demonitor_process(prt,buf,monitor);
- UnUseTmpHeapNoproc(REF_THING_SIZE);
- }
+ ret = do_driver_demonitor_process(prt,monitor);
DRV_MONITOR_UNLOCK_PDL(prt);
return ret;
}
-static ErlDrvTermData do_driver_get_monitored_process(Port *prt, Eterm *buf,
- const ErlDrvMonitor *monitor)
+static ErlDrvTermData do_driver_get_monitored_process(Port *prt,const ErlDrvMonitor *monitor)
{
Eterm ref;
ErtsMonitor *mon;
Eterm to;
+ Eterm heap[ERTS_REF_THING_SIZE];
+
+ ref = erts_driver_monitor_to_ref(heap, monitor);
- memcpy(buf,monitor,sizeof(Eterm)*REF_THING_SIZE);
- ref = make_internal_ref(buf);
mon = erts_lookup_monitor(ERTS_P_MONITORS(prt), ref);
if (mon == NULL) {
return driver_term_nil;
}
ASSERT(mon->type == MON_ORIGIN);
- to = mon->pid;
+ to = mon->u.pid;
ASSERT(is_internal_pid(to));
return (ErlDrvTermData) to;
}
@@ -6830,7 +7158,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
@@ -6841,31 +7169,16 @@ 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);
- ret = do_driver_get_monitored_process(prt,buf,monitor);
- UnUseTmpHeapNoproc(REF_THING_SIZE);
- }
+ ret = do_driver_get_monitored_process(prt,monitor);
DRV_MONITOR_UNLOCK_PDL(prt);
return ret;
}
-
int driver_compare_monitors(const ErlDrvMonitor *monitor1,
const ErlDrvMonitor *monitor2)
{
- return memcmp(monitor1,monitor2,sizeof(ErlDrvMonitor));
+ return sys_memcmp((void *) monitor1, (void *) monitor2,
+ ERTS_REF_THING_SIZE*sizeof(Eterm));
}
void erts_fire_port_monitor(Port *prt, Eterm ref)
@@ -6874,6 +7187,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);
@@ -6884,7 +7198,8 @@ 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_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)) {
@@ -6892,10 +7207,20 @@ void erts_fire_port_monitor(Port *prt, Eterm ref)
DTRACE3(driver_process_exit, process_str, port_str, prt->name);
}
#endif
+#ifdef USE_LTTNG_VM_TRACEPOINTS
+ if (LTTNG_ENABLED(driver_process_exit)) {
+ lttng_decl_portbuf(port_str);
+ lttng_decl_procbuf(proc_str);
+ lttng_pid_to_str(ERTS_PORT_GET_CONNECTED(prt), proc_str);
+ lttng_port_to_str(prt, port_str);
+ LTTNG3(driver_process_exit, proc_str, port_str, prt->name);
+ }
+#endif
fpe_was_unmasked = erts_block_fpe();
(*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);
@@ -6916,12 +7241,15 @@ 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) {
terminate_port(prt);
} else if (eof && (state & ERTS_PORT_SFLG_SOFT_EOF)) {
- deliver_result(prt->common.id, ERTS_PORT_GET_CONNECTED(prt), am_eof);
+ deliver_result(prt, prt->common.id, ERTS_PORT_GET_CONNECTED(prt), am_eof);
} else {
/* XXX UGLY WORK AROUND, Let erts_deliver_port_exit() terminate the port */
if (prt->port_data_lock)
@@ -6929,7 +7257,7 @@ driver_failure_term(ErlDrvPort ix, Eterm term, int eof)
prt->ioq.size = 0;
if (prt->port_data_lock)
driver_pdl_unlock(prt->port_data_lock);
- erts_deliver_port_exit(prt, prt->common.id, eof ? am_normal : term, 0);
+ erts_deliver_port_exit(prt, prt->common.id, eof ? am_normal : term, 0, 0);
}
return 0;
}
@@ -7166,7 +7494,7 @@ char *driver_dl_error(void)
#define ERL_DRV_SYS_INFO_SIZE(LAST_FIELD) \
- (((size_t) &((ErlDrvSysInfo *) 0)->LAST_FIELD) \
+ (offsetof(ErlDrvSysInfo, LAST_FIELD) \
+ sizeof(((ErlDrvSysInfo *) 0)->LAST_FIELD))
void
@@ -7182,7 +7510,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);
@@ -7228,6 +7556,20 @@ driver_system_info(ErlDrvSysInfo *sip, size_t si_size)
sip->nif_major_version = ERL_NIF_MAJOR_VERSION;
sip->nif_minor_version = ERL_NIF_MINOR_VERSION;
}
+ /*
+ * 'dirty_scheduler_support' is the last field in the 4th version
+ * (driver version 3.1, NIF version 2.7)
+ */
+ if (si_size >= ERL_DRV_SYS_INFO_SIZE(dirty_scheduler_support)) {
+ sip->dirty_scheduler_support =
+#ifdef ERTS_DIRTY_SCHEDULERS
+ 1
+#else
+ 0
+#endif
+ ;
+ }
+
}
@@ -7291,6 +7633,8 @@ no_stop_select_callback(ErlDrvEvent event, void* private)
erts_send_error_to_logger_nogl(dsbufp);
}
+#define IS_DRIVER_VERSION_GE(DE,MAJOR,MINOR) \
+ ((DE)->major_version >= (MAJOR) && (DE)->minor_version >= (MINOR))
static int
init_driver(erts_driver_t *drv, ErlDrvEntry *de, DE_Handle *handle)
@@ -7303,23 +7647,16 @@ init_driver(erts_driver_t *drv, ErlDrvEntry *de, DE_Handle *handle)
drv->flags = de->driver_flags;
drv->handle = handle;
#ifdef ERTS_SMP
- if (drv->flags & ERL_DRV_FLAG_USE_PORT_LOCKING)
- drv->lock = NULL;
- else {
- drv->lock = erts_alloc(ERTS_ALC_T_DRIVER_LOCK,
- sizeof(erts_mtx_t));
- erts_mtx_init_x(drv->lock,
- "driver_lock",
-#if defined(ERTS_ENABLE_LOCK_CHECK) || defined(ERTS_ENABLE_LOCK_COUNT)
- erts_atom_put((byte *) drv->name,
- sys_strlen(drv->name),
- ERTS_ATOM_ENC_LATIN1,
- 1),
-#else
- NIL,
-#endif
- 1
- );
+ if (drv->flags & ERL_DRV_FLAG_USE_PORT_LOCKING) {
+ drv->lock = NULL;
+ } else {
+ Eterm driver_id = erts_atom_put((byte *) drv->name,
+ sys_strlen(drv->name),
+ ERTS_ATOM_ENC_LATIN1, 1);
+
+ drv->lock = erts_alloc(ERTS_ALC_T_DRIVER_LOCK, sizeof(erts_mtx_t));
+
+ erts_mtx_init(drv->lock, "driver_lock", driver_id, ERTS_LOCK_FLAGS_CATEGORY_IO);
}
#endif
drv->entry = de;
@@ -7338,6 +7675,7 @@ init_driver(erts_driver_t *drv, ErlDrvEntry *de, DE_Handle *handle)
drv->timeout = de->timeout ? de->timeout : no_timeout_callback;
drv->ready_async = de->ready_async;
drv->process_exit = de->process_exit;
+ drv->emergency_close = IS_DRIVER_VERSION_GE(de,3,2) ? de->emergency_close : NULL;
if (de->stop_select)
drv->stop_select = de->stop_select;
else
@@ -7350,12 +7688,16 @@ init_driver(erts_driver_t *drv, ErlDrvEntry *de, DE_Handle *handle)
int fpe_was_unmasked = erts_block_fpe();
DTRACE4(driver_init, drv->name, drv->version.major, drv->version.minor,
drv->flags);
+ LTTNG4(driver_init, drv->name, drv->version.major, drv->version.minor,
+ drv->flags);
res = (*de->init)();
erts_unblock_fpe(fpe_was_unmasked);
return res;
}
}
+#undef IS_DRIVER_VERSION_GE
+
void
erts_destroy_driver(erts_driver_t *drv)
{
@@ -7472,15 +7814,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
@@ -7499,7 +7841,7 @@ Port *erts_get_heart_port(void)
if (!port)
continue;
/* only examine undead or alive ports */
- if (erts_atomic32_read_nob(&port->state) & ERTS_PORT_SFLGS_DEAD)
+ if (erts_atomic32_read_nob(&port->state) & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP)
continue;
/* immediate atom compare */
reg = port->common.u.alive.reg;
@@ -7510,3 +7852,23 @@ Port *erts_get_heart_port(void)
return NULL;
}
+
+void erts_emergency_close_ports(void)
+{
+ int ix, max = erts_ptab_max(&erts_port);
+
+ for (ix = 0; ix < max; ix++) {
+ Port *port = erts_pix2port(ix);
+
+ if (!port)
+ continue;
+ /* only examine undead or alive ports */
+ if (erts_atomic32_read_nob(&port->state) & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP)
+ continue;
+
+ /* emergency close socket */
+ if (port->drv_ptr->emergency_close) {
+ port->drv_ptr->emergency_close((ErlDrvData) port->drv_data);
+ }
+ }
+}
diff --git a/erts/emulator/beam/lttng-wrapper.h b/erts/emulator/beam/lttng-wrapper.h
new file mode 100644
index 0000000000..0bc75c1552
--- /dev/null
+++ b/erts/emulator/beam/lttng-wrapper.h
@@ -0,0 +1,107 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 1996-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%
+ */
+
+#ifndef __LTTNG_WRAPPER_H__
+#define __LTTNG_WRAPPER_H__
+
+#ifdef USE_LTTNG
+
+#include "erlang_lttng.h"
+#define USE_LTTNG_VM_TRACEPOINTS
+
+#define LTTNG_BUFFER_SZ (256)
+#define LTTNG_PROC_BUFFER_SZ (16)
+#define LTTNG_PORT_BUFFER_SZ (20)
+#define LTTNG_MFA_BUFFER_SZ (256)
+
+#define lttng_decl_procbuf(Name) \
+ char Name[LTTNG_PROC_BUFFER_SZ]
+
+#define lttng_decl_portbuf(Name) \
+ char Name[LTTNG_PORT_BUFFER_SZ]
+
+#define lttng_decl_mfabuf(Name) \
+ char Name[LTTNG_MFA_BUFFER_SZ]
+
+#define lttng_decl_carrier_stats(Name) \
+ lttng_carrier_stats_t Name##_STATSTRUCT, *Name = &Name##_STATSTRUCT
+
+#define lttng_pid_to_str(pid, name) \
+ erts_snprintf(name, LTTNG_PROC_BUFFER_SZ, "%T", (pid))
+
+#define lttng_portid_to_str(pid, name) \
+ erts_snprintf(name, LTTNG_PORT_BUFFER_SZ, "%T", (pid))
+
+#define lttng_proc_to_str(p, name) \
+ lttng_pid_to_str(((p) ? (p)->common.id : ERTS_INVALID_PID), name)
+
+#define lttng_port_to_str(p, name) \
+ lttng_portid_to_str(((p) ? (p)->common.id : ERTS_INVALID_PORT), name)
+
+#define lttng_mfa_to_str(m,f,a, Name) \
+ erts_snprintf(Name, LTTNG_MFA_BUFFER_SZ, "%T:%T/%lu", (Eterm)(m), (Eterm)(f), (Uint)(a))
+
+#define lttng_proc_to_mfa_str(p, Name) \
+ do { \
+ if (ERTS_PROC_IS_EXITING((p))) { \
+ strcpy(Name, "<exiting>"); \
+ } else { \
+ BeamInstr *_fptr = find_function_from_pc((p)->i); \
+ if (_fptr) { \
+ lttng_mfa_to_str(_fptr[0],_fptr[1],_fptr[2], Name); \
+ } else { \
+ strcpy(Name, "<unknown>"); \
+ } \
+ } \
+ } while(0)
+
+/* ErtsRunQueue->ErtsSchedulerData->Uint */
+#define lttng_rq_to_id(RQ) \
+ (RQ)->scheduler->no
+
+#define LTTNG_ENABLED(Name) \
+ tracepoint_enabled(org_erlang_otp, Name)
+
+/* include a special LTTNG_DO for do_tracepoint ? */
+#define LTTNG1(Name, Arg1) \
+ tracepoint(org_erlang_otp, Name, (Arg1))
+
+#define LTTNG2(Name, Arg1, Arg2) \
+ tracepoint(org_erlang_otp, Name, (Arg1), (Arg2))
+
+#define LTTNG3(Name, Arg1, Arg2, Arg3) \
+ tracepoint(org_erlang_otp, Name, (Arg1), (Arg2), (Arg3))
+
+#define LTTNG4(Name, Arg1, Arg2, Arg3, Arg4) \
+ tracepoint(org_erlang_otp, Name, (Arg1), (Arg2), (Arg3), (Arg4))
+
+#define LTTNG5(Name, Arg1, Arg2, Arg3, Arg4, Arg5) \
+ tracepoint(org_erlang_otp, Name, (Arg1), (Arg2), (Arg3), (Arg4), (Arg5))
+
+#else /* USE_LTTNG */
+
+#define LTTNG1(Name, Arg1) do {} while(0)
+#define LTTNG2(Name, Arg1, Arg2) do {} while(0)
+#define LTTNG3(Name, Arg1, Arg2, Arg3) do {} while(0)
+#define LTTNG4(Name, Arg1, Arg2, Arg3, Arg4) do {} while(0)
+#define LTTNG5(Name, Arg1, Arg2, Arg3, Arg4, Arg5) do {} while(0)
+
+#endif /* USE_LTTNG */
+#endif /* __LTTNG_WRAPPER_H__ */
diff --git a/erts/emulator/beam/module.c b/erts/emulator/beam/module.c
index daa6e136c5..a386407ec2 100644
--- a/erts/emulator/beam/module.c
+++ b/erts/emulator/beam/module.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -25,6 +26,7 @@
#include "erl_vm.h"
#include "global.h"
#include "module.h"
+#include "beam_catches.h"
#ifdef DEBUG
# define IF_DEBUG(x) x
@@ -49,7 +51,7 @@ static erts_smp_atomic_t tot_module_bytes;
#include "erl_smp.h"
-void module_info(int to, void *to_arg)
+void module_info(fmtfn_t to, void *to_arg)
{
index_info(to, to_arg, &module_tables[erts_active_code_ix()]);
}
@@ -66,6 +68,18 @@ static int module_cmp(Module* tmpl, Module* obj)
return tmpl->module != obj->module;
}
+void erts_module_instance_init(struct erl_module_instance* modi)
+{
+ modi->code_hdr = 0;
+ modi->code_length = 0;
+ modi->catches = BEAM_CATCHES_NIL;
+ modi->nif = NULL;
+ modi->num_breakpoints = 0;
+ modi->num_traced_exports = 0;
+#ifdef HIPE
+ modi->hipe_code = NULL;
+#endif
+}
static Module* module_alloc(Module* tmpl)
{
@@ -73,17 +87,11 @@ 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_length = 0;
- obj->old.code_length = 0;
obj->slot.index = -1;
- obj->curr.nif = NULL;
- obj->old.nif = NULL;
- obj->curr.num_breakpoints = 0;
- obj->old.num_breakpoints = 0;
- obj->curr.num_traced_exports = 0;
- obj->old.num_traced_exports = 0;
+ erts_module_instance_init(&obj->curr);
+ erts_module_instance_init(&obj->old);
+ obj->on_load = 0;
+ DBG_TRACE_MFA(make_atom(obj->module), 0, 0, "module_alloc");
return obj;
}
@@ -102,6 +110,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",
@@ -109,11 +120,13 @@ void init_module_table(void)
}
for (i=0; i<ERTS_NUM_CODE_IX; i++) {
- erts_smp_rwmtx_init_x(&the_old_code_rwlocks[i], "old_code", make_small(i));
+ erts_smp_rwmtx_init(&the_old_code_rwlocks[i], "old_code", make_small(i),
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
}
erts_smp_atomic_init_nob(&tot_module_bytes, 0);
}
+
Module*
erts_get_module(Eterm mod, ErtsCodeIndex code_ix)
{
@@ -134,19 +147,14 @@ erts_get_module(Eterm mod, ErtsCodeIndex code_ix)
}
}
-Module*
-erts_put_module(Eterm mod)
+
+static Module* put_module(Eterm mod, IndexTable* mod_tab)
{
Module e;
- IndexTable* mod_tab;
int oldsz, newsz;
Module* res;
ASSERT(is_atom(mod));
- ERTS_SMP_LC_ASSERT(erts_initialized == 0
- || erts_has_code_write_permission());
-
- mod_tab = &module_tables[erts_staging_code_ix()];
e.module = atom_val(mod);
oldsz = index_table_sz(mod_tab);
res = (Module*) index_put_entry(mod_tab, (void*) &e);
@@ -155,6 +163,15 @@ erts_put_module(Eterm mod)
return res;
}
+Module*
+erts_put_module(Eterm mod)
+{
+ ERTS_SMP_LC_ASSERT(erts_initialized == 0
+ || erts_has_code_write_permission());
+
+ return put_module(mod, &module_tables[erts_staging_code_ix()]);
+}
+
Module *module_code(int i, ErtsCodeIndex code_ix)
{
return (Module*) erts_index_lookup(&module_tables[code_ix], i);
@@ -176,6 +193,13 @@ static ErtsCodeIndex dbg_load_code_ix = 0;
static int entries_at_start_staging = 0;
+static ERTS_INLINE void copy_module(Module* dst_mod, Module* src_mod)
+{
+ dst_mod->curr = src_mod->curr;
+ dst_mod->old = src_mod->old;
+ dst_mod->on_load = src_mod->on_load;
+}
+
void module_start_staging(void)
{
IndexTable* src = &module_tables[erts_active_code_ix()];
@@ -194,9 +218,7 @@ void module_start_staging(void)
src_mod = (Module*) erts_index_lookup(src, i);
dst_mod = (Module*) erts_index_lookup(dst, i);
ASSERT(src_mod->module == dst_mod->module);
-
- dst_mod->curr = src_mod->curr;
- dst_mod->old = src_mod->old;
+ copy_module(dst_mod, src_mod);
}
/*
@@ -208,8 +230,7 @@ void module_start_staging(void)
dst_mod = (Module*) index_put_entry(dst, src_mod);
ASSERT(dst_mod != src_mod);
- dst_mod->curr = src_mod->curr;
- dst_mod->old = src_mod->old;
+ copy_module(dst_mod, src_mod);
}
newsz = index_table_sz(dst);
erts_smp_atomic_add_nob(&tot_module_bytes, (newsz - oldsz));
@@ -235,4 +256,3 @@ void module_end_staging(int commit)
IF_DEBUG(dbg_load_code_ix = -1);
}
-
diff --git a/erts/emulator/beam/module.h b/erts/emulator/beam/module.h
index 5235528e98..9d258d5dbf 100644
--- a/erts/emulator/beam/module.h
+++ b/erts/emulator/beam/module.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -20,34 +21,42 @@
#ifndef __MODULE_H__
#define __MODULE_H__
-#ifndef __INDEX_H__
#include "index.h"
+
+#ifdef HIPE
+#include "hipe_module.h"
#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;
int num_breakpoints;
int num_traced_exports;
+#ifdef HIPE
+ HipeModule *hipe_code;
+#endif
};
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 */
+ struct erl_module_instance* on_load;
} Module;
+void erts_module_instance_init(struct erl_module_instance* modi);
Module* erts_get_module(Eterm mod, ErtsCodeIndex code_ix);
Module* erts_put_module(Eterm mod);
void init_module_table(void);
void module_start_staging(void);
void module_end_staging(int commit);
-void module_info(int, void *);
+void module_info(fmtfn_t, void *);
Module *module_code(int, ErtsCodeIndex);
int module_code_size(ErtsCodeIndex);
diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab
index 68fcc177ae..44613c7d85 100644
--- a/erts/emulator/beam/ops.tab
+++ b/erts/emulator/beam/ops.tab
@@ -1,18 +1,19 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1997-2013. All Rights Reserved.
+# Copyright Ericsson AB 1997-2017. 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/.
+# 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
#
-# 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.
+# 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%
#
@@ -38,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,
@@ -75,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
@@ -93,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
@@ -166,62 +160,37 @@ 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 r f I
-i_select_val x f I
-i_select_val y f I
+i_select_val_bins x f I
+i_select_val_bins y f I
-i_select_val2 r f c f c f
-i_select_val2 x f c f c f
-i_select_val2 y f c f c f
+i_select_val_lins x f I
+i_select_val_lins y f I
-i_select_tuple_arity2 r f A f A f
-i_select_tuple_arity2 x f A f A f
-i_select_tuple_arity2 y f A f A 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_jump_on_val_zero r f I
+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 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
-jump Target | label Lbl | same_label(Target, Lbl) => label Lbl
-
-is_ne_exact L1 S1 S2 | jump Fail | label L2 | same_label(L1, L2) => \
- is_eq_exact Fail S1 S2 | label 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
+get_list xy xy xy
+# 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
@@ -232,33 +201,32 @@ 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
+i_get_tuple_element xy P x
%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
+i_get_tuple_element xy P y
%hot
+%macro: i_get_tuple_element2 GetTupleElement2 -pack
+i_get_tuple_element2 x P x
+
+%macro: i_get_tuple_element2y GetTupleElement2Y -pack
+i_get_tuple_element2y x P y y
+
+%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
@@ -268,35 +236,121 @@ 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
+
+# Operands for raise/2 are almost always in x(2) and x(1).
+# Optimize for that case.
+raise x==2 x==1 => i_raise
+raise Trace=y Value=y => move Trace x=2 | move Value x=1 | i_raise
+raise Trace Value => move Trace x=3 | move Value x=1 | move x=3 x=2 | i_raise
+
+i_raise
# Internal now, but could be useful to make known to the compiler.
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
-move_jump f c
-move_jump f x
-move_jump f y
+move_jump f ncxy
+
+# Movement to and from the stack is common
+# Try to pack as much as we can into one instruction
+
+# Window move
+move_window/5
+move_window/6
+
+# x -> y
+
+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
+
+move_window X1=x X2=x X3=x Y1=y Y3=y | move X4=x Y4=y | succ(Y3,Y4) => \
+ move_window X1 X2 X3 X4 Y1 Y4
+
+move_window X1=x X2=x X3=x X4=x Y1=y Y4=y | move X5=x Y5=y | succ(Y4,Y5) => \
+ move_window5 X1 X2 X3 X4 X5 Y1
+
+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
+
+# 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_apply(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
+
+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
+
+%macro: swap_temp SwapTemp -pack
+swap_temp x xy x
+
+%macro: swap Swap -pack
+swap x xy
+
+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
-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
+# 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
@@ -304,33 +358,57 @@ 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 xy x xy
+
+%macro: move2_par Move2Par -pack
+
+move2_par x y x y
+move2_par y x y x
+move2_par x x x x
+
+move2_par x x x y
+
+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
# The compiler almost never generates a "move Literal y(Y)" instruction,
# so let's cheat if we encounter one.
move S=n D=y => init D
move S=c D=y => move S x | move x D
-%macro:move Move -pack -gen_dest
+%macro:move Move -pack
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
@@ -345,7 +423,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
@@ -363,48 +441,56 @@ 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
-#
-# All other comparisons.
-#
+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 xy
+is_eq_exact f s s
+
+%macro: is_lt IsLessThan -fail_action
+is_lt f x x
+is_lt f x c
+is_lt f c x
+%cold
+is_lt f s s
+%hot
-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_ge IsGreaterEqual -fail_action
+is_ge f x x
+is_ge f x c
+is_ge f c x
+%cold
+is_ge f s s
+%hot
-is_ge Lbl S1 S2 => i_fetch S1 S2 | i_is_ge Lbl
-is_lt Lbl S1 S2 => i_fetch S1 S2 | i_is_lt 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_ne_exact NotEqualExact -fail_action
+is_ne_exact 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_eq Equal -fail_action
+is_eq f s s
+
+%macro: is_ne NotEqual -fail_action
+is_ne f s s
#
# Putting things.
@@ -422,91 +508,52 @@ 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
#
-# The instruction "put_list Const [] Dst" will not be generated by
-# the current BEAM compiler. But until R15A, play it safe by handling
-# that instruction with the following transformation.
+# The instruction "put_list Const [] Dst" were generated in rare
+# circumstances up to and including OTP 18. Starting with OTP 19,
+# AFAIK, it should never be generated.
#
put_list Const=c n Dst => move Const x | put_list x n Dst
-%macro:put_list PutList -pack -gen_dest
+%macro:put_list PutList -pack
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 c
-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 s s
+put_list s s d
%hot
#
@@ -528,143 +575,117 @@ 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
+#
+# is_tagged_tuple Fail=f Src=rxy Arity Atom=a
+#
+
+is_tagged_tuple Fail Literal=q Arity Atom => \
+ move Literal x | is_tagged_tuple Fail x Arity Atom
+is_tagged_tuple Fail=f c Arity Atom => jump Fail
+
+%macro:is_tagged_tuple IsTaggedTuple -fail_action
+
+is_tagged_tuple f rxy A a
+
# Test tuple & arity (head)
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 x A
-is_tuple_of_arity f y A
-is_tuple_of_arity f r A
+is_tuple_of_arity f rxy A
%macro: is_tuple IsTuple -fail_action
-is_tuple f x
-is_tuple f y
-is_tuple f r
+is_tuple f rxy
test_arity Fail Literal=q Arity => move Literal x | test_arity Fail x Arity
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
+test_arity f xy A
-original_reg Reg Pos =>
+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
-original_reg/2
+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_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=y | get_tuple_element Reg=x P2 D2=y | \
+ succ(P1, P2) => i_get_tuple_element2y Reg P1 D1 D2
-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_integer f xy
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 rx 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 rx x x
%macro: is_nonempty_list IsNonemptyList -fail_action
-is_nonempty_list f x
-is_nonempty_list f y
-is_nonempty_list f r
+is_nonempty_list f xy
%macro: is_atom IsAtom -fail_action
is_atom f x
-is_atom f r
%cold
is_atom f y
%hot
@@ -672,7 +693,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
@@ -684,14 +704,11 @@ is_nil Fail=f n =>
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_nil f xy
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
@@ -703,7 +720,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
@@ -711,7 +727,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
@@ -719,7 +734,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
@@ -727,7 +741,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
@@ -739,14 +752,11 @@ 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
+is_boolean f xy
%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
@@ -763,24 +773,23 @@ allocate_init t I y
#################################################################
#
-# The BIFs erts_internal:check_process_code/2 must be called like a function,
+# The BIFs erts_internal:check_process_code/1 must be called like a function,
# to ensure that c_p->i (program counter) is set correctly (an ordinary
# BIF call doesn't set it).
#
-call_ext u==2 Bif=u$bif:erts_internal:check_process_code/2 => i_call_ext Bif
-call_ext_last u==2 Bif=u$bif:erts_internal:check_process_code/2 D => i_call_ext_last Bif D
-call_ext_only u==2 Bif=u$bif:erts_internal:check_process_code/2 => i_call_ext_only Bif
+call_ext u==1 Bif=u$bif:erts_internal:check_process_code/1 => i_call_ext Bif
+call_ext_last u==1 Bif=u$bif:erts_internal:check_process_code/1 D => i_call_ext_last Bif D
+call_ext_only u==1 Bif=u$bif:erts_internal:check_process_code/1 => i_call_ext_only Bif
#
-# The BIFs erlang:garbage_collect/0 must be called like a function,
+# The BIFs erts_internal:garbage_collect/1 must be called like a function,
# to allow them to invoke the garbage collector. (The stack pointer must
# be saved and p->arity must be zeroed, which is not done on ordinary BIF calls.)
#
-
-call_ext u==0 Bif=u$bif:erlang:garbage_collect/0 => i_call_ext Bif
-call_ext_last u==0 Bif=u$bif:erlang:garbage_collect/0 D => i_call_ext_last Bif D
-call_ext_only u==0 Bif=u$bif:erlang:garbage_collect/0 => i_call_ext_only Bif
+call_ext u==1 Bif=u$bif:erts_internal:garbage_collect/1 => i_call_ext Bif
+call_ext_last u==1 Bif=u$bif:erts_internal:garbage_collect/1 D => i_call_ext_last Bif D
+call_ext_only u==1 Bif=u$bif:erts_internal:garbage_collect/1 => i_call_ext_only Bif
#
# put/2 and erase/1 must be able to do garbage collection, so we must call
@@ -886,76 +895,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
@@ -963,10 +972,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.
@@ -988,9 +1004,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
@@ -1006,6 +1022,8 @@ i_apply_fun_only
i_hibernate
+i_perf_counter
+
call_bif e
#
@@ -1015,80 +1033,70 @@ 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
+self xy
%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 xy 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 xy 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 xy 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
@@ -1102,9 +1110,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.
@@ -1122,9 +1130,7 @@ i_make_fun I t
%hot
%macro: is_function IsFunction -fail_action
-is_function f x
-is_function f y
-is_function f r
+is_function f xy
is_function Fail=f c => jump Fail
func_info M F A => i_func_info u M F A
@@ -1136,131 +1142,103 @@ 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
+i_bs_start_match2 xy 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
+%macro: i_bs_get_binary_imm2 BsGetBinaryImm_2 -fail_action
+%macro: i_bs_get_binary2 BsGetBinary_2 -fail_action
+%macro: i_bs_get_binary_all2 BsGetBinaryAll_2 -fail_action
+
+i_bs_get_binary_imm2 f x I I I x
+i_bs_get_binary2 f x I s I x
+i_bs_get_binary_all2 f x I I x
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
+%macro: i_bs_get_float2 BsGetFloat2 -fail_action
+i_bs_get_float2 f x I s I x
# 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
+i_bs_skip_bits2 f x xy 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
#
@@ -1282,13 +1260,11 @@ 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 xy 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
@@ -1305,39 +1281,34 @@ 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 xy 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)
@@ -1351,32 +1322,20 @@ 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
+bs_put_utf16 j I s
-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
@@ -1387,9 +1346,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)
@@ -1403,8 +1359,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)
@@ -1469,144 +1423,147 @@ apply_last I P
# Map instructions in R17.
#
-put_map_assoc F n Dst Live Size Rest=* => new_map F Dst Live Size Rest
-put_map_assoc F Src=s Dst Live Size Rest=* => \
+sorted_put_map_assoc/5
+put_map_assoc F Map Dst Live Size Rest=* | map_key_sort(Size, Rest) => \
+ sorted_put_map_assoc F Map Dst Live Size Rest
+
+sorted_put_map_exact/5
+put_map_exact F Map Dst Live Size Rest=* | map_key_sort(Size, Rest) => \
+ sorted_put_map_exact F Map Dst Live Size Rest
+
+sorted_put_map_assoc j Map Dst Live Size Rest=* | is_empty_map(Map) => \
+ new_map Dst Live Size Rest
+sorted_put_map_assoc F Src=s Dst Live Size Rest=* => \
update_map_assoc F Src Dst Live Size Rest
-put_map_assoc F Src Dst Live Size Rest=* => \
+sorted_put_map_assoc F Src Dst Live Size Rest=* => \
move Src x | update_map_assoc F x Dst Live Size Rest
-put_map_exact F n Dst Live Size Rest=* => new_map F Dst Live Size Rest
-put_map_exact F Src=s Dst Live Size Rest=* => \
+
+sorted_put_map_exact F Src=s Dst Live Size Rest=* => \
update_map_exact F Src Dst Live Size Rest
-put_map_exact F Src Dst Live Size Rest=* => \
+sorted_put_map_exact F Src Dst Live Size Rest=* => \
move Src x | update_map_exact F x Dst Live Size Rest
-new_map j d I I
+new_map d I I
update_map_assoc j s d I I
update_map_exact j s d I I
-is_map Fail Literal=q => move Literal x | is_map Fail x
-is_map Fail c => jump Fail
+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
-
-## Transform has_map_field(s) #{ K1 := _, K2 := _ }
-
-has_map_field/3
+is_map f xy
-has_map_fields Fail Src Size=u==1 Rest=* => gen_has_map_field(Fail,Src,Size,Rest)
-has_map_fields Fail Src Size Rest=* => i_has_map_fields Fail Src Size Rest
+## Transform has_map_fields #{ K1 := _, K2 := _ } to has_map_elements
-i_has_map_fields f s I
-
-has_map_field Fail Src=rxy Key=arxy => i_has_map_field Fail Src Key
-has_map_field Fail Src Key => move Key x | i_has_map_field Fail Src x
-
-%macro: i_has_map_field HasMapField -fail_action
-i_has_map_field f r a
-i_has_map_field f x a
-i_has_map_field f y a
-i_has_map_field f r r
-i_has_map_field f x r
-i_has_map_field f y r
-i_has_map_field f r x
-i_has_map_field f x x
-i_has_map_field f y x
-i_has_map_field f r y
-i_has_map_field f x y
-i_has_map_field f y y
+has_map_fields Fail Src Size Rest=* => \
+ gen_has_map_fields(Fail, Src, Size, Rest)
## Transform get_map_elements(s) #{ K1 := V1, K2 := V2 }
-get_map_element/4
-
-get_map_elements Fail Src=rxy Size=u==2 Rest=* => gen_get_map_element(Fail,Src,Size,Rest)
-get_map_elements Fail Src Size Rest=* => i_get_map_elements Fail Src Size 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
-get_map_element Fail Src=rxy Key=ax Dst => i_get_map_element Fail Src Key Dst
-get_map_element Fail Src=rxy Key=rycq Dst => \
+i_get_map_element Fail Src=xy Key=y Dst => \
move Key x | i_get_map_element Fail Src x Dst
-get_map_element Fail Src Key Dst => jump Fail
+
+%macro: i_get_map_element_hash GetMapElementHash -fail_action
+i_get_map_element_hash f xy c I xy
%macro: i_get_map_element GetMapElement -fail_action
-i_get_map_element f r a r
-i_get_map_element f x a r
-i_get_map_element f y a r
-i_get_map_element f r a x
-i_get_map_element f x a x
-i_get_map_element f y a x
-i_get_map_element f r a y
-i_get_map_element f x a y
-i_get_map_element f y a y
-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
+i_get_map_element f xy x xy
+
+#
+# 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 S2 Dst=d => i_fetch S1 S2 | i_plus Fail I 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 S1 S2 Dst => i_plus Fail Live S1 S2 Dst
+
+gen_minus Fail Live S1 S2 Dst => i_minus Fail Live S1 S2 Dst
+
+gc_bif2 Fail Live u$bif:erlang:stimes/2 S1 S2 Dst => \
+ i_times Fail Live S1 S2 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_bif2 Fail Live u$bif:erlang:rem/2 S1 S2 Dst => \
+ i_rem 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 S2 Dst=d => i_fetch S1 S2 | i_rem Fail I 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 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:band/2 S1 S2 Dst => \
+ i_band Fail Live 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:bor/2 S1 S2 Dst => \
+ i_bor Fail Live S1 S2 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
-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
+i_increment rxy I I d
+
+i_plus j I x xy d
+i_plus j I s s d
+
+i_minus j I x x d
+i_minus j I s s d
+
+i_times j I s s d
-i_increment r I I d
-i_increment x I I d
-i_increment y I I d
+i_m_div j I s s d
+i_int_div j I s s d
-i_plus j I d
-i_minus j I d
-i_times j I d
-i_m_div j I d
-i_int_div j I d
-i_rem j I d
+i_rem j I x x 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 d
-i_bor j I d
-i_bxor j I d
+i_band j I x c 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
@@ -1632,21 +1589,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/packet_parser.c b/erts/emulator/beam/packet_parser.c
index db0e78b1a7..f14910bc72 100644
--- a/erts/emulator/beam/packet_parser.c
+++ b/erts/emulator/beam/packet_parser.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2008-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2008-2016. 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.
+ * 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%
*/
@@ -255,6 +256,7 @@ int packet_get_length(enum PacketParseType htype,
const char* ptr, unsigned n, /* Bytes read so far */
unsigned max_plen, /* Max packet length, 0=no limit */
unsigned trunc_len, /* Truncate (lines) if longer, 0=no limit */
+ char delimiter, /* Line delimiting character */
int* statep) /* Protocol specific state */
{
unsigned hlen, plen;
@@ -298,9 +300,9 @@ int packet_get_length(enum PacketParseType htype,
goto remain;
case TCP_PB_LINE_LF: {
- /* TCP_PB_LINE_LF: [Data ... \n] */
+ /* TCP_PB_LINE_LF: [Data ... Delimiter] */
const char* ptr2;
- if ((ptr2 = memchr(ptr, '\n', n)) == NULL) {
+ if ((ptr2 = memchr(ptr, delimiter, n)) == NULL) {
if (n > max_plen && max_plen != 0) { /* packet full */
DEBUGF((" => packet full (no NL)=%d\r\n", n));
goto error;
diff --git a/erts/emulator/beam/packet_parser.h b/erts/emulator/beam/packet_parser.h
index 1c3a9aa3da..358d650804 100644
--- a/erts/emulator/beam/packet_parser.h
+++ b/erts/emulator/beam/packet_parser.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2008-2009. All Rights Reserved.
+ * Copyright Ericsson AB 2008-2016. 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.
+ * 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%
*/
@@ -104,7 +105,8 @@ int packet_get_length(enum PacketParseType htype,
const char* ptr, unsigned n, /* Bytes read so far */
unsigned max_plen, /* Packet max length, 0=no limit */
unsigned trunc_len, /* Truncate (lines) if longer, 0=no limit */
- int* statep); /* Internal protocol state */
+ char delimiter, /* Line delimiting character */
+ int* statep); /* Internal protocol state */
ERTS_GLB_INLINE
void packet_get_body(enum PacketParseType htype,
diff --git a/erts/emulator/beam/register.c b/erts/emulator/beam/register.c
index c626cb2780..bf3267cff1 100644
--- a/erts/emulator/beam/register.c
+++ b/erts/emulator/beam/register.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -101,7 +102,7 @@ is_proc_alive(Process *p)
return !ERTS_PROC_IS_EXITING(p);
}
-void register_info(int to, void *to_arg)
+void register_info(fmtfn_t to, void *to_arg)
{
int lock = !ERTS_IS_CRASH_DUMPING;
if (lock)
@@ -124,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;
@@ -144,12 +145,16 @@ void init_register_table(void)
rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_FREQUENT_READ;
rwmtx_opt.lived = ERTS_SMP_RWMTX_LONG_LIVED;
- erts_smp_rwmtx_init_opt(&regtab_rwmtx, &rwmtx_opt, "reg_tab");
+ erts_smp_rwmtx_init_opt(&regtab_rwmtx, &rwmtx_opt, "reg_tab", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
f.hash = (H_FUN) reg_hash;
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);
@@ -222,7 +227,8 @@ int erts_register_name(Process *c_p, Eterm name, Eterm id)
rp = (RegProc*) hash_put(&process_reg, (void*) &r);
if (proc && rp->p == proc) {
if (IS_TRACED_FL(proc, F_TRACE_PROCS)) {
- trace_proc(c_p, proc, am_register, name);
+ trace_proc(proc, ERTS_PROC_LOCK_MAIN,
+ proc, am_register, name);
}
proc->common.u.alive.reg = rp;
}
@@ -267,10 +273,13 @@ erts_whereis_name_to_id(Process *c_p, Eterm name)
int ix;
HashBucket* b;
#ifdef ERTS_SMP
- ErtsProcLocks c_p_locks = c_p ? ERTS_PROC_LOCK_MAIN : 0;
-
- ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(c_p);
+ ErtsProcLocks c_p_locks = 0;
+ if (c_p) {
+ c_p_locks = ERTS_PROC_LOCK_MAIN;
+ ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(c_p);
+ }
reg_safe_read_lock(c_p, &c_p_locks);
+
if (c_p && !c_p_locks)
erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
#endif
@@ -315,7 +324,8 @@ erts_whereis_name(Process *c_p,
Process** proc,
ErtsProcLocks need_locks,
int flags,
- Port** port)
+ Port** port,
+ int lock_port)
{
RegProc* rp = NULL;
HashValue hval;
@@ -380,8 +390,6 @@ erts_whereis_name(Process *c_p,
erts_smp_proc_unlock(rp->p, need_locks);
*proc = NULL;
}
- if (*proc && (flags & ERTS_P2P_FLG_SMP_INC_REFC))
- erts_smp_proc_inc_refc(rp->p);
}
#else
if (rp->p
@@ -390,6 +398,8 @@ erts_whereis_name(Process *c_p,
else
*proc = NULL;
#endif
+ if (*proc && (flags & ERTS_P2P_FLG_INC_REFC))
+ erts_proc_inc_refc(*proc);
}
}
@@ -398,31 +408,33 @@ erts_whereis_name(Process *c_p,
*port = NULL;
else {
#ifdef ERTS_SMP
- if (pending_port == rp->pt)
- pending_port = NULL;
- else {
- if (pending_port) {
- /* Ahh! Registered port changed while reg lock
- was unlocked... */
- erts_port_release(pending_port);
- pending_port = NULL;
- }
+ if (lock_port) {
+ if (pending_port == rp->pt)
+ pending_port = NULL;
+ else {
+ if (pending_port) {
+ /* Ahh! Registered port changed while reg lock
+ was unlocked... */
+ erts_port_release(pending_port);
+ pending_port = NULL;
+ }
- if (erts_smp_port_trylock(rp->pt) == EBUSY) {
- Eterm id = rp->pt->common.id; /* id read only... */
- /* Unlock all locks, acquire port lock, and restart... */
- if (current_c_p_locks) {
- erts_smp_proc_unlock(c_p, current_c_p_locks);
- current_c_p_locks = 0;
- }
- reg_read_unlock();
- pending_port = erts_id2port(id);
- goto restart;
- }
- }
+ if (erts_smp_port_trylock(rp->pt) == EBUSY) {
+ Eterm id = rp->pt->common.id; /* id read only... */
+ /* Unlock all locks, acquire port lock, and restart... */
+ if (current_c_p_locks) {
+ erts_smp_proc_unlock(c_p, current_c_p_locks);
+ current_c_p_locks = 0;
+ }
+ reg_read_unlock();
+ pending_port = erts_id2port(id);
+ goto restart;
+ }
+ }
+ ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(rp->pt));
+ }
#endif
*port = rp->pt;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(*port));
}
}
@@ -444,7 +456,7 @@ erts_whereis_process(Process *c_p,
int flags)
{
Process *proc;
- erts_whereis_name(c_p, c_p_locks, name, &proc, need_locks, flags, NULL);
+ erts_whereis_name(c_p, c_p_locks, name, &proc, need_locks, flags, NULL, 0);
return proc;
}
@@ -463,8 +475,8 @@ int erts_unregister_name(Process *c_p,
int res = 0;
RegProc r, *rp;
Port *port = c_prt;
+ ErtsProcLocks current_c_p_locks = 0;
#ifdef ERTS_SMP
- ErtsProcLocks current_c_p_locks;
/*
* SMP note: If 'c_prt != NULL' and 'c_prt->reg->name == name',
@@ -530,8 +542,12 @@ int erts_unregister_name(Process *c_p,
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(port));
rp->pt->common.u.alive.reg = NULL;
-
+
if (IS_TRACED_FL(port, F_TRACE_PORTS)) {
+ if (current_c_p_locks) {
+ erts_smp_proc_unlock(c_p, current_c_p_locks);
+ current_c_p_locks = 0;
+ }
trace_port(port, am_unregister, r.name);
}
@@ -548,7 +564,8 @@ int erts_unregister_name(Process *c_p,
#endif
rp->p->common.u.alive.reg = NULL;
if (IS_TRACED_FL(rp->p, F_TRACE_PROCS)) {
- trace_proc(c_p, rp->p, am_unregister, r.name);
+ trace_proc(rp->p, (c_p == rp->p) ? c_p_locks : ERTS_PROC_LOCK_MAIN,
+ rp->p, am_unregister, r.name);
}
#ifdef ERTS_SMP
if (rp->p != c_p) {
diff --git a/erts/emulator/beam/register.h b/erts/emulator/beam/register.h
index 7170463375..27a314ca78 100644
--- a/erts/emulator/beam/register.h
+++ b/erts/emulator/beam/register.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2012. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2016. 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.
+ * 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%
*/
@@ -43,12 +44,12 @@ typedef struct reg_proc
int process_reg_size(void);
int process_reg_sz(void);
void init_register_table(void);
-void register_info(int, void *);
+void register_info(fmtfn_t, void *);
int erts_register_name(Process *, Eterm, Eterm);
Eterm erts_whereis_name_to_id(Process *, Eterm);
void erts_whereis_name(Process *, ErtsProcLocks,
Eterm, Process**, ErtsProcLocks, int,
- Port**);
+ Port**, int);
Process *erts_whereis_process(Process *,
ErtsProcLocks,
Eterm,
diff --git a/erts/emulator/beam/safe_hash.c b/erts/emulator/beam/safe_hash.c
index 3326e5cc2a..527c9efeca 100644
--- a/erts/emulator/beam/safe_hash.c
+++ b/erts/emulator/beam/safe_hash.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2008-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2008-2016. 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.
+ * 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%
*/
@@ -154,7 +155,8 @@ int safe_hash_table_sz(SafeHash *h)
** Init a pre allocated or static hash structure
** and allocate buckets. NOT SAFE
*/
-SafeHash* safe_hash_init(ErtsAlcType_t type, SafeHash* h, char* name, int size, SafeHashFunctions fun)
+SafeHash* safe_hash_init(ErtsAlcType_t type, SafeHash* h, char* name, erts_lock_flags_t flags,
+ int size, SafeHashFunctions fun)
{
int i, bytes;
@@ -169,7 +171,8 @@ SafeHash* safe_hash_init(ErtsAlcType_t type, SafeHash* h, char* name, int size,
erts_smp_atomic_init_nob(&h->is_rehashing, 0);
erts_smp_atomic_init_nob(&h->nitems, 0);
for (i=0; i<SAFE_HASH_LOCK_CNT; i++) {
- erts_smp_mtx_init(&h->lock_vec[i].mtx,"safe_hash");
+ erts_smp_mtx_init(&h->lock_vec[i].mtx, "safe_hash", NIL,
+ flags);
}
return h;
}
@@ -272,5 +275,22 @@ void safe_hash_for_each(SafeHash* h, void (*func)(void *, void *), void *func_ar
}
}
+#ifdef ERTS_ENABLE_LOCK_COUNT
+void erts_lcnt_enable_hash_lock_count(SafeHash *h, erts_lock_flags_t flags, int enable) {
+ int i;
+
+ for(i = 0; i < SAFE_HASH_LOCK_CNT; i++) {
+ erts_smp_mtx_t *lock = &h->lock_vec[i].mtx;
+
+ if(enable) {
+ erts_lcnt_install_new_lock_info(&lock->lcnt, "safe_hash", NIL,
+ ERTS_LOCK_TYPE_MUTEX | flags);
+ } else {
+ erts_lcnt_uninstall(&lock->lcnt);
+ }
+ }
+}
+#endif /* ERTS_ENABLE_LOCK_COUNT */
+
#endif /* !ERTS_SYS_CONTINOUS_FD_NUMBERS */
diff --git a/erts/emulator/beam/safe_hash.h b/erts/emulator/beam/safe_hash.h
index c691126ef9..dde48a6de8 100644
--- a/erts/emulator/beam/safe_hash.h
+++ b/erts/emulator/beam/safe_hash.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2008-2009. All Rights Reserved.
+ * Copyright Ericsson AB 2008-2016. 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.
+ * 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%
*/
@@ -25,13 +26,9 @@
#ifndef __SAFE_HASH_H__
#define __SAFE_HASH_H__
-
-#ifndef __SYS_H__
#include "sys.h"
-#endif
-
#include "erl_alloc.h"
-
+#include "erl_lock_flags.h"
typedef unsigned long SafeHashValue;
@@ -89,7 +86,7 @@ typedef struct
/* A: Lockless atomics */
} SafeHash;
-SafeHash* safe_hash_init(ErtsAlcType_t, SafeHash*, char*, int, SafeHashFunctions);
+SafeHash* safe_hash_init(ErtsAlcType_t, SafeHash*, char*, erts_lock_flags_t, int, SafeHashFunctions);
void safe_hash_get_info(SafeHashInfo*, SafeHash*);
int safe_hash_table_sz(SafeHash *);
@@ -100,5 +97,9 @@ void* safe_hash_erase(SafeHash*, void*);
void safe_hash_for_each(SafeHash*, void (*func)(void *, void *), void *);
+#ifdef ERTS_ENABLE_LOCK_COUNT
+void erts_lcnt_enable_hash_lock_count(SafeHash*, erts_lock_flags_t, int);
+#endif
+
#endif /* __SAFE_HASH_H__ */
diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h
index 05f07e57b2..704d567337 100644
--- a/erts/emulator/beam/sys.h
+++ b/erts/emulator/beam/sys.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -20,27 +21,93 @@
#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
-#if defined(VALGRIND) && !defined(NO_FPE_SIGNALS)
-# define NO_FPE_SIGNALS
+#if defined(ERTS_DIRTY_SCHEDULERS) && !defined(ERTS_SMP)
+# error "Dirty schedulers not supported without smp support"
+#endif
+
+#ifdef ERTS_INLINE
+# ifndef ERTS_CAN_INLINE
+# define ERTS_CAN_INLINE 1
+# endif
+#else
+# if defined(__GNUC__)
+# define ERTS_CAN_INLINE 1
+# define ERTS_INLINE __inline__
+# elif defined(__WIN32__)
+# define ERTS_CAN_INLINE 1
+# define ERTS_INLINE __inline
+# else
+# define ERTS_CAN_INLINE 0
+# define ERTS_INLINE
+# 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
-#ifdef DISABLE_CHILD_WAITER_THREAD
-#undef ENABLE_CHILD_WAITER_THREAD
+#if defined(DEBUG) || defined(ERTS_ENABLE_LOCK_CHECK)
+# undef ERTS_CAN_INLINE
+# define ERTS_CAN_INLINE 0
+# undef ERTS_INLINE
+# define ERTS_INLINE
#endif
-#if defined(ERTS_SMP) && !defined(DISABLE_CHILD_WAITER_THREAD)
-#undef ENABLE_CHILD_WAITER_THREAD
-#define ENABLE_CHILD_WAITER_THREAD 1
+#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
+
+#if ERTS_CAN_INLINE || defined(ERTS_DO_INCL_GLB_INLINE_FUNC_DEF)
+# define ERTS_GLB_INLINE_INCL_FUNC_DEF 1
+#else
+# define ERTS_GLB_INLINE_INCL_FUNC_DEF 0
+#endif
+
+#if defined(VALGRIND) && !defined(NO_FPE_SIGNALS)
+# define NO_FPE_SIGNALS
#endif
#define ERTS_I64_LITERAL(X) X##LL
+#define ErtsInArea(ptr,start,nbytes) \
+ ((UWord)((char*)(ptr) - (char*)(start)) < (nbytes))
+
+#define ErtsContainerStruct(ptr, type, member) \
+ ((type *)((char *)(1 ? (ptr) : &((type *)0)->member) - offsetof(type, member)))
+
+/* Use this variant when the member is an array */
+#define ErtsContainerStruct_(ptr, type, memberv) \
+ ((type *)((char *)(1 ? (ptr) : ((type *)0)->memberv) - offsetof(type, memberv)))
+
+#define ErtsSizeofMember(type, member) sizeof(((type *)0)->member)
+
#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
@@ -66,39 +133,13 @@
*/
#ifndef ERTS_SYS_FD_TYPE
+#define ERTS_SYS_FD_INVALID ((ErtsSysFdType) -1)
typedef int ErtsSysFdType;
#else
-typedef ERTS_SYS_FD_TYPE ErtsSysFdType;
-#endif
-
-#ifdef ERTS_INLINE
-# ifndef ERTS_CAN_INLINE
-# define ERTS_CAN_INLINE 1
-# endif
-#else
-# if defined(__GNUC__)
-# define ERTS_CAN_INLINE 1
-# define ERTS_INLINE __inline__
-# elif defined(__WIN32__)
-# define ERTS_CAN_INLINE 1
-# define ERTS_INLINE __inline
-# else
-# define ERTS_CAN_INLINE 0
-# define ERTS_INLINE
-# endif
+#ifndef ERTS_SYS_FD_INVALID
+# error missing ERTS_SYS_FD_INVALID
#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)))
+typedef ERTS_SYS_FD_TYPE ErtsSysFdType;
#endif
#if ERTS_AT_LEAST_GCC_VSN__(2, 96, 0)
@@ -108,8 +149,20 @@ 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)
+#if (defined(__APPLE__) && defined(__MACH__)) || defined(__DARWIN__)
+# define ERTS_WRITE_UNLIKELY(X) X __attribute__ ((section ("__DATA,ERTS_LOW_WRITE") ))
+#else
+# define ERTS_WRITE_UNLIKELY(X) X __attribute__ ((section ("ERTS_LOW_WRITE") ))
+#endif
+#else
+# define ERTS_WRITE_UNLIKELY(X) X
+#endif
+
+/* clang may have too low __GNUC__ versions but can handle it */
#ifdef __GNUC__
-# if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ > 5)
+# if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ > 5) || defined(__clang__)
# define ERTS_DECLARE_DUMMY(X) X __attribute__ ((unused))
# else
# define ERTS_DECLARE_DUMMY(X) X
@@ -128,24 +181,8 @@ typedef ERTS_SYS_FD_TYPE ErtsSysFdType;
# endif
#endif
-#if defined(DEBUG) || defined(ERTS_ENABLE_LOCK_CHECK)
-# undef ERTS_CAN_INLINE
-# define ERTS_CAN_INLINE 0
-# undef ERTS_INLINE
-# define ERTS_INLINE
-#endif
-
-#if ERTS_CAN_INLINE
-#define ERTS_GLB_INLINE static ERTS_INLINE
-#else
-#define ERTS_GLB_INLINE
-#endif
-
-#if ERTS_CAN_INLINE || defined(ERTS_DO_INCL_GLB_INLINE_FUNC_DEF)
-# define ERTS_GLB_INLINE_INCL_FUNC_DEF 1
-#else
-# define ERTS_GLB_INLINE_INCL_FUNC_DEF 0
-#endif
+#define ERTS_MK_VSN_INT(Major, Minor, Build) \
+ ((((Major) & 0x3ff) << 20) | (((Minor) & 0x3ff) << 10) | ((Build) & 0x3ff))
#ifndef ERTS_EXIT_AFTER_DUMP
# define ERTS_EXIT_AFTER_DUMP exit
@@ -184,6 +221,38 @@ __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.
+ */
+#ifdef VALGRIND
+# define ERTS_UNDEF(V,I)
+#else
+# define ERTS_UNDEF(V,I) V = I
+#endif
+
+/*
+ * Compile time assert
+ * (the actual compiler error msg can be a bit confusing)
+ */
+#if ERTS_AT_LEAST_GCC_VSN__(3,1,1)
+# define ERTS_CT_ASSERT(e) \
+ do { \
+ enum { compile_time_assert__ = __builtin_choose_expr((e),0,(void)0) }; \
+ } while(0)
+#else
+# define ERTS_CT_ASSERT(e) \
+ do { \
+ enum { compile_time_assert__ = 1/(e) }; \
+ } while (0)
+#endif
+
/*
* Microsoft C/C++: We certainly want to use stdarg.h and prototypes.
* But MSC doesn't define __STDC__, unless we compile with the -Za
@@ -252,61 +321,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_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;
@@ -347,23 +366,52 @@ typedef long long Sint;
typedef Uint UWord;
typedef Sint SWord;
-
-#endif /* HALFWORD_HEAP */
+#define ERTS_UINT_MAX ERTS_UWORD_MAX
typedef UWord BeamInstr;
#ifndef HAVE_INT64
-#if SIZEOF_LONG == 8
-#define HAVE_INT64 1
+# if SIZEOF_LONG == 8
+# define HAVE_INT64 1
typedef unsigned long Uint64;
typedef long Sint64;
-#elif SIZEOF_LONG_LONG == 8
-#define HAVE_INT64 1
+# ifdef ULONG_MAX
+# define ERTS_UINT64_MAX ULONG_MAX
+# endif
+# ifdef LONG_MAX
+# define ERTS_SINT64_MAX LONG_MAX
+# endif
+# ifdef LONG_MIN
+# define ERTS_SINT64_MIN LONG_MIN
+# endif
+# define ErtsStrToSint64 strtol
+# elif SIZEOF_LONG_LONG == 8
+# define HAVE_INT64 1
typedef unsigned long long Uint64;
typedef long long Sint64;
-#else
-#define HAVE_INT64 0
+# ifdef ULLONG_MAX
+# define ERTS_UINT64_MAX ULLONG_MAX
+# endif
+# ifdef LLONG_MAX
+# define ERTS_SINT64_MAX LLONG_MAX
+# endif
+# ifdef LLONG_MIN
+# define ERTS_SINT64_MIN LLONG_MIN
+# endif
+# define ErtsStrToSint64 strtoll
+# else
+# error "No 64-bit integer type found"
+# endif
#endif
+
+#ifndef ERTS_UINT64_MAX
+# define ERTS_UINT64_MAX (~((Uint64) 0))
+#endif
+#ifndef ERTS_SINT64_MAX
+# define ERTS_SINT64_MAX ((Sint64) ((((Uint64) 1) << 63)-1))
+#endif
+#ifndef ERTS_SINT64_MIN
+# define ERTS_SINT64_MIN (-1*(((Sint64) 1) << 63))
#endif
#if SIZEOF_LONG == 4
@@ -439,18 +487,10 @@ extern volatile int erts_break_requested;
void erts_do_break_handling(void);
#endif
-#ifdef ERTS_WANT_GOT_SIGUSR1
-# ifndef UNIX
-# define ERTS_GOT_SIGUSR1 0
-# else
-# ifdef ERTS_SMP
-extern erts_smp_atomic32_t erts_got_sigusr1;
-# define ERTS_GOT_SIGUSR1 ((int) erts_smp_atomic32_read_mb(&erts_got_sigusr1))
-# else
-extern volatile int erts_got_sigusr1;
-# define ERTS_GOT_SIGUSR1 erts_got_sigusr1
-# endif
-# endif
+#if !defined(ERTS_SMP) && !defined(__WIN32__)
+extern volatile Uint erts_signal_state;
+#define ERTS_SIGNAL_STATE erts_signal_state
+void erts_handle_signal_state(void);
#endif
#ifdef ERTS_SMP
@@ -499,7 +539,7 @@ extern volatile int erts_writing_erl_crash_dump;
# define NO_ERF
# define NO_ERFC
/* This definition doesn't take NaN into account, but matherr() gets those */
-# define finite(x) (fabs(x) != HUGE_VAL)
+# define isfinite(x) (fabs(x) != HUGE_VAL)
# define USE_MATHERR
# define HAVE_FINITE
#endif
@@ -548,19 +588,22 @@ 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);
+UWord erts_sys_get_page_size(void);
+
/* Size of misc memory allocated from system dependent code */
Uint erts_sys_misc_mem_sz(void);
@@ -569,23 +612,21 @@ Uint erts_sys_misc_mem_sz(void);
#include "erl_printf.h"
/* 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)
-#define ERTS_PRINT_DSBUF (-4)
-
-#define ERTS_PRINT_MIN ERTS_PRINT_DSBUF
+#define ERTS_PRINT_STDERR ((fmtfn_t)0)
+#define ERTS_PRINT_STDOUT ((fmtfn_t)1)
+#define ERTS_PRINT_FILE ((fmtfn_t)2)
+#define ERTS_PRINT_SBUF ((fmtfn_t)3)
+#define ERTS_PRINT_SNBUF ((fmtfn_t)4)
+#define ERTS_PRINT_DSBUF ((fmtfn_t)5)
+#define ERTS_PRINT_FD ((fmtfn_t)6)
typedef struct {
char *buf;
size_t size;
} erts_print_sn_buf;
-int erts_print(int to, void *arg, char *format, ...); /* in utils.c */
-int erts_putc(int to, void *arg, char); /* in utils.c */
+int erts_print(fmtfn_t to, void *arg, char *format, ...); /* in utils.c */
+int erts_putc(fmtfn_t to, void *arg, char); /* in utils.c */
/* logger stuff is declared here instead of in global.h, so sys files
won't have to include global.h */
@@ -594,6 +635,7 @@ erts_dsprintf_buf_t *erts_create_logger_dsbuf(void);
int erts_send_info_to_logger(Eterm, erts_dsprintf_buf_t *);
int erts_send_warning_to_logger(Eterm, erts_dsprintf_buf_t *);
int erts_send_error_to_logger(Eterm, erts_dsprintf_buf_t *);
+int erts_send_error_term_to_logger(Eterm, erts_dsprintf_buf_t *, Eterm);
int erts_send_info_to_logger_str(Eterm, char *);
int erts_send_warning_to_logger_str(Eterm, char *);
int erts_send_error_to_logger_str(Eterm, char *);
@@ -611,6 +653,15 @@ typedef struct preload {
unsigned char* code; /* Code pointer */
} Preload;
+/*
+ * ErtsTracer is either NIL, 'true' or [Mod | State]
+ *
+ * If set to NIL, it means no tracer.
+ * If set to 'true' it means the current process' tracer.
+ * If set to [Mod | State], there is a tracer.
+ * See erts_tracer_update for more details
+ */
+typedef Eterm ErtsTracer;
/*
* This structure contains options to all built in drivers.
@@ -640,14 +691,37 @@ extern char *erts_default_arg0;
extern char os_type[];
-extern int sys_init_time(void);
+typedef struct {
+ int have_os_monotonic_time;
+ int have_corrected_os_monotonic_time;
+ ErtsMonotonicTime os_monotonic_time_unit;
+ ErtsMonotonicTime sys_clock_resolution;
+ struct {
+ Uint64 resolution;
+ char *func;
+ char *clock_id;
+ int locked_use;
+ int extended;
+ } os_monotonic_time_info;
+ struct {
+ Uint64 resolution;
+ char *func;
+ char *clock_id;
+ int locked_use;
+ } os_system_time_info;
+} ErtsSysInitTimeResult;
+
+#define ERTS_SYS_INIT_TIME_RESULT_INITER \
+ {0, 0, (ErtsMonotonicTime) -1, (ErtsMonotonicTime) 1}
+
+extern void erts_init_sys_time_sup(void);
+extern void sys_init_time(ErtsSysInitTimeResult *);
+extern void erts_late_sys_init_time(void);
extern void erts_deliver_time(void);
extern void erts_time_remaining(SysTimeval *);
-extern int erts_init_time_sup(void);
extern void erts_sys_init_float(void);
extern void erts_thread_init_float(void);
extern void erts_thread_disable_fpe(void);
-
ERTS_GLB_INLINE int erts_block_fpe(void);
ERTS_GLB_INLINE void erts_unblock_fpe(int);
@@ -690,17 +764,16 @@ extern char *erts_sys_ddll_error(int code);
/*
* System interfaces for startup.
*/
-#include "erl_time.h"
-
void erts_sys_schedule_interrupt(int set);
#ifdef ERTS_SMP
-void erts_sys_schedule_interrupt_timed(int set, erts_short_time_t msec);
+void erts_sys_schedule_interrupt_timed(int, ErtsMonotonicTime);
void erts_sys_main_thread(void);
#endif
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);
@@ -711,10 +784,6 @@ Preload* sys_preloaded(void);
unsigned char* sys_preload_begin(Preload*);
void sys_preload_end(Preload*);
int sys_get_key(int);
-void elapsed_time_both(UWord *ms_user, UWord *ms_sys,
- UWord *ms_user_diff, UWord *ms_sys_diff);
-void wall_clock_elapsed_time_both(UWord *ms_total,
- UWord *ms_diff);
void get_time(int *hour, int *minute, int *second);
void get_date(int *year, int *month, int *day);
void get_localtime(int *year, int *month, int *day,
@@ -733,6 +802,12 @@ int univ_to_local(
int local_to_univ(Sint *year, Sint *month, Sint *day,
Sint *hour, Sint *minute, Sint *second, int isdst);
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));
@@ -742,6 +817,16 @@ void init_getenv_state(GETENV_STATE *);
char * getenv_string(GETENV_STATE *);
void fini_getenv_state(GETENV_STATE *);
+#define HAVE_ERTS_CHECK_IO_DEBUG
+typedef struct {
+ int no_used_fds;
+ int no_driver_select_structs;
+ int no_driver_event_structs;
+} ErtsCheckIoDebugInfo;
+int erts_check_io_debug(ErtsCheckIoDebugInfo *ip);
+
+int erts_sys_is_area_readable(char *start, char *stop);
+
/* xxxP */
#define SYS_DEFAULT_FLOAT_DECIMALS 20
void init_sys_float(void);
@@ -770,6 +855,14 @@ int erts_sys_unsetenv(char *key);
char *erts_read_env(char *key);
void erts_free_read_env(void *value);
+#if defined(ERTS_SMP)
+#if defined(ERTS_THR_HAVE_SIG_FUNCS) && !defined(ETHR_UNUSABLE_SIGUSRX)
+extern void sys_thr_resume(erts_tid_t tid);
+extern void sys_thr_suspend(erts_tid_t tid);
+#define ERTS_SYS_SUSPEND_SIGNAL SIGUSR2
+#endif
+#endif
+
/* utils.c */
/* Options to sys_alloc_opt */
@@ -800,10 +893,13 @@ void sys_alloc_stat(SysAllocStat *);
#define ERTS_REFC_DEBUG
#endif
-typedef erts_smp_atomic_t erts_refc_t;
+typedef erts_atomic_t erts_refc_t;
ERTS_GLB_INLINE void erts_refc_init(erts_refc_t *refcp, erts_aint_t val);
ERTS_GLB_INLINE void erts_refc_inc(erts_refc_t *refcp, erts_aint_t min_val);
+ERTS_GLB_INLINE erts_aint_t erts_refc_inc_unless(erts_refc_t *refcp,
+ erts_aint_t unless_val,
+ erts_aint_t min_val);
ERTS_GLB_INLINE erts_aint_t erts_refc_inctest(erts_refc_t *refcp,
erts_aint_t min_val);
ERTS_GLB_INLINE void erts_refc_dec(erts_refc_t *refcp, erts_aint_t min_val);
@@ -819,30 +915,54 @@ ERTS_GLB_INLINE erts_aint_t erts_refc_read(erts_refc_t *refcp,
ERTS_GLB_INLINE void
erts_refc_init(erts_refc_t *refcp, erts_aint_t val)
{
- erts_smp_atomic_init_nob((erts_smp_atomic_t *) refcp, val);
+ erts_atomic_init_nob((erts_atomic_t *) refcp, val);
}
ERTS_GLB_INLINE void
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);
+ erts_aint_t val = erts_atomic_inc_read_nob((erts_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
- erts_smp_atomic_inc_nob((erts_smp_atomic_t *) refcp);
+ erts_atomic_inc_nob((erts_atomic_t *) refcp);
#endif
}
ERTS_GLB_INLINE erts_aint_t
+erts_refc_inc_unless(erts_refc_t *refcp,
+ erts_aint_t unless_val,
+ erts_aint_t min_val)
+{
+ erts_aint_t val = erts_atomic_read_nob((erts_atomic_t *) refcp);
+ while (1) {
+ erts_aint_t exp, new;
+#ifdef ERTS_REFC_DEBUG
+ if (val < 0)
+ erts_exit(ERTS_ABORT_EXIT,
+ "erts_refc_inc_unless(): Bad refc found (refc=%ld < %ld)!\n",
+ val, min_val);
+#endif
+ if (val == unless_val)
+ return val;
+ new = val + 1;
+ exp = val;
+ val = erts_atomic_cmpxchg_nob((erts_atomic_t *) refcp, new, exp);
+ if (val == exp)
+ return new;
+ }
+}
+
+ERTS_GLB_INLINE erts_aint_t
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);
+ erts_aint_t val = erts_atomic_inc_read_nob((erts_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
@@ -853,23 +973,23 @@ ERTS_GLB_INLINE void
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);
+ erts_aint_t val = erts_atomic_dec_read_nob((erts_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
- erts_smp_atomic_dec_nob((erts_smp_atomic_t *) refcp);
+ erts_atomic_dec_nob((erts_atomic_t *) refcp);
#endif
}
ERTS_GLB_INLINE erts_aint_t
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);
+ erts_aint_t val = erts_atomic_dec_read_nob((erts_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
@@ -880,23 +1000,23 @@ ERTS_GLB_INLINE void
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);
+ erts_aint_t val = erts_atomic_add_read_nob((erts_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
- erts_smp_atomic_add_nob((erts_smp_atomic_t *) refcp, diff);
+ erts_atomic_add_nob((erts_atomic_t *) refcp, diff);
#endif
}
ERTS_GLB_INLINE erts_aint_t
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);
+ erts_aint_t val = erts_atomic_read_nob((erts_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
@@ -905,6 +1025,140 @@ erts_refc_read(erts_refc_t *refcp, erts_aint_t min_val)
#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
+typedef erts_smp_atomic_t erts_smp_refc_t;
+
+ERTS_GLB_INLINE void erts_smp_refc_init(erts_smp_refc_t *refcp, erts_aint_t val);
+ERTS_GLB_INLINE void erts_smp_refc_inc(erts_smp_refc_t *refcp, erts_aint_t min_val);
+ERTS_GLB_INLINE erts_aint_t erts_smp_refc_inc_unless(erts_smp_refc_t *refcp,
+ erts_aint_t unless_val,
+ erts_aint_t min_val);
+ERTS_GLB_INLINE erts_aint_t erts_smp_refc_inctest(erts_smp_refc_t *refcp,
+ erts_aint_t min_val);
+ERTS_GLB_INLINE void erts_smp_refc_dec(erts_smp_refc_t *refcp, erts_aint_t min_val);
+ERTS_GLB_INLINE erts_aint_t erts_smp_refc_dectest(erts_smp_refc_t *refcp,
+ erts_aint_t min_val);
+ERTS_GLB_INLINE void erts_smp_refc_add(erts_smp_refc_t *refcp, erts_aint_t diff,
+ erts_aint_t min_val);
+ERTS_GLB_INLINE erts_aint_t erts_smp_refc_read(erts_smp_refc_t *refcp,
+ erts_aint_t min_val);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_INLINE void
+erts_smp_refc_init(erts_smp_refc_t *refcp, erts_aint_t val)
+{
+ erts_smp_atomic_init_nob((erts_smp_atomic_t *) refcp, val);
+}
+
+ERTS_GLB_INLINE void
+erts_smp_refc_inc(erts_smp_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)
+ erts_exit(ERTS_ABORT_EXIT,
+ "erts_smp_refc_inc(): Bad refc found (refc=%ld < %ld)!\n",
+ val, min_val);
+#else
+ erts_smp_atomic_inc_nob((erts_smp_atomic_t *) refcp);
+#endif
+}
+
+ERTS_GLB_INLINE erts_aint_t
+erts_smp_refc_inc_unless(erts_smp_refc_t *refcp,
+ erts_aint_t unless_val,
+ erts_aint_t min_val)
+{
+ erts_aint_t val = erts_smp_atomic_read_nob((erts_smp_atomic_t *) refcp);
+ while (1) {
+ erts_aint_t exp, new;
+#ifdef ERTS_REFC_DEBUG
+ if (val < 0)
+ erts_exit(ERTS_ABORT_EXIT,
+ "erts_smp_refc_inc_unless(): Bad refc found (refc=%ld < %ld)!\n",
+ val, min_val);
+#endif
+ if (val == unless_val)
+ return val;
+ new = val + 1;
+ exp = val;
+ val = erts_smp_atomic_cmpxchg_nob((erts_smp_atomic_t *) refcp, new, exp);
+ if (val == exp)
+ return new;
+ }
+}
+
+
+ERTS_GLB_INLINE erts_aint_t
+erts_smp_refc_inctest(erts_smp_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)
+ erts_exit(ERTS_ABORT_EXIT,
+ "erts_smp_refc_inctest(): Bad refc found (refc=%ld < %ld)!\n",
+ val, min_val);
+#endif
+ return val;
+}
+
+ERTS_GLB_INLINE void
+erts_smp_refc_dec(erts_smp_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)
+ erts_exit(ERTS_ABORT_EXIT,
+ "erts_smp_refc_dec(): Bad refc found (refc=%ld < %ld)!\n",
+ val, min_val);
+#else
+ erts_smp_atomic_dec_nob((erts_smp_atomic_t *) refcp);
+#endif
+}
+
+ERTS_GLB_INLINE erts_aint_t
+erts_smp_refc_dectest(erts_smp_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)
+ erts_exit(ERTS_ABORT_EXIT,
+ "erts_smp_refc_dectest(): Bad refc found (refc=%ld < %ld)!\n",
+ val, min_val);
+#endif
+ return val;
+}
+
+ERTS_GLB_INLINE void
+erts_smp_refc_add(erts_smp_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)
+ erts_exit(ERTS_ABORT_EXIT,
+ "erts_smp_refc_add(%ld): Bad refc found (refc=%ld < %ld)!\n",
+ diff, val, min_val);
+#else
+ erts_smp_atomic_add_nob((erts_smp_atomic_t *) refcp, diff);
+#endif
+}
+
+ERTS_GLB_INLINE erts_aint_t
+erts_smp_refc_read(erts_smp_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)
+ erts_exit(ERTS_ABORT_EXIT,
+ "erts_smp_refc_read(): Bad refc found (refc=%ld < %ld)!\n",
+ val, min_val);
+#endif
+ return val;
+}
+
+#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
+
+
#ifdef ERTS_ENABLE_KERNEL_POLL
extern int erts_use_kernel_poll;
#endif
@@ -997,7 +1251,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:
*
@@ -1015,6 +1268,14 @@ void erl_bin_write(unsigned char *, int, int);
# define DEBUGF(x)
#endif
+#ifndef MAX
+#define MAX(A, B) ((A) > (B) ? (A) : (B))
+#endif
+
+#ifndef MIN
+#define MIN(A, B) ((A) < (B) ? (A) : (B))
+#endif
+
#ifdef __WIN32__
#ifdef ARCH_64
#define ERTS_ALLOC_ALIGN_BYTES 16
diff --git a/erts/emulator/beam/time.c b/erts/emulator/beam/time.c
index 2fd8e0cf00..a3069e419a 100644
--- a/erts/emulator/beam/time.c
+++ b/erts/emulator/beam/time.c
@@ -1,72 +1,173 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2017. 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.
+ * 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%
*/
-
+
/*
- * TIMING WHEEL
+ * TIMER WHEEL
+ *
+ *
+ * The time scale used for timers is Erlang monotonic time. The
+ * time unit used is ERTS specific clock ticks. A clock tick is
+ * currently defined to 1 millisecond. That is, the resolution of
+ * timers triggered by the runtime system is 1 millisecond.
*
- * Timeouts kept in an wheel. A timeout is measured relative to the
- * current slot (tiw_pos) in the wheel, and inserted at slot
- * (tiw_pos + timeout) % TIW_SIZE. Each timeout also has a count
- * equal to timeout/TIW_SIZE, which is needed since the time axis
- * is wrapped arount the wheel.
+ * When a timer is set, it is determined at what Erlang monotonic
+ * time, in clock ticks, it should be triggered.
*
- * Several slots may be processed in one operation. If the number of
- * slots is greater that the wheel size, the wheel is only traversed
- * once,
+ * The 'pos' field of the wheel corresponds to current time of
+ * the wheel. That is, it corresponds to Erlang monotonic time in
+ * clock tick time unit. The 'pos' field of the wheel is
+ * monotonically increased when erts_bump_timers() is called. All
+ * timers in the wheel that have a time less than or equal to
+ * 'pos' are triggered by the bump operation. The bump operation
+ * may however be spread over multiple calls to erts_bump_timers()
+ * if there are a lots of timers to trigger.
*
- * The following example shows a time axis where there is one timeout
- * at each "tick", and where 1, 2, 3 ... wheel slots are released in
- * one operation. The notation "<x" means "release all items with
- * counts less than x".
+ * Each scheduler thread maintains its own timer wheel. The timer
+ * wheel of a scheduler, however, actually consists of two wheels.
+ * A soon wheel and a later wheel.
+ *
+ *
+ * -- The Soon Wheel --
+ *
+ * The soon wheel contain timers that should be triggered soon.
+ * That is, they are soon to be triggered. Each slot in the soon
+ * wheel is 1 clock tick wide. The number of slots in the soon
+ * wheel is currently 2¹⁴. That is, it contains timers in the
+ * range ('pos', 'pos' + 2¹⁴] which corresponds to a bit more
+ * than 16 seconds.
+ *
+ * When the bump operation is started, 'pos' is moved forward to a
+ * position that corresponds to current Erlang monotonic time. Then
+ * all timers that are in the range (old 'pos', new 'pos'] are
+ * triggered. During a bump operation, the soon wheel may contain
+ * timers in the two, possibly overlapping, ranges (old 'pos',
+ * old 'pos' + 2¹⁴], and (new 'pos', new 'pos' + 2¹⁴]. This may
+ * occur even if the bump operation doesn't yield, due to timeout
+ * callbacks inserting new timers.
+ *
+ *
+ * -- The Later Wheel --
+ *
+ * The later wheel contain timers that are further away from 'pos'
+ * than the width of the soon timer wheel. That is, currently
+ * timers further away from 'pos' than 2¹⁴ clock ticks. The width
+ * of each slot in the later wheel is half the width of the soon
+ * wheel. That is, each slot is currently 2¹³ clock ticks wide
+ * which corresponds to about 8 seconds. If three timers of the
+ * times 'pos' + 17000, 'pos' + 18000, and 'pos' + 19000 are
+ * inserted, they will all end up in the same slot in the later
+ * wheel.
+ *
+ * The number of slots in the later wheel is currently the same as
+ * in the soon wheel, i.e. 2¹⁴. That is, one revolution of the later
+ * wheel currently corresponds to 2¹⁴×2¹³ clock ticks which is
+ * almost 37 ½ hour. Timers even further away than that are put in
+ * the later slot identified by their time modulo the size of the later
+ * wheel. Such timers are however very uncommon. Most timers used
+ * by the runtime system will utilize the high level timer API.
+ * The high level timer implementation will not insert timers
+ * further away then one revolution into the later wheel. It will
+ * instead keep such timers in a tree of very long timers. The
+ * high level timer implementation utilize one timer wheel timer
+ * for the management of this tree of timers. This timer is set to
+ * the closest timeout in the tree. This timer may however be
+ * further away than one revolution in the later wheel.
+ *
+ * The 'later.pos' field identifies next position in the later wheel.
+ * 'later.pos' is always increased by the width of a later wheel slot.
+ * That is, currently 2¹³ clock ticks. When 'pos' is moved (during
+ * a bump operation) closer to 'later.pos' than the width of a later
+ * wheel slot, i.e. currently when 'pos' + 2¹³ ≥ 'later.pos', we
+ * inspect the slot identified by 'later.pos' and then move 'later.pos'
+ * forward. When inspecting the later slot we move all timers in the
+ * slot, that are in the soon wheel range, from the later wheel to
+ * the soon wheel. Timers one or more revolutions of the later wheel
+ * away are kept in the slot.
+ *
+ * During normal operation, timers originally located in the later
+ * wheel will currently be moved into the soon wheel about 8 to
+ * 16 seconds before they should be triggered. During extremely
+ * heavy load, the scheduler might however be heavily delayed, so
+ * the code must be prepared for situations where time for
+ * triggering the timer has passed when we inspect the later wheel
+ * slot, and then trigger the timer immediately. We must also be
+ * prepared to inspect multiple later wheel slots at once due to the
+ * delay.
+ *
+ *
+ * -- Slot Management --
+ *
+ * All timers of a slot are placed in a circular double linked
+ * list. This makes insertion and removal of a timer O(1).
+ *
+ * While bumping timers in a slot, we move the circular list
+ * away from the slot, and refer to it from the 'sentinel'
+ * field. The list will stay there until we are done with it
+ * even if the bump operation should yield. The cancel operation
+ * can remove the timer from this position as well as from the
+ * slot position by just removing it from the circular double
+ * linked list that it is in.
+ *
+ * -- At Once Slot --
+ *
+ * If a timer is set that has a time earlier or equal to 'pos',
+ * it is not inserted into the wheel. It is instead inserted,
+ * into a circular double linked list referred to by the "at
+ * once" slot. When the bump operation is performed these timers
+ * will be triggered at once. The circular list of the slot will
+ * be moved to the 'sentinel' field while bumping these timers
+ * as when bumping an ordinary wheel slot. A yielding bump
+ * operation and cancelation of timers is handled the same way
+ * as if the timer was in a wheel slot.
+ *
+ * -- Searching for Next Timeout --
+ *
+ * In order to limit the amount of work needed in order to find
+ * next timeout, we keep track of total amount of timers in the
+ * wheels, total amount of timers in the later wheel, total amount
+ * of timers in soon wheel, and the total amount of timers in
+ * each range of slots. Each slot range currently contain 512
+ * slots.
+ *
+ * When next timeout is less than the soon wheel width away we
+ * determine the exact timeout. Due to the timer counts of
+ * slot ranges, we currently at most need to search 1024 slots
+ * in the soon wheel. This besides inspecting slot range counts
+ * and two slots in the later wheel which potentially might trigger
+ * timeouts for moving timers from the later wheel to the soon wheel
+ * earlier than timeouts in the soon wheel. We also keep track
+ * of latest known minimum timeout position in each wheel which
+ * makes it possible to avoid scanning from current position
+ * each time.
+ *
+ * When next timeout is further away than the soon wheel width
+ * we settle for the earliest possible timeout in the first
+ * non-empty slot range. The further away the next timeout is, the
+ * more likely it is that the next timeout change before we
+ * actually get there. That is, a change due to another timer is
+ * set to an earlier time and/or the timer is cancelled. It is
+ * therefore in this case no point determining next timeout
+ * exactly. If the state should not change, we will wake up a bit
+ * early and do a recalculation of next timeout and eventually
+ * we will be so close to it that we determine it exactly.
*
- * Size of wheel: 4
- *
- * --|----|----|----|----|----|----|----|----|----|----|----|----|----
- * 0.0 0.1 0.2 0.3 1.0 1.1 1.2 1.3 2.0 2.1 2.2 2.3 3.0
- *
- * 1 [ )
- * <1 0.1 0.2 0.3 0.0 1.1 1.2 1.3 1.0 2.1 2.2 2.3 2.0
- *
- * 2 [ )
- * <1 <1 0.2 0.3 0.0 0.1 1.2 1.3 1.0 1.1 2.2 2.3 2.0
- *
- * 3 [ )
- * <1 <1 <1 0.3 0.0 0.1 0.2 1.3 1.0 1.1 1.2 2.3 2.0
- *
- * 4 [ )
- * <1 <1 <1 <1 0.0 0.1 0.2 0.3 1.0 1.1 1.2 1.3 2.0
- *
- * 5 [ )
- * <2 <1 <1 <1. 0.1 0.2 0.3 0.0 1.1 1.2 1.3 1.0
- *
- * 6 [ )
- * <2 <2 <1 <1. 0.2 0.3 0.0 0.1 1.2 1.3 1.0
- *
- * 7 [ )
- * <2 <2 <2 <1. 0.3 0.0 0.1 0.2 1.3 1.0
- *
- * 8 [ )
- * <2 <2 <2 <2. 0.0 0.1 0.2 0.3 1.0
- *
- * 9 [ )
- * <3 <2 <2 <2. 0.1 0.2 0.3 0.0
- *
*/
#ifdef HAVE_CONFIG_H
@@ -76,6 +177,14 @@
#include "sys.h"
#include "erl_vm.h"
#include "global.h"
+#define ERTS_WANT_TIMER_WHEEL_API
+#include "erl_time.h"
+
+#define ERTS_MAX_CLKTCKS \
+ ERTS_MONOTONIC_TO_CLKTCKS(ERTS_MONOTONIC_TIME_MAX)
+
+#define ERTS_CLKTCKS_WEEK \
+ ERTS_MONOTONIC_TO_CLKTCKS(ERTS_SEC_TO_MONOTONIC(7*60*60*24))
#ifdef ERTS_ENABLE_LOCK_CHECK
#define ASSERT_NO_LOCKED_LOCKS erts_lc_check_exact(NULL, 0)
@@ -83,26 +192,75 @@
#define ASSERT_NO_LOCKED_LOCKS
#endif
-static erts_smp_mtx_t tiw_lock;
+#if 0
+# define ERTS_TW_HARD_DEBUG
+#endif
+#if defined(ERTS_TW_HARD_DEBUG) && !defined(ERTS_TW_DEBUG)
+# define ERTS_TW_DEBUG
+#endif
+#if defined(DEBUG) && !defined(ERTS_TW_DEBUG)
+# define ERTS_TW_DEBUG
+#endif
-/* BEGIN tiw_lock protected variables
-**
-** The individual timer cells in tiw are also protected by the same mutex.
-*/
+#undef ERTS_TW_ASSERT
+#if defined(ERTS_TW_DEBUG)
+# define ERTS_TW_ASSERT(E) ERTS_ASSERT(E)
+#else
+# define ERTS_TW_ASSERT(E) ((void) 1)
+#endif
-#ifdef SMALL_MEMORY
-#define TIW_SIZE 8192
+#ifdef ERTS_TW_DEBUG
+# define ERTS_TWHEEL_BUMP_YIELD_LIMIT 500
#else
-#define TIW_SIZE 65536 /* timing wheel size (should be a power of 2) */
+# define ERTS_TWHEEL_BUMP_YIELD_LIMIT 10000
#endif
-static ErlTimer** tiw; /* the timing wheel, allocated in init_time() */
-static Uint tiw_pos; /* current position in wheel */
-static Uint tiw_nto; /* number of timeouts in wheel */
-static Uint tiw_min;
-static ErlTimer *tiw_min_ptr;
+#define ERTS_TW_COST_SLOT 1
+#define ERTS_TW_COST_SLOT_MOVE 5
+#define ERTS_TW_COST_TIMEOUT 100
+
+/*
+ * Every slot in the soon wheel is a clock tick (as defined
+ * by ERTS) wide. A clock tick is currently 1 milli second.
+ */
-/* END tiw_lock protected variables */
+#define ERTS_TW_SOON_WHEEL_FIRST_SLOT 0
+#define ERTS_TW_SOON_WHEEL_END_SLOT \
+ (ERTS_TW_SOON_WHEEL_FIRST_SLOT + ERTS_TW_SOON_WHEEL_SIZE)
+
+#define ERTS_TW_SOON_WHEEL_MASK (ERTS_TW_SOON_WHEEL_SIZE-1)
+
+/*
+ * Every slot in the later wheel is as wide as half the size
+ * of the soon wheel.
+ */
+
+#define ERTS_TW_LATER_WHEEL_SHIFT (ERTS_TW_SOON_WHEEL_BITS - 1)
+#define ERTS_TW_LATER_WHEEL_SLOT_SIZE \
+ ((ErtsMonotonicTime) (1 << ERTS_TW_LATER_WHEEL_SHIFT))
+#define ERTS_TW_LATER_WHEEL_POS_MASK \
+ (~((ErtsMonotonicTime) (1 << ERTS_TW_LATER_WHEEL_SHIFT)-1))
+
+#define ERTS_TW_LATER_WHEEL_FIRST_SLOT ERTS_TW_SOON_WHEEL_SIZE
+#define ERTS_TW_LATER_WHEEL_END_SLOT \
+ (ERTS_TW_LATER_WHEEL_FIRST_SLOT + ERTS_TW_LATER_WHEEL_SIZE)
+
+#define ERTS_TW_LATER_WHEEL_MASK (ERTS_TW_LATER_WHEEL_SIZE-1)
+
+#define ERTS_TW_SCNT_BITS 9
+#define ERTS_TW_SCNT_SHIFT
+#define ERTS_TW_SCNT_SIZE \
+ ((ERTS_TW_SOON_WHEEL_SIZE + ERTS_TW_LATER_WHEEL_SIZE) \
+ >> ERTS_TW_SCNT_BITS)
+
+#ifdef __GNUC__
+#if ERTS_TW_SOON_WHEEL_BITS < ERTS_TW_SCNT_BITS
+# warning Consider larger soon timer wheel
+#endif
+#if ERTS_TW_SOON_WHEEL_BITS < ERTS_TW_SCNT_BITS
+# warning Consider larger later timer wheel
+#endif
+#endif
/* Actual interval time chosen by sys_init_time() */
@@ -114,392 +272,1260 @@ static int tiw_itime; /* Constant after init */
# define TIW_ITIME tiw_itime
#endif
-erts_smp_atomic32_t do_time; /* set at clock interrupt */
-static ERTS_INLINE erts_short_time_t do_time_read(void)
+const int etp_tw_soon_wheel_size = ERTS_TW_SOON_WHEEL_SIZE;
+const ErtsMonotonicTime etp_tw_soon_wheel_mask = ERTS_TW_SOON_WHEEL_MASK;
+const int etp_tw_soon_wheel_first_slot = ERTS_TW_SOON_WHEEL_FIRST_SLOT;
+
+const int etp_tw_later_wheel_size = ERTS_TW_LATER_WHEEL_SIZE;
+const ErtsMonotonicTime etp_tw_later_wheel_slot_size = ERTS_TW_LATER_WHEEL_SLOT_SIZE;
+const int etp_tw_later_wheel_shift = ERTS_TW_LATER_WHEEL_SHIFT;
+const ErtsMonotonicTime etp_tw_later_wheel_mask = ERTS_TW_LATER_WHEEL_MASK;
+const ErtsMonotonicTime etp_tw_later_wheel_pos_mask = ERTS_TW_LATER_WHEEL_POS_MASK;
+const int etp_tw_later_wheel_first_slot = ERTS_TW_LATER_WHEEL_FIRST_SLOT;
+
+struct ErtsTimerWheel_ {
+ ErtsTWheelTimer *slots[1 /* At Once Slot */
+ + ERTS_TW_SOON_WHEEL_SIZE /* Soon Wheel Slots */
+ + ERTS_TW_LATER_WHEEL_SIZE]; /* Later Wheel Slots */
+ ErtsTWheelTimer **w;
+ Sint scnt[ERTS_TW_SCNT_SIZE];
+ Sint bump_scnt[ERTS_TW_SCNT_SIZE];
+ ErtsMonotonicTime pos;
+ Uint nto;
+ struct {
+ Uint nto;
+ } at_once;
+ struct {
+ ErtsMonotonicTime min_tpos;
+ Uint nto;
+ } soon;
+ struct {
+ ErtsMonotonicTime min_tpos;
+ int min_tpos_slot;
+ ErtsMonotonicTime pos;
+ Uint nto;
+ } later;
+ int yield_slot;
+ int yield_slots_left;
+ ErtsTWheelTimer sentinel;
+ int true_next_timeout_time;
+ ErtsMonotonicTime next_timeout_pos;
+ ErtsMonotonicTime next_timeout_time;
+};
+
+#define ERTS_TW_SLOT_AT_ONCE (-1)
+
+#define ERTS_TW_BUMP_LATER_WHEEL(TIW) \
+ ((tiw)->pos + ERTS_TW_LATER_WHEEL_SLOT_SIZE >= (TIW)->later.pos)
+
+static int bump_later_wheel(ErtsTimerWheel *tiw, int *yield_count_p);
+
+#ifdef ERTS_TW_DEBUG
+#define ERTS_TW_DBG_VERIFY_EMPTY_SOON_SLOTS(TIW, TO_POS) \
+ dbg_verify_empty_soon_slots((TIW), (TO_POS))
+#define ERTS_TW_DBG_VERIFY_EMPTY_LATER_SLOTS(TIW, TO_POS) \
+ dbg_verify_empty_later_slots((TIW), (TO_POS))
+void dbg_verify_empty_soon_slots(ErtsTimerWheel *, ErtsMonotonicTime);
+void dbg_verify_empty_later_slots(ErtsTimerWheel *, ErtsMonotonicTime);
+#else
+#define ERTS_TW_DBG_VERIFY_EMPTY_SOON_SLOTS(TIW, TO_POS)
+#define ERTS_TW_DBG_VERIFY_EMPTY_LATER_SLOTS(TIW, TO_POS)
+#endif
+
+static ERTS_INLINE int
+scnt_get_ix(int slot)
{
- return erts_smp_atomic32_read_acqb(&do_time);
+ return slot >> ERTS_TW_SCNT_BITS;
}
-static ERTS_INLINE erts_short_time_t do_time_update(void)
+static ERTS_INLINE void
+scnt_inc(Sint *scnt, int slot)
{
- return do_time_read();
+ scnt[slot >> ERTS_TW_SCNT_BITS]++;
}
-static ERTS_INLINE void do_time_init(void)
+#ifdef ERTS_TW_HARD_DEBUG
+
+static ERTS_INLINE void
+scnt_ix_inc(Sint *scnt, int six)
+{
+ scnt[six]++;
+}
+
+#endif
+
+static ERTS_INLINE void
+scnt_dec(Sint *scnt, int slot)
{
- erts_smp_atomic32_init_nob(&do_time, 0);
+ scnt[slot >> ERTS_TW_SCNT_BITS]--;
+ ERTS_TW_ASSERT(scnt[slot >> ERTS_TW_SCNT_BITS] >= 0);
}
-/* get the time (in units of TIW_ITIME) to the next timeout,
- or -1 if there are no timeouts */
+static ERTS_INLINE void
+scnt_ix_dec(Sint *scnt, int six)
+{
+ scnt[six]--;
+ ERTS_TW_ASSERT(scnt[six] >= 0);
+}
-static erts_short_time_t next_time_internal(void) /* PRE: tiw_lock taken by caller */
+static ERTS_INLINE void
+scnt_wheel_next(int *slotp, int *leftp, ErtsMonotonicTime *posp,
+ int *sixp, Sint *scnt, int first_slot,
+ int end_slot, ErtsMonotonicTime slot_sz)
{
- int i, tm, nto;
- Uint32 min;
- ErlTimer* p;
- erts_short_time_t dt;
-
- if (tiw_nto == 0)
- return -1; /* no timeouts in wheel */
-
- if (tiw_min_ptr) {
- min = tiw_min;
- dt = do_time_read();
- return ((min >= dt) ? (min - dt) : 0);
+ int slot = *slotp;
+ int left = *leftp;
+ int ix;
+
+ ERTS_TW_ASSERT(*leftp >= 0);
+
+ left--;
+ slot++;
+ if (slot == end_slot)
+ slot = first_slot;
+ ix = slot >> ERTS_TW_SCNT_BITS;
+
+ while (!scnt[ix] && left > 0) {
+ int diff, old_slot = slot;
+ ix++;
+ slot = (ix << ERTS_TW_SCNT_BITS);
+ diff = slot - old_slot;
+ if (left < diff) {
+ slot = old_slot + left;
+ diff = left;
+ }
+ if (slot < end_slot)
+ left -= diff;
+ else {
+ left -= end_slot - old_slot;
+ slot = first_slot;
+ ix = slot >> ERTS_TW_SCNT_BITS;
+ }
}
-
- /* start going through wheel to find next timeout */
- tm = nto = 0;
- min = (Uint32) -1; /* max Uint32 */
- i = tiw_pos;
- do {
- p = tiw[i];
- while (p != NULL) {
- nto++;
- if (p->count == 0) {
- /* found next timeout */
- dt = do_time_read();
- /* p->count is zero */
- tiw_min_ptr = p;
- tiw_min = tm;
- return ((tm >= dt) ? (tm - dt) : 0);
- } else {
- /* keep shortest time in 'min' */
- if (tm + p->count*TIW_SIZE < min) {
- min = tm + p->count*TIW_SIZE;
- tiw_min_ptr = p;
- tiw_min = min;
- }
- }
- p = p->next;
- }
- /* when we have found all timeouts the shortest time will be in min */
- if (nto == tiw_nto) break;
- tm++;
- i = (i + 1) % TIW_SIZE;
- } while (i != tiw_pos);
- dt = do_time_read();
- if (min <= (Uint32) dt)
- return 0;
- if ((min - (Uint32) dt) > (Uint32) ERTS_SHORT_TIME_T_MAX)
- return ERTS_SHORT_TIME_T_MAX;
- return (erts_short_time_t) (min - (Uint32) dt);
+
+ ERTS_TW_ASSERT(left >= -1);
+
+ if (posp)
+ *posp += slot_sz * ((ErtsMonotonicTime) (*leftp - left));
+ if (sixp)
+ *sixp = slot >> ERTS_TW_SCNT_BITS;
+ *leftp = left;
+ *slotp = slot;
+}
+
+
+static ERTS_INLINE void
+scnt_soon_wheel_next(int *slotp, int *leftp, ErtsMonotonicTime *posp,
+ int *sixp, Sint *scnt)
+{
+ scnt_wheel_next(slotp, leftp, posp, sixp, scnt,
+ ERTS_TW_SOON_WHEEL_FIRST_SLOT,
+ ERTS_TW_SOON_WHEEL_END_SLOT, 1);
}
-static void remove_timer(ErlTimer *p) {
- /* first */
- if (!p->prev) {
- tiw[p->slot] = p->next;
- if(p->next)
- p->next->prev = NULL;
- } else {
- p->prev->next = p->next;
+static ERTS_INLINE void
+scnt_later_wheel_next(int *slotp, int *leftp, ErtsMonotonicTime *posp,
+ int *sixp, Sint *scnt)
+{
+ scnt_wheel_next(slotp, leftp, posp, sixp, scnt,
+ ERTS_TW_LATER_WHEEL_FIRST_SLOT,
+ ERTS_TW_LATER_WHEEL_END_SLOT,
+ ERTS_TW_LATER_WHEEL_SLOT_SIZE);
+}
+
+
+static ERTS_INLINE int
+soon_slot(ErtsMonotonicTime soon_pos)
+{
+ ErtsMonotonicTime slot = soon_pos;
+ slot &= ERTS_TW_SOON_WHEEL_MASK;
+
+ ERTS_TW_ASSERT(ERTS_TW_SOON_WHEEL_FIRST_SLOT <= slot);
+ ERTS_TW_ASSERT(slot < ERTS_TW_SOON_WHEEL_END_SLOT);
+
+ return (int) slot;
+}
+
+static ERTS_INLINE int
+later_slot(ErtsMonotonicTime later_pos)
+{
+ ErtsMonotonicTime slot = later_pos;
+ slot >>= ERTS_TW_LATER_WHEEL_SHIFT;
+ slot &= ERTS_TW_LATER_WHEEL_MASK;
+ slot += ERTS_TW_LATER_WHEEL_FIRST_SLOT;
+
+ ERTS_TW_ASSERT(ERTS_TW_LATER_WHEEL_FIRST_SLOT <= slot);
+ ERTS_TW_ASSERT(slot < ERTS_TW_LATER_WHEEL_END_SLOT);
+
+ return (int) slot;
+}
+
+#ifdef ERTS_TW_HARD_DEBUG
+#define ERTS_HARD_DBG_CHK_WHEELS(TIW, CHK_MIN_TPOS) \
+ hrd_dbg_check_wheels((TIW), (CHK_MIN_TPOS))
+static void hrd_dbg_check_wheels(ErtsTimerWheel *tiw, int check_min_tpos);
+#else
+#define ERTS_HARD_DBG_CHK_WHEELS(TIW, CHK_MIN_TPOS)
+#endif
+
+static ErtsMonotonicTime
+find_next_timeout(ErtsSchedulerData *esdp, ErtsTimerWheel *tiw)
+{
+ int slot, slots;
+ int true_min_timeout = 0;
+ ErtsMonotonicTime min_timeout_pos;
+
+ ERTS_TW_ASSERT(tiw->pos + ERTS_TW_LATER_WHEEL_SLOT_SIZE < tiw->later.pos
+ && tiw->later.pos <= tiw->pos + ERTS_TW_SOON_WHEEL_SIZE);
+
+ ERTS_HARD_DBG_CHK_WHEELS(tiw, 0);
+
+ ERTS_TW_ASSERT(tiw->yield_slot == ERTS_TW_SLOT_INACTIVE);
+
+ if (tiw->nto == 0) { /* no timeouts in wheel */
+ ErtsMonotonicTime curr_time = erts_get_monotonic_time(esdp);
+ tiw->pos = min_timeout_pos = ERTS_MONOTONIC_TO_CLKTCKS(curr_time);
+ tiw->later.pos = min_timeout_pos + ERTS_TW_SOON_WHEEL_SIZE;
+ tiw->later.pos &= ERTS_TW_LATER_WHEEL_POS_MASK;
+ min_timeout_pos += ERTS_CLKTCKS_WEEK;
+ goto done;
}
- /* last */
- if (!p->next) {
- if (p->prev)
- p->prev->next = NULL;
- } else {
- p->next->prev = p->prev;
+ ERTS_TW_ASSERT(tiw->soon.nto || tiw->later.nto);
+
+ if (!tiw->soon.nto) {
+ ErtsMonotonicTime tpos, min_tpos;
+
+ /* Search later wheel... */
+
+ min_tpos = tiw->later.min_tpos & ERTS_TW_LATER_WHEEL_POS_MASK;
+
+ if (min_tpos <= tiw->later.pos) {
+ tpos = tiw->later.pos;
+ slots = ERTS_TW_LATER_WHEEL_SIZE;
+ }
+ else {
+ ErtsMonotonicTime tmp;
+ /* Don't inspect slots we know are empty... */
+ tmp = min_tpos - tiw->later.pos;
+ tmp /= ERTS_TW_LATER_WHEEL_SLOT_SIZE;
+ if (tmp >= ERTS_TW_LATER_WHEEL_SIZE) {
+ /* Timeout more than one revolution ahead... */
+
+ /* Pre-timeout for move from later to soon wheel... */
+ min_timeout_pos = min_tpos - ERTS_TW_LATER_WHEEL_SLOT_SIZE;
+ goto done;
+ }
+ tpos = min_tpos;
+ ERTS_TW_DBG_VERIFY_EMPTY_LATER_SLOTS(tiw, min_tpos);
+ slots = ERTS_TW_LATER_WHEEL_SIZE - ((int) tmp);
+ }
+
+ slot = later_slot(tpos);
+
+ /*
+ * We never search for an exact timeout in the
+ * later wheel, but instead settle for the first
+ * scnt range used.
+ */
+ if (tiw->w[slot])
+ true_min_timeout = 1;
+ else
+ scnt_later_wheel_next(&slot, &slots, &tpos, NULL, tiw->scnt);
+
+ tiw->later.min_tpos = tpos;
+ tiw->later.min_tpos_slot = slot;
+ ERTS_TW_ASSERT(slot == later_slot(tpos));
+
+ /* Pre-timeout for move from later to soon wheel... */
+ tpos -= ERTS_TW_LATER_WHEEL_SLOT_SIZE;
+ min_timeout_pos = tpos;
}
+ else {
+ ErtsMonotonicTime tpos;
+ /* Search soon wheel... */
+
+ min_timeout_pos = tiw->pos + ERTS_TW_SOON_WHEEL_SIZE;
+
+ /*
+ * Besides inspecting the soon wheel we
+ * may also have to inspect two slots in the
+ * later wheel which potentially can trigger
+ * timeouts before timeouts in soon wheel...
+ */
+ if (tiw->later.min_tpos > (tiw->later.pos
+ + 2*ERTS_TW_LATER_WHEEL_SLOT_SIZE)) {
+ ERTS_TW_DBG_VERIFY_EMPTY_LATER_SLOTS(
+ tiw, 2*ERTS_TW_LATER_WHEEL_SLOT_SIZE);
+ }
+ else {
+ int fslot;
+ tpos = tiw->later.pos;
+ tpos -= ERTS_TW_LATER_WHEEL_SLOT_SIZE;
+ fslot = later_slot(tiw->later.pos);
+ if (tiw->w[fslot])
+ min_timeout_pos = tpos;
+ else {
+ tpos += ERTS_TW_LATER_WHEEL_SLOT_SIZE;
+ if (tpos < min_timeout_pos) {
+ fslot++;
+ if (fslot == ERTS_TW_LATER_WHEEL_END_SLOT)
+ fslot = ERTS_TW_LATER_WHEEL_FIRST_SLOT;
+ if (tiw->w[fslot])
+ min_timeout_pos = tpos;
+ }
+ }
+ }
+
+ if (tiw->soon.min_tpos <= tiw->pos) {
+ tpos = tiw->pos;
+ slots = ERTS_TW_SOON_WHEEL_SIZE;
+ }
+ else {
+ ErtsMonotonicTime tmp;
+ /* Don't inspect slots we know are empty... */
+ tmp = tiw->soon.min_tpos - tiw->pos;
+ ERTS_TW_ASSERT(ERTS_TW_SOON_WHEEL_SIZE > tmp);
+ ERTS_TW_DBG_VERIFY_EMPTY_SOON_SLOTS(tiw, tiw->soon.min_tpos);
+ slots = ERTS_TW_SOON_WHEEL_SIZE - ((int) tmp);
+ tpos = tiw->soon.min_tpos;
+ }
+
+ slot = soon_slot(tpos);
+
+ /* find next non-empty slot */
+ while (tpos < min_timeout_pos) {
+ if (tiw->w[slot]) {
+ ERTS_TW_ASSERT(tiw->w[slot]->timeout_pos == tpos);
+ min_timeout_pos = tpos;
+ break;
+ }
+ scnt_soon_wheel_next(&slot, &slots, &tpos, NULL, tiw->scnt);
+ }
+
+ tiw->soon.min_tpos = min_timeout_pos;
+ true_min_timeout = 1;
+ }
+
+done: {
+ ErtsMonotonicTime min_timeout;
+
+ min_timeout = ERTS_CLKTCKS_TO_MONOTONIC(min_timeout_pos);
+ tiw->next_timeout_pos = min_timeout_pos;
+ tiw->next_timeout_time = min_timeout;
+ tiw->true_next_timeout_time = true_min_timeout;
+
+ ERTS_HARD_DBG_CHK_WHEELS(tiw, 1);
- p->next = NULL;
- p->prev = NULL;
- /* Make sure cancel callback isn't called */
- p->active = 0;
- tiw_nto--;
+ return min_timeout;
+ }
+}
+
+static ERTS_INLINE void
+insert_timer_into_slot(ErtsTimerWheel *tiw, int slot, ErtsTWheelTimer *p)
+{
+ ERTS_TW_ASSERT(ERTS_TW_SLOT_AT_ONCE <= slot
+ && slot < ERTS_TW_LATER_WHEEL_END_SLOT);
+ p->slot = slot;
+ if (!tiw->w[slot]) {
+ tiw->w[slot] = p;
+ p->next = p;
+ p->prev = p;
+ }
+ else {
+ ErtsTWheelTimer *next, *prev;
+ next = tiw->w[slot];
+ prev = next->prev;
+ p->next = next;
+ p->prev = prev;
+ prev->next = p;
+ next->prev = p;
+ }
+ if (slot == ERTS_TW_SLOT_AT_ONCE)
+ tiw->at_once.nto++;
+ else {
+ ErtsMonotonicTime tpos = p->timeout_pos;
+ if (slot < ERTS_TW_SOON_WHEEL_END_SLOT) {
+ ERTS_TW_ASSERT(p->timeout_pos < tiw->pos + ERTS_TW_SOON_WHEEL_SIZE);
+ tiw->soon.nto++;
+ if (tiw->soon.min_tpos > tpos)
+ tiw->soon.min_tpos = tpos;
+ }
+ else {
+ ERTS_TW_ASSERT(p->timeout_pos >= tiw->pos + ERTS_TW_SOON_WHEEL_SIZE);
+ tiw->later.nto++;
+ if (tiw->later.min_tpos > tpos) {
+ tiw->later.min_tpos = tpos;
+ tiw->later.min_tpos_slot = slot;
+ }
+ }
+ scnt_inc(tiw->scnt, slot);
+ }
+}
+
+static ERTS_INLINE void
+remove_timer(ErtsTimerWheel *tiw, ErtsTWheelTimer *p)
+{
+ int slot = p->slot;
+ int empty_slot;
+ ERTS_TW_ASSERT(slot != ERTS_TW_SLOT_INACTIVE);
+
+ /*
+ * Timer is in circular list either referred to
+ * by at once slot, slot in soon wheel, slot
+ * in later wheel, or by sentinel (timers currently
+ * being triggered).
+ */
+ ERTS_TW_ASSERT(ERTS_TW_SLOT_AT_ONCE <= slot
+ && slot < ERTS_TW_LATER_WHEEL_END_SLOT);
+
+ if (p->next == p) {
+ /* Cannot be referred by sentinel, i.e. must be referred by slot... */
+ ERTS_TW_ASSERT(tiw->w[slot] == p);
+ tiw->w[slot] = NULL;
+ empty_slot = 1;
+ }
+ else {
+ if (tiw->w[slot] == p)
+ tiw->w[slot] = p->next;
+ p->prev->next = p->next;
+ p->next->prev = p->prev;
+ empty_slot = 0;
+ }
+ if (slot == ERTS_TW_SLOT_AT_ONCE) {
+ ERTS_TW_ASSERT(tiw->at_once.nto > 0);
+ tiw->at_once.nto--;
+ }
+ else {
+ scnt_dec(tiw->scnt, slot);
+ if (slot < ERTS_TW_SOON_WHEEL_END_SLOT) {
+ if (empty_slot
+ && tiw->true_next_timeout_time
+ && p->timeout_pos == tiw->next_timeout_pos) {
+ tiw->true_next_timeout_time = 0;
+ }
+ if (--tiw->soon.nto == 0)
+ tiw->soon.min_tpos = ERTS_MAX_CLKTCKS;
+ }
+ else {
+ if (empty_slot
+ && tiw->true_next_timeout_time
+ && tiw->later.min_tpos_slot == slot) {
+ ErtsMonotonicTime tpos = tiw->later.min_tpos;
+ tpos &= ERTS_TW_LATER_WHEEL_POS_MASK;
+ tpos -= ERTS_TW_LATER_WHEEL_SLOT_SIZE;
+ if (tpos == tiw->next_timeout_pos)
+ tiw->true_next_timeout_time = 0;
+ }
+ if (--tiw->later.nto == 0) {
+ tiw->later.min_tpos = ERTS_MAX_CLKTCKS;
+ tiw->later.min_tpos_slot = ERTS_TW_LATER_WHEEL_END_SLOT;
+ }
+ }
+ }
+ p->slot = ERTS_TW_SLOT_INACTIVE;
}
-/* Private export to erl_time_sup.c */
-erts_short_time_t erts_next_time(void)
+ErtsMonotonicTime
+erts_check_next_timeout_time(ErtsSchedulerData *esdp)
{
- erts_short_time_t ret;
+ ErtsTimerWheel *tiw = esdp->timer_wheel;
+ ErtsMonotonicTime time;
+ ERTS_MSACC_DECLARE_CACHE_X();
+ ERTS_TW_ASSERT(tiw->next_timeout_time
+ == ERTS_CLKTCKS_TO_MONOTONIC(tiw->next_timeout_pos));
+ if (tiw->true_next_timeout_time)
+ return tiw->next_timeout_time; /* known timeout... */
+ if (tiw->next_timeout_pos > tiw->pos + ERTS_TW_SOON_WHEEL_SIZE)
+ return tiw->next_timeout_time; /* sufficiently later away... */
+ ERTS_MSACC_PUSH_AND_SET_STATE_CACHED_X(ERTS_MSACC_STATE_TIMERS);
+ time = find_next_timeout(esdp, tiw);
+ ERTS_MSACC_POP_STATE_M_X();
+ return time;
+}
- erts_smp_mtx_lock(&tiw_lock);
- (void)do_time_update();
- ret = next_time_internal();
- erts_smp_mtx_unlock(&tiw_lock);
- return ret;
+static ERTS_INLINE void
+timeout_timer(ErtsTWheelTimer *p)
+{
+ ErlTimeoutProc timeout;
+ void *arg;
+ p->slot = ERTS_TW_SLOT_INACTIVE;
+ timeout = p->timeout;
+ arg = p->arg;
+ (*timeout)(arg);
+ ASSERT_NO_LOCKED_LOCKS;
}
-static ERTS_INLINE void bump_timer_internal(erts_short_time_t dt) /* PRE: tiw_lock is write-locked */
+void
+erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time)
{
- Uint keep_pos;
- Uint count;
- ErlTimer *p, **prev, *timeout_head, **timeout_tail;
- Uint dtime = (Uint) dt;
-
- /* no need to bump the position if there aren't any timeouts */
- if (tiw_nto == 0) {
- erts_smp_mtx_unlock(&tiw_lock);
- return;
+ int slot, restarted, yield_count, slots, scnt_ix;
+ ErtsMonotonicTime bump_to;
+ Sint *scnt, *bump_scnt;
+ ERTS_MSACC_PUSH_AND_SET_STATE_M_X(ERTS_MSACC_STATE_TIMERS);
+
+ yield_count = ERTS_TWHEEL_BUMP_YIELD_LIMIT;
+
+ scnt = &tiw->scnt[0];
+ bump_scnt = &tiw->bump_scnt[0];
+
+ /*
+ * In order to be fair we always continue with work
+ * where we left off when restarting after a yield.
+ */
+
+ slot = tiw->yield_slot;
+ restarted = slot != ERTS_TW_SLOT_INACTIVE;
+ if (restarted) {
+ bump_to = tiw->pos;
+ if (slot >= ERTS_TW_LATER_WHEEL_FIRST_SLOT)
+ goto restart_yielded_later_slot;
+ tiw->yield_slot = ERTS_TW_SLOT_INACTIVE;
+ if (slot == ERTS_TW_SLOT_AT_ONCE)
+ goto restart_yielded_at_once_slot;
+ scnt_ix = scnt_get_ix(slot);
+ slots = tiw->yield_slots_left;
+ ASSERT(0 <= slots && slots <= ERTS_TW_SOON_WHEEL_SIZE);
+ goto restart_yielded_soon_slot;
}
- /* if do_time > TIW_SIZE we want to go around just once */
- count = (Uint)(dtime / TIW_SIZE) + 1;
- keep_pos = (tiw_pos + dtime) % TIW_SIZE;
- if (dtime > TIW_SIZE) dtime = TIW_SIZE;
-
- timeout_head = NULL;
- timeout_tail = &timeout_head;
- while (dtime > 0) {
- /* this is to decrease the counters with the right amount */
- /* when dtime >= TIW_SIZE */
- if (tiw_pos == keep_pos) count--;
- prev = &tiw[tiw_pos];
- while ((p = *prev) != NULL) {
- ASSERT( p != p->next);
- if (p->count < count) { /* we have a timeout */
- /* remove min time */
- if (tiw_min_ptr == p) {
- tiw_min_ptr = NULL;
- tiw_min = 0;
- }
+ do {
+
+ restarted = 0;
+ bump_to = ERTS_MONOTONIC_TO_CLKTCKS(curr_time);
+ tiw->true_next_timeout_time = 1;
+ tiw->next_timeout_pos = bump_to;
+ tiw->next_timeout_time = ERTS_CLKTCKS_TO_MONOTONIC(bump_to);
- /* Remove from list */
- remove_timer(p);
- *timeout_tail = p; /* Insert in timeout queue */
- timeout_tail = &p->next;
+ while (1) {
+ ErtsTWheelTimer *p;
+
+ if (tiw->nto == 0) {
+ empty_wheel:
+ ERTS_TW_DBG_VERIFY_EMPTY_SOON_SLOTS(tiw, bump_to);
+ ERTS_TW_DBG_VERIFY_EMPTY_LATER_SLOTS(tiw, bump_to);
+ tiw->true_next_timeout_time = 0;
+ tiw->next_timeout_pos = bump_to + ERTS_CLKTCKS_WEEK;
+ tiw->next_timeout_time = ERTS_CLKTCKS_TO_MONOTONIC(tiw->next_timeout_pos);;
+ tiw->pos = bump_to;
+ tiw->later.pos = bump_to + ERTS_TW_SOON_WHEEL_SIZE;
+ tiw->later.pos &= ERTS_TW_LATER_WHEEL_POS_MASK;
+ tiw->yield_slot = ERTS_TW_SLOT_INACTIVE;
+ ERTS_MSACC_POP_STATE_M_X();
+ return;
}
- else {
- /* no timeout, just decrease counter */
- p->count -= count;
- prev = &p->next;
+
+ p = tiw->w[ERTS_TW_SLOT_AT_ONCE];
+
+ if (p) {
+
+ if (p->next == p) {
+ ERTS_TW_ASSERT(tiw->sentinel.next == &tiw->sentinel);
+ ERTS_TW_ASSERT(tiw->sentinel.prev == &tiw->sentinel);
+ }
+ else {
+ tiw->sentinel.next = p->next;
+ tiw->sentinel.prev = p->prev;
+ tiw->sentinel.next->prev = &tiw->sentinel;
+ tiw->sentinel.prev->next = &tiw->sentinel;
+ }
+ tiw->w[ERTS_TW_SLOT_AT_ONCE] = NULL;
+
+ while (1) {
+ ERTS_TW_ASSERT(tiw->nto > 0);
+ ERTS_TW_ASSERT(tiw->at_once.nto > 0);
+ tiw->nto--;
+ tiw->at_once.nto--;
+
+ timeout_timer(p);
+
+ yield_count -= ERTS_TW_COST_TIMEOUT;
+
+ restart_yielded_at_once_slot:
+
+ p = tiw->sentinel.next;
+ if (p == &tiw->sentinel) {
+ ERTS_TW_ASSERT(tiw->sentinel.prev == &tiw->sentinel);
+ break;
+ }
+
+ if (yield_count <= 0) {
+ ERTS_TW_ASSERT(tiw->nto > 0);
+ ERTS_TW_ASSERT(tiw->at_once.nto > 0);
+ tiw->yield_slot = ERTS_TW_SLOT_AT_ONCE;
+ ERTS_MSACC_POP_STATE_M_X();
+ return; /* Yield! */
+ }
+
+ tiw->sentinel.next = p->next;
+ p->next->prev = &tiw->sentinel;
+ }
+
+ }
+
+ if (tiw->pos >= bump_to) {
+ ERTS_MSACC_POP_STATE_M_X();
+ break;
+ }
+
+ if (tiw->nto == 0)
+ goto empty_wheel;
+
+ /*
+ * Save slot counts in bump operation local
+ * array.
+ *
+ * The amount of timers to trigger (or move)
+ * will only decrease from now until we have
+ * completed this bump operation (even if we
+ * yield in the middle of it).
+ *
+ * The amount of timers in the wheels may
+ * however increase due to timers being set
+ * by timeout callbacks.
+ */
+ sys_memcpy((void *) bump_scnt, (void *) scnt,
+ sizeof(Sint) * ERTS_TW_SCNT_SIZE);
+
+ if (tiw->soon.min_tpos > tiw->pos) {
+ ErtsMonotonicTime skip_until_pos = tiw->soon.min_tpos;
+
+ /*
+ * No need inspecting slots where we know no timeouts
+ * to trigger should reside.
+ */
+
+ if (skip_until_pos > bump_to)
+ skip_until_pos = bump_to;
+
+ skip_until_pos--;
+
+ if (skip_until_pos > tiw->pos) {
+ ERTS_TW_DBG_VERIFY_EMPTY_SOON_SLOTS(tiw, skip_until_pos);
+ tiw->pos = skip_until_pos;
+ }
+ }
+
+ {
+ ErtsMonotonicTime tmp_slots = bump_to - tiw->pos;
+ tmp_slots = (bump_to - tiw->pos);
+ if (tmp_slots < ERTS_TW_SOON_WHEEL_SIZE)
+ slots = (int) tmp_slots;
+ else
+ slots = ERTS_TW_SOON_WHEEL_SIZE;
+ }
+
+ slot = soon_slot(tiw->pos+1);
+ tiw->pos = bump_to;
+
+ tiw->next_timeout_pos = bump_to;
+ tiw->next_timeout_time = ERTS_CLKTCKS_TO_MONOTONIC(bump_to);
+
+ scnt_ix = scnt_get_ix(slot);
+
+ /* Timeout timers in soon wheel */
+ while (slots > 0) {
+
+ yield_count -= ERTS_TW_COST_SLOT;
+
+ p = tiw->w[slot];
+ if (p) {
+ /* timeout callback need tiw->pos to be up to date */
+ if (p->next == p) {
+ ERTS_TW_ASSERT(tiw->sentinel.next == &tiw->sentinel);
+ ERTS_TW_ASSERT(tiw->sentinel.prev == &tiw->sentinel);
+ }
+ else {
+ tiw->sentinel.next = p->next;
+ tiw->sentinel.prev = p->prev;
+ tiw->sentinel.next->prev = &tiw->sentinel;
+ tiw->sentinel.prev->next = &tiw->sentinel;
+ }
+ tiw->w[slot] = NULL;
+
+ while (1) {
+
+ ERTS_TW_ASSERT(ERTS_TW_SOON_WHEEL_FIRST_SLOT <= p->slot
+ && p->slot < ERTS_TW_SOON_WHEEL_END_SLOT);
+ if (--tiw->soon.nto == 0)
+ tiw->soon.min_tpos = ERTS_MAX_CLKTCKS;
+ scnt_ix_dec(scnt, scnt_ix);
+ if (p->timeout_pos <= bump_to) {
+ timeout_timer(p);
+ tiw->nto--;
+ scnt_ix_dec(bump_scnt, scnt_ix);
+ yield_count -= ERTS_TW_COST_TIMEOUT;
+ }
+ else {
+ /* uncommon case */
+ insert_timer_into_slot(tiw, slot, p);
+ yield_count -= ERTS_TW_COST_SLOT_MOVE;
+ }
+
+ restart_yielded_soon_slot:
+
+ p = tiw->sentinel.next;
+ if (p == &tiw->sentinel) {
+ ERTS_TW_ASSERT(tiw->sentinel.prev == &tiw->sentinel);
+ break;
+ }
+
+ if (yield_count <= 0) {
+ tiw->yield_slot = slot;
+ tiw->yield_slots_left = slots;
+ ERTS_MSACC_POP_STATE_M_X();
+ return; /* Yield! */
+ }
+
+ tiw->sentinel.next = p->next;
+ p->next->prev = &tiw->sentinel;
+ }
+ }
+
+ scnt_soon_wheel_next(&slot, &slots, NULL, &scnt_ix, bump_scnt);
}
+
+ if (ERTS_TW_BUMP_LATER_WHEEL(tiw)) {
+ restart_yielded_later_slot:
+ if (bump_later_wheel(tiw, &yield_count))
+ return; /* Yield! */
+ }
}
- tiw_pos = (tiw_pos + 1) % TIW_SIZE;
- dtime--;
- }
- tiw_pos = keep_pos;
- if (tiw_min_ptr)
- tiw_min -= dt;
-
- erts_smp_mtx_unlock(&tiw_lock);
-
- /* Call timedout timers callbacks */
- while (timeout_head) {
- p = timeout_head;
- timeout_head = p->next;
- /* Here comes hairy use of the timer fields!
- * They are reset without having the lock.
- * It is assumed that no code but this will
- * accesses any field until the ->timeout
- * callback is called.
- */
- p->next = NULL;
- p->prev = NULL;
- p->slot = 0;
- (*p->timeout)(p->arg);
- }
+
+ } while (restarted);
+
+ tiw->true_next_timeout_time = 0;
+ ERTS_TW_ASSERT(tiw->next_timeout_pos == bump_to);
+
+ (void) find_next_timeout(NULL, tiw);
+ ERTS_MSACC_POP_STATE_M_X();
}
-void erts_bump_timer(erts_short_time_t dt) /* dt is value from do_time */
+static int
+bump_later_wheel(ErtsTimerWheel *tiw, int *ycount_p)
{
- erts_smp_mtx_lock(&tiw_lock);
- bump_timer_internal(dt);
+ ErtsMonotonicTime cpos = tiw->pos;
+ ErtsMonotonicTime later_pos = tiw->later.pos;
+ int ycount = *ycount_p;
+ int slots, fslot, scnt_ix;
+ Sint *scnt, *bump_scnt;
+
+ scnt = &tiw->scnt[0];
+ bump_scnt = &tiw->bump_scnt[0];
+
+ ERTS_HARD_DBG_CHK_WHEELS(tiw, 0);
+
+ if (tiw->yield_slot >= ERTS_TW_LATER_WHEEL_FIRST_SLOT) {
+ fslot = tiw->yield_slot;
+ scnt_ix = scnt_get_ix(fslot);
+ slots = tiw->yield_slots_left;
+ ASSERT(0 <= slots && slots <= ERTS_TW_LATER_WHEEL_SIZE);
+ tiw->yield_slot = ERTS_TW_SLOT_INACTIVE;
+ goto restart_yielded_slot;
+ }
+ else {
+ ErtsMonotonicTime end_later_pos, tmp_slots, min_tpos;
+
+ min_tpos = tiw->later.min_tpos & ERTS_TW_LATER_WHEEL_POS_MASK;
+ end_later_pos = cpos + ERTS_TW_SOON_WHEEL_SIZE;
+ end_later_pos &= ERTS_TW_LATER_WHEEL_POS_MASK;
+
+ /* Skip known empty slots... */
+ if (min_tpos > later_pos) {
+ if (min_tpos > end_later_pos) {
+ ERTS_TW_DBG_VERIFY_EMPTY_LATER_SLOTS(tiw, end_later_pos);
+ tiw->later.pos = end_later_pos;
+ goto done;
+ }
+ later_pos = min_tpos;
+ ERTS_TW_DBG_VERIFY_EMPTY_LATER_SLOTS(tiw, later_pos);
+ }
+
+ tmp_slots = end_later_pos;
+ tmp_slots -= later_pos;
+ tmp_slots /= ERTS_TW_LATER_WHEEL_SLOT_SIZE;
+ if (tmp_slots < ERTS_TW_LATER_WHEEL_SIZE)
+ slots = (int) tmp_slots;
+ else
+ slots = ERTS_TW_LATER_WHEEL_SIZE;
+
+ fslot = later_slot(later_pos);
+ scnt_ix = scnt_get_ix(fslot);
+
+ tiw->later.pos = end_later_pos;
+ }
+
+ while (slots > 0) {
+ ErtsTWheelTimer *p;
+
+ ycount -= ERTS_TW_COST_SLOT;
+
+ p = tiw->w[fslot];
+
+ if (p) {
+
+ if (p->next == p) {
+ ERTS_TW_ASSERT(tiw->sentinel.next == &tiw->sentinel);
+ ERTS_TW_ASSERT(tiw->sentinel.prev == &tiw->sentinel);
+ }
+ else {
+ tiw->sentinel.next = p->next;
+ tiw->sentinel.prev = p->prev;
+ tiw->sentinel.next->prev = &tiw->sentinel;
+ tiw->sentinel.prev->next = &tiw->sentinel;
+ }
+ tiw->w[fslot] = NULL;
+
+ while (1) {
+ ErtsMonotonicTime tpos = p->timeout_pos;
+
+ ERTS_TW_ASSERT(p->slot == fslot);
+
+ if (--tiw->later.nto == 0) {
+ tiw->later.min_tpos = ERTS_MAX_CLKTCKS;
+ tiw->later.min_tpos_slot = ERTS_TW_LATER_WHEEL_END_SLOT;
+ }
+ scnt_ix_dec(scnt, scnt_ix);
+
+ if (tpos >= tiw->later.pos + ERTS_TW_LATER_WHEEL_SLOT_SIZE) {
+ /* keep in later slot; very uncommon... */
+ insert_timer_into_slot(tiw, fslot, p);
+ ycount -= ERTS_TW_COST_SLOT_MOVE;
+ }
+ else {
+ scnt_ix_dec(bump_scnt, scnt_ix);
+ ERTS_TW_ASSERT(tpos < cpos + ERTS_TW_SOON_WHEEL_SIZE);
+ if (tpos > cpos) {
+ /* move into soon wheel */
+ insert_timer_into_slot(tiw, soon_slot(tpos), p);
+ ycount -= ERTS_TW_COST_SLOT_MOVE;
+ }
+ else {
+ /* trigger at once */
+ timeout_timer(p);
+ tiw->nto--;
+ ycount -= ERTS_TW_COST_TIMEOUT;
+ }
+ }
+
+ restart_yielded_slot:
+
+ p = tiw->sentinel.next;
+ if (p == &tiw->sentinel) {
+ ERTS_TW_ASSERT(tiw->sentinel.prev == &tiw->sentinel);
+ break;
+ }
+
+ if (ycount < 0) {
+ tiw->yield_slot = fslot;
+ tiw->yield_slots_left = slots;
+ *ycount_p = 0;
+ ERTS_HARD_DBG_CHK_WHEELS(tiw, 0);
+ return 1; /* Yield! */
+ }
+
+ tiw->sentinel.next = p->next;
+ p->next->prev = &tiw->sentinel;
+ }
+ }
+
+ scnt_later_wheel_next(&fslot, &slots, NULL, &scnt_ix, bump_scnt);
+ }
+
+done:
+
+ ERTS_HARD_DBG_CHK_WHEELS(tiw, 0);
+
+ *ycount_p = ycount;
+
+ return 0;
}
Uint
erts_timer_wheel_memory_size(void)
{
- return (Uint) TIW_SIZE * sizeof(ErlTimer*);
+ return sizeof(ErtsTimerWheel)*erts_no_schedulers;
+}
+
+ErtsTimerWheel *
+erts_create_timer_wheel(ErtsSchedulerData *esdp)
+{
+ ErtsMonotonicTime mtime;
+ int i;
+ ErtsTimerWheel *tiw;
+
+ /* Some compile time sanity checks... */
+
+ /* Slots... */
+ ERTS_CT_ASSERT(ERTS_TW_SLOT_AT_ONCE == -1);
+ ERTS_CT_ASSERT(ERTS_TW_SLOT_INACTIVE < ERTS_TW_SLOT_AT_ONCE);
+ ERTS_CT_ASSERT(ERTS_TW_SLOT_AT_ONCE + 1 == ERTS_TW_SOON_WHEEL_FIRST_SLOT);
+ ERTS_CT_ASSERT(ERTS_TW_SOON_WHEEL_FIRST_SLOT < ERTS_TW_SOON_WHEEL_END_SLOT);
+ ERTS_CT_ASSERT(ERTS_TW_SOON_WHEEL_END_SLOT == ERTS_TW_LATER_WHEEL_FIRST_SLOT);
+ ERTS_CT_ASSERT(ERTS_TW_LATER_WHEEL_FIRST_SLOT < ERTS_TW_LATER_WHEEL_END_SLOT);
+
+ /* Both wheel sizes should be a powers of 2 */
+ ERTS_CT_ASSERT(ERTS_TW_SOON_WHEEL_SIZE
+ && !(ERTS_TW_SOON_WHEEL_SIZE & (ERTS_TW_SOON_WHEEL_SIZE-1)));
+ ERTS_CT_ASSERT(ERTS_TW_LATER_WHEEL_SIZE
+ && !(ERTS_TW_LATER_WHEEL_SIZE & (ERTS_TW_LATER_WHEEL_SIZE-1)));
+
+ tiw = erts_alloc_permanent_cache_aligned(ERTS_ALC_T_TIMER_WHEEL,
+ sizeof(ErtsTimerWheel));
+ tiw->w = &tiw->slots[1];
+ for(i = ERTS_TW_SLOT_AT_ONCE; i < ERTS_TW_LATER_WHEEL_END_SLOT; i++)
+ tiw->w[i] = NULL;
+
+ for (i = 0; i < ERTS_TW_SCNT_SIZE; i++)
+ tiw->scnt[i] = 0;
+
+ mtime = erts_get_monotonic_time(esdp);
+ tiw->pos = ERTS_MONOTONIC_TO_CLKTCKS(mtime);
+ tiw->nto = 0;
+ tiw->at_once.nto = 0;
+ tiw->soon.min_tpos = ERTS_MAX_CLKTCKS;
+ tiw->soon.nto = 0;
+ tiw->later.min_tpos = ERTS_MAX_CLKTCKS;
+ tiw->later.min_tpos_slot = ERTS_TW_LATER_WHEEL_END_SLOT;
+ tiw->later.pos = tiw->pos + ERTS_TW_SOON_WHEEL_SIZE;
+ tiw->later.pos &= ERTS_TW_LATER_WHEEL_POS_MASK;
+ tiw->later.nto = 0;
+ tiw->yield_slot = ERTS_TW_SLOT_INACTIVE;
+ tiw->true_next_timeout_time = 0;
+ tiw->next_timeout_pos = tiw->pos + ERTS_CLKTCKS_WEEK;
+ tiw->next_timeout_time = ERTS_CLKTCKS_TO_MONOTONIC(tiw->next_timeout_pos);
+ tiw->sentinel.next = &tiw->sentinel;
+ tiw->sentinel.prev = &tiw->sentinel;
+ tiw->sentinel.timeout = NULL;
+ tiw->sentinel.arg = NULL;
+ return tiw;
}
+ErtsNextTimeoutRef
+erts_get_next_timeout_reference(ErtsTimerWheel *tiw)
+{
+ return (ErtsNextTimeoutRef) &tiw->next_timeout_time;
+}
+
+
/* this routine links the time cells into a free list at the start
and sets the time queue as empty */
void
-erts_init_time(void)
+erts_init_time(int time_correction, ErtsTimeWarpMode time_warp_mode)
{
- int i, itime;
+ int itime;
/* system dependent init; must be done before do_time_init()
if timer thread is enabled */
- itime = erts_init_time_sup();
+ 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;
#endif
-
- erts_smp_mtx_init(&tiw_lock, "timer_wheel");
-
- tiw = (ErlTimer**) erts_alloc(ERTS_ALC_T_TIMER_WHEEL,
- TIW_SIZE * sizeof(ErlTimer*));
- for(i = 0; i < TIW_SIZE; i++)
- tiw[i] = NULL;
- do_time_init();
- tiw_pos = tiw_nto = 0;
- tiw_min_ptr = NULL;
- tiw_min = 0;
}
+void
+erts_twheel_set_timer(ErtsTimerWheel *tiw,
+ ErtsTWheelTimer *p, ErlTimeoutProc timeout,
+ void *arg, ErtsMonotonicTime timeout_pos)
+{
+ int slot;
+ ERTS_MSACC_PUSH_AND_SET_STATE_M_X(ERTS_MSACC_STATE_TIMERS);
+ p->timeout = timeout;
+ p->arg = arg;
+ ERTS_TW_ASSERT(p->slot == ERTS_TW_SLOT_INACTIVE);
-/*
-** Insert a process into the time queue, with a timeout 't'
-*/
-static void
-insert_timer(ErlTimer* p, Uint t)
-{
- Uint tm;
- Uint64 ticks;
-
- /* The current slot (tiw_pos) in timing wheel is the next slot to be
- * be processed. Hence no extra time tick is needed.
- *
- * (x + y - 1)/y is precisely the "number of bins" formula.
- */
- ticks = (t + (TIW_ITIME - 1)) / TIW_ITIME;
+ tiw->nto++;
- /*
- * Ticks must be a Uint64, or the addition may overflow here,
- * resulting in an incorrect value for p->count below.
- */
- ticks += do_time_update(); /* Add backlog of unprocessed time */
-
/* calculate slot */
- tm = (ticks + tiw_pos) % TIW_SIZE;
- p->slot = (Uint) tm;
- p->count = (Uint) (ticks / TIW_SIZE);
-
- /* insert at head of list at slot */
- p->next = tiw[tm];
- p->prev = NULL;
- if (p->next != NULL)
- p->next->prev = p;
- tiw[tm] = p;
-
-
- /* insert min time */
- if ((tiw_nto == 0) || ((tiw_min_ptr != NULL) && (ticks < tiw_min))) {
- tiw_min = ticks;
- tiw_min_ptr = p;
+ if (timeout_pos <= tiw->pos) {
+ /* at once */
+ p->timeout_pos = timeout_pos = tiw->pos;
+ slot = ERTS_TW_SLOT_AT_ONCE;
}
- if ((tiw_min_ptr == p) && (ticks > tiw_min)) {
- /* some other timer might be 'min' now */
- tiw_min = 0;
- tiw_min_ptr = NULL;
+ else if (timeout_pos < tiw->pos + ERTS_TW_SOON_WHEEL_SIZE) {
+ /* soon wheel */
+ p->timeout_pos = timeout_pos;
+ slot = soon_slot(timeout_pos);
+ if (tiw->soon.min_tpos > timeout_pos)
+ tiw->soon.min_tpos = timeout_pos;
+ }
+ else {
+ /* later wheel */
+ p->timeout_pos = timeout_pos;
+ slot = later_slot(timeout_pos);
+
+ /*
+ * Next timeout due to this timeout
+ * should be in good time before the
+ * actual timeout (one later wheel slot
+ * size). This, in order to move it
+ * from the later wheel to the soon
+ * wheel.
+ */
+ timeout_pos &= ERTS_TW_LATER_WHEEL_POS_MASK;
+ timeout_pos -= ERTS_TW_LATER_WHEEL_SLOT_SIZE;
}
- tiw_nto++;
+ insert_timer_into_slot(tiw, slot, p);
+
+ if (timeout_pos <= tiw->next_timeout_pos) {
+ tiw->true_next_timeout_time = 1;
+ if (timeout_pos < tiw->next_timeout_pos) {
+ tiw->next_timeout_pos = timeout_pos;
+ tiw->next_timeout_time = ERTS_CLKTCKS_TO_MONOTONIC(timeout_pos);
+ }
+ }
+ ERTS_MSACC_POP_STATE_M_X();
}
void
-erts_set_timer(ErlTimer* p, ErlTimeoutProc timeout, ErlCancelProc cancel,
- void* arg, Uint t)
+erts_twheel_cancel_timer(ErtsTimerWheel *tiw, ErtsTWheelTimer *p)
{
-
- erts_deliver_time();
- erts_smp_mtx_lock(&tiw_lock);
- if (p->active) { /* XXX assert ? */
- erts_smp_mtx_unlock(&tiw_lock);
- return;
+ if (p->slot != ERTS_TW_SLOT_INACTIVE) {
+ ERTS_MSACC_PUSH_AND_SET_STATE_M_X(ERTS_MSACC_STATE_TIMERS);
+ remove_timer(tiw, p);
+ tiw->nto--;
+ ERTS_MSACC_POP_STATE_M_X();
}
- p->timeout = timeout;
- p->cancel = cancel;
- p->arg = arg;
- p->active = 1;
- insert_timer(p, t);
- erts_smp_mtx_unlock(&tiw_lock);
-#if defined(ERTS_SMP)
- if (t <= (Uint) ERTS_SHORT_TIME_T_MAX)
- erts_sys_schedule_interrupt_timed(1, (erts_short_time_t) t);
-#endif
}
void
-erts_cancel_timer(ErlTimer* p)
+erts_twheel_debug_foreach(ErtsTimerWheel *tiw,
+ void (*tclbk)(void *),
+ void (*func)(void *,
+ ErtsMonotonicTime,
+ void *),
+ void *arg)
{
- erts_smp_mtx_lock(&tiw_lock);
- if (!p->active) { /* allow repeated cancel (drivers) */
- erts_smp_mtx_unlock(&tiw_lock);
- return;
- }
+ ErtsTWheelTimer *tmr;
+ int ix;
- /* is it the 'min' timer, remove min */
- if (p == tiw_min_ptr) {
- tiw_min_ptr = NULL;
- tiw_min = 0;
+ tmr = tiw->sentinel.next;
+ while (tmr != &tiw->sentinel) {
+ if (tmr->timeout == tclbk)
+ (*func)(arg, tmr->timeout_pos, tmr->arg);
+ tmr = tmr->next;
}
- remove_timer(p);
- p->slot = p->count = 0;
-
- if (p->cancel != NULL) {
- erts_smp_mtx_unlock(&tiw_lock);
- (*p->cancel)(p->arg);
- return;
+ for (ix = ERTS_TW_SLOT_AT_ONCE; ix < ERTS_TW_LATER_WHEEL_END_SLOT; ix++) {
+ tmr = tiw->w[ix];
+ if (tmr) {
+ do {
+ if (tmr->timeout == tclbk)
+ (*func)(arg, tmr->timeout_pos, tmr->arg);
+ tmr = tmr->next;
+ } while (tmr != tiw->w[ix]);
+ }
}
- erts_smp_mtx_unlock(&tiw_lock);
}
-/*
- Returns the amount of time left in ms until the timer 'p' is triggered.
- 0 is returned if 'p' isn't active.
- 0 is returned also if the timer is overdue (i.e., would have triggered
- immediately if it hadn't been cancelled).
-*/
-Uint
-erts_time_left(ErlTimer *p)
+#ifdef ERTS_TW_DEBUG
+
+void
+dbg_verify_empty_soon_slots(ErtsTimerWheel *tiw, ErtsMonotonicTime to_pos)
{
- Uint left;
- erts_short_time_t dt;
+ int ix;
+ ErtsMonotonicTime tmp;
- erts_smp_mtx_lock(&tiw_lock);
+ ix = soon_slot(tiw->pos);
+ tmp = to_pos;
+ if (tmp > tiw->pos) {
+ int slots;
+ tmp -= tiw->pos;
+ ERTS_TW_ASSERT(tmp > 0);
+ if (tmp < (ErtsMonotonicTime) ERTS_TW_SOON_WHEEL_SIZE)
+ slots = (int) tmp;
+ else
+ slots = ERTS_TW_SOON_WHEEL_SIZE;
- if (!p->active) {
- erts_smp_mtx_unlock(&tiw_lock);
- return 0;
- }
+ while (slots > 0) {
+ ERTS_TW_ASSERT(!tiw->w[ix]);
+ ix++;
+ if (ix == ERTS_TW_SOON_WHEEL_END_SLOT)
+ ix = ERTS_TW_SOON_WHEEL_FIRST_SLOT;
+ slots--;
+ }
+ }
+}
+
+void
+dbg_verify_empty_later_slots(ErtsTimerWheel *tiw, ErtsMonotonicTime to_pos)
+{
+ int ix;
+ ErtsMonotonicTime tmp;
+
+ ix = later_slot(tiw->later.pos);
+ tmp = to_pos;
+ tmp &= ERTS_TW_LATER_WHEEL_POS_MASK;
+ if (tmp > tiw->later.pos) {
+ ErtsMonotonicTime pos_min;
+ int slots;
+ tmp -= tiw->later.pos;
+ tmp /= ERTS_TW_LATER_WHEEL_SLOT_SIZE;
+ ERTS_TW_ASSERT(tmp > 0);
- if (p->slot < tiw_pos)
- left = (p->count + 1) * TIW_SIZE + p->slot - tiw_pos;
- else
- left = p->count * TIW_SIZE + p->slot - tiw_pos;
- dt = do_time_read();
- if (left < dt)
- left = 0;
- else
- left -= dt;
+ pos_min = tiw->later.pos;
- erts_smp_mtx_unlock(&tiw_lock);
+ if (tmp < (ErtsMonotonicTime) ERTS_TW_LATER_WHEEL_SIZE)
+ slots = (int) tmp;
+ else {
+ pos_min += ((tmp / ERTS_TW_LATER_WHEEL_SIZE)
+ * ERTS_TW_LATER_WHEEL_SLOT_SIZE);
+ slots = ERTS_TW_LATER_WHEEL_SIZE;
+ }
- return (Uint) left * TIW_ITIME;
+ while (slots > 0) {
+ ErtsTWheelTimer *tmr = tiw->w[ix];
+ pos_min += ERTS_TW_LATER_WHEEL_SLOT_SIZE;
+ if (tmr) {
+ ErtsTWheelTimer *end = tmr;
+ do {
+ ERTS_TW_ASSERT(tmr->timeout_pos >= pos_min);
+ tmr = tmr->next;
+ } while (tmr != end);
+ }
+ ix++;
+ if (ix == ERTS_TW_LATER_WHEEL_END_SLOT)
+ ix = ERTS_TW_LATER_WHEEL_FIRST_SLOT;
+ slots--;
+ }
+ }
}
-#ifdef DEBUG
-void erts_p_slpq(void)
+#endif /* ERTS_TW_DEBUG */
+
+#ifdef ERTS_TW_HARD_DEBUG
+
+static void
+hrd_dbg_check_wheels(ErtsTimerWheel *tiw, int check_min_tpos)
{
- int i;
- ErlTimer* p;
-
- erts_smp_mtx_lock(&tiw_lock);
-
- /* print the whole wheel, starting at the current position */
- erts_printf("\ntiw_pos = %d tiw_nto %d\n", tiw_pos, tiw_nto);
- i = tiw_pos;
- if (tiw[i] != NULL) {
- erts_printf("%d:\n", i);
- for(p = tiw[i]; p != NULL; p = p->next) {
- erts_printf(" (count %d, slot %d)\n",
- p->count, p->slot);
- }
+ int ix, six, soon_tmo, later_tmo, at_once_tmo,
+ scnt_slot, scnt_slots, scnt_six;
+ ErtsMonotonicTime min_tpos;
+ Sint scnt[ERTS_TW_SCNT_SIZE];
+ ErtsTWheelTimer *p;
+
+ for (six = 0; six < ERTS_TW_SCNT_SIZE; six++)
+ scnt[six] = 0;
+
+ min_tpos = ERTS_MONOTONIC_TO_CLKTCKS(tiw->next_timeout_time);
+
+ at_once_tmo = 0;
+ p = tiw->w[ERTS_TW_SLOT_AT_ONCE];
+ if (p) {
+ ErtsTWheelTimer *first = p;
+ do {
+ at_once_tmo++;
+ ERTS_TW_ASSERT(p->slot == ERTS_TW_SLOT_AT_ONCE);
+ ERTS_TW_ASSERT(p->timeout_pos <= tiw->pos);
+ ERTS_TW_ASSERT(!check_min_tpos || tiw->pos >= min_tpos);
+ ERTS_TW_ASSERT(p->next->prev == p);
+ p = p->next;
+ } while (p != first);
}
- for(i = (i+1)%TIW_SIZE; i != tiw_pos; i = (i+1)%TIW_SIZE) {
- if (tiw[i] != NULL) {
- erts_printf("%d:\n", i);
- for(p = tiw[i]; p != NULL; p = p->next) {
- erts_printf(" (count %d, slot %d)\n",
- p->count, p->slot);
- }
- }
+
+ soon_tmo = 0;
+ scnt_slot = ERTS_TW_SOON_WHEEL_END_SLOT-1;
+ scnt_slots = ERTS_TW_SOON_WHEEL_SIZE;
+ scnt_six = 0;
+ scnt_soon_wheel_next(&scnt_slot, &scnt_slots,
+ NULL, &scnt_six, tiw->scnt);
+ for (ix = ERTS_TW_SOON_WHEEL_FIRST_SLOT;
+ ix < ERTS_TW_SOON_WHEEL_END_SLOT;
+ ix++) {
+ p = tiw->w[ix];
+ six = scnt_get_ix(ix);
+ ERTS_TW_ASSERT(!p || six == scnt_six);
+ if (p) {
+ ErtsTWheelTimer *first = p;
+ do {
+ ErtsMonotonicTime tpos = p->timeout_pos;
+ soon_tmo++;
+ scnt_ix_inc(scnt, six);
+ ERTS_TW_ASSERT(p->slot == ix);
+ ERTS_TW_ASSERT(ix == soon_slot(tpos));
+ ERTS_TW_ASSERT(p->timeout_pos < tiw->pos + ERTS_TW_SOON_WHEEL_SIZE);
+ ERTS_TW_ASSERT(!check_min_tpos || tpos >= min_tpos);
+ ERTS_TW_ASSERT(p->next->prev == p);
+ p = p->next;
+ } while (p != first);
+ }
+ if (ix == scnt_slot)
+ scnt_soon_wheel_next(&scnt_slot, &scnt_slots,
+ NULL, &scnt_six, tiw->scnt);
}
- erts_smp_mtx_unlock(&tiw_lock);
+ later_tmo = 0;
+ scnt_slot = ERTS_TW_SOON_WHEEL_END_SLOT-1;
+ scnt_slots = ERTS_TW_SOON_WHEEL_SIZE;
+ scnt_six = 0;
+ scnt_later_wheel_next(&scnt_slot, &scnt_slots,
+ NULL, &scnt_six, tiw->scnt);
+ for (ix = ERTS_TW_LATER_WHEEL_FIRST_SLOT;
+ ix < ERTS_TW_LATER_WHEEL_END_SLOT;
+ ix++) {
+ p = tiw->w[ix];
+ six = scnt_get_ix(ix);
+ ERTS_TW_ASSERT(!p || six == scnt_six);
+ if (p) {
+ ErtsTWheelTimer *first = p;
+ six = scnt_get_ix(ix);
+ do {
+ ErtsMonotonicTime tpos = p->timeout_pos;
+ later_tmo++;
+ scnt_ix_inc(scnt, six);
+ ERTS_TW_ASSERT(p->slot == ix);
+ ERTS_TW_ASSERT(later_slot(tpos) == ix);
+ tpos &= ERTS_TW_LATER_WHEEL_POS_MASK;
+ tpos -= ERTS_TW_LATER_WHEEL_SLOT_SIZE;
+ ERTS_TW_ASSERT(!check_min_tpos || tpos >= min_tpos);
+ ERTS_TW_ASSERT(p->next->prev == p);
+ p = p->next;
+ } while (p != first);
+ }
+ if (ix == scnt_slot)
+ scnt_later_wheel_next(&scnt_slot, &scnt_slots,
+ NULL, &scnt_six, tiw->scnt);
+ }
+
+ if (tiw->yield_slot != ERTS_TW_SLOT_INACTIVE) {
+ p = tiw->sentinel.next;
+ ix = tiw->yield_slot;
+ while (p != &tiw->sentinel) {
+ ErtsMonotonicTime tpos = p->timeout_pos;
+ ERTS_TW_ASSERT(ix == p->slot);
+ if (ix == ERTS_TW_SLOT_AT_ONCE)
+ at_once_tmo++;
+ else {
+ scnt_inc(scnt, ix);
+ if (ix >= ERTS_TW_LATER_WHEEL_FIRST_SLOT) {
+ later_tmo++;
+ ERTS_TW_ASSERT(ix == later_slot(tpos));
+ }
+ else {
+ soon_tmo++;
+ ERTS_TW_ASSERT(ix == (tpos & ERTS_TW_SOON_WHEEL_MASK));
+ ERTS_TW_ASSERT(tpos < tiw->pos + ERTS_TW_SOON_WHEEL_SIZE);
+ }
+ p = p->next;
+ }
+ }
+ }
+
+
+ ERTS_TW_ASSERT(tiw->at_once.nto == at_once_tmo);
+ ERTS_TW_ASSERT(tiw->soon.nto == soon_tmo);
+ ERTS_TW_ASSERT(tiw->later.nto == later_tmo);
+ ERTS_TW_ASSERT(tiw->nto == soon_tmo + later_tmo + at_once_tmo);
+
+ for (six = 0; six < ERTS_TW_SCNT_SIZE; six++)
+ ERTS_TW_ASSERT(scnt[six] == tiw->scnt[six]);
}
-#endif /* DEBUG */
+
+#endif /* ERTS_TW_HARD_DEBUG */
diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c
index 738f793020..d7116bd2c3 100644
--- a/erts/emulator/beam/utils.c
+++ b/erts/emulator/beam/utils.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2014. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -41,6 +42,7 @@
#include "dist.h"
#include "erl_printf.h"
#include "erl_threads.h"
+#include "erl_lock_count.h"
#include "erl_smp.h"
#include "erl_time.h"
#include "erl_thr_progress.h"
@@ -48,6 +50,16 @@
#include "erl_sched_spec_pre_alloc.h"
#include "beam_bp.h"
#include "erl_ptab.h"
+#include "erl_check_io.h"
+#include "erl_bif_unique.h"
+#include "erl_io_queue.h"
+#define ERTS_WANT_TIMER_WHEEL_API
+#include "erl_time.h"
+#ifdef HIPE
+# include "hipe_mode_switch.h"
+#endif
+#define ERTS_WANT_NFUNC_SCHED_INTERNALS__
+#include "erl_nfunc_sched.h"
#undef M_TRIM_THRESHOLD
#undef M_TOP_PAD
@@ -63,46 +75,10 @@
#define HAVE_MALLOPT 0
#endif
-/* profile_scheduler mini message queue */
-
-typedef struct {
- Uint scheduler_id;
- Uint no_schedulers;
- Uint Ms;
- Uint s;
- Uint us;
- Eterm state;
-} profile_sched_msg;
-
-typedef struct {
- profile_sched_msg msg[2];
- Uint n;
-} profile_sched_msg_q;
-
-#ifdef ERTS_SMP
-
-#if 0 /* Unused */
-static void
-dispatch_profile_msg_q(profile_sched_msg_q *psmq)
-{
- int i = 0;
- profile_sched_msg *msg = NULL;
- ASSERT(psmq != NULL);
- for (i = 0; i < psmq->n; i++) {
- msg = &(psmq->msg[i]);
- profile_scheduler_q(make_small(msg->scheduler_id), msg->state, am_undefined, msg->Ms, msg->s, msg->us);
- }
-}
-#endif
-
-#endif
-
-
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;
@@ -113,7 +89,7 @@ erts_heap_alloc(Process* p, Uint need, Uint xtra)
&& HEAP_TOP(p) >= p->space_verified_from
&& HEAP_TOP(p) + need <= p->space_verified_from + p->space_verified
&& HEAP_LIMIT(p) - HEAP_TOP(p) >= need) {
-
+
Uint consumed = need + (HEAP_TOP(p) - p->space_verified_from);
ASSERT(consumed <= p->space_verified);
p->space_verified -= consumed;
@@ -130,6 +106,7 @@ erts_heap_alloc(Process* p, Uint need, Uint xtra)
if (bp != NULL && need <= (bp->alloc_size - bp->used_size)) {
Eterm* ret = bp->mem + bp->used_size;
bp->used_size += need;
+ p->mbuf_sz += need;
return ret;
}
#ifdef DEBUG
@@ -148,21 +125,11 @@ 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;
bp->used_size = need;
- MBUF_SIZE(p) += n;
+ MBUF_SIZE(p) += need;
bp->off_heap.first = NULL;
bp->off_heap.overhead = 0;
return bp->mem;
@@ -186,12 +153,18 @@ erts_set_hole_marker(Eterm* ptr, Uint sz)
* Helper function for the ESTACK macros defined in global.h.
*/
void
-erl_grow_estack(ErtsEStack* s, Eterm* default_estack)
+erl_grow_estack(ErtsEStack* s, Uint need)
{
Uint old_size = (s->end - s->start);
- Uint new_size = old_size * 2;
+ Uint new_size;
Uint sp_offs = s->sp - s->start;
- if (s->start != default_estack) {
+
+ if (need < old_size)
+ new_size = 2*old_size;
+ else
+ new_size = ((need / old_size) + 2) * old_size;
+
+ if (s->start != s->edefault) {
s->start = erts_realloc(s->alloc_type, s->start,
new_size*sizeof(Eterm));
} else {
@@ -206,12 +179,18 @@ erl_grow_estack(ErtsEStack* s, Eterm* default_estack)
* Helper function for the WSTACK macros defined in global.h.
*/
void
-erl_grow_wstack(ErtsWStack* s, UWord* default_wstack)
+erl_grow_wstack(ErtsWStack* s, Uint need)
{
Uint old_size = (s->wend - s->wstart);
- Uint new_size = old_size * 2;
+ Uint new_size;
Uint sp_offs = s->wsp - s->wstart;
- if (s->wstart != default_wstack) {
+
+ if (need < old_size)
+ new_size = 2 * old_size;
+ else
+ new_size = ((need / old_size) + 2) * old_size;
+
+ if (s->wstart != s->wdefault) {
s->wstart = erts_realloc(s->alloc_type, s->wstart,
new_size*sizeof(UWord));
} else {
@@ -223,6 +202,55 @@ erl_grow_wstack(ErtsWStack* s, UWord* default_wstack)
s->wsp = s->wstart + sp_offs;
}
+/*
+ * Helper function for the PSTACK macros defined in global.h.
+ */
+void
+erl_grow_pstack(ErtsPStack* s, void* default_pstack, unsigned need_bytes)
+{
+ Uint old_size = s->size;
+ Uint new_size;
+
+ if (need_bytes < old_size)
+ new_size = 2 * old_size;
+ else
+ new_size = ((need_bytes / old_size) + 2) * old_size;
+
+ if (s->pstart != default_pstack) {
+ s->pstart = erts_realloc(s->alloc_type, s->pstart, new_size);
+ } else {
+ byte* new_ptr = erts_alloc(s->alloc_type, new_size);
+ sys_memcpy(new_ptr, s->pstart, old_size);
+ s->pstart = new_ptr;
+ }
+ s->size = new_size;
+}
+
+/*
+ * 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
@@ -257,10 +285,10 @@ erl_grow_wstack(ErtsWStack* s, UWord* default_wstack)
* 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++;
@@ -310,44 +338,53 @@ int erts_fit_in_bits_int32(Sint32 value)
return fit_in_bits((Sint64) (Uint32) value, 4);
}
+int erts_fit_in_bits_uint(Uint value)
+{
+#if ERTS_SIZEOF_ETERM == 4
+ return fit_in_bits((Sint64) (Uint32) value, 4);
+#elif ERTS_SIZEOF_ETERM == 8
+ return fit_in_bits(value, 5);
+#else
+# error "No way, Jose"
+#endif
+}
+
int
-erts_print(int to, void *arg, char *format, ...)
+erts_print(fmtfn_t to, void *arg, char *format, ...)
{
int res;
va_list arg_list;
va_start(arg_list, format);
- if (to < ERTS_PRINT_MIN)
- res = -EINVAL;
- else {
- switch (to) {
- case ERTS_PRINT_STDOUT:
+ {
+ switch ((UWord)to) {
+ case (UWord)ERTS_PRINT_STDOUT:
res = erts_vprintf(format, arg_list);
break;
- case ERTS_PRINT_STDERR:
+ case (UWord)ERTS_PRINT_STDERR:
res = erts_vfprintf(stderr, format, arg_list);
break;
- case ERTS_PRINT_FILE:
+ case (UWord)ERTS_PRINT_FILE:
res = erts_vfprintf((FILE *) arg, format, arg_list);
break;
- case ERTS_PRINT_SBUF:
+ case (UWord)ERTS_PRINT_SBUF:
res = erts_vsprintf((char *) arg, format, arg_list);
break;
- case ERTS_PRINT_SNBUF:
+ case (UWord)ERTS_PRINT_SNBUF:
res = erts_vsnprintf(((erts_print_sn_buf *) arg)->buf,
((erts_print_sn_buf *) arg)->size,
format,
arg_list);
break;
- case ERTS_PRINT_DSBUF:
+ case (UWord)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);
+ case (UWord)ERTS_PRINT_FD:
+ res = erts_vfdprintf((int)(SWord) arg, format, arg_list);
break;
+ default:
+ res = erts_vcbprintf(to, arg, format, arg_list);
+ break;
}
}
@@ -356,7 +393,7 @@ erts_print(int to, void *arg, char *format, ...)
}
int
-erts_putc(int to, void *arg, char c)
+erts_putc(fmtfn_t to, void *arg, char c)
{
return erts_print(to, arg, "%c", c);
}
@@ -605,7 +642,7 @@ erts_bld_atom_uword_2tup_list(Uint **hpp, Uint *szp,
ui = uint_to_big(uints[i], *hpp);
*hpp += BIG_UINT_HEAP_SIZE;
}
-
+
res = CONS(*hpp+3, TUPLE2(*hpp, atoms[i], ui), res);
*hpp += 5;
}
@@ -643,14 +680,14 @@ erts_bld_atom_2uint_3tup_list(Uint **hpp, Uint *szp, Sint length,
ui1 = uint_to_big(uints1[i], *hpp);
*hpp += BIG_UINT_HEAP_SIZE;
}
-
+
if (IS_USMALL(0, uints2[i]))
ui2 = make_small(uints2[i]);
else {
ui2 = uint_to_big(uints2[i], *hpp);
*hpp += BIG_UINT_HEAP_SIZE;
}
-
+
res = CONS(*hpp+4, TUPLE3(*hpp, atoms[i], ui1, ui2), res);
*hpp += 6;
}
@@ -665,12 +702,7 @@ erts_bld_atom_2uint_3tup_list(Uint **hpp, Uint *szp, Sint length,
/* make a hash index from an erlang term */
/*
-** There are three hash functions.
-** make_broken_hash: the one used for backward compatibility
-** is called from the bif erlang:hash/2. Should never be used
-** as it a) hashes only a part of binaries, b) hashes bignums really poorly,
-** c) hashes bignums differently on different endian processors and d) hashes
-** small integers with different weights on different bytes.
+** There are two hash functions.
**
** make_hash: A hash function that will give the same values for the same
** terms regardless of the internal representation. Small integers are
@@ -706,7 +738,7 @@ erts_bld_atom_2uint_3tup_list(Uint **hpp, Uint *szp, Sint length,
** If N < 0, Y = FUNNY_NUMBER4 else Y = FUNNY_NUMBER3.
** The hash value is Y*h(J) mod 2^32 where h(J) is calculated like
** h(0) = <initial hash>
-** h(i) = h(i-i)*X + B(i-1)
+** h(i) = h(i-1)*X + B(i-1)
** The above should hold regardless of internal representation.
** Pids are hashed like small numbers but with differrent constants, as are
** ports.
@@ -761,7 +793,7 @@ hash_binary_bytes(Eterm bin, Uint sz, Uint32 hash)
Uint b;
Uint lshift = bitoffs;
Uint rshift = 8 - lshift;
-
+
while (sz--) {
b = (previous << lshift) & 0xFF;
previous = *ptr++;
@@ -772,7 +804,7 @@ hash_binary_bytes(Eterm bin, Uint sz, Uint32 hash)
b = (previous << lshift) & 0xFF;
previous = *ptr++;
b |= previous >> rshift;
-
+
b >>= 8 - bitsize;
hash = (hash*FUNNY_NUMBER1 + b) * FUNNY_NUMBER12 + bitsize;
}
@@ -787,11 +819,10 @@ Uint32 make_hash(Eterm term_arg)
Eterm hash = 0;
unsigned op;
- /* Must not collide with the real tag_val_def's: */
-#define MAKE_HASH_TUPLE_OP 0x11
-#define MAKE_HASH_TERM_ARRAY_OP 0x12
-#define MAKE_HASH_CDR_PRE_OP 0x13
-#define MAKE_HASH_CDR_POST_OP 0x14
+#define MAKE_HASH_TUPLE_OP (FIRST_VACANT_TAG_DEF)
+#define MAKE_HASH_TERM_ARRAY_OP (FIRST_VACANT_TAG_DEF+1)
+#define MAKE_HASH_CDR_PRE_OP (FIRST_VACANT_TAG_DEF+2)
+#define MAKE_HASH_CDR_POST_OP (FIRST_VACANT_TAG_DEF+3)
/*
** Convenience macro for calculating a bytewise hash on an unsigned 32 bit
@@ -803,21 +834,21 @@ Uint32 make_hash(Eterm term_arg)
do { \
Uint32 x = (Uint32) (Expr); \
hash = \
- (((((hash)*(Prime1) + (x & 0xFF)) * (Prime1) + \
- ((x >> 8) & 0xFF)) * (Prime1) + \
- ((x >> 16) & 0xFF)) * (Prime1) + \
+ (((((hash)*(Prime1) + (x & 0xFF)) * (Prime1) + \
+ ((x >> 8) & 0xFF)) * (Prime1) + \
+ ((x >> 16) & 0xFF)) * (Prime1) + \
(x >> 24)); \
} while(0)
-#define UINT32_HASH_RET(Expr, Prime1, Prime2) \
+#define UINT32_HASH_RET(Expr, Prime1, Prime2) \
UINT32_HASH_STEP(Expr, Prime1); \
hash = hash * (Prime2); \
- break
-
-
+ break
+
+
/*
* Significant additions needed for real 64 bit port with larger fixnums.
- */
+ */
/*
* Note, for the simple 64bit port, not utilizing the
@@ -832,7 +863,7 @@ tail_recur:
hash = hash*FUNNY_NUMBER3 + 1;
break;
case ATOM_DEF:
- hash = hash*FUNNY_NUMBER1 +
+ hash = hash*FUNNY_NUMBER1 +
(atom_tab(atom_val(term))->slot.bucket.hvalue);
break;
case SMALL_DEF:
@@ -841,7 +872,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
@@ -860,11 +891,11 @@ tail_recur:
{
Export* ep = *((Export **) (export_val(term) + 1));
- hash = hash * FUNNY_NUMBER11 + ep->code[2];
- hash = hash*FUNNY_NUMBER1 +
- (atom_tab(atom_val(ep->code[0]))->slot.bucket.hvalue);
- hash = hash*FUNNY_NUMBER1 +
- (atom_tab(atom_val(ep->code[1]))->slot.bucket.hvalue);
+ hash = hash * FUNNY_NUMBER11 + ep->info.mfa.arity;
+ hash = hash*FUNNY_NUMBER1 +
+ (atom_tab(atom_val(ep->info.mfa.module))->slot.bucket.hvalue);
+ hash = hash*FUNNY_NUMBER1 +
+ (atom_tab(atom_val(ep->info.mfa.function))->slot.bucket.hvalue);
break;
}
@@ -874,7 +905,7 @@ tail_recur:
Uint num_free = funp->num_free;
hash = hash * FUNNY_NUMBER10 + num_free;
- hash = hash*FUNNY_NUMBER1 +
+ hash = hash*FUNNY_NUMBER1 +
(atom_tab(atom_val(funp->fe->module))->slot.bucket.hvalue);
hash = hash*FUNNY_NUMBER2 + funp->fe->old_index;
hash = hash*FUNNY_NUMBER2 + funp->fe->old_uniq;
@@ -899,14 +930,17 @@ tail_recur:
UINT32_HASH_RET(internal_ref_numbers(term)[0],FUNNY_NUMBER9,FUNNY_NUMBER10);
case EXTERNAL_REF_DEF:
UINT32_HASH_RET(external_ref_numbers(term)[0],FUNNY_NUMBER9,FUNNY_NUMBER10);
- case FLOAT_DEF:
+ case FLOAT_DEF:
{
- FloatDef ff;
- GET_DOUBLE(term, ff);
- hash = hash*FUNNY_NUMBER6 + (ff.fw[0] ^ ff.fw[1]);
- break;
+ FloatDef ff;
+ GET_DOUBLE(term, ff);
+ if (ff.fd == 0.0f) {
+ /* ensure positive 0.0 */
+ ff.fd = erts_get_positive_zero_float();
+ }
+ hash = hash*FUNNY_NUMBER6 + (ff.fw[0] ^ ff.fw[1]);
+ break;
}
-
case MAKE_HASH_CDR_PRE_OP:
term = (Eterm) WSTACK_POP(stack);
if (is_not_list(term)) {
@@ -923,12 +957,12 @@ tail_recur:
** as multiplications on a Sparc is so slow.
*/
hash = hash*FUNNY_NUMBER2 + unsigned_val(*list);
-
+
if (is_not_list(CDR(list))) {
WSTACK_PUSH(stack, MAKE_HASH_CDR_POST_OP);
term = CDR(list);
goto tail_recur;
- }
+ }
list = list_val(CDR(list));
}
WSTACK_PUSH2(stack, CDR(list), MAKE_HASH_CDR_PRE_OP);
@@ -959,7 +993,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
@@ -969,32 +1003,17 @@ tail_recur:
}
hash *= is_neg ? FUNNY_NUMBER4 : FUNNY_NUMBER3;
break;
- }
- case MAP_DEF:
- {
- map_t *mp = (map_t *)map_val(term);
- int size = map_get_size(mp);
- Eterm *ks = map_get_keys(mp);
- Eterm *vs = map_get_values(mp);
-
- /* Use a prime with size to remedy some of
- * the {} and <<>> hash problems */
- hash = hash*FUNNY_NUMBER13 + FUNNY_NUMBER14 + size;
- if (size == 0)
- break;
-
- /* push values first */
- WSTACK_PUSH3(stack, (UWord)vs, (UWord) size, MAKE_HASH_TERM_ARRAY_OP);
- WSTACK_PUSH3(stack, (UWord)ks, (UWord) size, MAKE_HASH_TERM_ARRAY_OP);
- break;
}
- case TUPLE_DEF:
+ case MAP_DEF:
+ hash = hash*FUNNY_NUMBER13 + FUNNY_NUMBER14 + make_hash2(term);
+ break;
+ case TUPLE_DEF:
{
Eterm* ptr = tuple_val(term);
Uint arity = arityval(*ptr);
WSTACK_PUSH3(stack, (UWord) arity, (UWord)(ptr+1), (UWord) arity);
- op = MAKE_HASH_TUPLE_OP;
+ op = MAKE_HASH_TUPLE_OP;
}/*fall through*/
case MAKE_HASH_TUPLE_OP:
case MAKE_HASH_TERM_ARRAY_OP:
@@ -1011,10 +1030,10 @@ tail_recur:
hash = hash*FUNNY_NUMBER9 + arity;
}
break;
- }
-
+ }
+
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;
@@ -1023,6 +1042,10 @@ tail_recur:
DESTROY_WSTACK(stack);
return hash;
+#undef MAKE_HASH_TUPLE_OP
+#undef MAKE_HASH_TERM_ARRAY_OP
+#undef MAKE_HASH_CDR_PRE_OP
+#undef MAKE_HASH_CDR_POST_OP
#undef UINT32_HASH_STEP
#undef UINT32_HASH_RET
}
@@ -1091,11 +1114,12 @@ Uint32
make_hash2(Eterm term)
{
Uint32 hash;
- Uint32 hash_xor_keys = 0;
- Uint32 hash_xor_values = 0;
+ Uint32 hash_xor_pairs;
DeclareTmpHeapNoproc(tmp_big,2);
-/* (HCONST * {2, ..., 16}) mod 2^32 */
+ ERTS_UNDEF(hash_xor_pairs, 0);
+
+/* (HCONST * {2, ..., 22}) mod 2^32 */
#define HCONST_2 0x3c6ef372UL
#define HCONST_3 0xdaa66d2bUL
#define HCONST_4 0x78dde6e4UL
@@ -1111,10 +1135,16 @@ make_hash2(Eterm term)
#define HCONST_14 0xa708a81eUL
#define HCONST_15 0x454021d7UL
#define HCONST_16 0xe3779b90UL
+#define HCONST_17 0x81af1549UL
+#define HCONST_18 0x1fe68f02UL
+#define HCONST_19 0xbe1e08bbUL
+#define HCONST_20 0x5c558274UL
+#define HCONST_21 0xfa8cfc2dUL
+#define HCONST_22 0x98c475e6UL
#define HASH_MAP_TAIL (_make_header(1,_TAG_HEADER_REF))
-#define HASH_MAP_KEY (_make_header(2,_TAG_HEADER_REF))
-#define HASH_MAP_VAL (_make_header(3,_TAG_HEADER_REF))
+#define HASH_MAP_PAIR (_make_header(2,_TAG_HEADER_REF))
+#define HASH_CDR (_make_header(3,_TAG_HEADER_REF))
#define UINT32_HASH_2(Expr1, Expr2, AConst) \
do { \
@@ -1132,11 +1162,18 @@ make_hash2(Eterm term)
if (y < 0) { \
UINT32_HASH(-y, AConst); \
/* Negative numbers are unnecessarily mixed twice. */ \
- } \
- UINT32_HASH(y, AConst); \
+ } \
+ UINT32_HASH(y, AConst); \
} while(0)
#define IS_SSMALL28(x) (((Uint) (((x) >> (28-1)) + 1)) < 2)
+
+#ifdef ARCH_64
+# define POINTER_HASH(Ptr, AConst) UINT32_HASH_2((Uint32)(UWord)(Ptr), (((UWord)(Ptr)) >> 32), AConst)
+#else
+# define POINTER_HASH(Ptr, AConst) UINT32_HASH(Ptr, AConst)
+#endif
+
/* Optimization. Simple cases before declaration of estack. */
if (primary_tag(term) == TAG_PRIMARY_IMMED1) {
switch (term & _TAG_IMMED1_MASK) {
@@ -1191,9 +1228,9 @@ make_hash2(Eterm term)
if (c > 0)
UINT32_HASH(sh, HCONST_4);
if (is_list(term)) {
- term = *ptr;
- tmp = *++ptr;
- ESTACK_PUSH(s, tmp);
+ tmp = CDR(ptr);
+ ESTACK_PUSH(s, tmp);
+ term = CAR(ptr);
}
}
break;
@@ -1208,59 +1245,98 @@ make_hash2(Eterm term)
int arity = header_arity(hdr);
Eterm* elem = tuple_val(term);
UINT32_HASH(arity, HCONST_9);
- if (arity == 0) /* Empty tuple */
+ if (arity == 0) /* Empty tuple */
goto hash2_common;
- for (i = arity; i >= 1; i--) {
- tmp = elem[i];
- ESTACK_PUSH(s, tmp);
+ for (i = arity; ; i--) {
+ term = elem[i];
+ if (i == 1)
+ break;
+ ESTACK_PUSH(s, term);
}
- goto hash2_common;
- }
- break;
- case MAP_SUBTAG:
- {
- map_t *mp = (map_t *)map_val(term);
- int i;
- int size = map_get_size(mp);
- Eterm *ks = map_get_keys(mp);
- Eterm *vs = map_get_values(mp);
- UINT32_HASH(size, HCONST_16);
- if (size == 0) {
- goto hash2_common;
- }
- ESTACK_PUSH(s, hash_xor_values);
- ESTACK_PUSH(s, hash_xor_keys);
- ESTACK_PUSH(s, hash);
- ESTACK_PUSH(s, HASH_MAP_TAIL);
- hash = 0;
- hash_xor_keys = 0;
- hash_xor_values = 0;
- for (i = size - 1; i >= 0; i--) {
- tmp = vs[i];
- ESTACK_PUSH(s, HASH_MAP_VAL);
- ESTACK_PUSH(s, tmp);
- }
- /* We do not want to expose the tuple representation.
- * Do not push the keys as a tuple.
- */
- for (i = size - 1; i >= 0; i--) {
- tmp = ks[i];
- ESTACK_PUSH(s, HASH_MAP_KEY);
- ESTACK_PUSH(s, tmp);
- }
- goto hash2_common;
}
break;
+ case MAP_SUBTAG:
+ {
+ Eterm* ptr = boxed_val(term) + 1;
+ Uint size;
+ int i;
+ switch (hdr & _HEADER_MAP_SUBTAG_MASK) {
+ case HAMT_SUBTAG_HEAD_FLATMAP:
+ {
+ flatmap_t *mp = (flatmap_t *)flatmap_val(term);
+ Eterm *ks = flatmap_get_keys(mp);
+ Eterm *vs = flatmap_get_values(mp);
+ size = flatmap_get_size(mp);
+ UINT32_HASH(size, HCONST_16);
+ if (size == 0)
+ goto hash2_common;
+
+ /* We want a portable hash function that is *independent* of
+ * the order in which keys and values are encountered.
+ * We therefore calculate context independent hashes for all .
+ * key-value pairs and then xor them together.
+ */
+ ESTACK_PUSH(s, hash_xor_pairs);
+ ESTACK_PUSH(s, hash);
+ ESTACK_PUSH(s, HASH_MAP_TAIL);
+ hash = 0;
+ hash_xor_pairs = 0;
+ for (i = size - 1; i >= 0; i--) {
+ ESTACK_PUSH(s, HASH_MAP_PAIR);
+ ESTACK_PUSH(s, vs[i]);
+ ESTACK_PUSH(s, ks[i]);
+ }
+ goto hash2_common;
+ }
+
+ case HAMT_SUBTAG_HEAD_ARRAY:
+ case HAMT_SUBTAG_HEAD_BITMAP:
+ size = *ptr++;
+ UINT32_HASH(size, HCONST_16);
+ if (size == 0)
+ goto hash2_common;
+ ESTACK_PUSH(s, hash_xor_pairs);
+ ESTACK_PUSH(s, hash);
+ ESTACK_PUSH(s, HASH_MAP_TAIL);
+ hash = 0;
+ hash_xor_pairs = 0;
+ }
+ switch (hdr & _HEADER_MAP_SUBTAG_MASK) {
+ case HAMT_SUBTAG_HEAD_ARRAY:
+ i = 16;
+ break;
+ case HAMT_SUBTAG_HEAD_BITMAP:
+ case HAMT_SUBTAG_NODE_BITMAP:
+ i = hashmap_bitcount(MAP_HEADER_VAL(hdr));
+ break;
+ default:
+ erts_exit(ERTS_ERROR_EXIT, "bad header");
+ }
+ while (i) {
+ if (is_list(*ptr)) {
+ Eterm* cons = list_val(*ptr);
+ ESTACK_PUSH(s, HASH_MAP_PAIR);
+ ESTACK_PUSH(s, CDR(cons));
+ ESTACK_PUSH(s, CAR(cons));
+ }
+ else {
+ ASSERT(is_boxed(*ptr));
+ ESTACK_PUSH(s, *ptr);
+ }
+ i--; ptr++;
+ }
+ goto hash2_common;
+ }
+ break;
case EXPORT_SUBTAG:
{
Export* ep = *((Export **) (export_val(term) + 1));
-
UINT32_HASH_2
- (ep->code[2],
- atom_tab(atom_val(ep->code[0]))->slot.bucket.hvalue,
+ (ep->info.mfa.arity,
+ atom_tab(atom_val(ep->info.mfa.module))->slot.bucket.hvalue,
HCONST);
UINT32_HASH
- (atom_tab(atom_val(ep->code[1]))->slot.bucket.hvalue,
+ (atom_tab(atom_val(ep->info.mfa.function))->slot.bucket.hvalue,
HCONST_14);
goto hash2_common;
}
@@ -1269,9 +1345,8 @@ make_hash2(Eterm term)
{
ErlFunThing* funp = (ErlFunThing *) fun_val(term);
Uint num_free = funp->num_free;
-
UINT32_HASH_2
- (num_free,
+ (num_free,
atom_tab(atom_val(funp->fe->module))->slot.bucket.hvalue,
HCONST);
UINT32_HASH_2
@@ -1350,7 +1425,8 @@ make_hash2(Eterm term)
do {
Uint t;
Uint32 x, y;
- t = i < n ? BIG_DIGIT(ptr, i++) : 0;
+ ASSERT(i < n);
+ t = BIG_DIGIT(ptr, i++);
x = t & 0xffffffff;
y = t >> 32;
UINT32_HASH_2(x, y, con);
@@ -1383,6 +1459,10 @@ make_hash2(Eterm term)
{
FloatDef ff;
GET_DOUBLE(term, ff);
+ if (ff.fd == 0.0f) {
+ /* ensure positive 0.0 */
+ ff.fd = erts_get_positive_zero_float();
+ }
#if defined(WORDS_BIGENDIAN) || defined(DOUBLE_MIDDLE_ENDIAN)
UINT32_HASH_2(ff.fw[0], ff.fw[1], HCONST_12);
#else
@@ -1391,9 +1471,9 @@ make_hash2(Eterm term)
goto hash2_common;
}
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;
@@ -1424,7 +1504,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:
{
@@ -1440,7 +1520,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,
@@ -1458,19 +1538,13 @@ make_hash2(Eterm term)
switch (term) {
case HASH_MAP_TAIL: {
hash = (Uint32) ESTACK_POP(s);
- UINT32_HASH(hash_xor_keys, HCONST_16);
- UINT32_HASH(hash_xor_values, HCONST_16);
- hash_xor_keys = (Uint32) ESTACK_POP(s);
- hash_xor_values = (Uint32) ESTACK_POP(s);
+ UINT32_HASH(hash_xor_pairs, HCONST_19);
+ hash_xor_pairs = (Uint32) ESTACK_POP(s);
goto hash2_common;
}
- case HASH_MAP_KEY:
- hash_xor_keys ^= hash;
- hash = 0;
- goto hash2_common;
- case HASH_MAP_VAL:
- hash_xor_values ^= hash;
- hash = 0;
+ case HASH_MAP_PAIR:
+ hash_xor_pairs ^= hash;
+ hash = 0;
goto hash2_common;
default:
break;
@@ -1478,391 +1552,538 @@ make_hash2(Eterm term)
}
}
}
-
-#undef HASH_MAP_TAIL
-#undef HASH_MAP_KEY
-#undef HASH_MAP_VAL
-
-#undef UINT32_HASH_2
-#undef UINT32_HASH
-#undef SINT32_HASH
}
-#undef HCONST
-#undef MIX
+/* Term hash function for internal use.
+ *
+ * Limitation #1: Is not "portable" in any way between different VM instances.
+ *
+ * Limitation #2: The hash value is only valid as long as the term exists
+ * somewhere in the VM. Why? Because external pids, ports and refs are hashed
+ * by mixing the node *pointer* value. If a node disappears and later reappears
+ * with a new ErlNode struct, externals from that node will hash different than
+ * before.
+ *
+ * One IMPORTANT property must hold (for hamt).
+ * EVERY BIT of the term that is significant for equality (see EQ)
+ * MUST BE USED AS INPUT FOR THE HASH. Two different terms must always have a
+ * chance of hashing different when salted: hash([Salt|A]) vs hash([Salt|B]).
+ *
+ * This is why we can not use cached hash values for atoms for example.
+ *
+ */
+#define CONST_HASH(AConst) \
+do { /* Lightweight mixing of constant (type info) */ \
+ hash ^= AConst; \
+ hash = (hash << 17) ^ (hash >> (32-17)); \
+} while (0)
-Uint32 make_broken_hash(Eterm term)
+Uint32
+make_internal_hash(Eterm term, Uint32 salt)
{
- Uint32 hash = 0;
- DECLARE_WSTACK(stack);
- unsigned op;
-tail_recur:
- op = tag_val_def(term);
- for (;;) {
- switch (op) {
- case NIL_DEF:
- hash = hash*FUNNY_NUMBER3 + 1;
- break;
- case ATOM_DEF:
- hash = hash*FUNNY_NUMBER1 +
- (atom_tab(atom_val(term))->slot.bucket.hvalue);
- break;
- case SMALL_DEF:
-#if defined(ARCH_64) && !HALFWORD_HEAP
+ Uint32 hash;
+
+ /* Optimization. Simple cases before declaration of estack. */
+ if (primary_tag(term) == TAG_PRIMARY_IMMED1) {
+ hash = salt;
+ #if ERTS_SIZEOF_ETERM == 8
+ UINT32_HASH_2((Uint32)term, (Uint32)(term >> 32), HCONST);
+ #elif ERTS_SIZEOF_ETERM == 4
+ UINT32_HASH(term, HCONST);
+ #else
+ # error "No you don't"
+ #endif
+ return hash;
+ }
{
- Sint y1 = signed_val(term);
- Uint y2 = y1 < 0 ? -(Uint)y1 : y1;
- Uint32 y3 = (Uint32) (y2 >> 32);
- int arity = 1;
-
-#if defined(WORDS_BIGENDIAN)
- if (!IS_SSMALL28(y1))
- { /* like a bignum */
- Uint32 y4 = (Uint32) y2;
- hash = hash*FUNNY_NUMBER2 + ((y4 << 16) | (y4 >> 16));
- if (y3)
- {
- hash = hash*FUNNY_NUMBER2 + ((y3 << 16) | (y3 >> 16));
- arity++;
+ Eterm tmp;
+ DECLARE_ESTACK(s);
+
+ hash = salt;
+ for (;;) {
+ switch (primary_tag(term)) {
+ case TAG_PRIMARY_LIST:
+ {
+ int c = 0;
+ Uint32 sh = 0;
+ Eterm* ptr = list_val(term);
+ while (is_byte(*ptr)) {
+ /* Optimization for strings. */
+ sh = (sh << 8) + unsigned_val(*ptr);
+ if (c == 3) {
+ UINT32_HASH(sh, HCONST_4);
+ c = sh = 0;
+ } else {
+ c++;
+ }
+ term = CDR(ptr);
+ if (is_not_list(term))
+ break;
+ ptr = list_val(term);
}
- hash = hash * (y1 < 0 ? FUNNY_NUMBER3 : FUNNY_NUMBER2) + arity;
- } else {
- hash = hash*FUNNY_NUMBER2 + (((Uint) y1) & 0xfffffff);
- }
-#else
- if (!IS_SSMALL28(y1))
- { /* like a bignum */
- hash = hash*FUNNY_NUMBER2 + ((Uint32) y2);
- if (y3)
- {
- hash = hash*FUNNY_NUMBER2 + y3;
- arity++;
+ if (c > 0)
+ UINT32_HASH_2(sh, (Uint32)c, HCONST_22);
+
+ if (is_list(term)) {
+ tmp = CDR(ptr);
+ CONST_HASH(HCONST_17); /* Hash CAR in cons cell */
+ ESTACK_PUSH(s, tmp);
+ if (is_not_list(tmp)) {
+ ESTACK_PUSH(s, HASH_CDR);
+ }
+ term = CAR(ptr);
}
- hash = hash * (y1 < 0 ? FUNNY_NUMBER3 : FUNNY_NUMBER2) + arity;
- } else {
- hash = hash*FUNNY_NUMBER2 + (((Uint) y1) & 0xfffffff);
}
-#endif
- }
-#else
- hash = hash*FUNNY_NUMBER2 + unsigned_val(term);
-#endif
break;
-
- case BINARY_DEF:
+ case TAG_PRIMARY_BOXED:
{
- size_t sz = binary_size(term);
- size_t i = (sz < 15) ? sz : 15;
-
- hash = hash_binary_bytes(term, i, hash);
- hash = hash*FUNNY_NUMBER4 + sz;
+ Eterm hdr = *boxed_val(term);
+ ASSERT(is_header(hdr));
+ switch (hdr & _TAG_HEADER_MASK) {
+ case ARITYVAL_SUBTAG:
+ {
+ int i;
+ int arity = header_arity(hdr);
+ Eterm* elem = tuple_val(term);
+ UINT32_HASH(arity, HCONST_9);
+ if (arity == 0) /* Empty tuple */
+ goto pop_next;
+ for (i = arity; ; i--) {
+ term = elem[i];
+ if (i == 1)
+ break;
+ ESTACK_PUSH(s, term);
+ }
+ }
break;
- }
- case EXPORT_DEF:
- {
- Export* ep = *((Export **) (export_val(term) + 1));
+ case MAP_SUBTAG:
+ {
+ Eterm* ptr = boxed_val(term) + 1;
+ Uint size;
+ int i;
+
+ /*
+ * We rely on key-value iteration order being constant
+ * for identical maps (in this VM instance).
+ */
+ switch (hdr & _HEADER_MAP_SUBTAG_MASK) {
+ case HAMT_SUBTAG_HEAD_FLATMAP:
+ {
+ flatmap_t *mp = (flatmap_t *)flatmap_val(term);
+ Eterm *ks = flatmap_get_keys(mp);
+ Eterm *vs = flatmap_get_values(mp);
+ size = flatmap_get_size(mp);
+ UINT32_HASH(size, HCONST_16);
+ if (size == 0)
+ goto pop_next;
+
+ for (i = size - 1; i >= 0; i--) {
+ ESTACK_PUSH(s, vs[i]);
+ ESTACK_PUSH(s, ks[i]);
+ }
+ goto pop_next;
+ }
+ case HAMT_SUBTAG_HEAD_ARRAY:
+ case HAMT_SUBTAG_HEAD_BITMAP:
+ size = *ptr++;
+ UINT32_HASH(size, HCONST_16);
+ if (size == 0)
+ goto pop_next;
+ }
+ switch (hdr & _HEADER_MAP_SUBTAG_MASK) {
+ case HAMT_SUBTAG_HEAD_ARRAY:
+ i = 16;
+ break;
+ case HAMT_SUBTAG_HEAD_BITMAP:
+ case HAMT_SUBTAG_NODE_BITMAP:
+ i = hashmap_bitcount(MAP_HEADER_VAL(hdr));
+ break;
+ default:
+ erts_exit(ERTS_ERROR_EXIT, "bad header");
+ }
+ while (i) {
+ if (is_list(*ptr)) {
+ Eterm* cons = list_val(*ptr);
+ ESTACK_PUSH(s, CDR(cons));
+ ESTACK_PUSH(s, CAR(cons));
+ }
+ else {
+ ASSERT(is_boxed(*ptr));
+ ESTACK_PUSH(s, *ptr);
+ }
+ i--; ptr++;
+ }
+ goto pop_next;
+ }
+ break;
+ case EXPORT_SUBTAG:
+ {
+ Export* ep = *((Export **) (export_val(term) + 1));
+ /* Assumes Export entries never move */
+ POINTER_HASH(ep, HCONST_14);
+ goto pop_next;
+ }
- hash = hash * FUNNY_NUMBER11 + ep->code[2];
- hash = hash*FUNNY_NUMBER1 +
- (atom_tab(atom_val(ep->code[0]))->slot.bucket.hvalue);
- hash = hash*FUNNY_NUMBER1 +
- (atom_tab(atom_val(ep->code[1]))->slot.bucket.hvalue);
+ case FUN_SUBTAG:
+ {
+ ErlFunThing* funp = (ErlFunThing *) fun_val(term);
+ Uint num_free = funp->num_free;
+ UINT32_HASH_2(num_free, funp->fe->module, HCONST_20);
+ UINT32_HASH_2(funp->fe->old_index, funp->fe->old_uniq, HCONST_21);
+ if (num_free == 0) {
+ goto pop_next;
+ } else {
+ Eterm* bptr = funp->env + num_free - 1;
+ while (num_free-- > 1) {
+ term = *bptr--;
+ ESTACK_PUSH(s, term);
+ }
+ term = *bptr;
+ }
+ }
break;
- }
-
- case FUN_DEF:
- {
- ErlFunThing* funp = (ErlFunThing *) fun_val(term);
- Uint num_free = funp->num_free;
+ case REFC_BINARY_SUBTAG:
+ case HEAP_BINARY_SUBTAG:
+ case SUB_BINARY_SUBTAG:
+ {
+ byte* bptr;
+ unsigned sz = binary_size(term);
+ Uint32 con = HCONST_13 + hash;
+ Uint bitoffs;
+ Uint bitsize;
- hash = hash * FUNNY_NUMBER10 + num_free;
- hash = hash*FUNNY_NUMBER1 +
- (atom_tab(atom_val(funp->fe->module))->slot.bucket.hvalue);
- hash = hash*FUNNY_NUMBER2 + funp->fe->old_index;
- hash = hash*FUNNY_NUMBER2 + funp->fe->old_uniq;
- if (num_free > 0) {
- if (num_free > 1) {
- WSTACK_PUSH3(stack, (UWord) &funp->env[1], (num_free-1), MAKE_HASH_TERM_ARRAY_OP);
+ ERTS_GET_BINARY_BYTES(term, bptr, bitoffs, bitsize);
+ if (sz == 0 && bitsize == 0) {
+ hash = con;
+ } else {
+ if (bitoffs == 0) {
+ hash = block_hash(bptr, sz, con);
+ if (bitsize > 0) {
+ UINT32_HASH_2(bitsize, (bptr[sz] >> (8 - bitsize)),
+ HCONST_15);
+ }
+ } else {
+ byte* buf = (byte *) erts_alloc(ERTS_ALC_T_TMP,
+ sz + (bitsize != 0));
+ erts_copy_bits(bptr, bitoffs, 1, buf, 0, 1, sz*8+bitsize);
+ hash = block_hash(buf, sz, con);
+ if (bitsize > 0) {
+ UINT32_HASH_2(bitsize, (buf[sz] >> (8 - bitsize)),
+ HCONST_15);
+ }
+ erts_free(ERTS_ALC_T_TMP, (void *) buf);
+ }
}
- term = funp->env[0];
- goto tail_recur;
+ goto pop_next;
}
break;
- }
-
- case PID_DEF:
- hash = hash*FUNNY_NUMBER5 + internal_pid_number(term);
- break;
- case EXTERNAL_PID_DEF:
- hash = hash*FUNNY_NUMBER5 + external_pid_number(term);
- break;
- case PORT_DEF:
- hash = hash*FUNNY_NUMBER9 + internal_port_number(term);
- break;
- case EXTERNAL_PORT_DEF:
- hash = hash*FUNNY_NUMBER9 + external_port_number(term);
- break;
- case REF_DEF:
- hash = hash*FUNNY_NUMBER9 + internal_ref_numbers(term)[0];
- break;
- case EXTERNAL_REF_DEF:
- hash = hash*FUNNY_NUMBER9 + external_ref_numbers(term)[0];
- break;
- case FLOAT_DEF:
- {
- FloatDef ff;
- GET_DOUBLE(term, ff);
- hash = hash*FUNNY_NUMBER6 + (ff.fw[0] ^ ff.fw[1]);
- }
- break;
-
- case MAKE_HASH_CDR_PRE_OP:
- term = (Eterm) WSTACK_POP(stack);
- if (is_not_list(term)) {
- WSTACK_PUSH(stack, (UWord) MAKE_HASH_CDR_POST_OP);
- goto tail_recur;
- }
- /*fall through*/
- case LIST_DEF:
- {
- Eterm* list = list_val(term);
- WSTACK_PUSH2(stack, (UWord) CDR(list),
- (UWord) MAKE_HASH_CDR_PRE_OP);
- term = CAR(list);
- goto tail_recur;
- }
-
- case MAKE_HASH_CDR_POST_OP:
- hash *= FUNNY_NUMBER8;
- break;
-
- case BIG_DEF:
- {
- Eterm* ptr = big_val(term);
- int is_neg = BIG_SIGN(ptr);
- Uint arity = BIG_ARITY(ptr);
- Uint i = arity;
- ptr++;
+ case POS_BIG_SUBTAG:
+ case NEG_BIG_SUBTAG:
+ {
+ Eterm* ptr = big_val(term);
+ Uint i = 0;
+ Uint n = BIG_SIZE(ptr);
+ Uint32 con = BIG_SIGN(ptr) ? HCONST_10 : HCONST_11;
#if D_EXP == 16
- /* hash over 32 bit LE */
-
- while(i--) {
- hash = hash*FUNNY_NUMBER2 + *ptr++;
- }
+ do {
+ Uint32 x, y;
+ x = i < n ? BIG_DIGIT(ptr, i++) : 0;
+ x += (Uint32)(i < n ? BIG_DIGIT(ptr, i++) : 0) << 16;
+ y = i < n ? BIG_DIGIT(ptr, i++) : 0;
+ y += (Uint32)(i < n ? BIG_DIGIT(ptr, i++) : 0) << 16;
+ UINT32_HASH_2(x, y, con);
+ } while (i < n);
#elif D_EXP == 32
-
-#if defined(WORDS_BIGENDIAN)
- while(i--) {
- Uint d = *ptr++;
- hash = hash*FUNNY_NUMBER2 + ((d << 16) | (d >> 16));
- }
-#else
- while(i--) {
- hash = hash*FUNNY_NUMBER2 + *ptr++;
- }
-#endif
-
+ do {
+ Uint32 x, y;
+ x = i < n ? BIG_DIGIT(ptr, i++) : 0;
+ y = i < n ? BIG_DIGIT(ptr, i++) : 0;
+ UINT32_HASH_2(x, y, con);
+ } while (i < n);
#elif D_EXP == 64
- {
- Uint32 h = 0, l;
-#if defined(WORDS_BIGENDIAN)
- while(i--) {
- Uint d = *ptr++;
- l = d & 0xffffffff;
- h = d >> 32;
- hash = hash*FUNNY_NUMBER2 + ((l << 16) | (l >> 16));
- if (h || i)
- hash = hash*FUNNY_NUMBER2 + ((h << 16) | (h >> 16));
- }
+ do {
+ Uint t;
+ Uint32 x, y;
+ ASSERT(i < n);
+ t = BIG_DIGIT(ptr, i++);
+ x = t & 0xffffffff;
+ y = t >> 32;
+ UINT32_HASH_2(x, y, con);
+ } while (i < n);
#else
- while(i--) {
- Uint d = *ptr++;
- l = d & 0xffffffff;
- h = d >> 32;
- hash = hash*FUNNY_NUMBER2 + l;
- if (h || i)
- hash = hash*FUNNY_NUMBER2 + h;
- }
+#error "unsupported D_EXP size"
#endif
- /* adjust arity to match 32 bit mode */
- arity = (arity << 1) - (h == 0);
+ goto pop_next;
+ }
+ break;
+ case REF_SUBTAG:
+ UINT32_HASH(internal_ref_numbers(term)[0], HCONST_7);
+ ASSERT(internal_ref_no_numbers(term) == 3);
+ UINT32_HASH_2(internal_ref_numbers(term)[1],
+ internal_ref_numbers(term)[2], HCONST_8);
+ goto pop_next;
+
+ case EXTERNAL_REF_SUBTAG:
+ {
+ ExternalThing* thing = external_thing_ptr(term);
+
+ ASSERT(external_thing_ref_no_numbers(thing) == 3);
+ /* See limitation #2 */
+ #ifdef ARCH_64
+ POINTER_HASH(thing->node, HCONST_7);
+ UINT32_HASH(external_thing_ref_numbers(thing)[0], HCONST_7);
+ #else
+ UINT32_HASH_2(thing->node,
+ external_thing_ref_numbers(thing)[0], HCONST_7);
+ #endif
+ UINT32_HASH_2(external_thing_ref_numbers(thing)[1],
+ external_thing_ref_numbers(thing)[2], HCONST_8);
+ goto pop_next;
+ }
+ case EXTERNAL_PID_SUBTAG: {
+ ExternalThing* thing = external_thing_ptr(term);
+ /* See limitation #2 */
+ #ifdef ARCH_64
+ POINTER_HASH(thing->node, HCONST_5);
+ UINT32_HASH(thing->data.ui[0], HCONST_5);
+ #else
+ UINT32_HASH_2(thing->node, thing->data.ui[0], HCONST_5);
+ #endif
+ goto pop_next;
+ }
+ case EXTERNAL_PORT_SUBTAG: {
+ ExternalThing* thing = external_thing_ptr(term);
+ /* See limitation #2 */
+ #ifdef ARCH_64
+ POINTER_HASH(thing->node, HCONST_6);
+ UINT32_HASH(thing->data.ui[0], HCONST_6);
+ #else
+ UINT32_HASH_2(thing->node, thing->data.ui[0], HCONST_6);
+ #endif
+ goto pop_next;
+ }
+ case FLOAT_SUBTAG:
+ {
+ FloatDef ff;
+ GET_DOUBLE(term, ff);
+ if (ff.fd == 0.0f) {
+ /* ensure positive 0.0 */
+ ff.fd = erts_get_positive_zero_float();
+ }
+ UINT32_HASH_2(ff.fw[0], ff.fw[1], HCONST_12);
+ goto pop_next;
+ }
+ default:
+ erts_exit(ERTS_ERROR_EXIT, "Invalid tag in make_internal_hash(0x%X, %lu)\n", term, salt);
}
-
-#else
-#error "unsupported D_EXP size"
-#endif
- hash = hash * (is_neg ? FUNNY_NUMBER3 : FUNNY_NUMBER2) + arity;
}
break;
+ case TAG_PRIMARY_IMMED1:
+ #if ERTS_SIZEOF_ETERM == 8
+ UINT32_HASH_2((Uint32)term, (Uint32)(term >> 32), HCONST);
+ #else
+ UINT32_HASH(term, HCONST);
+ #endif
+ goto pop_next;
- case MAP_DEF:
- {
- map_t *mp = (map_t *)map_val(term);
- int size = map_get_size(mp);
- Eterm *ks = map_get_keys(mp);
- Eterm *vs = map_get_values(mp);
-
- /* Use a prime with size to remedy some of
- * the {} and <<>> hash problems */
- hash = hash*FUNNY_NUMBER13 + FUNNY_NUMBER14 + size;
- if (size == 0)
- break;
+ default:
+ erts_exit(ERTS_ERROR_EXIT, "Invalid tag in make_internal_hash(0x%X, %lu)\n", term, salt);
- /* push values first */
- WSTACK_PUSH3(stack, (UWord)vs, (UWord) size, MAKE_HASH_TERM_ARRAY_OP);
- WSTACK_PUSH3(stack, (UWord)ks, (UWord) size, MAKE_HASH_TERM_ARRAY_OP);
- break;
- }
- case TUPLE_DEF:
- {
- Eterm* ptr = tuple_val(term);
- Uint arity = arityval(*ptr);
+ pop_next:
+ if (ESTACK_ISEMPTY(s)) {
+ DESTROY_ESTACK(s);
- WSTACK_PUSH3(stack, (UWord) arity, (UWord) (ptr+1), (UWord) arity);
- op = MAKE_HASH_TUPLE_OP;
- }/*fall through*/
- case MAKE_HASH_TUPLE_OP:
- case MAKE_HASH_TERM_ARRAY_OP:
- {
- Uint i = (Uint) WSTACK_POP(stack);
- Eterm* ptr = (Eterm*) WSTACK_POP(stack);
- if (i != 0) {
- term = *ptr;
- WSTACK_PUSH3(stack, (UWord)(ptr+1), (UWord) i-1, (UWord) op);
- goto tail_recur;
+ return hash;
}
- if (op == MAKE_HASH_TUPLE_OP) {
- Uint32 arity = (UWord) WSTACK_POP(stack);
- hash = hash*FUNNY_NUMBER9 + arity;
+
+ term = ESTACK_POP(s);
+
+ switch (term) {
+ case HASH_CDR:
+ CONST_HASH(HCONST_18); /* Hash CDR i cons cell */
+ goto pop_next;
+ default:
+ break;
}
- break;
}
-
- default:
- erl_exit(1, "Invalid tag in make_broken_hash\n");
- return 0;
- }
- if (WSTACK_ISEMPTY(stack)) break;
- op = (Uint) WSTACK_POP(stack);
+ }
}
- DESTROY_WSTACK(stack);
- return hash;
-
-#undef MAKE_HASH_TUPLE_OP
-#undef MAKE_HASH_TERM_ARRAY_OP
-#undef MAKE_HASH_CDR_PRE_OP
-#undef MAKE_HASH_CDR_POST_OP
+#undef CONST_HASH
+#undef HASH_MAP_TAIL
+#undef HASH_MAP_PAIR
+#undef HASH_CDR
+
+#undef UINT32_HASH_2
+#undef UINT32_HASH
+#undef SINT32_HASH
}
-static int do_send_to_logger(Eterm tag, Eterm gleader, char *buf, int len)
+#undef HCONST
+#undef MIX
+
+static Eterm
+do_allocate_logger_message(Eterm gleader, Eterm **hp, ErlOffHeap **ohp,
+ ErlHeapFragment **bp, Process **p, Uint sz)
{
- /* error_logger !
- {notify,{info_msg,gleader,{emulator,"~s~n",[<message as list>]}}} |
- {notify,{error,gleader,{emulator,"~s~n",[<message as list>]}}} |
- {notify,{warning_msg,gleader,{emulator,"~s~n",[<message as list>}]}} */
- Eterm* hp;
- Uint sz;
Uint gl_sz;
- Eterm gl;
- Eterm list,plist,format,tuple1,tuple2,tuple3;
- ErlOffHeap *ohp;
- ErlHeapFragment *bp = NULL;
-#if !defined(ERTS_SMP)
- Process *p;
-#endif
-
- ASSERT(is_atom(tag));
-
- if (len <= 0) {
- return -1;
- }
+ gl_sz = IS_CONST(gleader) ? 0 : size_object(gleader);
+ sz = sz + gl_sz;
#ifndef ERTS_SMP
#ifdef USE_THREADS
- p = NULL;
- if (erts_get_scheduler_data()) /* Must be scheduler thread */
+ if (!erts_get_scheduler_data()) /* Must be scheduler thread */
+ *p = NULL;
+ else
#endif
{
- p = erts_whereis_process(NULL, 0, am_error_logger, 0, 0);
- if (p) {
- erts_aint32_t state = erts_smp_atomic32_read_acqb(&p->state);
+ *p = erts_whereis_process(NULL, 0, am_error_logger, 0, 0);
+ if (*p) {
+ erts_aint32_t state = erts_smp_atomic32_read_acqb(&(*p)->state);
if (state & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS))
- p = NULL;
+ *p = NULL;
}
}
- if (!p) {
- /* buf *always* points to a null terminated string */
- erts_fprintf(stderr, "(no error logger present) %T: \"%s\"\n",
- tag, buf);
- return 0;
+ if (!*p) {
+ return NIL;
}
+
/* So we have an error logger, lets build the message */
#endif
- gl_sz = IS_CONST(gleader) ? 0 : size_object(gleader);
- sz = len * 2 /* message list */+ 2 /* cons surrounding message list */
- + gl_sz +
- 3 /*outer 2-tuple*/ + 4 /* middle 3-tuple */ + 4 /*inner 3-tuple */ +
- 8 /* "~s~n" */;
+ *bp = new_message_buffer(sz);
+ *ohp = &(*bp)->off_heap;
+ *hp = (*bp)->mem;
-#ifndef ERTS_SMP
- if (sz <= HeapWordsLeft(p)) {
- ohp = &MSO(p);
- hp = HEAP_TOP(p);
- HEAP_TOP(p) += sz;
- } else {
-#endif
- bp = new_message_buffer(sz);
- ohp = &bp->off_heap;
- hp = bp->mem;
-#ifndef ERTS_SMP
- }
-#endif
- gl = (is_nil(gleader)
+ return (is_nil(gleader)
? am_noproc
: (IS_CONST(gleader)
? gleader
- : copy_struct(gleader,gl_sz,&hp,ohp)));
- list = buf_to_intlist(&hp, buf, len, NIL);
- plist = CONS(hp,list,NIL);
- hp += 2;
- format = buf_to_intlist(&hp, "~s~n", 4, NIL);
- tuple1 = TUPLE3(hp, am_emulator, format, plist);
- hp += 4;
- tuple2 = TUPLE3(hp, tag, gl, tuple1);
- hp += 4;
- tuple3 = TUPLE2(hp, am_notify, tuple2);
+ : copy_struct(gleader,gl_sz,hp,*ohp)));
+}
+
+static void do_send_logger_message(Eterm *hp, ErlOffHeap *ohp, ErlHeapFragment *bp,
+ Process *p, Eterm message)
+{
#ifdef HARDDEBUG
- erts_fprintf(stderr, "%T\n", tuple3);
+ erts_fprintf(stderr, "%T\n", message);
#endif
#ifdef ERTS_SMP
{
Eterm from = erts_get_current_pid();
if (is_not_internal_pid(from))
from = NIL;
- erts_queue_error_logger_message(from, tuple3, bp);
+ erts_queue_error_logger_message(from, message, bp);
}
#else
- erts_queue_message(p, NULL /* only used for smp build */, bp, tuple3, NIL
-#ifdef USE_VM_PROBES
- , NIL
-#endif
- );
+ {
+ ErtsMessage *mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = bp;
+ erts_queue_message(p, 0, mp, message, am_system);
+ }
#endif
+}
+
+/* error_logger !
+ {notify,{info_msg,gleader,{emulator,format,[args]}}} |
+ {notify,{error,gleader,{emulator,format,[args]}}} |
+ {notify,{warning_msg,gleader,{emulator,format,[args}]}} */
+static int do_send_to_logger(Eterm tag, Eterm gleader, char *buf, int len)
+{
+ Uint sz;
+ Eterm gl;
+ Eterm list,args,format,tuple1,tuple2,tuple3;
+
+ Eterm *hp = NULL;
+ ErlOffHeap *ohp = NULL;
+ ErlHeapFragment *bp = NULL;
+ Process *p = NULL;
+
+ ASSERT(is_atom(tag));
+
+ if (len <= 0) {
+ return -1;
+ }
+
+ sz = len * 2 /* message list */ + 2 /* cons surrounding message list */
+ + 3 /*outer 2-tuple*/ + 4 /* middle 3-tuple */ + 4 /*inner 3-tuple */
+ + 8 /* "~s~n" */;
+
+ /* gleader size is accounted and allocated next */
+ gl = do_allocate_logger_message(gleader, &hp, &ohp, &bp, &p, sz);
+
+ if(is_nil(gl)) {
+ /* buf *always* points to a null terminated string */
+ erts_fprintf(stderr, "(no error logger present) %T: \"%s\"\n",
+ tag, buf);
+ return 0;
+ }
+
+ list = buf_to_intlist(&hp, buf, len, NIL);
+ args = CONS(hp,list,NIL);
+ hp += 2;
+ format = buf_to_intlist(&hp, "~s~n", 4, NIL);
+ tuple1 = TUPLE3(hp, am_emulator, format, args);
+ hp += 4;
+ tuple2 = TUPLE3(hp, tag, gl, tuple1);
+ hp += 4;
+ tuple3 = TUPLE2(hp, am_notify, tuple2);
+
+ do_send_logger_message(hp, ohp, bp, p, tuple3);
+ return 0;
+}
+
+static int do_send_term_to_logger(Eterm tag, Eterm gleader,
+ char *buf, int len, Eterm args)
+{
+ Uint sz;
+ Eterm gl;
+ Uint args_sz;
+ Eterm format,tuple1,tuple2,tuple3;
+
+ Eterm *hp = NULL;
+ ErlOffHeap *ohp = NULL;
+ ErlHeapFragment *bp = NULL;
+ Process *p = NULL;
+
+ ASSERT(is_atom(tag));
+
+ args_sz = size_object(args);
+ sz = len * 2 /* format */ + args_sz
+ + 3 /*outer 2-tuple*/ + 4 /* middle 3-tuple */ + 4 /*inner 3-tuple */;
+
+ /* gleader size is accounted and allocated next */
+ gl = do_allocate_logger_message(gleader, &hp, &ohp, &bp, &p, sz);
+
+ if(is_nil(gl)) {
+ /* buf *always* points to a null terminated string */
+ erts_fprintf(stderr, "(no error logger present) %T: \"%s\" %T\n",
+ tag, buf, args);
+ return 0;
+ }
+
+ format = buf_to_intlist(&hp, buf, len, NIL);
+ args = copy_struct(args, args_sz, &hp, ohp);
+ tuple1 = TUPLE3(hp, am_emulator, format, args);
+ hp += 4;
+ tuple2 = TUPLE3(hp, tag, gl, tuple1);
+ hp += 4;
+ tuple3 = TUPLE2(hp, am_notify, tuple2);
+
+ do_send_logger_message(hp, ohp, bp, p, tuple3);
return 0;
}
static ERTS_INLINE int
-send_info_to_logger(Eterm gleader, char *buf, int len)
+send_info_to_logger(Eterm gleader, char *buf, int len)
{
return do_send_to_logger(am_info_msg, gleader, buf, len);
}
static ERTS_INLINE int
-send_warning_to_logger(Eterm gleader, char *buf, int len)
+send_warning_to_logger(Eterm gleader, char *buf, int len)
{
Eterm tag;
switch (erts_error_logger_warnings) {
@@ -1874,11 +2095,17 @@ send_warning_to_logger(Eterm gleader, char *buf, int len)
}
static ERTS_INLINE int
-send_error_to_logger(Eterm gleader, char *buf, int len)
+send_error_to_logger(Eterm gleader, char *buf, int len)
{
return do_send_to_logger(am_error, gleader, buf, len);
}
+static ERTS_INLINE int
+send_error_term_to_logger(Eterm gleader, char *buf, int len, Eterm args)
+{
+ return do_send_term_to_logger(am_error, gleader, buf, len, args);
+}
+
#define LOGGER_DSBUF_INC_SZ 256
static erts_dsprintf_buf_t *
@@ -1954,6 +2181,15 @@ erts_send_error_to_logger(Eterm gleader, erts_dsprintf_buf_t *dsbufp)
}
int
+erts_send_error_term_to_logger(Eterm gleader, erts_dsprintf_buf_t *dsbufp, Eterm args)
+{
+ int res;
+ res = send_error_term_to_logger(gleader, dsbufp->str, dsbufp->str_len, args);
+ destroy_logger_dsbuf(dsbufp);
+ return res;
+}
+
+int
erts_send_info_to_logger_str(Eterm gleader, char *str)
{
return send_info_to_logger(gleader, str, sys_strlen(str));
@@ -2059,11 +2295,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;
@@ -2071,18 +2303,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;
@@ -2090,7 +2322,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)) {
@@ -2098,43 +2330,27 @@ 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;
goto term_array;
}
- case MAP_SUBTAG:
- {
- aa = map_val_rel(a, a_base);
- if (!is_boxed(b) || *boxed_val_rel(b,b_base) != *aa)
- goto not_equal;
- bb = map_val_rel(b,b_base);
- sz = map_get_size((map_t*)aa);
-
- if (sz != map_get_size((map_t*)bb)) goto not_equal;
- if (sz == 0) goto pop_next;
-
- aa += 2;
- bb += 2;
- sz += 1; /* increment for tuple-keys */
- goto term_array;
- }
case REFC_BINARY_SUBTAG:
case HEAP_BINARY_SUBTAG:
case SUB_BINARY_SUBTAG:
@@ -2147,17 +2363,17 @@ tailrecur_ne:
Uint b_bitsize;
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) {
@@ -2168,9 +2384,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 */
@@ -2179,11 +2395,11 @@ 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 ||
@@ -2201,16 +2417,16 @@ 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;
}
break; /* not equal */
@@ -2230,33 +2446,31 @@ 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;
anum = external_thing_ref_numbers(athing);
bnum = external_thing_ref_numbers(bthing);
- alen = external_thing_ref_no_of_numbers(athing);
- blen = external_thing_ref_no_of_numbers(bthing);
+ alen = external_thing_ref_no_numbers(athing);
+ blen = external_thing_ref_no_numbers(bthing);
goto ref_common;
+
case REF_SUBTAG:
- if (!is_internal_ref_rel(b,b_base))
- goto not_equal;
- {
- RefThing* athing = ref_thing_ptr_rel(a,a_base);
- RefThing* bthing = ref_thing_ptr_rel(b,b_base);
- alen = internal_thing_ref_no_of_numbers(athing);
- blen = internal_thing_ref_no_of_numbers(bthing);
- anum = internal_thing_ref_numbers(athing);
- bnum = internal_thing_ref_numbers(bthing);
- }
+ if (!is_internal_ref(b))
+ goto not_equal;
+
+ alen = internal_ref_no_numbers(a);
+ anum = internal_ref_numbers(a);
+ blen = internal_ref_no_numbers(b);
+ bnum = internal_ref_numbers(b);
ref_common:
ASSERT(alen > 0 && blen > 0);
@@ -2267,7 +2481,7 @@ tailrecur_ne:
if (alen == 3 && blen == 3) {
/* Most refs are of length 3 */
if (anum[1] == bnum[1] && anum[2] == bnum[2]) {
- goto pop_next;
+ goto pop_next;
} else {
goto not_equal;
}
@@ -2292,7 +2506,7 @@ tailrecur_ne:
for (i = common_len; i < blen; i++)
if (bnum[i] != 0)
goto not_equal;
- }
+ }
}
goto pop_next;
}
@@ -2300,11 +2514,11 @@ tailrecur_ne:
case NEG_BIG_SUBTAG:
{
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);
@@ -2318,14 +2532,54 @@ 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(a)) {
+ aa = flatmap_val(a);
+ if (!is_boxed(b) || *boxed_val(b) != *aa)
+ goto not_equal;
+ bb = flatmap_val(b);
+ sz = flatmap_get_size((flatmap_t*)aa);
+
+ if (sz != flatmap_get_size((flatmap_t*)bb)) goto not_equal;
+ if (sz == 0) goto pop_next;
+
+ aa += 2;
+ bb += 2;
+ sz += 1; /* increment for tuple-keys */
+ goto term_array;
+
+ } else {
+ if (!is_boxed(b) || *boxed_val(b) != hdr)
+ goto not_equal;
+
+ aa = hashmap_val(a) + 1;
+ bb = hashmap_val(b) + 1;
+ switch (hdr & _HEADER_MAP_SUBTAG_MASK) {
+ case HAMT_SUBTAG_HEAD_ARRAY:
+ aa++; bb++;
+ sz = 16;
+ break;
+ case HAMT_SUBTAG_HEAD_BITMAP:
+ aa++; bb++;
+ case HAMT_SUBTAG_NODE_BITMAP:
+ sz = hashmap_bitcount(MAP_HEADER_VAL(hdr));
+ ASSERT(sz > 0 && sz < 17);
+ break;
+ default:
+ erts_exit(ERTS_ERROR_EXIT, "Unknown hashmap subsubtag\n");
+ }
+ goto term_array;
+ }
+ default:
+ ASSERT(!"Unknown boxed subtab in EQ");
}
break;
}
@@ -2340,7 +2594,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;
@@ -2357,7 +2611,7 @@ term_array: /* arrays in 'aa' and 'bb', length in 'sz' */
}
goto tailrecur_ne;
}
-
+
pop_next:
if (!WSTACK_ISEMPTY(stack)) {
UWord something = WSTACK_POP(stack);
@@ -2418,7 +2672,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));
@@ -2429,27 +2683,50 @@ 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.
*/
Sint cmp(Eterm a, Eterm b)
{
- return erts_cmp(a, b, 0);
+ return erts_cmp(a, b, 0, 0);
+}
+
+Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only);
+
+Sint erts_cmp(Eterm a, Eterm b, int exact, int eq_only)
+{
+ if (is_atom(a) && is_atom(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(a) && is_float(b)) {
+ FloatDef af, bf;
+ GET_DOUBLE(a, af);
+ GET_DOUBLE(b, bf);
+ return float_comp(af.fd, bf.fd);
+ }
+ return erts_cmp_compound(a,b,exact,eq_only);
}
-#endif
+
/* erts_cmp(Eterm a, Eterm b, int exact)
* exact = 1 -> term-based compare
* exact = 0 -> arith-based compare
*/
-#if HALFWORD_HEAP
-Sint erts_cmp_rel_opt(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base, int exact)
-#else
-Sint erts_cmp(Eterm a, Eterm b, int exact)
-#endif
+Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only)
{
- DECLARE_WSTACK(stack);
+#define PSTACK_TYPE struct erts_cmp_hashmap_state
+ struct erts_cmp_hashmap_state {
+ Sint wstack_rollback;
+ int was_exact;
+ Eterm *ap;
+ Eterm *bp;
+ Eterm min_key;
+ Sint cmp_res; /* result so far -1,0,+1 */
+ };
+ PSTACK_DECLARE(hmap_stack, 1);
+ WSTACK_DECLARE(stack);
+ WSTACK_DECLARE(b_stack); /* only used by hashmaps */
Eterm* aa;
Eterm* bb;
int i;
@@ -2465,6 +2742,26 @@ Sint erts_cmp(Eterm a, Eterm b, int exact)
Uint32 *anum;
Uint32 *bnum;
+/* The WSTACK contains naked Eterms and Operations marked with header-tags */
+#define OP_BITS 4
+#define OP_MASK 0xF
+#define TERM_ARRAY_OP 0
+#define SWITCH_EXACT_OFF_OP 1
+#define HASHMAP_PHASE1_ARE_KEYS_EQUAL 2
+#define HASHMAP_PHASE1_IS_MIN_KEY 3
+#define HASHMAP_PHASE1_CMP_VALUES 4
+#define HASHMAP_PHASE2_ARE_KEYS_EQUAL 5
+#define HASHMAP_PHASE2_IS_MIN_KEY_A 6
+#define HASHMAP_PHASE2_IS_MIN_KEY_B 7
+
+
+#define OP_WORD(OP) (((OP) << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER)
+#define TERM_ARRAY_OP_WORD(SZ) OP_WORD(((SZ) << OP_BITS) | TERM_ARRAY_OP)
+
+#define GET_OP(WORD) (ASSERT(is_header(WORD)), ((WORD) >> _TAG_PRIMARY_SIZE) & OP_MASK)
+#define GET_OP_ARG(WORD) (ASSERT(is_header(WORD)), ((WORD) >> (OP_BITS + _TAG_PRIMARY_SIZE)))
+
+
#define RETURN_NEQ(cmp) { j=(cmp); ASSERT(j != 0); goto not_equal; }
#define ON_CMP_GOTO(cmp) if ((j=(cmp)) == 0) goto pop_next; else goto not_equal
@@ -2473,15 +2770,17 @@ Sint erts_cmp(Eterm a, Eterm b, int exact)
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); \
} \
} while (0)
+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:
@@ -2489,7 +2788,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));
@@ -2507,16 +2806,16 @@ 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;
}
anode = erts_this_node;
adata = internal_port_data(a);
-
+
port_common:
CMP_NODES(anode, bnode);
ON_CMP_GOTO((Sint)(adata - bdata));
@@ -2525,16 +2824,16 @@ 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;
}
anode = erts_this_node;
adata = internal_pid_data(a);
-
+
pid_common:
if (adata != bdata) {
RETURN_NEQ(adata < bdata ? -1 : 1);
@@ -2560,12 +2859,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;
@@ -2573,7 +2872,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)) {
@@ -2581,20 +2880,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)) {
@@ -2606,68 +2905,141 @@ tailrecur_ne:
++aa;
++bb;
goto term_array;
- case (_TAG_HEADER_MAP >> _TAG_PRIMARY_SIZE) :
- if (!is_map_rel(b,b_base)) {
- a_tag = MAP_DEF;
- goto mixed_types;
- }
- aa = (Eterm *)map_val_rel(a,a_base);
- bb = (Eterm *)map_val_rel(b,b_base);
-
- i = map_get_size((map_t*)aa);
- if (i != map_get_size((map_t*)bb)) {
- RETURN_NEQ((int)(i - map_get_size((map_t*)bb)));
- }
- if (i == 0) {
- goto pop_next;
+ case (_TAG_HEADER_MAP >> _TAG_PRIMARY_SIZE) :
+ {
+ struct erts_cmp_hashmap_state* sp;
+ if (is_flatmap_header(ahdr)) {
+ 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(a);
+ bb = (Eterm *)flatmap_val(b);
+
+ i = flatmap_get_size((flatmap_t*)aa);
+ if (i != flatmap_get_size((flatmap_t*)bb)) {
+ RETURN_NEQ((int)(i - flatmap_get_size((flatmap_t*)bb)));
+ }
+ if (i == 0) {
+ goto pop_next;
+ }
+ aa += 2;
+ bb += 2;
+ if (exact) {
+ i += 1; /* increment for tuple-keys */
+ goto term_array;
+ }
+ else {
+ /* Value array */
+ WSTACK_PUSH3(stack,(UWord)(bb+1),(UWord)(aa+1),TERM_ARRAY_OP_WORD(i));
+ /* Switch back from 'exact' key compare */
+ WSTACK_PUSH(stack,OP_WORD(SWITCH_EXACT_OFF_OP));
+ /* Now do 'exact' compare of key tuples */
+ a = *aa;
+ b = *bb;
+ exact = 1;
+ goto bodyrecur;
+ }
+ }
+ 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(a) - hashmap_size(b);
+ if (i) {
+ RETURN_NEQ(i);
+ }
+ if (hashmap_size(a) == 0) {
+ goto pop_next;
+ }
+
+ /* Hashmap compare strategy:
+ Phase 1. While keys are identical
+ Do synchronous stepping through leafs of both trees in hash
+ order. Maintain value compare result of minimal key.
+
+ Phase 2. If key diff was found in phase 1
+ Ignore values from now on.
+ Continue iterate trees by always advancing the one
+ lagging behind hash-wise. Identical keys are skipped.
+ A minimal key can only be candidate as tie-breaker if we
+ have passed that hash value in the other tree (which means
+ the key did not exist in the other tree).
+ */
+
+ sp = PSTACK_PUSH(hmap_stack);
+ hashmap_iterator_init(&stack, a, 0);
+ hashmap_iterator_init(&b_stack, b, 0);
+ sp->ap = hashmap_iterator_next(&stack);
+ sp->bp = hashmap_iterator_next(&b_stack);
+ sp->cmp_res = 0;
+ ASSERT(sp->ap && sp->bp);
+
+ a = CAR(sp->ap);
+ b = CAR(sp->bp);
+ sp->was_exact = exact;
+ exact = 1;
+ WSTACK_PUSH(stack, OP_WORD(HASHMAP_PHASE1_ARE_KEYS_EQUAL));
+ sp->wstack_rollback = WSTACK_COUNT(stack);
+ goto bodyrecur;
}
- aa += 2;
- bb += 2;
- i += 1; /* increment for tuple-keys */
- goto term_array;
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->info.mfa.module,
+ b_exp->info.mfa.module)) != 0) {
RETURN_NEQ(j);
}
- if ((j = cmp_atoms(a_exp->code[1], b_exp->code[1])) != 0) {
+ if ((j = erts_cmp_atoms(a_exp->info.mfa.function,
+ b_exp->info.mfa.function)) != 0) {
RETURN_NEQ(j);
}
- ON_CMP_GOTO((Sint) a_exp->code[2] - (Sint) b_exp->code[2]);
+ ON_CMP_GOTO((Sint) a_exp->info.mfa.arity - (Sint) b_exp->info.mfa.arity);
}
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,
@@ -2688,7 +3060,7 @@ tailrecur_ne:
diff = f1->num_free - f2->num_free;
if (diff != 0) {
RETURN_NEQ(diff);
- }
+ }
i = f1->num_free;
if (i == 0) goto pop_next;
aa = f1->env;
@@ -2699,29 +3071,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):
/*
@@ -2729,31 +3101,26 @@ 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)) {
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);
+ blen = internal_ref_no_numbers(b);
+ bnum = internal_ref_numbers(b);
+ } 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);
+ blen = external_thing_ref_no_numbers(bthing);
} else {
a_tag = REF_DEF;
goto mixed_types;
}
- {
- RefThing* athing = ref_thing_ptr_rel(a,a_base);
- anode = erts_this_node;
- anum = internal_thing_ref_numbers(athing);
- alen = internal_thing_ref_no_of_numbers(athing);
- }
-
+ anode = erts_this_node;
+ alen = internal_ref_no_numbers(a);
+ anum = internal_ref_numbers(a);
+
ref_common:
CMP_NODES(anode, bnode);
-
+
ASSERT(alen > 0 && blen > 0);
if (alen != blen) {
if (alen > blen) {
@@ -2771,43 +3138,42 @@ tailrecur_ne:
} while (alen < blen);
}
}
-
+
ASSERT(alen == blen);
for (i = (Sint) alen - 1; i >= 0; i--)
if (anum[i] != bnum[i])
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)) {
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);
+ blen = internal_ref_no_numbers(b);
+ bnum = internal_ref_numbers(b);
+ } 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);
+ blen = external_thing_ref_no_numbers(bthing);
} else {
a_tag = EXTERNAL_REF_DEF;
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);
+ alen = external_thing_ref_no_numbers(athing);
}
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;
@@ -2816,8 +3182,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) {
@@ -2848,13 +3214,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 */
@@ -2926,7 +3287,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;
@@ -2974,9 +3335,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)) {
@@ -2984,35 +3345,191 @@ term_array: /* arrays in 'aa' and 'bb', length in 'i' */
goto not_equal;
}
} else {
- /* (ab)Use TAG_PRIMARY_HEADER to recognize a term_array */
- WSTACK_PUSH3(stack, i, (UWord)bb, (UWord)aa | TAG_PRIMARY_HEADER);
+ WSTACK_PUSH3(stack, (UWord)bb, (UWord)aa, TERM_ARRAY_OP_WORD(i));
goto tailrecur_ne;
}
}
}
a = *aa;
b = *bb;
- goto tailrecur;
-
+ goto tailrecur;
+
pop_next:
if (!WSTACK_ISEMPTY(stack)) {
UWord something = WSTACK_POP(stack);
- if (primary_tag((Eterm) something) == TAG_PRIMARY_HEADER) { /* a term_array */
- aa = (Eterm*) something;
- bb = (Eterm*) WSTACK_POP(stack);
- i = WSTACK_POP(stack);
- goto term_array;
+ struct erts_cmp_hashmap_state* sp;
+ if (primary_tag((Eterm) something) == TAG_PRIMARY_HEADER) { /* an operation */
+ switch (GET_OP(something)) {
+ case TERM_ARRAY_OP:
+ i = GET_OP_ARG(something);
+ aa = (Eterm*)WSTACK_POP(stack);
+ bb = (Eterm*) WSTACK_POP(stack);
+ goto term_array;
+
+ case SWITCH_EXACT_OFF_OP:
+ /* Done with exact compare of map keys, switch back */
+ ASSERT(exact);
+ exact = 0;
+ goto pop_next;
+
+ case HASHMAP_PHASE1_ARE_KEYS_EQUAL: {
+ sp = PSTACK_TOP(hmap_stack);
+ if (j) {
+ /* Key diff found, enter phase 2 */
+ if (hashmap_key_hash_cmp(sp->ap, sp->bp) < 0) {
+ sp->min_key = CAR(sp->ap);
+ sp->cmp_res = -1;
+ sp->ap = hashmap_iterator_next(&stack);
+ }
+ else {
+ sp->min_key = CAR(sp->bp);
+ sp->cmp_res = 1;
+ sp->bp = hashmap_iterator_next(&b_stack);
+ }
+ exact = 1; /* only exact key compares in phase 2 */
+ goto case_HASHMAP_PHASE2_LOOP;
+ }
+
+ /* No key diff found so far, compare values if min key */
+
+ if (sp->cmp_res) {
+ a = CAR(sp->ap);
+ b = sp->min_key;
+ exact = 1;
+ WSTACK_PUSH(stack, OP_WORD(HASHMAP_PHASE1_IS_MIN_KEY));
+ sp->wstack_rollback = WSTACK_COUNT(stack);
+ goto bodyrecur;
+ }
+ /* no min key-value found yet */
+ a = CDR(sp->ap);
+ b = CDR(sp->bp);
+ exact = sp->was_exact;
+ WSTACK_PUSH(stack, OP_WORD(HASHMAP_PHASE1_CMP_VALUES));
+ sp->wstack_rollback = WSTACK_COUNT(stack);
+ goto bodyrecur;
+ }
+ case HASHMAP_PHASE1_IS_MIN_KEY:
+ sp = PSTACK_TOP(hmap_stack);
+ if (j < 0) {
+ a = CDR(sp->ap);
+ b = CDR(sp->bp);
+ exact = sp->was_exact;
+ WSTACK_PUSH(stack, OP_WORD(HASHMAP_PHASE1_CMP_VALUES));
+ sp->wstack_rollback = WSTACK_COUNT(stack);
+ goto bodyrecur;
+ }
+ goto case_HASHMAP_PHASE1_LOOP;
+
+ case HASHMAP_PHASE1_CMP_VALUES:
+ sp = PSTACK_TOP(hmap_stack);
+ if (j) {
+ sp->cmp_res = j;
+ sp->min_key = CAR(sp->ap);
+ }
+ case_HASHMAP_PHASE1_LOOP:
+ sp->ap = hashmap_iterator_next(&stack);
+ sp->bp = hashmap_iterator_next(&b_stack);
+ if (!sp->ap) {
+ /* end of maps with identical keys */
+ ASSERT(!sp->bp);
+ j = sp->cmp_res;
+ exact = sp->was_exact;
+ (void) PSTACK_POP(hmap_stack);
+ ON_CMP_GOTO(j);
+ }
+ a = CAR(sp->ap);
+ b = CAR(sp->bp);
+ exact = 1;
+ WSTACK_PUSH(stack, OP_WORD(HASHMAP_PHASE1_ARE_KEYS_EQUAL));
+ sp->wstack_rollback = WSTACK_COUNT(stack);
+ goto bodyrecur;
+
+ case_HASHMAP_PHASE2_LOOP:
+ if (sp->ap && sp->bp) {
+ a = CAR(sp->ap);
+ b = CAR(sp->bp);
+ ASSERT(exact);
+ WSTACK_PUSH(stack, OP_WORD(HASHMAP_PHASE2_ARE_KEYS_EQUAL));
+ sp->wstack_rollback = WSTACK_COUNT(stack);
+ goto bodyrecur;
+ }
+ goto case_HASHMAP_PHASE2_NEXT_STEP;
+
+ case HASHMAP_PHASE2_ARE_KEYS_EQUAL:
+ sp = PSTACK_TOP(hmap_stack);
+ if (j == 0) {
+ /* keys are equal, skip them */
+ sp->ap = hashmap_iterator_next(&stack);
+ sp->bp = hashmap_iterator_next(&b_stack);
+ goto case_HASHMAP_PHASE2_LOOP;
+ }
+ /* fall through */
+ case_HASHMAP_PHASE2_NEXT_STEP:
+ if (sp->ap || sp->bp) {
+ if (hashmap_key_hash_cmp(sp->ap, sp->bp) < 0) {
+ ASSERT(sp->ap);
+ a = CAR(sp->ap);
+ b = sp->min_key;
+ ASSERT(exact);
+ WSTACK_PUSH(stack, OP_WORD(HASHMAP_PHASE2_IS_MIN_KEY_A));
+ }
+ else { /* hash_cmp > 0 */
+ ASSERT(sp->bp);
+ a = CAR(sp->bp);
+ b = sp->min_key;
+ ASSERT(exact);
+ WSTACK_PUSH(stack, OP_WORD(HASHMAP_PHASE2_IS_MIN_KEY_B));
+ }
+ sp->wstack_rollback = WSTACK_COUNT(stack);
+ goto bodyrecur;
+ }
+ /* End of both maps */
+ j = sp->cmp_res;
+ exact = sp->was_exact;
+ (void) PSTACK_POP(hmap_stack);
+ ON_CMP_GOTO(j);
+
+ case HASHMAP_PHASE2_IS_MIN_KEY_A:
+ sp = PSTACK_TOP(hmap_stack);
+ if (j < 0) {
+ sp->min_key = CAR(sp->ap);
+ sp->cmp_res = -1;
+ }
+ sp->ap = hashmap_iterator_next(&stack);
+ goto case_HASHMAP_PHASE2_LOOP;
+
+ case HASHMAP_PHASE2_IS_MIN_KEY_B:
+ sp = PSTACK_TOP(hmap_stack);
+ if (j < 0) {
+ sp->min_key = CAR(sp->bp);
+ sp->cmp_res = 1;
+ }
+ sp->bp = hashmap_iterator_next(&b_stack);
+ goto case_HASHMAP_PHASE2_LOOP;
+
+ default:
+ ASSERT(!"Invalid cmp op");
+ } /* switch */
}
a = (Eterm) something;
b = (Eterm) WSTACK_POP(stack);
goto tailrecur;
}
- DESTROY_WSTACK(stack);
+ ASSERT(PSTACK_IS_EMPTY(hmap_stack));
+ PSTACK_DESTROY(hmap_stack);
+ WSTACK_DESTROY(stack);
+ WSTACK_DESTROY(b_stack);
return 0;
not_equal:
- DESTROY_WSTACK(stack);
+ if (!PSTACK_IS_EMPTY(hmap_stack) && !eq_only) {
+ WSTACK_ROLLBACK(stack, PSTACK_TOP(hmap_stack)->wstack_rollback);
+ goto pop_next;
+ }
+ PSTACK_DESTROY(hmap_stack);
+ WSTACK_DESTROY(stack);
+ WSTACK_DESTROY(b_stack);
return j;
#undef CMP_NODES
@@ -3022,40 +3539,41 @@ not_equal:
Eterm
store_external_or_ref_(Uint **hpp, ErlOffHeap* oh, Eterm ns)
{
+ struct erl_off_heap_header *ohhp;
Uint i;
Uint size;
- Uint *from_hp;
- Uint *to_hp = *hpp;
+ Eterm *from_hp;
+ Eterm *to_hp = *hpp;
ASSERT(is_external(ns) || is_internal_ref(ns));
- if(is_external(ns)) {
- from_hp = external_val(ns);
- size = thing_arityval(*from_hp) + 1;
- *hpp += size;
-
- for(i = 0; i < size; i++)
- to_hp[i] = from_hp[i];
-
- erts_refc_inc(&((ExternalThing *) to_hp)->node->refc, 2);
-
- ((struct erl_off_heap_header*) to_hp)->next = oh->first;
- oh->first = (struct erl_off_heap_header*) to_hp;
-
- return make_external(to_hp);
- }
-
- /* Internal ref */
- from_hp = internal_ref_val(ns);
-
+ from_hp = boxed_val(ns);
size = thing_arityval(*from_hp) + 1;
-
*hpp += size;
for(i = 0; i < size; i++)
to_hp[i] = from_hp[i];
- return make_internal_ref(to_hp);
+ if (is_external_header(*from_hp)) {
+ ExternalThing *etp = (ExternalThing *) from_hp;
+ ASSERT(is_external(ns));
+ erts_smp_refc_inc(&etp->node->refc, 2);
+ }
+ else if (is_ordinary_ref_thing(from_hp))
+ return make_internal_ref(to_hp);
+ else {
+ ErtsMRefThing *mreft = (ErtsMRefThing *) from_hp;
+ ErtsMagicBinary *mb = mreft->mb;
+ ASSERT(is_magic_ref_thing(from_hp));
+ erts_refc_inc(&mb->intern.refc, 2);
+ OH_OVERHEAD(oh, mb->orig_size / sizeof(Eterm));
+ }
+
+ ohhp = (struct erl_off_heap_header*) to_hp;
+ ohhp->next = oh->first;
+ oh->first = ohhp;
+
+ return make_boxed(to_hp);
}
Eterm
@@ -3072,7 +3590,7 @@ store_external_or_ref_in_proc_(Process *proc, Eterm ns)
return store_external_or_ref_(&hp, &MSO(proc), ns);
}
-void bin_write(int to, void *to_arg, byte* buf, size_t sz)
+void bin_write(fmtfn_t to, void *to_arg, byte* buf, size_t sz)
{
size_t i;
@@ -3089,31 +3607,149 @@ 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)
+ * return number of chars in list
+ * or -1 for type error
+ * or -2 for not enough buffer space (buffer contains truncated result)
+ */
+Sint
+intlist_to_buf(Eterm list, char *buf, Sint len)
{
Eterm* listptr;
- int sz = 0;
+ Sint sz = 0;
- if (is_nil(list))
+ if (is_nil(list))
return 0;
if (is_not_list(list))
return -1;
listptr = list_val(list);
while (sz < len) {
- if (!is_byte(*listptr))
+ if (!is_byte(*listptr))
return -1;
buf[sz++] = unsigned_val(*listptr);
if (is_nil(*(listptr + 1)))
return(sz);
- if (is_not_list(*(listptr + 1)))
+ if (is_not_list(*(listptr + 1)))
return -1;
listptr = list_val(*(listptr + 1));
}
- return -1; /* not enough space */
+ return -2; /* not enough space */
+}
+
+/** @brief Fill buf with the UTF8 contents of the unicode list
+ * @param len Max number of characters to write.
+ * @param written NULL or bytes written.
+ * @return 0 ok,
+ * -1 type error,
+ * -2 list too long, only \c len characters written
+ */
+int
+erts_unicode_list_to_buf(Eterm list, byte *buf, Sint len, Sint* written)
+{
+ Eterm* listptr;
+ Sint sz = 0;
+ Sint val;
+ int res;
+
+ while (1) {
+ if (is_nil(list)) {
+ res = 0;
+ break;
+ }
+ if (is_not_list(list)) {
+ res = -1;
+ break;
+ }
+ listptr = list_val(list);
+
+ if (len-- <= 0) {
+ res = -2;
+ break;
+ }
+
+ if (is_not_small(CAR(listptr))) {
+ res = -1;
+ break;
+ }
+ val = signed_val(CAR(listptr));
+ if (0 <= val && val < 0x80) {
+ buf[sz] = val;
+ sz++;
+ } else if (val < 0x800) {
+ buf[sz+0] = 0xC0 | (val >> 6);
+ buf[sz+1] = 0x80 | (val & 0x3F);
+ sz += 2;
+ } else if (val < 0x10000UL) {
+ if (0xD800 <= val && val <= 0xDFFF) {
+ res = -1;
+ break;
+ }
+ buf[sz+0] = 0xE0 | (val >> 12);
+ buf[sz+1] = 0x80 | ((val >> 6) & 0x3F);
+ buf[sz+2] = 0x80 | (val & 0x3F);
+ sz += 3;
+ } else if (val < 0x110000) {
+ buf[sz+0] = 0xF0 | (val >> 18);
+ buf[sz+1] = 0x80 | ((val >> 12) & 0x3F);
+ buf[sz+2] = 0x80 | ((val >> 6) & 0x3F);
+ buf[sz+3] = 0x80 | (val & 0x3F);
+ sz += 4;
+ } else {
+ res = -1;
+ break;
+ }
+ list = CDR(listptr);
+ }
+
+ if (written)
+ *written = sz;
+ return res;
+}
+
+Sint
+erts_unicode_list_to_buf_len(Eterm list)
+{
+ Eterm* listptr;
+ Sint sz = 0;
+
+ if (is_nil(list)) {
+ return 0;
+ }
+ if (is_not_list(list)) {
+ return -1;
+ }
+ listptr = list_val(list);
+
+ while (1) {
+ Sint val;
+
+ if (is_not_small(CAR(listptr))) {
+ return -1;
+ }
+ val = signed_val(CAR(listptr));
+ if (0 <= val && val < 0x80) {
+ sz++;
+ } else if (val < 0x800) {
+ sz += 2;
+ } else if (val < 0x10000UL) {
+ if (0xD800 <= val && val <= 0xDFFF) {
+ return -1;
+ }
+ sz += 3;
+ } else if (val < 0x110000) {
+ sz += 4;
+ } else {
+ return -1;
+ }
+ list = CDR(listptr);
+ if (is_nil(list)) {
+ return sz;
+ }
+ if (is_not_list(list)) {
+ return -1;
+ }
+ listptr = list_val(list);
+ }
}
/*
@@ -3197,106 +3833,303 @@ buf_to_intlist(Eterm** hpp, const char *buf, size_t len, Eterm tail)
**
*/
-ErlDrvSizeT erts_iolist_to_buf(Eterm obj, char* buf, ErlDrvSizeT alloced_len)
+typedef enum {
+ ERTS_IL2B_BCOPY_OK,
+ ERTS_IL2B_BCOPY_YIELD,
+ ERTS_IL2B_BCOPY_OVERFLOW,
+ ERTS_IL2B_BCOPY_TYPE_ERROR
+} ErtsIL2BBCopyRes;
+
+static ErtsIL2BBCopyRes
+iolist_to_buf_bcopy(ErtsIOList2BufState *state, Eterm obj, int *yield_countp);
+
+static ERTS_INLINE ErlDrvSizeT
+iolist_to_buf(const int yield_support,
+ ErtsIOList2BufState *state,
+ Eterm obj,
+ char* buf,
+ ErlDrvSizeT alloced_len)
{
- ErlDrvSizeT len = (ErlDrvSizeT) alloced_len;
- Eterm* objp;
+#undef IOLIST_TO_BUF_BCOPY
+#define IOLIST_TO_BUF_BCOPY(CONSP) \
+do { \
+ size_t size = binary_size(obj); \
+ if (size > 0) { \
+ Uint bitsize; \
+ byte* bptr; \
+ Uint bitoffs; \
+ Uint num_bits; \
+ if (yield_support) { \
+ size_t max_size = ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT; \
+ if (yield_count > 0) \
+ max_size *= yield_count+1; \
+ if (size > max_size) { \
+ state->objp = CONSP; \
+ goto L_bcopy_yield; \
+ } \
+ if (size >= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT) { \
+ int cost = (int) size; \
+ cost /= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT; \
+ yield_count -= cost; \
+ } \
+ } \
+ if (len < size) \
+ goto L_overflow; \
+ ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize); \
+ if (bitsize != 0) \
+ goto L_type_error; \
+ num_bits = 8*size; \
+ copy_binary_to_buffer(buf, 0, bptr, bitoffs, num_bits); \
+ buf += size; \
+ len -= size; \
+ } \
+} while (0)
+
+ ErlDrvSizeT res, len;
+ Eterm* objp = NULL;
+ int init_yield_count;
+ int yield_count;
DECLARE_ESTACK(s);
- goto L_again;
-
- while (!ESTACK_ISEMPTY(s)) {
- obj = ESTACK_POP(s);
- L_again:
- if (is_list(obj)) {
- L_iter_list:
- objp = list_val(obj);
- obj = CAR(objp);
- if (is_byte(obj)) {
- if (len == 0) {
- goto L_overflow;
- }
- *buf++ = unsigned_val(obj);
- len--;
- } else if (is_binary(obj)) {
- byte* bptr;
- size_t size = binary_size(obj);
- Uint bitsize;
- Uint bitoffs;
- Uint num_bits;
-
- if (len < size) {
+
+ len = (ErlDrvSizeT) alloced_len;
+
+ if (!yield_support) {
+ yield_count = init_yield_count = 0; /* Shut up faulty warning... >:-( */
+ goto L_again;
+ }
+ else {
+
+ if (state->iolist.reds_left <= 0)
+ return ERTS_IOLIST_TO_BUF_YIELD;
+
+ ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK);
+ init_yield_count = (ERTS_IOLIST_TO_BUF_YIELD_COUNT_PER_RED
+ * state->iolist.reds_left);
+ yield_count = init_yield_count;
+
+ if (!state->iolist.estack.start)
+ goto L_again;
+ else {
+ int chk_stack;
+ /* Restart; restore state... */
+ ESTACK_RESTORE(s, &state->iolist.estack);
+
+ if (!state->bcopy.bptr)
+ chk_stack = 0;
+ else {
+ chk_stack = 1;
+ switch (iolist_to_buf_bcopy(state, THE_NON_VALUE, &yield_count)) {
+ case ERTS_IL2B_BCOPY_OK:
+ break;
+ case ERTS_IL2B_BCOPY_YIELD:
+ BUMP_ALL_REDS(state->iolist.c_p);
+ state->iolist.reds_left = 0;
+ ESTACK_SAVE(s, &state->iolist.estack);
+ return ERTS_IOLIST_TO_BUF_YIELD;
+ case ERTS_IL2B_BCOPY_OVERFLOW:
goto L_overflow;
- }
- ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);
- if (bitsize != 0) {
+ case ERTS_IL2B_BCOPY_TYPE_ERROR:
goto L_type_error;
}
- num_bits = 8*size;
- copy_binary_to_buffer(buf, 0, bptr, bitoffs, num_bits);
- buf += size;
- len -= size;
- } else if (is_list(obj)) {
- ESTACK_PUSH(s, CDR(objp));
- goto L_iter_list; /* on head */
- } else if (is_not_nil(obj)) {
- goto L_type_error;
}
- obj = CDR(objp);
- if (is_list(obj)) {
- goto L_iter_list; /* on tail */
- } else if (is_binary(obj)) {
- byte* bptr;
- size_t size = binary_size(obj);
- Uint bitsize;
- Uint bitoffs;
- Uint num_bits;
- if (len < size) {
- goto L_overflow;
+ obj = state->iolist.obj;
+ buf = state->buf;
+ len = state->len;
+ objp = state->objp;
+ state->objp = NULL;
+ if (objp)
+ goto L_tail;
+ if (!chk_stack)
+ goto L_again;
+ /* check stack */
+ }
+ }
+
+ while (!ESTACK_ISEMPTY(s)) {
+ obj = ESTACK_POP(s);
+ L_again:
+ if (is_list(obj)) {
+ while (1) { /* Tail loop */
+ while (1) { /* Head loop */
+ if (yield_support && --yield_count <= 0)
+ goto L_yield;
+ objp = list_val(obj);
+ obj = CAR(objp);
+ if (is_byte(obj)) {
+ if (len == 0) {
+ goto L_overflow;
+ }
+ *buf++ = unsigned_val(obj);
+ len--;
+ } else if (is_binary(obj)) {
+ IOLIST_TO_BUF_BCOPY(objp);
+ } else if (is_list(obj)) {
+ ESTACK_PUSH(s, CDR(objp));
+ continue; /* Head loop */
+ } else if (is_not_nil(obj)) {
+ goto L_type_error;
+ }
+ break;
}
- ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);
- if (bitsize != 0) {
+
+ L_tail:
+
+ obj = CDR(objp);
+
+ if (is_list(obj)) {
+ continue; /* Tail loop */
+ } else if (is_binary(obj)) {
+ IOLIST_TO_BUF_BCOPY(NULL);
+ } else if (is_not_nil(obj)) {
goto L_type_error;
}
- num_bits = 8*size;
- copy_binary_to_buffer(buf, 0, bptr, bitoffs, num_bits);
- buf += size;
- len -= size;
- } else if (is_not_nil(obj)) {
- goto L_type_error;
+ break;
}
} else if (is_binary(obj)) {
- byte* bptr;
- size_t size = binary_size(obj);
- Uint bitsize;
- Uint bitoffs;
- Uint num_bits;
- if (len < size) {
- goto L_overflow;
- }
- ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);
- if (bitsize != 0) {
- goto L_type_error;
- }
- num_bits = 8*size;
- copy_binary_to_buffer(buf, 0, bptr, bitoffs, num_bits);
- buf += size;
- len -= size;
+ IOLIST_TO_BUF_BCOPY(NULL);
} else if (is_not_nil(obj)) {
goto L_type_error;
- }
+ } else if (yield_support && --yield_count <= 0)
+ goto L_yield;
}
-
+
+ res = len;
+
+ L_return:
+
DESTROY_ESTACK(s);
- return len;
+
+ if (yield_support) {
+ int reds;
+ CLEAR_SAVED_ESTACK(&state->iolist.estack);
+ reds = ((init_yield_count - yield_count - 1)
+ / ERTS_IOLIST_TO_BUF_YIELD_COUNT_PER_RED) + 1;
+ BUMP_REDS(state->iolist.c_p, reds);
+ state->iolist.reds_left -= reds;
+ if (state->iolist.reds_left < 0)
+ state->iolist.reds_left = 0;
+ }
+
+
+ return res;
L_type_error:
- DESTROY_ESTACK(s);
- return ERTS_IOLIST_TO_BUF_TYPE_ERROR;
+ res = ERTS_IOLIST_TO_BUF_TYPE_ERROR;
+ goto L_return;
L_overflow:
- DESTROY_ESTACK(s);
- return ERTS_IOLIST_TO_BUF_OVERFLOW;
+ res = ERTS_IOLIST_TO_BUF_OVERFLOW;
+ goto L_return;
+
+ L_bcopy_yield:
+
+ state->buf = buf;
+ state->len = len;
+
+ switch (iolist_to_buf_bcopy(state, obj, &yield_count)) {
+ case ERTS_IL2B_BCOPY_OK:
+ ERTS_INTERNAL_ERROR("Missing yield");
+ case ERTS_IL2B_BCOPY_YIELD:
+ BUMP_ALL_REDS(state->iolist.c_p);
+ state->iolist.reds_left = 0;
+ ESTACK_SAVE(s, &state->iolist.estack);
+ return ERTS_IOLIST_TO_BUF_YIELD;
+ case ERTS_IL2B_BCOPY_OVERFLOW:
+ goto L_overflow;
+ case ERTS_IL2B_BCOPY_TYPE_ERROR:
+ goto L_type_error;
+ }
+
+ L_yield:
+
+ BUMP_ALL_REDS(state->iolist.c_p);
+ state->iolist.reds_left = 0;
+ state->iolist.obj = obj;
+ state->buf = buf;
+ state->len = len;
+ ESTACK_SAVE(s, &state->iolist.estack);
+ return ERTS_IOLIST_TO_BUF_YIELD;
+
+#undef IOLIST_TO_BUF_BCOPY
+}
+
+static ErtsIL2BBCopyRes
+iolist_to_buf_bcopy(ErtsIOList2BufState *state, Eterm obj, int *yield_countp)
+{
+ ErtsIL2BBCopyRes res;
+ char *buf = state->buf;
+ ErlDrvSizeT len = state->len;
+ byte* bptr;
+ size_t size;
+ size_t max_size;
+ Uint bitoffs;
+ Uint num_bits;
+ int yield_count = *yield_countp;
+
+ if (state->bcopy.bptr) {
+ bptr = state->bcopy.bptr;
+ size = state->bcopy.size;
+ bitoffs = state->bcopy.bitoffs;
+ state->bcopy.bptr = NULL;
+ }
+ else {
+ Uint bitsize;
+
+ ASSERT(is_binary(obj));
+
+ size = binary_size(obj);
+ if (size <= 0)
+ return ERTS_IL2B_BCOPY_OK;
+
+ if (len < size)
+ return ERTS_IL2B_BCOPY_OVERFLOW;
+
+ ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);
+ if (bitsize != 0)
+ return ERTS_IL2B_BCOPY_TYPE_ERROR;
+ }
+
+ ASSERT(size > 0);
+ max_size = (size_t) ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT;
+ if (yield_count > 0)
+ max_size *= (size_t) (yield_count+1);
+
+ if (size <= max_size) {
+ if (size >= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT) {
+ int cost = (int) size;
+ cost /= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT;
+ yield_count -= cost;
+ }
+ res = ERTS_IL2B_BCOPY_OK;
+ }
+ else {
+ ASSERT(0 < max_size && max_size < size);
+ yield_count = 0;
+ state->bcopy.bptr = bptr + max_size;
+ state->bcopy.bitoffs = bitoffs;
+ state->bcopy.size = size - max_size;
+ size = max_size;
+ res = ERTS_IL2B_BCOPY_YIELD;
+ }
+
+ num_bits = 8*size;
+ copy_binary_to_buffer(buf, 0, bptr, bitoffs, num_bits);
+ state->buf += size;
+ state->len -= size;
+ *yield_countp = yield_count;
+
+ return res;
+}
+
+ErlDrvSizeT erts_iolist_to_buf_yielding(ErtsIOList2BufState *state)
+{
+ return iolist_to_buf(1, state, state->iolist.obj, state->buf, state->len);
+}
+
+ErlDrvSizeT erts_iolist_to_buf(Eterm obj, char* buf, ErlDrvSizeT alloced_len)
+{
+ return iolist_to_buf(0, NULL, obj, buf, alloced_len);
}
/*
@@ -3307,11 +4140,32 @@ ErlDrvSizeT erts_iolist_to_buf(Eterm obj, char* buf, ErlDrvSizeT alloced_len)
* Any input term error detected in erts_iolist_to_buf should also
* be detected in this function!
*/
-int erts_iolist_size(Eterm obj, ErlDrvSizeT* sizep)
+
+static ERTS_INLINE int
+iolist_size(const int yield_support, ErtsIOListState *state, Eterm obj, ErlDrvSizeT* sizep)
{
+ int res, init_yield_count, yield_count;
Eterm* objp;
- Uint size = 0; /* Intentionally Uint due to halfword heap */
+ Uint size = (Uint) *sizep;
DECLARE_ESTACK(s);
+
+ if (!yield_support)
+ yield_count = init_yield_count = 0; /* Shut up faulty warning... >:-( */
+ else {
+ if (state->reds_left <= 0)
+ return ERTS_IOLIST_YIELD;
+ ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK);
+ init_yield_count = ERTS_IOLIST_SIZE_YIELDS_COUNT_PER_RED;
+ init_yield_count *= state->reds_left;
+ yield_count = init_yield_count;
+ if (state->estack.start) {
+ /* Restart; restore state... */
+ ESTACK_RESTORE(s, &state->estack);
+ size = (Uint) state->size;
+ obj = state->obj;
+ }
+ }
+
goto L_again;
#define SAFE_ADD(Var, Val) \
@@ -3327,58 +4181,109 @@ int erts_iolist_size(Eterm obj, ErlDrvSizeT* sizep)
obj = ESTACK_POP(s);
L_again:
if (is_list(obj)) {
- L_iter_list:
- objp = list_val(obj);
- /* Head */
- obj = CAR(objp);
- if (is_byte(obj)) {
- size++;
- if (size == 0) {
- goto L_overflow_error;
+ while (1) { /* Tail loop */
+ while (1) { /* Head loop */
+ if (yield_support && --yield_count <= 0)
+ goto L_yield;
+ objp = list_val(obj);
+ /* Head */
+ obj = CAR(objp);
+ if (is_byte(obj)) {
+ size++;
+ if (size == 0) {
+ goto L_overflow_error;
+ }
+ } else if (is_binary(obj) && binary_bitsize(obj) == 0) {
+ SAFE_ADD(size, binary_size(obj));
+ } else if (is_list(obj)) {
+ ESTACK_PUSH(s, CDR(objp));
+ continue; /* Head loop */
+ } else if (is_not_nil(obj)) {
+ goto L_type_error;
+ }
+ break;
}
- } else if (is_binary(obj) && binary_bitsize(obj) == 0) {
- SAFE_ADD(size, binary_size(obj));
- } else if (is_list(obj)) {
- ESTACK_PUSH(s, CDR(objp));
- goto L_iter_list; /* on head */
- } else if (is_not_nil(obj)) {
- goto L_type_error;
+ /* Tail */
+ obj = CDR(objp);
+ if (is_list(obj))
+ continue; /* Tail loop */
+ else if (is_binary(obj) && binary_bitsize(obj) == 0) {
+ SAFE_ADD(size, binary_size(obj));
+ } else if (is_not_nil(obj)) {
+ goto L_type_error;
+ }
+ break;
}
- /* Tail */
- obj = CDR(objp);
- if (is_list(obj))
- goto L_iter_list; /* on tail */
- else if (is_binary(obj) && binary_bitsize(obj) == 0) {
+ } else {
+ if (yield_support && --yield_count <= 0)
+ goto L_yield;
+ if (is_binary(obj) && binary_bitsize(obj) == 0) { /* Tail was binary */
SAFE_ADD(size, binary_size(obj));
} else if (is_not_nil(obj)) {
goto L_type_error;
}
- } else if (is_binary(obj) && binary_bitsize(obj) == 0) { /* Tail was binary */
- SAFE_ADD(size, binary_size(obj));
- } else if (is_not_nil(obj)) {
- goto L_type_error;
}
}
#undef SAFE_ADD
- DESTROY_ESTACK(s);
*sizep = (ErlDrvSizeT) size;
- return ERTS_IOLIST_OK;
- L_overflow_error:
+ res = ERTS_IOLIST_OK;
+
+ L_return:
+
DESTROY_ESTACK(s);
- return ERTS_IOLIST_OVERFLOW;
+
+ if (yield_support) {
+ int yc, reds;
+ CLEAR_SAVED_ESTACK(&state->estack);
+ yc = init_yield_count - yield_count;
+ reds = ((yc - 1) / ERTS_IOLIST_SIZE_YIELDS_COUNT_PER_RED) + 1;
+ BUMP_REDS(state->c_p, reds);
+ state->reds_left -= reds;
+ state->size = (ErlDrvSizeT) size;
+ state->have_size = 1;
+ }
+
+ return res;
+
+ L_overflow_error:
+ res = ERTS_IOLIST_OVERFLOW;
+ size = 0;
+ goto L_return;
L_type_error:
- DESTROY_ESTACK(s);
- return ERTS_IOLIST_TYPE;
+ res = ERTS_IOLIST_TYPE;
+ size = 0;
+ goto L_return;
+
+ L_yield:
+ BUMP_ALL_REDS(state->c_p);
+ state->reds_left = 0;
+ state->size = size;
+ state->obj = obj;
+ ESTACK_SAVE(s, &state->estack);
+ return ERTS_IOLIST_YIELD;
}
-/* return 0 if item is not a non-empty flat list of bytes */
-int
+int erts_iolist_size_yielding(ErtsIOListState *state)
+{
+ ErlDrvSizeT size = state->size;
+ return iolist_size(1, state, state->obj, &size);
+}
+
+int erts_iolist_size(Eterm obj, ErlDrvSizeT* sizep)
+{
+ *sizep = 0;
+ return iolist_size(0, NULL, obj, sizep);
+}
+
+/* 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);
@@ -3394,145 +4299,6 @@ is_string(Eterm list)
return 0;
}
-#ifdef ERTS_SMP
-
-/*
- * Process and Port timers in smp case
- */
-
-ERTS_SCHED_PREF_PRE_ALLOC_IMPL(ptimer_pre, ErtsSmpPTimer, 1000)
-
-#define ERTS_PTMR_FLGS_ALLCD_SIZE \
- 2
-#define ERTS_PTMR_FLGS_ALLCD_MASK \
- ((((Uint32) 1) << ERTS_PTMR_FLGS_ALLCD_SIZE) - 1)
-
-#define ERTS_PTMR_FLGS_PREALLCD ((Uint32) 1)
-#define ERTS_PTMR_FLGS_SLALLCD ((Uint32) 2)
-#define ERTS_PTMR_FLGS_LLALLCD ((Uint32) 3)
-#define ERTS_PTMR_FLG_CANCELLED (((Uint32) 1) << (ERTS_PTMR_FLGS_ALLCD_SIZE+0))
-
-static void
-init_ptimers(void)
-{
- init_ptimer_pre_alloc();
-}
-
-static ERTS_INLINE void
-free_ptimer(ErtsSmpPTimer *ptimer)
-{
- switch (ptimer->timer.flags & ERTS_PTMR_FLGS_ALLCD_MASK) {
- case ERTS_PTMR_FLGS_PREALLCD:
- (void) ptimer_pre_free(ptimer);
- break;
- case ERTS_PTMR_FLGS_SLALLCD:
- erts_free(ERTS_ALC_T_SL_PTIMER, (void *) ptimer);
- break;
- case ERTS_PTMR_FLGS_LLALLCD:
- erts_free(ERTS_ALC_T_LL_PTIMER, (void *) ptimer);
- break;
- default:
- erl_exit(ERTS_ABORT_EXIT,
- "Internal error: Bad ptimer alloc type\n");
- break;
- }
-}
-
-/* Callback for process timeout cancelled */
-static void
-ptimer_cancelled(ErtsSmpPTimer *ptimer)
-{
- free_ptimer(ptimer);
-}
-
-/* Callback for process timeout */
-static void
-ptimer_timeout(ErtsSmpPTimer *ptimer)
-{
- if (is_internal_pid(ptimer->timer.id)) {
- Process *p;
- p = erts_pid2proc_opt(NULL,
- 0,
- ptimer->timer.id,
- ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS,
- ERTS_P2P_FLG_ALLOW_OTHER_X);
- if (p) {
- if (!ERTS_PROC_IS_EXITING(p)
- && !(ptimer->timer.flags & ERTS_PTMR_FLG_CANCELLED)) {
- ASSERT(*ptimer->timer.timer_ref == ptimer);
- *ptimer->timer.timer_ref = NULL;
- (*ptimer->timer.timeout_func)(p);
- }
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS);
- }
- }
- else {
- Port *p;
- ASSERT(is_internal_port(ptimer->timer.id));
- p = erts_id2port_sflgs(ptimer->timer.id,
- NULL,
- 0,
- ERTS_PORT_SFLGS_DEAD);
- if (p) {
- if (!(ptimer->timer.flags & ERTS_PTMR_FLG_CANCELLED)) {
- ASSERT(*ptimer->timer.timer_ref == ptimer);
- *ptimer->timer.timer_ref = NULL;
- (*ptimer->timer.timeout_func)(p);
- }
- erts_port_release(p);
- }
- }
- free_ptimer(ptimer);
-}
-
-void
-erts_create_smp_ptimer(ErtsSmpPTimer **timer_ref,
- Eterm id,
- ErlTimeoutProc timeout_func,
- Uint timeout)
-{
- ErtsSmpPTimer *res = ptimer_pre_alloc();
- if (res)
- res->timer.flags = ERTS_PTMR_FLGS_PREALLCD;
- else {
- if (timeout < ERTS_ALC_MIN_LONG_LIVED_TIME) {
- res = erts_alloc(ERTS_ALC_T_SL_PTIMER, sizeof(ErtsSmpPTimer));
- res->timer.flags = ERTS_PTMR_FLGS_SLALLCD;
- }
- else {
- res = erts_alloc(ERTS_ALC_T_LL_PTIMER, sizeof(ErtsSmpPTimer));
- res->timer.flags = ERTS_PTMR_FLGS_LLALLCD;
- }
- }
- res->timer.timeout_func = timeout_func;
- res->timer.timer_ref = timer_ref;
- res->timer.id = id;
- res->timer.tm.active = 0; /* MUST be initalized */
-
- ASSERT(!*timer_ref);
-
- *timer_ref = res;
-
- erts_set_timer(&res->timer.tm,
- (ErlTimeoutProc) ptimer_timeout,
- (ErlCancelProc) ptimer_cancelled,
- (void*) res,
- timeout);
-}
-
-void
-erts_cancel_smp_ptimer(ErtsSmpPTimer *ptimer)
-{
- if (ptimer) {
- ASSERT(*ptimer->timer.timer_ref == ptimer);
- *ptimer->timer.timer_ref = NULL;
- ptimer->timer.flags |= ERTS_PTMR_FLG_CANCELLED;
- erts_cancel_timer(&ptimer->timer.tm);
- }
-}
-
-#endif
-
static int trim_threshold;
static int top_pad;
static int mmap_threshold;
@@ -3542,9 +4308,7 @@ Uint tot_bin_allocated;
void erts_init_utils(void)
{
-#ifdef ERTS_SMP
- init_ptimers();
-#endif
+
}
void erts_init_utils_mem(void)
@@ -3680,6 +4444,9 @@ erts_save_emu_args(int argc, char **argv)
size += sz+1;
}
ptr = (char *) malloc(size);
+ if (!ptr) {
+ ERTS_INTERNAL_ERROR("malloc failed to allocate memory!");
+ }
#ifdef DEBUG
end_ptr = ptr + size;
#endif
@@ -3944,19 +4711,7 @@ void erts_silence_warn_unused_result(long unused)
void
erts_interval_init(erts_interval_t *icp)
{
-#ifdef ARCH_64
- erts_atomic_init_nob(&icp->counter.atomic, 0);
-#else
- erts_dw_aint_t dw;
-#ifdef ETHR_SU_DW_NAINT_T__
- dw.dw_sint = 0;
-#else
- dw.sint[ERTS_DW_AINT_HIGH_WORD] = 0;
- dw.sint[ERTS_DW_AINT_LOW_WORD] = 0;
-#endif
- erts_dw_atomic_init_nob(&icp->counter.atomic, &dw);
-
-#endif
+ erts_atomic64_init_nob(&icp->counter.atomic, 0);
#ifdef DEBUG
icp->smp_api = 0;
#endif
@@ -3978,55 +4733,13 @@ erts_smp_interval_init(erts_interval_t *icp)
static ERTS_INLINE Uint64
step_interval_nob(erts_interval_t *icp)
{
-#ifdef ARCH_64
- return (Uint64) erts_atomic_inc_read_nob(&icp->counter.atomic);
-#else
- erts_dw_aint_t exp;
-
- erts_dw_atomic_read_nob(&icp->counter.atomic, &exp);
- while (1) {
- erts_dw_aint_t new = exp;
-
-#ifdef ETHR_SU_DW_NAINT_T__
- new.dw_sint++;
-#else
- new.sint[ERTS_DW_AINT_LOW_WORD]++;
- if (new.sint[ERTS_DW_AINT_LOW_WORD] == 0)
- new.sint[ERTS_DW_AINT_HIGH_WORD]++;
-#endif
-
- if (erts_dw_atomic_cmpxchg_nob(&icp->counter.atomic, &new, &exp))
- return erts_interval_dw_aint_to_val__(&new);
-
- }
-#endif
+ return (Uint64) erts_atomic64_inc_read_nob(&icp->counter.atomic);
}
static ERTS_INLINE Uint64
step_interval_relb(erts_interval_t *icp)
{
-#ifdef ARCH_64
- return (Uint64) erts_atomic_inc_read_relb(&icp->counter.atomic);
-#else
- erts_dw_aint_t exp;
-
- erts_dw_atomic_read_nob(&icp->counter.atomic, &exp);
- while (1) {
- erts_dw_aint_t new = exp;
-
-#ifdef ETHR_SU_DW_NAINT_T__
- new.dw_sint++;
-#else
- new.sint[ERTS_DW_AINT_LOW_WORD]++;
- if (new.sint[ERTS_DW_AINT_LOW_WORD] == 0)
- new.sint[ERTS_DW_AINT_HIGH_WORD]++;
-#endif
-
- if (erts_dw_atomic_cmpxchg_relb(&icp->counter.atomic, &new, &exp))
- return erts_interval_dw_aint_to_val__(&new);
-
- }
-#endif
+ return (Uint64) erts_atomic64_inc_read_relb(&icp->counter.atomic);
}
@@ -4034,38 +4747,10 @@ static ERTS_INLINE Uint64
ensure_later_interval_nob(erts_interval_t *icp, Uint64 ic)
{
Uint64 curr_ic;
-#ifdef ARCH_64
- curr_ic = (Uint64) erts_atomic_read_nob(&icp->counter.atomic);
- if (curr_ic > ic)
- return curr_ic;
- return (Uint64) erts_atomic_inc_read_nob(&icp->counter.atomic);
-#else
- erts_dw_aint_t exp;
-
- erts_dw_atomic_read_nob(&icp->counter.atomic, &exp);
- curr_ic = erts_interval_dw_aint_to_val__(&exp);
+ curr_ic = (Uint64) erts_atomic64_read_nob(&icp->counter.atomic);
if (curr_ic > ic)
return curr_ic;
-
- while (1) {
- erts_dw_aint_t new = exp;
-
-#ifdef ETHR_SU_DW_NAINT_T__
- new.dw_sint++;
-#else
- new.sint[ERTS_DW_AINT_LOW_WORD]++;
- if (new.sint[ERTS_DW_AINT_LOW_WORD] == 0)
- new.sint[ERTS_DW_AINT_HIGH_WORD]++;
-#endif
-
- if (erts_dw_atomic_cmpxchg_nob(&icp->counter.atomic, &new, &exp))
- return erts_interval_dw_aint_to_val__(&new);
-
- curr_ic = erts_interval_dw_aint_to_val__(&exp);
- if (curr_ic > ic)
- return curr_ic;
- }
-#endif
+ return (Uint64) erts_atomic64_inc_read_nob(&icp->counter.atomic);
}
@@ -4073,38 +4758,10 @@ static ERTS_INLINE Uint64
ensure_later_interval_acqb(erts_interval_t *icp, Uint64 ic)
{
Uint64 curr_ic;
-#ifdef ARCH_64
- curr_ic = (Uint64) erts_atomic_read_acqb(&icp->counter.atomic);
- if (curr_ic > ic)
- return curr_ic;
- return (Uint64) erts_atomic_inc_read_acqb(&icp->counter.atomic);
-#else
- erts_dw_aint_t exp;
-
- erts_dw_atomic_read_acqb(&icp->counter.atomic, &exp);
- curr_ic = erts_interval_dw_aint_to_val__(&exp);
+ curr_ic = (Uint64) erts_atomic64_read_acqb(&icp->counter.atomic);
if (curr_ic > ic)
return curr_ic;
-
- while (1) {
- erts_dw_aint_t new = exp;
-
-#ifdef ETHR_SU_DW_NAINT_T__
- new.dw_sint++;
-#else
- new.sint[ERTS_DW_AINT_LOW_WORD]++;
- if (new.sint[ERTS_DW_AINT_LOW_WORD] == 0)
- new.sint[ERTS_DW_AINT_HIGH_WORD]++;
-#endif
-
- if (erts_dw_atomic_cmpxchg_acqb(&icp->counter.atomic, &new, &exp))
- return erts_interval_dw_aint_to_val__(&new);
-
- curr_ic = erts_interval_dw_aint_to_val__(&exp);
- if (curr_ic > ic)
- return curr_ic;
- }
-#endif
+ return (Uint64) erts_atomic64_inc_read_acqb(&icp->counter.atomic);
}
Uint64
@@ -4191,8 +4848,8 @@ erts_smp_ensure_later_interval_acqb(erts_interval_t *icp, Uint64 ic)
*/
Uint64 erts_timestamp_millis(void)
{
-#ifdef HAVE_GETHRTIME
- return (Uint64) (sys_gethrtime() / 1000000);
+#ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT
+ return ERTS_MONOTONIC_TO_MSEC(erts_os_monotonic_time());
#else
Uint64 res;
SysTimeval tv;
@@ -4203,6 +4860,53 @@ Uint64 erts_timestamp_millis(void)
#endif
}
+void *
+erts_calc_stacklimit(char *prev_c, UWord stacksize)
+{
+ /*
+ * We *don't* want this function inlined, i.e., it is
+ * risky to call this function from another function
+ * in utils.c
+ */
+
+ UWord pagesize = erts_sys_get_page_size();
+ char c;
+ char *start;
+ if (&c > prev_c) {
+ start = (char *) ((((UWord) prev_c) / pagesize) * pagesize);
+ return (void *) (start + stacksize);
+ }
+ else {
+ start = (char *) (((((UWord) prev_c) - 1) / pagesize + 1) * pagesize);
+ return (void *) (start - stacksize);
+ }
+}
+
+/*
+ * erts_check_below_limit() and
+ * erts_check_above_limit() are put
+ * in utils.c in order to prevent
+ * inlining.
+ */
+
+int
+erts_check_below_limit(char *ptr, char *limit)
+{
+ return ptr < limit;
+}
+
+int
+erts_check_above_limit(char *ptr, char *limit)
+{
+ return ptr > limit;
+}
+
+void *
+erts_ptr_id(void *ptr)
+{
+ return ptr;
+}
+
#ifdef DEBUG
/*
* Handy functions when using a debugger - don't use in the code!
@@ -4232,7 +4936,7 @@ Process *p;
if(p)
print_process_info(ERTS_PRINT_STDERR, NULL, p);
}
-
+
void ppi(Eterm pid)
{
pp(erts_proc_lookup(pid));
@@ -4258,5 +4962,3 @@ ps(Process* p, Eterm* stop)
}
}
#endif
-
-
diff --git a/erts/emulator/beam/version.h b/erts/emulator/beam/version.h
index 3952c751b7..0fa775fe8c 100644
--- a/erts/emulator/beam/version.h
+++ b/erts/emulator/beam/version.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2009. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2016. 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.
+ * 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%
*/
diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c
index b62e9a0306..3a7b3bb50c 100644
--- a/erts/emulator/drivers/common/efile_drv.c
+++ b/erts/emulator/drivers/common/efile_drv.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -100,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
@@ -124,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 */
@@ -264,23 +257,6 @@ dt_private *get_dt_private(int);
-#define GET_TIME(i, b) \
- (i).year = get_int32((b) + 0 * 4); \
- (i).month = get_int32((b) + 1 * 4); \
- (i).day = get_int32((b) + 2 * 4); \
- (i).hour = get_int32((b) + 3 * 4); \
- (i).minute = get_int32((b) + 4 * 4); \
- (i).second = get_int32((b) + 5 * 4)
-
-#define PUT_TIME(i, b) \
- put_int32((i).year, (b) + 0 * 4); \
- put_int32((i).month, (b) + 1 * 4); \
- put_int32((i).day, (b) + 2 * 4); \
- put_int32((i).hour, (b) + 3 * 4); \
- put_int32((i).minute,(b) + 4 * 4); \
- put_int32((i).second,(b) + 5 * 4)
-
-
#if ALWAYS_READ_LINE_AHEAD
#define DEFAULT_LINEBUF_SIZE 2048
#else
@@ -531,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.
*/
@@ -777,7 +742,8 @@ file_init(void)
efile_init();
#ifdef USE_VM_PROBES
- erts_mtx_init(&dt_driver_mutex, "efile_drv dtrace mutex");
+ erts_mtx_init(&dt_driver_mutex, "efile_drv dtrace mutex", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_IO);
pthread_key_create(&dt_driver_key, NULL);
#endif /* USE_VM_PROBES */
@@ -911,7 +877,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);
@@ -980,7 +946,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);
@@ -1548,10 +1514,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;
@@ -1633,12 +1599,12 @@ static void invoke_altname(void *data)
}
static void invoke_pwritev(void *data) {
- struct t_data *d = (struct t_data *) data;
+ struct t_data* const d = (struct t_data *) data;
+ struct t_pwritev * const c = &d->c.pwritev;
SysIOVec *iov0;
SysIOVec *iov;
int iovlen;
int iovcnt;
- struct t_pwritev *c = &d->c.pwritev;
size_t p;
int segment;
size_t size, write_size, written;
@@ -1712,9 +1678,9 @@ static void invoke_pwritev(void *data) {
d->result_ok = 0;
d->again = 0;
deq_error:
- MUTEX_LOCK(d->c.writev.q_mtx);
- driver_deq(d->c.pwritev.port, c->size);
- MUTEX_UNLOCK(d->c.writev.q_mtx);
+ MUTEX_LOCK(c->q_mtx);
+ driver_deq(c->port, c->size);
+ MUTEX_UNLOCK(c->q_mtx);
goto done;
} else {
@@ -1725,9 +1691,9 @@ static void invoke_pwritev(void *data) {
ASSERT(written >= FILE_SEGMENT_WRITE);
}
- MUTEX_LOCK(d->c.writev.q_mtx);
- driver_deq(d->c.pwritev.port, written);
- MUTEX_UNLOCK(d->c.writev.q_mtx);
+ MUTEX_LOCK(c->q_mtx);
+ driver_deq(c->port, written);
+ MUTEX_UNLOCK(c->q_mtx);
done:
EF_FREE(iov); /* Free our copy of the vector, nothing to restore */
@@ -1955,6 +1921,8 @@ static void invoke_sendfile(void *data)
d->result_ok = 1;
if (d->c.sendfile.nbytes != 0)
d->c.sendfile.nbytes -= nbytes;
+ } else if (nbytes == 0 && d->c.sendfile.nbytes == 0) {
+ d->result_ok = 1;
} else
d->result_ok = 0;
} else {
@@ -1970,7 +1938,8 @@ static void free_sendfile(void *data) {
MUTEX_LOCK(d->c.sendfile.q_mtx);
driver_deq(d->c.sendfile.port,1);
MUTEX_UNLOCK(d->c.sendfile.q_mtx);
- driver_select(d->c.sendfile.port, (ErlDrvEvent)(long)d->c.sendfile.out_fd, ERL_DRV_USE_NO_CALLBACK|ERL_DRV_WRITE, 0);
+ driver_select(d->c.sendfile.port, (ErlDrvEvent)(long)d->c.sendfile.out_fd,
+ ERL_DRV_USE_NO_CALLBACK|ERL_DRV_WRITE, 0);
}
EF_FREE(data);
}
@@ -2363,9 +2332,9 @@ file_async_ready(ErlDrvData e, ErlDrvThreadData data)
free_read(data);
break;
case FILE_READ_LINE:
- /* The read_line stucture differs from the read structure.
- The data->read_offset and d->c.read_line.read_offset are copies, as are
- data->read_size and d->c.read_line.read_size
+ /* The read_line structure differs from the read structure.
+ The data->read_offset and d->c.read_line.read_offset are copies, as are
+ data->read_size and d->c.read_line.read_size
The read_line function does not kniow in advance how large the binary has to be,
why new allocation (but not reallocation of the old binary, for obvious reasons)
may happen in the worker thread. */
@@ -2588,14 +2557,13 @@ file_async_ready(ErlDrvData e, ErlDrvThreadData data)
desc->sendfile_state = sending;
desc->d = d;
driver_select(desc->port, (ErlDrvEvent)(long)d->c.sendfile.out_fd,
- ERL_DRV_USE_NO_CALLBACK|ERL_DRV_WRITE, 1);
+ ERL_DRV_USE|ERL_DRV_WRITE, 1);
}
break;
#endif
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,
@@ -2934,12 +2902,12 @@ file_output(ErlDrvData e, char* buf, ErlDrvSizeT count)
d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1
+ FILENAME_BYTELEN(buf + 9*4) + FILENAME_CHARSIZE);
- d->info.mode = get_int32(buf + 0 * 4);
- d->info.uid = get_int32(buf + 1 * 4);
- d->info.gid = get_int32(buf + 2 * 4);
- d->info.accessTime = (time_t)((Sint64)get_int64(buf + 3 * 4));
- d->info.modifyTime = (time_t)((Sint64)get_int64(buf + 5 * 4));
- d->info.cTime = (time_t)((Sint64)get_int64(buf + 7 * 4));
+ d->info.mode = get_int32(buf + 0 * 4);
+ d->info.uid = get_int32(buf + 1 * 4);
+ d->info.gid = get_int32(buf + 2 * 4);
+ d->info.accessTime = get_int64(buf + 3 * 4);
+ d->info.modifyTime = get_int64(buf + 5 * 4);
+ d->info.cTime = get_int64(buf + 7 * 4);
FILENAME_COPY(d->b, buf + 9*4);
#ifdef USE_VM_PROBES
diff --git a/erts/emulator/drivers/common/erl_efile.h b/erts/emulator/drivers/common/erl_efile.h
index 5a8e3bc5db..b7f063b4f2 100644
--- a/erts/emulator/drivers/common/erl_efile.h
+++ b/erts/emulator/drivers/common/erl_efile.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1997-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1997-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -104,9 +105,9 @@ typedef struct _Efile_info {
Uint32 inode; /* Inode number. */
Uint32 uid; /* User id of owner. */
Uint32 gid; /* Group id of owner. */
- time_t accessTime; /* Last time the file was accessed. */
- time_t modifyTime; /* Last time the file was modified. */
- time_t cTime; /* Creation time (Windows) or last
+ Sint64 accessTime; /* Last time the file was accessed. */
+ Sint64 modifyTime; /* Last time the file was modified. */
+ Sint64 cTime; /* Creation time (Windows) or last
* inode change (Unix).
*/
} Efile_info;
diff --git a/erts/emulator/drivers/common/gzio.c b/erts/emulator/drivers/common/gzio.c
index 1ef1602ec9..f60c781894 100644
--- a/erts/emulator/drivers/common/gzio.c
+++ b/erts/emulator/drivers/common/gzio.c
@@ -308,7 +308,7 @@ ErtsGzFile erts_gzopen (path, mode)
/* ===========================================================================
Read a byte from a gz_stream; update next_in and avail_in. Return EOF
for end of file.
- IN assertion: the stream s has been sucessfully opened for reading.
+ IN assertion: the stream s has been successfully opened for reading.
*/
local int get_byte(s)
gz_stream *s;
diff --git a/erts/emulator/drivers/common/gzio.h b/erts/emulator/drivers/common/gzio.h
index ea50d922ec..ee0ebe7bd8 100644
--- a/erts/emulator/drivers/common/gzio.h
+++ b/erts/emulator/drivers/common/gzio.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1999-2009. All Rights Reserved.
+ * Copyright Ericsson AB 1999-2016. 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.
+ * 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%
*/
diff --git a/erts/emulator/drivers/common/gzio_zutil.h b/erts/emulator/drivers/common/gzio_zutil.h
index 854205cc2c..b229ae4efd 100644
--- a/erts/emulator/drivers/common/gzio_zutil.h
+++ b/erts/emulator/drivers/common/gzio_zutil.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2009. All Rights Reserved.
+ * Copyright Ericsson AB 2009-2016. 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.
+ * 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%
*/
diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c
index 09bada457d..554c48059f 100644
--- a/erts/emulator/drivers/common/inet_drv.c
+++ b/erts/emulator/drivers/common/inet_drv.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1997-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1997-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -33,6 +34,7 @@
#include <stdio.h>
#include <stdlib.h>
+#include <stddef.h>
#include <ctype.h>
#include <sys/types.h>
#include <errno.h>
@@ -57,6 +59,9 @@
#ifdef HAVE_NETPACKET_PACKET_H
#include <netpacket/packet.h>
#endif
+#ifdef HAVE_SYS_UN_H
+#include <sys/un.h>
+#endif
/* All platforms fail on malloc errors. */
#define FATAL_MALLOC
@@ -93,10 +98,6 @@ typedef unsigned long long llu_t;
#define INT16_MAX (32767)
#endif
-#ifdef __OSE__
-#include "inet.h"
-#endif
-
#ifdef __WIN32__
#define STRNCASECMP strncasecmp
@@ -268,14 +269,13 @@ static BOOL (WINAPI *fpSetHandleInformation)(HANDLE,DWORD,DWORD);
#define sock_htonl(x) htonl((x))
#define sock_send(s,buf,len,flag) send((s),(buf),(len),(flag))
#define sock_sendv(s, vec, size, np, flag) \
- WSASend((s),(WSABUF*)(vec),\
- (size),(np),(flag),NULL,NULL)
+ WSASend((s),(WSABUF*)(vec),(size),(np),(flag),NULL,NULL)
#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))
+ recvfrom((s),(buf),(blen),(flag),(addr),(alen))
#define sock_sendto(s,buf,blen,flag,addr,alen) \
- sendto((s),(buf),(blen),(flag),(addr),(alen))
+ sendto((s),(buf),(blen),(flag),(addr),(alen))
#define sock_hostname(buf, len) gethostname((buf), (len))
#define sock_getservbyname(name,proto) getservbyname((name),(proto))
@@ -294,135 +294,11 @@ static BOOL (WINAPI *fpSetHandleInformation)(HANDLE,DWORD,DWORD);
static unsigned long zero_value = 0;
static unsigned long one_value = 1;
-#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 SD_SEND
+#define TCP_SHUT_RD SD_RECEIVE
+#define TCP_SHUT_RDWR SD_BOTH
-#else /* !__OSE__ && !__WIN32__ */
+#else /* !__WIN32__ */
#include <sys/time.h>
#ifdef NETDB_H_NEEDS_IN_H
@@ -692,13 +568,16 @@ static int my_strncasecmp(const char *s1, const char *s2, size_t n)
inet_driver_select((d)->port, (ErlDrvEvent)(long)(d)->event, (flags), (onoff)); \
} while(0)
+#define TCP_SHUT_WR SHUT_WR
+#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
#else
-# define SOCKLEN_T int
+# define SOCKLEN_T size_t
#endif
#include "packet_parser.h"
@@ -712,6 +591,18 @@ static int my_strncasecmp(const char *s1, const char *s2, size_t n)
(((unsigned char*) (s))[1] << 8) | \
(((unsigned char*) (s))[0]))
+#if defined(HAVE_SYS_UN_H) || defined(SO_BINDTODEVICE)
+
+/* strnlen doesn't exist everywhere */
+static size_t my_strnlen(const char *s, size_t maxlen)
+{
+ size_t i = 0;
+ while (i < maxlen && s[i] != '\0')
+ i++;
+ return i;
+}
+
+#endif
#ifdef VALGRIND
# include <valgrind/memcheck.h>
@@ -732,10 +623,13 @@ static int my_strncasecmp(const char *s1, const char *s2, size_t n)
*/
/* general address encode/decode tag */
+#define INET_AF_UNSPEC 0
#define INET_AF_INET 1
#define INET_AF_INET6 2
#define INET_AF_ANY 3 /* INADDR_ANY or IN6ADDR_ANY_INIT */
#define INET_AF_LOOPBACK 4 /* INADDR_LOOPBACK or IN6ADDR_LOOPBACK_INIT */
+#define INET_AF_LOCAL 5
+#define INET_AF_UNDEFINED 6 /* Unknown */
/* open and INET_REQ_GETTYPE enumeration */
#define INET_TYPE_STREAM 1
@@ -758,7 +652,7 @@ static int my_strncasecmp(const char *s1, const char *s2, size_t n)
/* INET_REQ_GETSTATUS enumeration */
#define INET_F_OPEN 0x0001
-#define INET_F_BOUND 0x0002
+/* INET_F_BOUND removed - renumber when there comes a bigger rewrite */
#define INET_F_ACTIVE 0x0004
#define INET_F_LISTEN 0x0008
#define INET_F_CON 0x0010
@@ -821,6 +715,14 @@ static int my_strncasecmp(const char *s1, const char *s2, size_t n)
#define TCP_ADDF_CLOSE_SENT 2 /* Close sent (active mode only) */
#define TCP_ADDF_DELAYED_CLOSE_RECV 4 /* If receive fails, report {error,closed} (passive mode) */
#define TCP_ADDF_DELAYED_CLOSE_SEND 8 /* If send fails, report {error,closed} (passive mode) */
+#define TCP_ADDF_PENDING_SHUT_WR 16 /* Call shutdown(sock, SHUT_WR) when queue empties */
+#define TCP_ADDF_PENDING_SHUT_RDWR 32 /* Call shutdown(sock, SHUT_RDWR) when queue empties */
+#define TCP_ADDF_PENDING_SHUTDOWN \
+ (TCP_ADDF_PENDING_SHUT_WR | TCP_ADDF_PENDING_SHUT_RDWR)
+#define TCP_ADDF_SHOW_ECONNRESET 64 /* Tell user about incoming RST */
+#define TCP_ADDF_DELAYED_ECONNRESET 128 /* An ECONNRESET error occurred on send or shutdown */
+#define TCP_ADDF_SHUTDOWN_WR_DONE 256 /* A shutdown(sock, SHUT_WR) or SHUT_RDWR was made */
+#define TCP_ADDF_LINGER_ZERO 512 /* Discard driver queue on port close */
/* *_REQ_* replies */
#define INET_REP_ERROR 0
@@ -865,6 +767,10 @@ static int my_strncasecmp(const char *s1, const char *s2, size_t n)
#define INET_LOPT_MSGQ_HIWTRMRK 36 /* set local msgq high watermark */
#define INET_LOPT_MSGQ_LOWTRMRK 37 /* set local msgq low watermark */
#define INET_LOPT_NETNS 38 /* Network namespace pathname */
+#define INET_LOPT_TCP_SHOW_ECONNRESET 39 /* tell user about incoming RST */
+#define INET_LOPT_LINE_DELIM 40 /* Line delimiting char */
+#define INET_OPT_TCLASS 41 /* IPv6 transport class */
+#define INET_OPT_BIND_TO_DEVICE 42 /* get/set network device the socket is bound to */
/* SCTP options: a separate range, from 100: */
#define SCTP_OPT_RTOINFO 100
#define SCTP_OPT_ASSOCINFO 101
@@ -946,19 +852,15 @@ static int my_strncasecmp(const char *s1, const char *s2, size_t n)
#define INET_STATE_CLOSED (0)
#define INET_STATE_OPEN (INET_F_OPEN)
-#define INET_STATE_BOUND (INET_STATE_OPEN | INET_F_BOUND)
-#define INET_STATE_CONNECTED (INET_STATE_BOUND | INET_F_ACTIVE)
-#define INET_STATE_LISTENING (INET_STATE_BOUND | INET_F_LISTEN)
-#define INET_STATE_CONNECTING (INET_STATE_BOUND | INET_F_CON)
+#define INET_STATE_CONNECTED (INET_STATE_OPEN | INET_F_ACTIVE)
+#define INET_STATE_LISTENING (INET_STATE_OPEN | INET_F_LISTEN)
+#define INET_STATE_CONNECTING (INET_STATE_OPEN | INET_F_CON)
#define INET_STATE_ACCEPTING (INET_STATE_LISTENING | INET_F_ACC)
#define INET_STATE_MULTI_ACCEPTING (INET_STATE_ACCEPTING | INET_F_MULTI_CLIENT)
#define IS_OPEN(d) \
(((d)->state & INET_F_OPEN) == INET_F_OPEN)
-#define IS_BOUND(d) \
- (((d)->state & INET_F_BOUND) == INET_F_BOUND)
-
#define IS_CONNECTED(d) \
(((d)->state & INET_STATE_CONNECTED) == INET_STATE_CONNECTED)
@@ -1011,23 +913,39 @@ typedef union {
#ifdef HAVE_IN6
struct sockaddr_in6 sai6;
#endif
+#ifdef HAVE_SYS_UN_H
+ struct sockaddr_un sal;
+#endif
} inet_address;
-/* for AF_INET & AF_INET6 */
-#define inet_address_port(x) ((x)->sai.sin_port)
+#define inet_address_port(x) \
+ ((((x)->sai.sin_family == AF_INET) || \
+ ((x)->sai.sin_family == AF_INET6)) ? \
+ ((x)->sai.sin_port) : -1)
+
+#ifdef HAVE_SYS_UN_H
+#define localaddrlen(data) \
+ ((((unsigned char*)(data))[0] == INET_AF_LOCAL) ? \
+ (1 + 1 + ((unsigned char*)(data))[1]) : 1)
+#else
+#define localaddrlen(data) (1)
+#endif
#if defined(HAVE_IN6) && defined(AF_INET6)
-#define addrlen(family) \
- ((family == AF_INET) ? sizeof(struct in_addr) : \
- ((family == AF_INET6) ? sizeof(struct in6_addr) : 0))
+#define addrlen(data) \
+ ((((unsigned char*)(data))[0] == INET_AF_INET) ? \
+ (1 + 2 + 4) : \
+ ((((unsigned char*)(data))[0] == INET_AF_INET6) ? \
+ (1 + 2 + 16) : localaddrlen(data)))
#else
-#define addrlen(family) \
- ((family == AF_INET) ? sizeof(struct in_addr) : 0)
+#define addrlen(data) \
+ ((((unsigned char*)(data))[0] == INET_AF_INET) ? \
+ (1 + 2 + 4) : localaddrlen(data))
#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;
@@ -1114,8 +1032,10 @@ typedef struct {
inet_address peer_addr; /* fake peer address */
inet_address name_addr; /* fake local address */
- inet_address* peer_ptr; /* fake peername or NULL */
- inet_address* name_ptr; /* fake sockname or NULL */
+ inet_address* peer_ptr; /* fake peername or NULL */
+ inet_address* name_ptr; /* fake sockname or NULL */
+ SOCKLEN_T peer_addr_len; /* fake peername size */
+ SOCKLEN_T name_addr_len; /* fake sockname size */
int bufsz; /* minimum buffer constraint */
unsigned int hsz; /* the list header size, -1 is large !!! */
@@ -1134,6 +1054,7 @@ typedef struct {
#else
Uint32 send_oct[2]; /* number of octets sent, 64 bits */
#endif
+ char delimiter; /* Line delimiting character (def: '\n') */
unsigned long send_cnt; /* number of packets sent */
unsigned long send_max; /* maximum packet send */
double send_avg; /* average packet size sent */
@@ -1146,13 +1067,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;
@@ -1168,86 +1082,20 @@ 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);
static void tcp_inet_timeout(ErlDrvData);
static void tcp_inet_process_exit(ErlDrvData, ErlDrvMonitor *);
static void inet_stop_select(ErlDrvEvent, void*);
+static void inet_emergency_close(ErlDrvData);
#ifdef __WIN32__
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 !! */
@@ -1257,9 +1105,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,
@@ -1267,17 +1112,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,
@@ -1288,7 +1125,8 @@ static struct erl_drv_entry tcp_inet_driver_entry =
ERL_DRV_FLAG_USE_PORT_LOCKING|ERL_DRV_FLAG_SOFT_BUSY,
NULL,
tcp_inet_process_exit,
- inet_stop_select
+ inet_stop_select,
+ inet_emergency_close
};
@@ -1341,7 +1179,8 @@ static struct erl_drv_entry udp_inet_driver_entry =
ERL_DRV_FLAG_USE_PORT_LOCKING,
NULL,
NULL,
- inet_stop_select
+ inet_stop_select,
+ inet_emergency_close
};
#endif
@@ -1375,7 +1214,8 @@ static struct erl_drv_entry sctp_inet_driver_entry =
ERL_DRV_FLAG_USE_PORT_LOCKING,
NULL,
NULL, /* process_exit */
- inet_stop_select
+ inet_stop_select,
+ inet_emergency_close
};
#endif
@@ -1404,9 +1244,13 @@ static int tcp_sendv(tcp_descriptor* desc, ErlIOVec* ev);
static int tcp_recv(tcp_descriptor* desc, int request_len);
static int tcp_deliver(tcp_descriptor* desc, int len);
+static int tcp_shutdown_error(tcp_descriptor* desc, int err);
+
static int tcp_inet_output(tcp_descriptor* desc, HANDLE event);
static int tcp_inet_input(tcp_descriptor* desc, HANDLE event);
+static void tcp_desc_close(tcp_descriptor*);
+
#ifdef HAVE_UDP
typedef struct {
inet_descriptor inet; /* common data structure (DON'T MOVE) */
@@ -1421,17 +1265,9 @@ static int packet_inet_input(udp_descriptor* udesc, HANDLE event);
static int packet_inet_output(udp_descriptor* udesc, HANDLE event);
#endif
-/* convert descriptor poiner to inet_descriptor pointer */
+/* 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)
@@ -1447,6 +1283,8 @@ static int async_ref = 0; /* async reference id generator */
} while (0)
static ErlDrvTermData am_ok;
+static ErlDrvTermData am_undefined;
+static ErlDrvTermData am_unspec;
static ErlDrvTermData am_tcp;
static ErlDrvTermData am_error;
static ErlDrvTermData am_einval;
@@ -1464,6 +1302,9 @@ static ErlDrvTermData am_udp;
static ErlDrvTermData am_udp_passive;
static ErlDrvTermData am_udp_error;
#endif
+#ifdef HAVE_SYS_UN_H
+static ErlDrvTermData am_local;
+#endif
#ifdef HAVE_SCTP
static ErlDrvTermData am_sctp;
static ErlDrvTermData am_sctp_passive;
@@ -1485,11 +1326,16 @@ static ErlDrvTermData am_reuseaddr;
static ErlDrvTermData am_dontroute;
static ErlDrvTermData am_priority;
static ErlDrvTermData am_tos;
+static ErlDrvTermData am_tclass;
static ErlDrvTermData am_ipv6_v6only;
static ErlDrvTermData am_netns;
+static ErlDrvTermData am_bind_to_device;
#endif
-/* speical errors for bad ports and sequences */
+static char str_eafnosupport[] = "eafnosupport";
+static char str_einval[] = "einval";
+
+/* special errors for bad ports and sequences */
#define EXBADPORT "exbadport"
#define EXBADSEQ "exbadseq"
@@ -1546,7 +1392,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,
@@ -1559,7 +1405,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)
@@ -1567,7 +1413,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)
@@ -1672,40 +1518,67 @@ static void *realloc_wrapper(void *current, ErlDrvSizeT size){
#endif
#ifdef HAVE_UDP
-static int load_ip_port(ErlDrvTermData* spec, int i, char* buf)
-{
- spec[i++] = ERL_DRV_INT;
- spec[i++] = (ErlDrvTermData) get_int16(buf);
- return i;
-}
-
-static int load_ip_address(ErlDrvTermData* spec, int i, int family, char* buf)
+static int load_address(ErlDrvTermData* spec, int i, char* buf)
{
int n;
- if (family == AF_INET) {
- for (n = 0; n < 4; n++) {
+ switch (*buf++) { /* Family */
+ case INET_AF_INET: {
+ for (n = 2; n < 2+4; n++) {
spec[i++] = ERL_DRV_INT;
spec[i++] = (ErlDrvTermData) ((unsigned char)buf[n]);
}
spec[i++] = ERL_DRV_TUPLE;
spec[i++] = 4;
+ spec[i++] = ERL_DRV_INT;
+ spec[i++] = (ErlDrvTermData) get_int16(buf);
+ break;
}
#if defined(HAVE_IN6) && defined(AF_INET6)
- else if (family == AF_INET6) {
- for (n = 0; n < 16; n += 2) {
+ case INET_AF_INET6: {
+ for (n = 2; n < 2+16; n += 2) {
spec[i++] = ERL_DRV_INT;
spec[i++] = (ErlDrvTermData) get_int16(buf+n);
}
spec[i++] = ERL_DRV_TUPLE;
spec[i++] = 8;
+ spec[i++] = ERL_DRV_INT;
+ spec[i++] = (ErlDrvTermData) get_int16(buf);
+ break;
}
#endif
- else {
+#ifdef HAVE_SYS_UN_H
+ case INET_AF_LOCAL: {
+ int len = *(unsigned char*)buf++;
+ i = LOAD_ATOM(spec, i, am_local);
+ i = LOAD_BUF2BINARY(spec, i, buf, len);
spec[i++] = ERL_DRV_TUPLE;
+ spec[i++] = 2;
+ spec[i++] = ERL_DRV_INT;
spec[i++] = 0;
+ break;
+ }
+#endif
+ case INET_AF_UNSPEC: {
+ i = LOAD_ATOM(spec, i, am_unspec);
+ i = LOAD_BUF2BINARY(spec, i, buf, 0);
+ spec[i++] = ERL_DRV_TUPLE;
+ spec[i++] = 2;
+ spec[i++] = ERL_DRV_INT;
+ spec[i++] = 0;
+ break;
+ }
+ default: { /* INET_AF_UNDEFINED */
+ i = LOAD_ATOM(spec, i, am_undefined);
+ i = LOAD_BUF2BINARY(spec, i, buf, 0);
+ spec[i++] = ERL_DRV_TUPLE;
+ spec[i++] = 2;
+ spec[i++] = ERL_DRV_INT;
+ spec[i++] = 0;
+ break;
+ }
}
return i;
-}
+ }
#endif
@@ -1713,10 +1586,13 @@ static int load_ip_address(ErlDrvTermData* spec, int i, int family, char* buf)
/* For SCTP, we often need to return {IP, Port} tuples: */
static int inet_get_address(char* dst, inet_address* src, unsigned int* len);
-#define LOAD_IP_AND_PORT_CNT \
+/* Max of {{int()*8},int()} | {{int()*4},int()} |
+ * {{'local',binary()},int()}
+ */
+#define LOAD_INET_GET_ADDRESS_CNT \
(8*LOAD_INT_CNT + LOAD_TUPLE_CNT + LOAD_INT_CNT + LOAD_TUPLE_CNT)
-static int load_ip_and_port
+static int load_inet_get_address
(ErlDrvTermData* spec, int i, inet_descriptor* desc,
struct sockaddr_storage* addr)
{
@@ -1734,8 +1610,7 @@ static int load_ip_and_port
/* NB: the following functions are safe to use, as they create tuples
of copied Ints on the "spec", and do not install any String pts --
a ptr to "abuf" would be dangling upon exiting this function: */
- i = load_ip_address(spec, i, desc->sfamily, abuf+3);
- i = load_ip_port (spec, i, abuf+1);
+ i = load_address(spec, i, abuf); /* IP,Port | Family,Addr */
i = LOAD_TUPLE (spec, i, 2);
return i;
}
@@ -1828,7 +1703,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 "
@@ -2324,13 +2199,16 @@ static int inet_reply_ok(inet_descriptor* desc)
ErlDrvTermData caller = desc->caller;
int i = 0;
+ desc->caller = 0;
+ if (is_not_internal_pid(caller))
+ return 0;
+
i = LOAD_ATOM(spec, i, am_inet_reply);
i = LOAD_PORT(spec, i, desc->dport);
i = LOAD_ATOM(spec, i, am_ok);
i = LOAD_TUPLE(spec, i, 3);
ASSERT(i == sizeof(spec)/sizeof(*spec));
- desc->caller = 0;
return erl_drv_send_term(desc->dport, caller, spec, i);
}
@@ -2427,7 +2305,6 @@ static ErlDrvTermData am_http_error;
static ErlDrvTermData am_abs_path;
static ErlDrvTermData am_absoluteURI;
static ErlDrvTermData am_star;
-static ErlDrvTermData am_undefined;
static ErlDrvTermData am_http;
static ErlDrvTermData am_https;
static ErlDrvTermData am_scheme;
@@ -2723,7 +2600,7 @@ int ssl_tls_inetdrv(void* arg, unsigned type, unsigned major, unsigned minor,
{
tcp_descriptor* desc = (tcp_descriptor*) arg;
int i = 0;
- ErlDrvTermData spec[28];
+ ErlDrvTermData spec[30];
ErlDrvTermData caller = ERL_DRV_NIL;
ErlDrvBinary* bin;
int ret;
@@ -2764,11 +2641,11 @@ int ssl_tls_inetdrv(void* arg, unsigned type, unsigned major, unsigned minor,
if (desc->inet.active == INET_PASSIVE) {
i = LOAD_TUPLE(spec, i, 2);
i = LOAD_TUPLE(spec, i, 4);
- ASSERT(i <= 28);
+ ASSERT(i <= sizeof(spec)/sizeof(*spec));
ret = erl_drv_send_term(desc->inet.dport, caller, spec, i);
}
else {
- ASSERT(i <= 28);
+ ASSERT(i <= sizeof(spec)/sizeof(*spec));
ret = erl_drv_output_term(desc->inet.dport, spec, i);
}
done:
@@ -2890,6 +2767,9 @@ static ErlDrvTermData am_sctp_rtoinfo, /* Option names */
/* For #sctp_paddrinfo{}: */
am_active, am_inactive,
+# if HAVE_DECL_SCTP_UNCONFIRMED
+ am_unconfirmed,
+# endif
/* For #sctp_status{}: */
# if HAVE_DECL_SCTP_EMPTY
@@ -3115,7 +2995,7 @@ static int sctp_parse_async_event
ASSERT(sptr->spc_length <= sz); /* No buffer overrun */
i = LOAD_ATOM (spec, i, am_sctp_paddr_change);
- i = load_ip_and_port(spec, i, desc, &sptr->spc_aaddr);
+ i = load_inet_get_address(spec, i, desc, &sptr->spc_aaddr);
switch (sptr->spc_state)
{
@@ -3542,10 +3422,11 @@ static int tcp_error_message(tcp_descriptor* desc, int err)
#ifdef HAVE_UDP
/*
** active mode message:
-** {udp, S, IP, Port, [H1,...Hsz | Data]} or
-** {sctp, S, IP, Port, {[AncilData], Event_or_Data}}
+** {udp, S, IP, Port, [H1,...Hsz | Data]} or
+** {sctp, S, IP, Port, {[AncilData], Event_or_Data}}
** where
** [H1,...,HSz] are msg headers (without IP/Port, UDP only),
+** [AddrLen, H2,...,HSz] are msg headers for UDP AF_UNIX only
** Data : List() | Binary()
*/
static int packet_binary_message
@@ -3555,6 +3436,7 @@ static int packet_binary_message
ErlDrvTermData spec [PACKET_ERL_DRV_TERM_DATA_LEN];
int i = 0;
int alen;
+ char* data = bin->orig_bytes+offs;
DEBUGF(("packet_binary_message(%ld): len = %d\r\n",
(long)desc->port, len));
@@ -3564,13 +3446,12 @@ static int packet_binary_message
i = LOAD_ATOM(spec, i, am_udp ); /* UDP only */
# endif
i = LOAD_PORT(spec, i, desc->dport); /* S */
-
- alen = addrlen(desc->sfamily);
- i = load_ip_address(spec, i, desc->sfamily, bin->orig_bytes+offs+3);
- i = load_ip_port(spec, i, bin->orig_bytes+offs+1); /* IP, Port */
-
- offs += (alen + 3);
- len -= (alen + 3);
+
+ alen = addrlen(data);
+ i = load_address(spec, i, data); /* IP,Port | Family,Addr */
+
+ offs += alen;
+ len -= alen;
# ifdef HAVE_SCTP
if (!IS_SCTP(desc))
@@ -3840,8 +3721,10 @@ static void inet_init_sctp(void) {
INIT_ATOM(dontroute);
INIT_ATOM(priority);
INIT_ATOM(tos);
+ INIT_ATOM(tclass);
INIT_ATOM(ipv6_v6only);
INIT_ATOM(netns);
+ INIT_ATOM(bind_to_device);
/* Option names */
INIT_ATOM(sctp_rtoinfo);
@@ -3919,7 +3802,10 @@ static void inet_init_sctp(void) {
/* For #sctp_paddrinfo{}: */
INIT_ATOM(active);
INIT_ATOM(inactive);
-
+# if HAVE_DECL_SCTP_UNCONFIRMED
+ INIT_ATOM(unconfirmed);
+# endif
+
/* For #sctp_status{}: */
# if HAVE_DECL_SCTP_EMPTY
INIT_ATOM(empty);
@@ -3948,12 +3834,14 @@ static int inet_init()
if (0 != erl_drv_tsd_key_create("inet_buffer_stack_key", &buffer_stack_key))
goto error;
- ASSERT(sizeof(struct in_addr) == 4);
+ ERTS_CT_ASSERT(sizeof(struct in_addr) == 4);
# if defined(HAVE_IN6) && defined(AF_INET6)
- ASSERT(sizeof(struct in6_addr) == 16);
+ ERTS_CT_ASSERT(sizeof(struct in6_addr) == 16);
# endif
INIT_ATOM(ok);
+ INIT_ATOM(undefined);
+ INIT_ATOM(unspec);
INIT_ATOM(tcp);
#ifdef HAVE_UDP
INIT_ATOM(udp);
@@ -3971,6 +3859,9 @@ static int inet_init()
INIT_ATOM(udp_passive);
INIT_ATOM(udp_error);
#endif
+#ifdef HAVE_SYS_UN_H
+ INIT_ATOM(local);
+#endif
INIT_ATOM(empty_out_q);
INIT_ATOM(ssl_tls);
@@ -3982,7 +3873,6 @@ static int inet_init()
INIT_ATOM(abs_path);
INIT_ATOM(absoluteURI);
am_star = driver_mk_atom("*");
- INIT_ATOM(undefined);
INIT_ATOM(http);
INIT_ATOM(https);
INIT_ATOM(scheme);
@@ -3996,7 +3886,7 @@ static int inet_init()
#ifdef HAVE_SCTP
/* Check the size of SCTP AssocID -- currently both this driver and the
Erlang part require 32 bit: */
- ASSERT(sizeof(sctp_assoc_t)==ASSOC_ID_LEN);
+ ERTS_CT_ASSERT(sizeof(sctp_assoc_t)==ASSOC_ID_LEN);
# if defined(HAVE_SCTP_BINDX)
p_sctp_bindx = sctp_bindx;
# if defined(HAVE_SCTP_PEELOFF)
@@ -4078,63 +3968,106 @@ static int inet_init()
/*
-** Set a inaddr structure:
-** src = [P1,P0,X1,X2,.....]
+** Set an inaddr structure:
+** *src = [P1,P0,X1,X2,.....]
** dst points to a structure large enugh to keep any kind
** of inaddr.
** *len is set to length of src on call
** and is set to actual length of dst on return
-** return NULL on error and ptr after port address on success
+** return NULL if ok or ptr to errno string for error
*/
static char* inet_set_address(int family, inet_address* dst,
- char* src, ErlDrvSizeT* len)
+ char* *src, ErlDrvSizeT* len)
{
short port;
- if ((family == AF_INET) && (*len >= 2+4)) {
+ switch (family) {
+ case AF_INET: {
+ if (*len < 2+4) return str_einval;
sys_memzero((char*)dst, sizeof(struct sockaddr_in));
- port = get_int16(src);
+ port = get_int16(*src);
#ifndef NO_SA_LEN
dst->sai.sin_len = sizeof(struct sockaddr_in);
#endif
dst->sai.sin_family = family;
dst->sai.sin_port = sock_htons(port);
- sys_memcpy(&dst->sai.sin_addr, src+2, 4);
+ sys_memcpy(&dst->sai.sin_addr, (*src)+2, 4);
*len = sizeof(struct sockaddr_in);
- return src + 2+4;
+ *src += 2 + 4;
+ return NULL;
}
#if defined(HAVE_IN6) && defined(AF_INET6)
- else if ((family == AF_INET6) && (*len >= 2+16)) {
+ case AF_INET6: {
+ if (*len < 2+16) return str_einval;
sys_memzero((char*)dst, sizeof(struct sockaddr_in6));
- port = get_int16(src);
+ port = get_int16(*src);
#ifndef NO_SA_LEN
dst->sai6.sin6_len = sizeof(struct sockaddr_in6);
#endif
dst->sai6.sin6_family = family;
dst->sai6.sin6_port = sock_htons(port);
dst->sai6.sin6_flowinfo = 0; /* XXX this may be set as well ?? */
- sys_memcpy(&dst->sai6.sin6_addr, src+2, 16);
- *len = sizeof(struct sockaddr_in6);
- return src + 2+16;
+ sys_memcpy(&dst->sai6.sin6_addr, (*src)+2, 16);
+ *len = sizeof(struct sockaddr_in6);
+ *src += 2 + 16;
+ return NULL;
}
#endif
- return NULL;
+#ifdef HAVE_SYS_UN_H
+ case AF_UNIX: {
+ int n;
+ if (*len == 0) return str_einval;
+ n = *((unsigned char*)(*src)); /* Length field */
+ if (*len < 1+n) return str_einval;
+ if (n +
+#ifdef __linux__
+ /* Make sure the address gets zero terminated
+ * except when the first byte is \0 because then it is
+ * sort of zero terminated although the zero termination
+ * comes before the address...
+ * This fix handles Linux's nonportable
+ * abstract socket address extension.
+ */
+ ((*len) > 1 && (*src)[1] == '\0' ? 0 : 1)
+#else
+ 1
+#endif
+ > sizeof(dst->sal.sun_path)) {
+ return str_einval;
+ }
+ sys_memzero((char*)dst, sizeof(struct sockaddr_un));
+ dst->sal.sun_family = family;
+ sys_memcpy(dst->sal.sun_path, (*src)+1, n);
+ *len = offsetof(struct sockaddr_un, sun_path) + n;
+#ifndef NO_SA_LEN
+ dst->sal.sun_len = *len;
+#endif
+ *src += 1 + n;
+ return NULL;
+ }
+#endif
+ }
+ return str_eafnosupport;
}
/*
** Set an inaddr structure, address family comes from source data,
** or from argument if source data specifies constant address.
**
-** src = [TAG,P1,P0] when TAG = INET_AF_ANY | INET_AF_LOOPBACK
-** src = [TAG,P1,P0,X1,X2,...] when TAG = INET_AF_INET | INET_AF_INET6
+** *src = [TAG,P1,P0]
+** when TAG = INET_AF_ANY | INET_AF_LOOPBACK
+** *src = [TAG,P1,P0,X1,X2,...]
+** when TAG = INET_AF_INET | INET_AF_INET6 | INET_AF_LOCAL
+** *src = [TAG,Len,...]
+** when TAG = INET_AF_LOCAL
*/
static char *inet_set_faddress(int family, inet_address* dst,
- char *src, ErlDrvSizeT* len) {
+ char* *src, ErlDrvSizeT* len) {
int tag;
- if (*len < 1) return NULL;
+ if (*len < 1) return str_einval;
(*len) --;
- tag = *(src ++);
+ tag = *((*src) ++);
switch (tag) {
case INET_AF_INET:
family = AF_INET;
@@ -4144,12 +4077,18 @@ static char *inet_set_faddress(int family, inet_address* dst,
family = AF_INET6;
break;
# endif
+# ifdef HAVE_SYS_UN_H
+ case INET_AF_LOCAL: {
+ family = AF_UNIX;
+ break;
+ }
+# endif
case INET_AF_ANY:
case INET_AF_LOOPBACK: {
int port;
- if (*len < 2) return NULL;
- port = get_int16(src);
+ if (*len < 2) return str_einval;
+ port = get_int16(*src);
switch (family) {
case AF_INET: {
struct in_addr addr;
@@ -4161,7 +4100,7 @@ static char *inet_set_faddress(int family, inet_address* dst,
addr.s_addr = sock_htonl(INADDR_LOOPBACK);
break;
default:
- return NULL;
+ return str_einval;
}
sys_memzero((char*)dst, sizeof(struct sockaddr_in));
#ifndef NO_SA_LEN
@@ -4183,7 +4122,7 @@ static char *inet_set_faddress(int family, inet_address* dst,
paddr = &in6addr_loopback;
break;
default:
- return NULL;
+ return str_einval;
}
sys_memzero((char*)dst, sizeof(struct sockaddr_in6));
#ifndef NO_SA_LEN
@@ -4197,27 +4136,28 @@ static char *inet_set_faddress(int family, inet_address* dst,
} break;
# endif
default:
- return NULL;
+ return str_einval;
}
- return src + 2;
+ *src += 2;
+ return NULL;
} break;
default:
- return NULL;
+ return str_eafnosupport;
}
return inet_set_address(family, dst, src, len);
}
-
/* Get a inaddr structure
** src = inaddr structure
-** *len is the lenght of structure
** dst is filled with [F,P1,P0,X1,....]
+** *len is the length of structure
** where F is the family code (coded)
** and *len is the length of dst on return
** (suitable to deliver to erlang)
*/
static int inet_get_address(char* dst, inet_address* src, unsigned int* len)
{
+ /* Compare the code with inet_address_to_erlang() */
int family;
short port;
@@ -4240,6 +4180,37 @@ static int inet_get_address(char* dst, inet_address* src, unsigned int* len)
return 0;
}
#endif
+#ifdef HAVE_SYS_UN_H
+ else if (family == AF_UNIX) {
+ size_t n, m;
+ if (*len < offsetof(struct sockaddr_un, sun_path)) return -1;
+ n = *len - offsetof(struct sockaddr_un, sun_path);
+ if (255 < n) return -1;
+ m = my_strnlen(src->sal.sun_path, n);
+#ifdef __linux__
+ /* Assume that the address is a zero terminated string,
+ * except when the first byte is \0 i.e the string length is 0,
+ * then use the reported length instead.
+ * This fix handles Linux's nonportable
+ * abstract socket address extension.
+ */
+ if (m == 0) m = n;
+#endif
+ dst[0] = INET_AF_LOCAL;
+ dst[1] = (char) ((unsigned char) m);
+ sys_memcpy(dst+2, src->sal.sun_path, m);
+ *len = 1 + 1 + m;
+ return 0;
+ }
+#endif
+ else if (family == AF_UNSPEC) {
+ dst[0] = INET_AF_UNSPEC;
+ *len = 1;
+ }
+ else {
+ dst[0] = INET_AF_UNDEFINED;
+ *len = 1;
+ }
return -1;
}
@@ -4248,7 +4219,9 @@ static int inet_get_address(char* dst, inet_address* src, unsigned int* len)
** according to the size of the current,
** and return the resulting encoded size
*/
-static int inet_address_to_erlang(char *dst, inet_address **src) {
+static int
+inet_address_to_erlang(char *dst, inet_address **src, SOCKLEN_T sz) {
+ /* Compare the code with inet_get_address() */
short port;
switch ((*src)->sa.sa_family) {
@@ -4273,6 +4246,31 @@ static int inet_address_to_erlang(char *dst, inet_address **src) {
(*src) = (inet_address *) (&(*src)->sai6 + 1);
return 1 + 2 + 16;
#endif
+#ifdef HAVE_SYS_UN_H
+ case AF_UNIX: {
+ size_t n, m;
+ if (sz < offsetof(struct sockaddr_un, sun_path)) return -1;
+ n = sz - offsetof(struct sockaddr_un, sun_path);
+ if (255 < n) return -1;
+ m = my_strnlen((*src)->sal.sun_path, n);
+#ifdef __linux__
+ /* Assume that the address is a zero terminated string,
+ * except when the first byte is \0 i.e the string length is 0,
+ * Then use the reported length instead.
+ * This fix handles Linux's nonportable
+ * abstract socket address extension.
+ */
+ if (m == 0) m = n;
+#endif
+ if (dst) {
+ dst[0] = INET_AF_LOCAL;
+ dst[1] = (char) ((unsigned char) m);
+ sys_memcpy(dst+2, (*src)->sal.sun_path, m);
+ }
+ (*src) = (inet_address *) (&(*src)->sal + 1);
+ return 1 + 1 + m;
+ }
+#endif
default:
return -1;
}
@@ -4281,7 +4279,7 @@ static int inet_address_to_erlang(char *dst, inet_address **src) {
/* Encode n encoded addresses from addrs in the result buffer
*/
static ErlDrvSizeT reply_inet_addrs
-(int n, inet_address *addrs, char **rbuf, ErlDrvSizeT rsize) {
+(int n, inet_address *addrs, char **rbuf, ErlDrvSizeT rsize, SOCKLEN_T sz) {
inet_address *ia;
int i, s;
ErlDrvSizeT rlen;
@@ -4289,11 +4287,19 @@ static ErlDrvSizeT reply_inet_addrs
if (IS_SOCKET_ERROR(n)) return ctl_error(sock_errno(), rbuf, rsize);
if (n == 0) return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize);
+ /* The sz argument is only used when we have got an actual size
+ * of addrs[0] from e.g getsockname() and then n == 1
+ * so we will loop over 1 element below. Otherwise sz
+ * would be expected to differ between addresses but that
+ * can only happen for AF_UNIX and we will only be called with
+ * n > 1 for SCTP and that will never (?) happen with AF_UNIX
+ */
+
/* Calculate result length */
rlen = 1;
ia = addrs;
for (i = 0; i < n; i++) {
- s = inet_address_to_erlang(NULL, &ia);
+ s = inet_address_to_erlang(NULL, &ia, sz);
if (s < 0) break;
rlen += s;
}
@@ -4304,7 +4310,7 @@ static ErlDrvSizeT reply_inet_addrs
rlen = 1;
ia = addrs;
for (i = 0; i < n; i++) {
- s = inet_address_to_erlang((*rbuf)+rlen, &ia);
+ s = inet_address_to_erlang((*rbuf)+rlen, &ia, sz);
if (s < 0) break;
rlen += s;
}
@@ -4321,16 +4327,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.
@@ -4340,10 +4336,15 @@ 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;
+
+ /* mark as disconnected in case when socket is left lingering due to
+ * {exit_on_close, false} option in gen_tcp socket creation. Next
+ * write to socket should produce {error, enotconn} and send a
+ * message {tcp_error,#Port<>,econnreset} */
+ desc->state &= ~INET_STATE_CONNECTED;
}
}
@@ -4372,7 +4373,7 @@ static int erl_inet_close(inet_descriptor* desc)
desc_close(desc);
desc->state = INET_STATE_CLOSED;
} else if (desc->prebound && (desc->s != INVALID_SOCKET)) {
- sock_select(desc, FD_READ | FD_WRITE | FD_CLOSE, 0);
+ sock_select(desc, FD_READ | FD_WRITE | FD_CLOSE | ERL_DRV_USE_NO_CALLBACK, 0);
desc->event_mask = 0;
#ifdef __WIN32__
desc->forced_events = 0;
@@ -4382,69 +4383,11 @@ 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)
{
int save_errno;
+ int protocol;
#ifdef HAVE_SETNS
int current_ns, new_ns;
current_ns = new_ns = 0;
@@ -4483,7 +4426,11 @@ static ErlDrvSSizeT inet_ctl_open(inet_descriptor* desc, int domain, int type,
}
}
#endif
- if ((desc->s = sock_open(domain, type, desc->sprotocol)) == INVALID_SOCKET)
+ protocol = desc->sprotocol;
+#ifdef HAVE_SYS_UN_H
+ if (domain == AF_UNIX) protocol = 0;
+#endif
+ if ((desc->s = sock_open(domain, type, protocol)) == INVALID_SOCKET)
save_errno = sock_errno();
#ifdef HAVE_SETNS
if (desc->netns != NULL) {
@@ -4523,9 +4470,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;
@@ -4536,23 +4480,22 @@ static ErlDrvSSizeT inet_ctl_open(inet_descriptor* desc, int domain, int type,
/* as inet_open but pass in an open socket (MUST BE OF RIGHT TYPE) */
static ErlDrvSSizeT inet_ctl_fdopen(inet_descriptor* desc, int domain, int type,
- SOCKET s, char** rbuf, ErlDrvSizeT rsize)
+ SOCKET s, Uint32 bound,
+ char** rbuf, ErlDrvSizeT rsize)
{
inet_address name;
- unsigned int sz = sizeof(name);
+ unsigned int sz;
- /* check that it is a socket and that the socket is bound */
- if (IS_SOCKET_ERROR(sock_name(s, (struct sockaddr*) &name, &sz)))
- return ctl_error(sock_errno(), rbuf, rsize);
- 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
+ if (bound) {
+ /* check that it is a socket and that the socket is bound */
+ sz = sizeof(name);
+ sys_memzero((char *) &name, sz);
+ if (IS_SOCKET_ERROR(sock_name(s, (struct sockaddr*) &name, &sz)))
+ return ctl_error(sock_errno(), rbuf, rsize);
+ if (name.sa.sa_family != domain)
+ return ctl_error(EINVAL, rbuf, rsize);
+ }
desc->s = s;
-#endif
if ((desc->event = sock_create_event(desc)) == INVALID_EVENT)
return ctl_error(sock_errno(), rbuf, rsize);
@@ -4560,17 +4503,13 @@ static ErlDrvSSizeT inet_ctl_fdopen(inet_descriptor* desc, int domain, int type,
#ifdef __WIN32__
driver_select(desc->port, desc->event, ERL_DRV_READ, 1);
#endif
- desc->state = INET_STATE_BOUND; /* assume bound */
+
+ desc->state = INET_STATE_OPEN;
+
if (type == SOCK_STREAM) { /* check if connected */
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
}
}
@@ -4713,6 +4652,36 @@ static char* sockaddr_to_buf(struct sockaddr* addr, char* ptr, char* end)
return NULL;
}
+/* sockaddr_bufsz_need
+ * Returns the number of bytes needed to store the information
+ * through sockaddr_to_buf
+ */
+
+static size_t sockaddr_bufsz_need(struct sockaddr* addr)
+{
+ if (addr->sa_family == AF_INET || addr->sa_family == 0) {
+ return 1 + sizeof(struct in_addr);
+ }
+#if defined(HAVE_IN6) && defined(AF_INET6)
+ else if (addr->sa_family == AF_INET6) {
+ return 1 + sizeof(struct in6_addr);
+ }
+#endif
+#if defined(AF_LINK)
+ if (addr->sa_family == AF_LINK) {
+ struct sockaddr_dl *sdl_p = (struct sockaddr_dl*) addr;
+ return 2 + sdl_p->sdl_alen;
+ }
+#endif
+#if defined(AF_PACKET) && defined(HAVE_NETPACKET_PACKET_H)
+ else if(addr->sa_family == AF_PACKET) {
+ struct sockaddr_ll *sll_p = (struct sockaddr_ll*) addr;
+ return 2 + sll_p->sll_halen;
+ }
+#endif
+ return 0;
+}
+
static char* buf_to_sockaddr(char* ptr, char* end, struct sockaddr* addr)
{
buf_check(ptr,end,1);
@@ -5772,7 +5741,7 @@ done:
ia_p->Ipv6IfIndex &&
ia_p->Ipv6IfIndex != index)
{
- /* Oops, there was an other interface for IPv6. Possible? XXX */
+ /* Oops, there was another interface for IPv6. Possible? XXX */
index = ia_p->Ipv6IfIndex;
goto index;
}
@@ -5791,6 +5760,11 @@ done:
}
#elif defined(HAVE_GETIFADDRS)
+#ifdef DEBUG
+#define GETIFADDRS_BUFSZ (1)
+#else
+#define GETIFADDRS_BUFSZ (512)
+#endif
static ErlDrvSSizeT inet_ctl_getifaddrs(inet_descriptor* desc_p,
char **rbuf_pp, ErlDrvSizeT rsize)
@@ -5801,15 +5775,15 @@ static ErlDrvSSizeT inet_ctl_getifaddrs(inet_descriptor* desc_p,
char *buf_p;
char *buf_alloc_p;
- buf_size = 512;
- buf_alloc_p = ALLOC(buf_size);
+ buf_size = GETIFADDRS_BUFSZ;
+ buf_alloc_p = ALLOC(GETIFADDRS_BUFSZ);
buf_p = buf_alloc_p;
# define BUF_ENSURE(Size) \
do { \
int NEED_, GOT_ = buf_p - buf_alloc_p; \
NEED_ = GOT_ + (Size); \
if (NEED_ > buf_size) { \
- buf_size = NEED_ + 512; \
+ buf_size = NEED_ + GETIFADDRS_BUFSZ; \
buf_alloc_p = REALLOC(buf_alloc_p, buf_size); \
buf_p = buf_alloc_p + GOT_; \
} \
@@ -5822,7 +5796,7 @@ static ErlDrvSSizeT inet_ctl_getifaddrs(inet_descriptor* desc_p,
while (! (P_ = sockaddr_to_buf((sa), buf_p, \
buf_alloc_p+buf_size))) { \
int GOT_ = buf_p - buf_alloc_p; \
- buf_size += 512; \
+ buf_size += GETIFADDRS_BUFSZ; \
buf_alloc_p = REALLOC(buf_alloc_p, buf_size); \
buf_p = buf_alloc_p + GOT_; \
} \
@@ -5879,10 +5853,11 @@ static ErlDrvSSizeT inet_ctl_getifaddrs(inet_descriptor* desc_p,
|| ifa_p->ifa_addr->sa_family == AF_PACKET
#endif
) {
- char *bp = buf_p;
- BUF_ENSURE(1);
- SOCKADDR_TO_BUF(INET_IFOPT_HWADDR, ifa_p->ifa_addr);
- if (buf_p - bp < 4) buf_p = bp; /* Empty hwaddr */
+ size_t need = sockaddr_bufsz_need(ifa_p->ifa_addr);
+ if (need > 3) {
+ BUF_ENSURE(1 + need);
+ SOCKADDR_TO_BUF(INET_IFOPT_HWADDR, ifa_p->ifa_addr);
+ }
}
#endif
}
@@ -5897,6 +5872,7 @@ static ErlDrvSSizeT inet_ctl_getifaddrs(inet_descriptor* desc_p,
return buf_size;
# undef BUF_ENSURE
}
+#undef GETIFADDRS_BUFSZ
#else
@@ -5995,11 +5971,14 @@ static int inet_set_opts(inet_descriptor* desc, char* ptr, int len)
int ival;
char* arg_ptr;
int arg_sz;
+#ifdef SO_BINDTODEVICE
+ char ifname[IFNAMSIZ];
+#endif
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: */
@@ -6016,6 +5995,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:
@@ -6067,7 +6047,12 @@ static int inet_set_opts(inet_descriptor* desc, char* ptr, int len)
desc->active_count = 0;
if ((desc->stype == SOCK_STREAM) && (desc->active != INET_PASSIVE) &&
(desc->state == INET_STATE_CLOSED)) {
- tcp_closed_message((tcp_descriptor *) desc);
+ tcp_descriptor *tdesc = (tcp_descriptor *) desc;
+ if (tdesc->tcp_add_flags & TCP_ADDF_DELAYED_ECONNRESET) {
+ tdesc->tcp_add_flags &= ~TCP_ADDF_DELAYED_ECONNRESET;
+ tcp_error_message(tdesc, ECONNRESET);
+ }
+ tcp_closed_message(tdesc);
if (desc->exitf) {
driver_exit(desc->port, 0);
return 0; /* Give up on this socket, descriptor lost */
@@ -6184,6 +6169,22 @@ static int inet_set_opts(inet_descriptor* desc, char* ptr, int len)
continue;
#endif
+ case INET_LOPT_TCP_SHOW_ECONNRESET:
+ if (desc->sprotocol == IPPROTO_TCP) {
+ tcp_descriptor* tdesc = (tcp_descriptor*) desc;
+ if (ival)
+ tdesc->tcp_add_flags |= TCP_ADDF_SHOW_ECONNRESET;
+ else
+ tdesc->tcp_add_flags &= ~TCP_ADDF_SHOW_ECONNRESET;
+ }
+ continue;
+
+ case INET_LOPT_LINE_DELIM:
+ DEBUGF(("inet_set_opts(%ld): s=%d, LINE_DELIM=%d\r\n",
+ (long)desc->port, desc->s, ival));
+ desc->delimiter = (char)ival;
+ continue;
+
case INET_OPT_REUSEADDR:
#ifdef __WIN32__
continue; /* Bjorn says */
@@ -6228,6 +6229,13 @@ static int inet_set_opts(inet_descriptor* desc, char* ptr, int len)
arg_sz = sizeof(li_val);
DEBUGF(("inet_set_opts(%ld): s=%d, SO_LINGER=%d,%d",
(long)desc->port, desc->s, li_val.l_onoff,li_val.l_linger));
+ if (desc->sprotocol == IPPROTO_TCP) {
+ tcp_descriptor* tdesc = (tcp_descriptor*) desc;
+ if (li_val.l_onoff && li_val.l_linger == 0)
+ tdesc->tcp_add_flags |= TCP_ADDF_LINGER_ZERO;
+ else
+ tdesc->tcp_add_flags &= ~TCP_ADDF_LINGER_ZERO;
+ }
break;
case INET_OPT_PRIORITY:
@@ -6251,6 +6259,15 @@ static int inet_set_opts(inet_descriptor* desc, char* ptr, int len)
#else
continue;
#endif
+#if defined(IPV6_TCLASS) && defined(SOL_IPV6)
+ case INET_OPT_TCLASS:
+ proto = SOL_IPV6;
+ type = IPV6_TCLASS;
+ propagate = 1;
+ DEBUGF(("inet_set_opts(%ld): s=%d, IPV6_TCLASS=%d\r\n",
+ (long)desc->port, desc->s, ival));
+ break;
+#endif
case TCP_OPT_NODELAY:
proto = IPPROTO_TCP;
@@ -6342,6 +6359,29 @@ static int inet_set_opts(inet_descriptor* desc, char* ptr, int len)
len -= arg_sz;
break;
+#ifdef SO_BINDTODEVICE
+ case INET_OPT_BIND_TO_DEVICE:
+ if (ival < 0) return -1;
+ if (len < ival) return -1;
+ if (ival > sizeof(ifname)) {
+ return -1;
+ }
+ memcpy(ifname, ptr, ival);
+ ifname[ival] = '\0';
+ ptr += ival;
+ len -= ival;
+
+ proto = SOL_SOCKET;
+ type = SO_BINDTODEVICE;
+ arg_ptr = (char*)&ifname;
+ arg_sz = sizeof(ifname);
+ propagate = 1; /* We do want to know if this fails */
+
+ DEBUGF(("inet_set_opts(%ld): s=%d, SO_BINDTODEVICE=%s\r\n",
+ (long)desc->port, desc->s, ifname));
+ break;
+#endif
+
default:
return -1;
}
@@ -6474,6 +6514,9 @@ static int sctp_set_opts(inet_descriptor* desc, char* ptr, int len)
# ifdef SCTP_DELAYED_ACK_TIME
struct sctp_assoc_value av; /* Not in SOLARIS10 */
# endif
+# ifdef SO_BINDTODEVICE
+ char ifname[IFNAMSIZ];
+# endif
}
arg;
@@ -6684,6 +6727,19 @@ static int sctp_set_opts(inet_descriptor* desc, char* ptr, int len)
continue; /* Option not supported -- ignore it */
# endif
+# if defined(IPV6_TCLASS) && defined(SOL_IPV6)
+ case INET_OPT_TCLASS:
+ {
+ arg.ival= get_int32 (curr); curr += 4;
+ proto = SOL_IPV6;
+ type = IPV6_TCLASS;
+ arg_ptr = (char*) (&arg.ival);
+ arg_sz = sizeof ( arg.ival);
+ break;
+ }
+# endif
+
+
case INET_OPT_IPV6_V6ONLY:
# if HAVE_DECL_IPV6_V6ONLY
{
@@ -6700,6 +6756,23 @@ static int sctp_set_opts(inet_descriptor* desc, char* ptr, int len)
continue; /* Option not supported -- ignore it */
# endif
+#ifdef SO_BINDTODEVICE
+ case INET_OPT_BIND_TO_DEVICE:
+ arg_sz = get_int32(curr); curr += 4;
+ CHKLEN(curr, arg_sz);
+ if (arg_sz >= sizeof(arg.ifname))
+ return -1;
+ memcpy(arg.ifname, curr, arg_sz);
+ arg.ifname[arg_sz] = '\0';
+ curr += arg_sz;
+
+ proto = SOL_SOCKET;
+ type = SO_BINDTODEVICE;
+ arg_ptr = (char*) (&arg.ifname);
+ arg_sz = sizeof ( arg.ifname);
+ break;
+#endif
+
case SCTP_OPT_AUTOCLOSE:
{
arg.ival= get_int32 (curr); curr += 4;
@@ -6740,7 +6813,6 @@ static int sctp_set_opts(inet_descriptor* desc, char* ptr, int len)
case SCTP_OPT_SET_PEER_PRIMARY_ADDR:
{
ErlDrvSizeT alen;
- char *after;
CHKLEN(curr, ASSOC_ID_LEN);
/* XXX: These 2 opts have isomorphic value data structures,
@@ -6751,12 +6823,9 @@ static int sctp_set_opts(inet_descriptor* desc, char* ptr, int len)
/* Fill in "arg.prim.sspp_addr": */
alen = ptr + len - curr;
- after = inet_set_faddress(desc->sfamily,
- (inet_address*) (&arg.prim.sspp_addr),
- curr, &alen);
- if (after == NULL)
- return -1;
- curr = after;
+ if (inet_set_faddress
+ (desc->sfamily, (inet_address*) (&arg.prim.sspp_addr),
+ &curr, &alen) != NULL) return -1;
proto = IPPROTO_SCTP;
if (eopt == SCTP_OPT_PRIMARY_ADDR)
@@ -6782,7 +6851,6 @@ static int sctp_set_opts(inet_descriptor* desc, char* ptr, int len)
case SCTP_OPT_PEER_ADDR_PARAMS:
{
ErlDrvSizeT alen;
- char *after;
# ifdef HAVE_STRUCT_SCTP_PADDRPARAMS_SPP_FLAGS
int eflags, cflags, hb_enable, hb_disable,
pmtud_enable, pmtud_disable;
@@ -6797,12 +6865,9 @@ static int sctp_set_opts(inet_descriptor* desc, char* ptr, int len)
/* Fill in "pap.spp_address": */
alen = ptr + len - curr;
- after = inet_set_faddress(desc->sfamily,
- (inet_address*) (&arg.pap.spp_address),
- curr, &alen);
- if (after == NULL)
- return -1;
- curr = after;
+ if (inet_set_faddress
+ (desc->sfamily, (inet_address*) (&arg.pap.spp_address),
+ &curr, &alen) != NULL) return -1;
CHKLEN(curr, 4 + 2 + 3*4);
@@ -6973,6 +7038,9 @@ static ErlDrvSSizeT inet_fill_opts(inet_descriptor* desc,
ErlDrvSizeT dest_used = 0;
ErlDrvSizeT dest_allocated = destlen;
char *orig_dest = *dest;
+#ifdef SO_BINDTODEVICE
+ char ifname[IFNAMSIZ];
+#endif
/* Ptr is a name parameter */
#define RETURN_ERROR() \
@@ -7009,7 +7077,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; \
@@ -7163,6 +7231,17 @@ static ErlDrvSSizeT inet_fill_opts(inet_descriptor* desc,
continue;
#endif
+ case INET_LOPT_TCP_SHOW_ECONNRESET:
+ if (desc->sprotocol == IPPROTO_TCP) {
+ tcp_descriptor* tdesc = (tcp_descriptor*) desc;
+ *ptr++ = opt;
+ ival = !!(tdesc->tcp_add_flags & TCP_ADDF_SHOW_ECONNRESET);
+ put_int32(ival, ptr);
+ } else {
+ TRUNCATE_TO(0,ptr);
+ }
+ continue;
+
case INET_OPT_PRIORITY:
#ifdef SO_PRIORITY
type = SO_PRIORITY;
@@ -7182,6 +7261,15 @@ static ErlDrvSSizeT inet_fill_opts(inet_descriptor* desc,
put_int32(0, ptr);
continue;
#endif
+ case INET_OPT_TCLASS:
+#if defined(IPV6_TCLASS) && defined(SOL_IPV6)
+ proto = SOL_IPV6;
+ type = IPV6_TCLASS;
+ break;
+#else
+ TRUNCATE_TO(0,ptr);
+ continue;
+#endif
case INET_OPT_REUSEADDR:
type = SO_REUSEADDR;
break;
@@ -7288,6 +7376,26 @@ static ErlDrvSSizeT inet_fill_opts(inet_descriptor* desc,
put_int32(arg_sz,ptr);
continue;
}
+
+#ifdef SO_BINDTODEVICE
+ case INET_OPT_BIND_TO_DEVICE:
+ arg_sz = sizeof(ifname);
+ TRUNCATE_TO(0,ptr);
+ PLACE_FOR(5 + arg_sz,ptr);
+ arg_ptr = ptr + 5;
+ if (IS_SOCKET_ERROR(sock_getopt(desc->s,SOL_SOCKET,SO_BINDTODEVICE,
+ arg_ptr,&arg_sz))) {
+ TRUNCATE_TO(0,ptr);
+ continue;
+ }
+ arg_sz = my_strnlen(arg_ptr, arg_sz);
+ TRUNCATE_TO(arg_sz + 5,ptr);
+ *ptr++ = opt;
+ put_int32(arg_sz,ptr);
+ ptr += arg_sz;
+ continue;
+#endif
+
default:
RETURN_ERROR();
}
@@ -7314,14 +7422,14 @@ static ErlDrvSSizeT inet_fill_opts(inet_descriptor* desc,
#ifdef HAVE_SCTP
#define LOAD_PADDRINFO_CNT \
- (2*LOAD_ATOM_CNT + LOAD_ASSOC_ID_CNT + LOAD_IP_AND_PORT_CNT + \
+ (2*LOAD_ATOM_CNT + LOAD_ASSOC_ID_CNT + LOAD_INET_GET_ADDRESS_CNT + \
4*LOAD_INT_CNT + LOAD_TUPLE_CNT)
static int load_paddrinfo (ErlDrvTermData * spec, int i,
inet_descriptor* desc, struct sctp_paddrinfo* pai)
{
i = LOAD_ATOM (spec, i, am_sctp_paddrinfo);
i = LOAD_ASSOC_ID (spec, i, pai->spinfo_assoc_id);
- i = load_ip_and_port(spec, i, desc, &pai->spinfo_address);
+ i = load_inet_get_address(spec, i, desc, &pai->spinfo_address);
switch(pai->spinfo_state)
{
case SCTP_ACTIVE:
@@ -7330,8 +7438,13 @@ static int load_paddrinfo (ErlDrvTermData * spec, int i,
case SCTP_INACTIVE:
i = LOAD_ATOM (spec, i, am_inactive);
break;
+# if HAVE_DECL_SCTP_UNCONFIRMED
+ case SCTP_UNCONFIRMED:
+ i = LOAD_ATOM (spec, i, am_unconfirmed);
+ break;
+# endif
default:
- ASSERT(0); /* NB: SCTP_UNCONFIRMED modifier not yet supported */
+ i = LOAD_ATOM (spec, i, am_undefined);
}
i = LOAD_INT (spec, i, pai->spinfo_cwnd);
i = LOAD_INT (spec, i, pai->spinfo_srtt);
@@ -7370,7 +7483,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); \
@@ -7564,6 +7677,25 @@ static ErlDrvSSizeT sctp_fill_opts(inet_descriptor* desc,
i = LOAD_TUPLE (spec, i, 2);
break;
}
+
+#ifdef SO_BINDTODEVICE
+ /* The following option returns a binary: */
+ case INET_OPT_BIND_TO_DEVICE: {
+ char ifname[IFNAMSIZ];
+ unsigned int sz = sizeof(ifname);
+
+ if (sock_getopt(desc->s, SOL_SOCKET, SO_BINDTODEVICE,
+ &ifname, &sz) < 0) continue;
+ /* Fill in the response: */
+ PLACE_FOR(spec, i,
+ LOAD_ATOM_CNT + LOAD_BUF2BINARY_CNT + LOAD_TUPLE_CNT);
+ i = LOAD_ATOM (spec, i, am_bind_to_device);
+ i = LOAD_BUF2BINARY(spec, i, ifname, my_strnlen(ifname, sz));
+ i = LOAD_TUPLE (spec, i, 2);
+ break;
+ }
+#endif
+
/* The following options just return an integer value: */
case INET_OPT_RCVBUF :
case INET_OPT_SNDBUF :
@@ -7571,6 +7703,7 @@ static ErlDrvSSizeT sctp_fill_opts(inet_descriptor* desc,
case INET_OPT_DONTROUTE:
case INET_OPT_PRIORITY :
case INET_OPT_TOS :
+ case INET_OPT_TCLASS :
case INET_OPT_IPV6_V6ONLY:
case SCTP_OPT_AUTOCLOSE:
case SCTP_OPT_MAXSEG :
@@ -7644,6 +7777,19 @@ static ErlDrvSSizeT sctp_fill_opts(inet_descriptor* desc,
continue;
# endif
}
+ case INET_OPT_TCLASS:
+ {
+# if defined(IPV6_TCLASS) && defined(SOL_IPV6)
+ proto = SOL_IPV6;
+ type = IPV6_TCLASS;
+ is_int = 1;
+ tag = am_tclass;
+ break;
+# else
+ /* Not supported -- ignore */
+ continue;
+# endif
+ }
case INET_OPT_IPV6_V6ONLY:
# if HAVE_DECL_IPV6_V6ONLY
{
@@ -7732,7 +7878,7 @@ static ErlDrvSSizeT sctp_fill_opts(inet_descriptor* desc,
/* Fill in the response: */
PLACE_FOR(spec, i,
2*LOAD_ATOM_CNT + LOAD_ASSOC_ID_CNT +
- LOAD_IP_AND_PORT_CNT + 2*LOAD_TUPLE_CNT);
+ LOAD_INET_GET_ADDRESS_CNT + 2*LOAD_TUPLE_CNT);
switch (eopt) {
case SCTP_OPT_PRIMARY_ADDR:
i = LOAD_ATOM(spec, i, am_sctp_primary_addr);
@@ -7746,7 +7892,7 @@ static ErlDrvSSizeT sctp_fill_opts(inet_descriptor* desc,
ASSERT(0);
}
i = LOAD_ASSOC_ID (spec, i, sp.sspp_assoc_id);
- i = load_ip_and_port(spec, i, desc, &sp.sspp_addr);
+ i = load_inet_get_address(spec, i, desc, &sp.sspp_addr);
i = LOAD_TUPLE (spec, i, 3);
i = LOAD_TUPLE (spec, i, 2);
break;
@@ -7773,7 +7919,7 @@ static ErlDrvSSizeT sctp_fill_opts(inet_descriptor* desc,
struct sctp_paddrparams ap;
unsigned int sz = sizeof(ap);
int n;
- char *after;
+ char *before, *xerror;
ErlDrvSizeT alen;
if (buflen < ASSOC_ID_LEN) RETURN_ERROR(spec, -EINVAL);
@@ -7781,23 +7927,32 @@ static ErlDrvSSizeT sctp_fill_opts(inet_descriptor* desc,
buf += ASSOC_ID_LEN;
buflen -= ASSOC_ID_LEN;
alen = buflen;
- after = inet_set_faddress(desc->sfamily,
- (inet_address*) (&ap.spp_address),
- buf, &alen);
- if (after == NULL) RETURN_ERROR(spec, -EINVAL);
- buflen -= after - buf;
- buf = after;
-
+ before = buf;
+ xerror =
+ inet_set_faddress
+ (desc->sfamily, (inet_address*) (&ap.spp_address),
+ &buf, &alen);
+ if (xerror != NULL) {
+#ifdef EAFNOSUPPORT
+ if (xerror == str_eafnosupport) {
+ RETURN_ERROR(spec, -EAFNOSUPPORT);
+ }
+#else
+ RETURN_ERROR(spec, -EINVAL);
+#endif
+ }
+ buflen -= buf - before;
+
if (sock_getopt(desc->s, IPPROTO_SCTP, SCTP_PEER_ADDR_PARAMS,
&ap, &sz) < 0) continue;
/* Fill in the response: */
PLACE_FOR(spec, i,
2*LOAD_ATOM_CNT + LOAD_ASSOC_ID_CNT +
- LOAD_IP_AND_PORT_CNT + 4*LOAD_INT_CNT);
+ LOAD_INET_GET_ADDRESS_CNT + 4*LOAD_INT_CNT);
i = LOAD_ATOM (spec, i, am_sctp_peer_addr_params);
i = LOAD_ATOM (spec, i, am_sctp_paddrparams);
i = LOAD_ASSOC_ID (spec, i, ap.spp_assoc_id);
- i = load_ip_and_port(spec, i, desc, &ap.spp_address);
+ i = load_inet_get_address(spec, i, desc, &ap.spp_address);
i = LOAD_INT (spec, i, ap.spp_hbinterval);
i = LOAD_INT (spec, i, ap.spp_pathmaxrxt);
@@ -8013,7 +8168,7 @@ static ErlDrvSSizeT sctp_fill_opts(inet_descriptor* desc,
{
struct sctp_paddrinfo pai;
unsigned int sz = sizeof(pai);
- char *after;
+ char *before, *xerror;
ErlDrvSizeT alen;
if (buflen < ASSOC_ID_LEN) RETURN_ERROR(spec, -EINVAL);
@@ -8021,13 +8176,22 @@ static ErlDrvSSizeT sctp_fill_opts(inet_descriptor* desc,
buf += ASSOC_ID_LEN;
buflen -= ASSOC_ID_LEN;
alen = buflen;
- after = inet_set_faddress(desc->sfamily,
- (inet_address*) (&pai.spinfo_address),
- buf, &alen);
- if (after == NULL) RETURN_ERROR(spec, -EINVAL);
- buflen -= after - buf;
- buf = after;
-
+ before = buf;
+ xerror =
+ inet_set_faddress
+ (desc->sfamily, (inet_address*) (&pai.spinfo_address),
+ &buf, &alen);
+ if (xerror != NULL) {
+#ifdef EAFNOSUPPORT
+ if (xerror == str_eafnosupport) {
+ RETURN_ERROR(spec, -EAFNOSUPPORT);
+ }
+#else
+ RETURN_ERROR(spec, -EINVAL);
+#endif
+ }
+ buflen -= buf - before;
+
if (sock_getopt(desc->s, IPPROTO_SCTP, SCTP_GET_PEER_ADDR_INFO,
&pai, &sz) < 0) continue;
/* Fill in the response: */
@@ -8196,6 +8360,19 @@ static void inet_stop(inet_descriptor* desc)
FREE(desc);
}
+static void inet_emergency_close(ErlDrvData data)
+{
+ /* valid for any (UDP, TCP or SCTP) descriptor */
+ tcp_descriptor* tcp_desc = (tcp_descriptor*)data;
+ inet_descriptor* desc = INETP(tcp_desc);
+ DEBUGF(("inet_emergency_close(%ld) {s=%d\r\n",
+ (long)desc->port, desc->s));
+ if (desc->s != INVALID_SOCKET) {
+ sock_close(desc->s);
+ }
+}
+
+
static void set_default_msgq_limits(ErlDrvPort port)
{
ErlDrvSizeT q_high = INET_HIGH_MSGQ_WATERMARK;
@@ -8243,6 +8420,7 @@ static ErlDrvData inet_start(ErlDrvPort port, int size, int protocol)
desc->deliver = INET_DELIVER_TERM; /* standard term format */
desc->active = INET_PASSIVE; /* start passive */
desc->active_count = 0;
+ desc->delimiter = '\n'; /* line delimiting char */
desc->oph = NULL;
desc->opt = NULL;
@@ -8276,23 +8454,14 @@ 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;
}
-
-#ifndef MAXHOSTNAMELEN
-#define MAXHOSTNAMELEN 256
-#endif
+/* MAXHOSTNAMELEN could be 64 or 255 depending
+on the platform. Instead, use INET_MAXHOSTNAMELEN
+which is always 255 across all platforms */
+#define INET_MAXHOSTNAMELEN 255
/*
** common TCP/UDP/SCTP control command
@@ -8433,6 +8602,11 @@ static ErlDrvSSizeT inet_ctl(inet_descriptor* desc, int cmd, char* buf,
put_int32(INET_AF_INET6, &tbuf[0]);
}
#endif
+#ifdef HAVE_SYS_UN_H
+ else if (desc->sfamily == AF_UNIX) {
+ put_int32(INET_AF_LOCAL, &tbuf[0]);
+ }
+#endif
else
return ctl_error(EINVAL, rbuf, rsize);
@@ -8464,13 +8638,14 @@ static ErlDrvSSizeT inet_ctl(inet_descriptor* desc, int cmd, char* buf,
}
case INET_REQ_GETHOSTNAME: { /* get host name */
- char tbuf[MAXHOSTNAMELEN];
+ char tbuf[INET_MAXHOSTNAMELEN + 1];
DEBUGF(("inet_ctl(%ld): GETHOSTNAME\r\n", (long)desc->port));
if (len != 0)
return ctl_error(EINVAL, rbuf, rsize);
- if (IS_SOCKET_ERROR(sock_hostname(tbuf, MAXHOSTNAMELEN)))
+ /* gethostname requires len to be max(hostname) + 1 */
+ if (IS_SOCKET_ERROR(sock_hostname(tbuf, INET_MAXHOSTNAMELEN + 1)))
return ctl_error(sock_errno(), rbuf, rsize);
return ctl_reply(INET_REP_OK, tbuf, strlen(tbuf), rbuf, rsize);
}
@@ -8481,7 +8656,6 @@ static ErlDrvSSizeT inet_ctl(inet_descriptor* desc, int cmd, char* buf,
if (len != 4) return ctl_error(EINVAL, rbuf, rsize);
if (! IS_OPEN(desc)) return ctl_xerror(EXBADPORT, rbuf, rsize);
- if (! IS_BOUND(desc)) return ctl_xerror(EXBADSEQ, rbuf, rsize);
#ifdef HAVE_SCTP
if (IS_SCTP(desc) && p_sctp_getpaddrs) {
@@ -8492,19 +8666,19 @@ static ErlDrvSSizeT inet_ctl(inet_descriptor* desc, int cmd, char* buf,
assoc_id = get_int32(buf);
n = p_sctp_getpaddrs(desc->s, assoc_id, &sa);
- rlen = reply_inet_addrs(n, (inet_address *) sa, rbuf, rsize);
+ rlen = reply_inet_addrs(n, (inet_address *) sa, rbuf, rsize, 0);
if (n > 0) p_sctp_freepaddrs(sa);
return rlen;
}
#endif
{ /* Fallback to sock_peer */
inet_address addr;
- unsigned int sz;
+ SOCKLEN_T sz;
int i;
sz = sizeof(addr);
i = sock_peer(desc->s, (struct sockaddr *) &addr, &sz);
- return reply_inet_addrs(i >= 0 ? 1 : i, &addr, rbuf, rsize);
+ return reply_inet_addrs(i >= 0 ? 1 : i, &addr, rbuf, rsize, sz);
}
}
@@ -8512,15 +8686,22 @@ static ErlDrvSSizeT inet_ctl(inet_descriptor* desc, int cmd, char* buf,
char tbuf[sizeof(inet_address)];
inet_address peer;
inet_address* ptr;
- unsigned int sz = sizeof(peer);
+ unsigned int sz;
DEBUGF(("inet_ctl(%ld): PEER\r\n", (long)desc->port));
if (!(desc->state & INET_F_ACTIVE))
return ctl_error(ENOTCONN, rbuf, rsize);
- if ((ptr = desc->peer_ptr) == NULL) {
+ if ((ptr = desc->peer_ptr) != NULL) {
+ sz = desc->peer_addr_len;
+ }
+ else {
ptr = &peer;
- if (IS_SOCKET_ERROR(sock_peer(desc->s, (struct sockaddr*)ptr,&sz)))
+ sz = sizeof(peer);
+ sys_memzero((char *) &peer, sz);
+ if (IS_SOCKET_ERROR
+ (sock_peer
+ (desc->s, (struct sockaddr*)ptr, &sz)))
return ctl_error(sock_errno(), rbuf, rsize);
}
if (inet_get_address(tbuf, ptr, &sz) < 0)
@@ -8529,17 +8710,19 @@ static ErlDrvSSizeT inet_ctl(inet_descriptor* desc, int cmd, char* buf,
}
case INET_REQ_SETPEER: { /* set fake peername Port Address */
+ char *xerror;
if (len == 0) {
desc->peer_ptr = NULL;
return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize);
}
else if (len < 2)
return ctl_error(EINVAL, rbuf, rsize);
- else if (inet_set_address(desc->sfamily, &desc->peer_addr,
- buf, &len) == NULL)
- return ctl_error(EINVAL, rbuf, rsize);
+ else if ((xerror = inet_set_faddress
+ (desc->sfamily, &desc->peer_addr, &buf, &len)) != NULL)
+ return ctl_xerror(xerror, rbuf, rsize);
else {
desc->peer_ptr = &desc->peer_addr;
+ desc->peer_addr_len = (SOCKLEN_T) len;
return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize);
}
}
@@ -8550,7 +8733,6 @@ static ErlDrvSSizeT inet_ctl(inet_descriptor* desc, int cmd, char* buf,
if (len != 4) return ctl_error(EINVAL, rbuf, rsize);
if (! IS_OPEN(desc)) return ctl_xerror(EXBADPORT, rbuf, rsize);
- if (! IS_BOUND(desc)) return ctl_xerror(EXBADSEQ, rbuf, rsize);
#ifdef HAVE_SCTP
if (IS_SCTP(desc) && p_sctp_getladdrs) {
@@ -8561,19 +8743,20 @@ static ErlDrvSSizeT inet_ctl(inet_descriptor* desc, int cmd, char* buf,
assoc_id = get_int32(buf);
n = p_sctp_getladdrs(desc->s, assoc_id, &sa);
- rlen = reply_inet_addrs(n, (inet_address *) sa, rbuf, rsize);
+ rlen = reply_inet_addrs(n, (inet_address *) sa, rbuf, rsize, 0);
if (n > 0) p_sctp_freeladdrs(sa);
return rlen;
}
#endif
{ /* Fallback to sock_name */
inet_address addr;
- unsigned int sz;
+ SOCKLEN_T sz;
int i;
sz = sizeof(addr);
+ sys_memzero((char *) &addr, sz);
i = sock_name(desc->s, (struct sockaddr *) &addr, &sz);
- return reply_inet_addrs(i >= 0 ? 1 : i, &addr, rbuf, rsize);
+ return reply_inet_addrs(i >= 0 ? 1 : i, &addr, rbuf, rsize, sz);
}
}
@@ -8581,16 +8764,19 @@ static ErlDrvSSizeT inet_ctl(inet_descriptor* desc, int cmd, char* buf,
char tbuf[sizeof(inet_address)];
inet_address name;
inet_address* ptr;
- unsigned int sz = sizeof(name);
+ unsigned int sz;
DEBUGF(("inet_ctl(%ld): NAME\r\n", (long)desc->port));
- if (!IS_BOUND(desc))
- return ctl_error(EINVAL, rbuf, rsize); /* address is not valid */
-
- if ((ptr = desc->name_ptr) == NULL) {
+ if ((ptr = desc->name_ptr) != NULL) {
+ sz = desc->name_addr_len;
+ }
+ else {
ptr = &name;
- if (IS_SOCKET_ERROR(sock_name(desc->s, (struct sockaddr*)ptr, &sz)))
+ sz = sizeof(name);
+ sys_memzero((char *) &name, sz);
+ if (IS_SOCKET_ERROR
+ (sock_name(desc->s, (struct sockaddr*)ptr, &sz)))
return ctl_error(sock_errno(), rbuf, rsize);
}
if (inet_get_address(tbuf, ptr, &sz) < 0)
@@ -8598,26 +8784,28 @@ static ErlDrvSSizeT inet_ctl(inet_descriptor* desc, int cmd, char* buf,
return ctl_reply(INET_REP_OK, tbuf, sz, rbuf, rsize);
}
- case INET_REQ_SETNAME: { /* set fake peername Port Address */
+ case INET_REQ_SETNAME: { /* set fake sockname Port Address */
+ char *xerror;
if (len == 0) {
desc->name_ptr = NULL;
return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize);
}
else if (len < 2)
return ctl_error(EINVAL, rbuf, rsize);
- else if (inet_set_address(desc->sfamily, &desc->name_addr,
- buf, &len) == NULL)
- return ctl_error(EINVAL, rbuf, rsize);
+ else if ((xerror = inet_set_faddress
+ (desc->sfamily, &desc->name_addr, &buf, &len)) != NULL)
+ return ctl_xerror(xerror, rbuf, rsize);
else {
desc->name_ptr = &desc->name_addr;
+ desc->name_addr_len = (SOCKLEN_T) len;
return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize);
}
}
case INET_REQ_BIND: { /* bind socket */
- char tbuf[2];
+ char tbuf[2], *xerror;
inet_address local;
- short port;
+ int port;
DEBUGF(("inet_ctl(%ld): BIND\r\n", (long)desc->port));
@@ -8626,21 +8814,24 @@ static ErlDrvSSizeT inet_ctl(inet_descriptor* desc, int cmd, char* buf,
if (desc->state != INET_STATE_OPEN)
return ctl_xerror(EXBADPORT, rbuf, rsize);
- if (inet_set_faddress(desc->sfamily, &local, buf, &len) == NULL)
- return ctl_error(EINVAL, rbuf, rsize);
+ if ((xerror = inet_set_faddress
+ (desc->sfamily, &local, &buf, &len)) != NULL)
+ return ctl_xerror(xerror, rbuf, rsize);
if (IS_SOCKET_ERROR(sock_bind(desc->s,(struct sockaddr*) &local, len)))
return ctl_error(sock_errno(), rbuf, rsize);
- desc->state = INET_STATE_BOUND;
+ desc->state = INET_STATE_OPEN;
- if ((port = inet_address_port(&local)) == 0) {
+ port = inet_address_port(&local);
+ if (port == 0) {
SOCKLEN_T adrlen = sizeof(local);
+ sys_memzero((char *) &local, adrlen);
sock_name(desc->s, &local.sa, &adrlen);
port = inet_address_port(&local);
}
- port = sock_ntohs(port);
- put_int16(port, tbuf);
+ else if (port == -1) port = 0;
+ put_int16(sock_ntohs((Uint16) port), tbuf);
return ctl_reply(INET_REP_OK, tbuf, 2, rbuf, rsize);
}
@@ -8988,6 +9179,11 @@ static tcp_descriptor* tcp_inet_copy(tcp_descriptor* desc,SOCKET s,
copy_desc->low = desc->low;
copy_desc->send_timeout = desc->send_timeout;
copy_desc->send_timeout_close = desc->send_timeout_close;
+
+ if (desc->tcp_add_flags & TCP_ADDF_SHOW_ECONNRESET)
+ copy_desc->tcp_add_flags |= TCP_ADDF_SHOW_ECONNRESET;
+ else
+ copy_desc->tcp_add_flags &= ~TCP_ADDF_SHOW_ECONNRESET;
/* The new port will be linked and connected to the original caller */
port = driver_create_port(port, owner, "tcp_inet", (ErlDrvData) copy_desc);
@@ -9006,10 +9202,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;
}
@@ -9061,32 +9253,30 @@ static void tcp_inet_stop(ErlDrvData e)
tcp_descriptor* desc = (tcp_descriptor*)e;
DEBUGF(("tcp_inet_stop(%ld) {s=%d\r\n",
(long)desc->inet.port, desc->inet.s));
+
tcp_close_check(desc);
- /* free input buffer & output buffer */
- if (desc->i_buf != NULL)
- release_buffer(desc->i_buf);
- desc->i_buf = NULL; /* net_mess2 may call this function recursively when
- faulty messages arrive on dist ports*/
+ tcp_clear_input(desc);
+
DEBUGF(("tcp_inet_stop(%ld) }\r\n", (long)desc->inet.port));
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);
+/* Closes a tcp descriptor without leaving things hanging; the VM keeps trying
+ * to flush IO queues as long as it contains anything even after the port has
+ * been closed from the erlang side, which is desired behavior (Think escripts
+ * writing to files) but pretty hopeless if the underlying fd has been set to
+ * INVALID_SOCKET through desc_close.
+ *
+ * This function should be used in place of desc_close/erl_inet_close in all
+ * TCP-related operations. Note that this only closes the desc cleanly; it
+ * will be freed through tcp_inet_stop later on. */
+static void tcp_desc_close(tcp_descriptor* desc)
+{
+ tcp_clear_input(desc);
+ tcp_clear_output(desc);
- return res;
+ erl_inet_close(INETP(desc));
}
-#endif
/* TCP requests from Erlang */
static ErlDrvSSizeT tcp_inet_ctl(ErlDrvData e, unsigned int cmd,
@@ -9108,23 +9298,25 @@ static ErlDrvSSizeT tcp_inet_ctl(ErlDrvData e, unsigned int cmd,
case INET_AF_INET6:
domain = AF_INET6;
break;
-#else
- case INET_AF_INET6:
- return ctl_xerror("eafnosupport", rbuf, rsize);
+#endif
+#ifdef HAVE_SYS_UN_H
+ case INET_AF_LOCAL:
+ domain = AF_UNIX;
break;
#endif
default:
- return ctl_error(EINVAL, rbuf, rsize);
+ return ctl_xerror(str_eafnosupport, rbuf, rsize);
}
if (buf[1] != INET_TYPE_STREAM) return ctl_error(EINVAL, rbuf, rsize);
return inet_ctl_open(INETP(desc), domain, SOCK_STREAM, rbuf, rsize);
break;
}
- case INET_REQ_FDOPEN: { /* pass in an open socket */
+ case INET_REQ_FDOPEN: { /* pass in an open (and optionally bound) socket */
int domain;
+ int bound;
DEBUGF(("tcp_inet_ctl(%ld): FDOPEN\r\n", (long)desc->inet.port));
- if (len != 6) return ctl_error(EINVAL, rbuf, rsize);
+ if (len != 6 && len != 10) return ctl_error(EINVAL, rbuf, rsize);
switch(buf[0]) {
case INET_AF_INET:
domain = AF_INET;
@@ -9133,17 +9325,23 @@ static ErlDrvSSizeT tcp_inet_ctl(ErlDrvData e, unsigned int cmd,
case INET_AF_INET6:
domain = AF_INET6;
break;
-#else
- case INET_AF_INET6:
- return ctl_xerror("eafnosupport", rbuf, rsize);
+#endif
+#ifdef HAVE_SYS_UN_H
+ case INET_AF_LOCAL:
+ domain = AF_UNIX;
break;
#endif
default:
- return ctl_error(EINVAL, rbuf, rsize);
+ return ctl_xerror(str_eafnosupport, rbuf, rsize);
}
if (buf[1] != INET_TYPE_STREAM) return ctl_error(EINVAL, rbuf, rsize);
+
+ if (len == 6) bound = 1;
+ else bound = get_int32(buf+2+4);
+
return inet_ctl_fdopen(INETP(desc), domain, SOCK_STREAM,
- (SOCKET) get_int32(buf+2), rbuf, rsize);
+ (SOCKET) get_int32(buf+2),
+ bound, rbuf, rsize);
break;
}
@@ -9155,8 +9353,6 @@ static ErlDrvSSizeT tcp_inet_ctl(ErlDrvData e, unsigned int cmd,
return ctl_xerror(EXBADPORT, rbuf, rsize);
if (!IS_OPEN(INETP(desc)))
return ctl_xerror(EXBADPORT, rbuf, rsize);
- if (!IS_BOUND(INETP(desc)))
- return ctl_xerror(EXBADSEQ, rbuf, rsize);
if (len != 2)
return ctl_error(EINVAL, rbuf, rsize);
backlog = get_int16(buf);
@@ -9169,7 +9365,7 @@ static ErlDrvSSizeT tcp_inet_ctl(ErlDrvData e, unsigned int cmd,
case INET_REQ_CONNECT: { /* do async connect */
int code;
- char tbuf[2];
+ char tbuf[2], *xerror;
unsigned timeout;
DEBUGF(("tcp_inet_ctl(%ld): CONNECT\r\n", (long)desc->inet.port));
@@ -9179,8 +9375,6 @@ static ErlDrvSSizeT tcp_inet_ctl(ErlDrvData e, unsigned int cmd,
return ctl_xerror(EXBADPORT, rbuf, rsize);
if (IS_CONNECTED(INETP(desc)))
return ctl_error(EISCONN, rbuf, rsize);
- if (!IS_BOUND(INETP(desc)))
- return ctl_xerror(EXBADSEQ, rbuf, rsize);
if (IS_CONNECTING(INETP(desc)))
return ctl_error(EINVAL, rbuf, rsize);
if (len < 6)
@@ -9188,9 +9382,9 @@ static ErlDrvSSizeT tcp_inet_ctl(ErlDrvData e, unsigned int cmd,
timeout = get_int32(buf);
buf += 4;
len -= 4;
- if (inet_set_address(desc->inet.sfamily, &desc->inet.remote,
- buf, &len) == NULL)
- return ctl_error(EINVAL, rbuf, rsize);
+ if ((xerror = inet_set_faddress
+ (desc->inet.sfamily, &desc->inet.remote, &buf, &len)) != NULL)
+ return ctl_xerror(xerror, rbuf, rsize);
code = sock_connect(desc->inet.s,
(struct sockaddr*) &desc->inet.remote, len);
@@ -9281,6 +9475,7 @@ static ErlDrvSSizeT tcp_inet_ctl(ErlDrvData e, unsigned int cmd,
return ctl_reply(INET_REP_OK, tbuf, 2, rbuf, rsize);
} else {
n = sizeof(desc->inet.remote);
+ sys_memzero((char *) &remote, n);
s = sock_accept(desc->inet.s, (struct sockaddr*) &remote, &n);
if (s == INVALID_SOCKET) {
if (sock_errno() == ERRNO_BLOCK) {
@@ -9327,7 +9522,7 @@ static ErlDrvSSizeT tcp_inet_ctl(ErlDrvData e, unsigned int cmd,
case INET_REQ_CLOSE:
DEBUGF(("tcp_inet_ctl(%ld): CLOSE\r\n", (long)desc->inet.port));
tcp_close_check(desc);
- erl_inet_close(INETP(desc));
+ tcp_desc_close(desc);
return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize);
@@ -9343,7 +9538,11 @@ static ErlDrvSSizeT tcp_inet_ctl(ErlDrvData e, unsigned int cmd,
if (desc->tcp_add_flags & TCP_ADDF_DELAYED_CLOSE_RECV) {
desc->tcp_add_flags &= ~(TCP_ADDF_DELAYED_CLOSE_RECV|
TCP_ADDF_DELAYED_CLOSE_SEND);
- return ctl_reply(INET_REP_ERROR, "closed", 6, rbuf, rsize);
+ if (desc->tcp_add_flags & TCP_ADDF_DELAYED_ECONNRESET) {
+ desc->tcp_add_flags &= ~TCP_ADDF_DELAYED_ECONNRESET;
+ return ctl_reply(INET_REP_ERROR, "econnreset", 10, rbuf, rsize);
+ } else
+ return ctl_reply(INET_REP_ERROR, "closed", 6, rbuf, rsize);
}
return ctl_error(ENOTCONN, rbuf, rsize);
}
@@ -9395,10 +9594,20 @@ static ErlDrvSSizeT tcp_inet_ctl(ErlDrvData e, unsigned int cmd,
return ctl_error(EINVAL, rbuf, rsize);
}
how = buf[0];
- if (sock_shutdown(INETP(desc)->s, how) == 0) {
+ if (how != TCP_SHUT_RD && driver_sizeq(desc->inet.port) > 0) {
+ if (how == TCP_SHUT_WR) {
+ desc->tcp_add_flags |= TCP_ADDF_PENDING_SHUT_WR;
+ } else if (how == TCP_SHUT_RDWR) {
+ desc->tcp_add_flags |= TCP_ADDF_PENDING_SHUT_RDWR;
+ }
return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize);
- } else {
+ }
+ if (IS_SOCKET_ERROR(sock_shutdown(INETP(desc)->s, how))) {
+ if (how != TCP_SHUT_RD)
+ desc->tcp_add_flags |= TCP_ADDF_SHUTDOWN_WR_DONE;
return ctl_error(sock_errno(), rbuf, rsize);
+ } else {
+ return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize);
}
}
default:
@@ -9437,7 +9646,7 @@ static void tcp_inet_timeout(ErlDrvData e)
set_busy_port(desc->inet.port, 0);
inet_reply_error_am(INETP(desc), am_timeout);
if (desc->send_timeout_close) {
- erl_inet_close(INETP(desc));
+ tcp_desc_close(desc);
}
}
else {
@@ -9451,7 +9660,7 @@ static void tcp_inet_timeout(ErlDrvData e)
else if ((state & INET_STATE_CONNECTING) == INET_STATE_CONNECTING) {
/* assume connect timeout */
/* close the socket since it's not usable (see man pages) */
- erl_inet_close(INETP(desc));
+ tcp_desc_close(desc);
async_error_am(INETP(desc), am_timeout);
}
else if ((state & INET_STATE_ACCEPTING) == INET_STATE_ACCEPTING) {
@@ -9509,17 +9718,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;
@@ -9530,11 +9728,19 @@ static void tcp_inet_commandv(ErlDrvData e, ErlIOVec* ev)
if (!IS_CONNECTED(INETP(desc))) {
if (desc->tcp_add_flags & TCP_ADDF_DELAYED_CLOSE_SEND) {
desc->tcp_add_flags &= ~TCP_ADDF_DELAYED_CLOSE_SEND;
- inet_reply_error_am(INETP(desc), am_closed);
+ if (desc->tcp_add_flags & TCP_ADDF_DELAYED_ECONNRESET) {
+ /* Don't clear flag. Leave it enabled for the next receive
+ * operation.
+ */
+ inet_reply_error(INETP(desc), ECONNRESET);
+ } else
+ inet_reply_error_am(INETP(desc), am_closed);
}
else
inet_reply_error(INETP(desc), ENOTCONN);
}
+ else if (desc->tcp_add_flags & TCP_ADDF_PENDING_SHUTDOWN)
+ tcp_shutdown_error(desc, EPIPE);
else if (tcp_sendv(desc, ev) == 0)
inet_reply_ok(INETP(desc));
DEBUGF(("tcp_inet_commandv(%ld) }\r\n", (long)desc->inet.port));
@@ -9547,6 +9753,8 @@ static void tcp_inet_flush(ErlDrvData e)
/* Discard send queue to avoid hanging port (OTP-7615) */
tcp_clear_output(desc);
}
+ if (desc->tcp_add_flags & TCP_ADDF_LINGER_ZERO)
+ tcp_clear_output(desc);
}
static void tcp_inet_process_exit(ErlDrvData e, ErlDrvMonitor *monitorp)
@@ -9582,22 +9790,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
@@ -9631,8 +9823,7 @@ static int tcp_recv_closed(tcp_descriptor* desc)
/* passive mode do not terminate port ! */
tcp_clear_input(desc);
if (desc->inet.exitf) {
- tcp_clear_output(desc);
- desc_close(INETP(desc));
+ tcp_desc_close(desc);
} else {
desc_close_read(INETP(desc));
}
@@ -9675,7 +9866,7 @@ static int tcp_recv_error(tcp_descriptor* desc, int err)
driver_cancel_timer(desc->inet.port);
tcp_clear_input(desc);
if (desc->inet.exitf) {
- desc_close(INETP(desc));
+ tcp_desc_close(desc);
} else {
desc_close_read(INETP(desc));
}
@@ -9719,7 +9910,7 @@ static int tcp_remain(tcp_descriptor* desc, int* len)
tlen = packet_get_length(desc->inet.htype, ptr, n,
desc->inet.psize, desc->i_bufsz,
- &desc->http_state);
+ desc->inet.delimiter, &desc->http_state);
DEBUGF(("tcp_remain(%ld): s=%d, n=%d, nfill=%d nsz=%d, tlen %d\r\n",
(long)desc->inet.port, desc->inet.s, n, nfill, nsz, tlen));
@@ -9909,7 +10100,10 @@ static int tcp_recv(tcp_descriptor* desc, int request_len)
int err = sock_errno();
if (err == ECONNRESET) {
DEBUGF((" => detected close (connreset)\r\n"));
- return tcp_recv_closed(desc);
+ if (desc->tcp_add_flags & TCP_ADDF_SHOW_ECONNRESET)
+ return tcp_recv_error(desc, err);
+ else
+ return tcp_recv_closed(desc);
}
if (err == ERRNO_BLOCK) {
DEBUGF((" => would block\r\n"));
@@ -10121,7 +10315,19 @@ static void tcp_inet_event(ErlDrvData e, ErlDrvEvent event)
if (netEv.lNetworkEvents & FD_CLOSE) {
/* error in err = netEv.iErrorCode[FD_CLOSE_BIT] */
DEBUGF(("Detected close in %s, line %d\r\n", __FILE__, __LINE__));
- tcp_recv_closed(desc);
+ if (desc->tcp_add_flags & TCP_ADDF_SHOW_ECONNRESET) {
+ err = netEv.iErrorCode[FD_CLOSE_BIT];
+ if (err == ECONNRESET)
+ tcp_recv_error(desc, err);
+ else if (err == ECONNABORTED && IS_CONNECTED(INETP(desc))) {
+ /* translate this error to ECONNRESET */
+ tcp_recv_error(desc, ECONNRESET);
+ }
+ else
+ tcp_recv_closed(desc);
+ }
+ else
+ tcp_recv_closed(desc);
}
DEBUGF(("tcp_inet_event(%ld) }\r\n", (long)desc->inet.port));
return;
@@ -10131,146 +10337,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:
@@ -10293,6 +10360,7 @@ static int tcp_inet_input(tcp_descriptor* desc, HANDLE event)
inet_async_op *this_op = desc->inet.opt;
len = sizeof(desc->inet.remote);
+ sys_memzero((char *) &remote, len);
s = sock_accept(desc->inet.s, (struct sockaddr*) &remote, &len);
if (s == INVALID_SOCKET && sock_errno() == ERRNO_BLOCK) {
/* Just try again, no real error, just a ghost trigger from poll,
@@ -10359,6 +10427,7 @@ static int tcp_inet_input(tcp_descriptor* desc, HANDLE event)
while (desc->inet.state == INET_STATE_MULTI_ACCEPTING) {
len = sizeof(desc->inet.remote);
+ sys_memzero((char *) &remote, len);
s = sock_accept(desc->inet.s, (struct sockaddr*) &remote, &len);
if (s == INVALID_SOCKET && sock_errno() == ERRNO_BLOCK) {
/* Just try again, no real error, keep the last return code */
@@ -10428,8 +10497,11 @@ static int tcp_inet_input(tcp_descriptor* desc, HANDLE event)
return ret;
}
-static int tcp_send_error(tcp_descriptor* desc, int err)
+static int tcp_send_or_shutdown_error(tcp_descriptor* desc, int err)
{
+ int show_econnreset = (err == ECONNRESET
+ && desc->tcp_add_flags & TCP_ADDF_SHOW_ECONNRESET);
+
/*
* If the port is busy, we must do some clean-up before proceeding.
*/
@@ -10445,26 +10517,34 @@ static int tcp_send_error(tcp_descriptor* desc, int err)
/*
* We used to handle "expected errors" differently from unexpected ones.
- * Now we handle all errors in the same way. We just have to distinguish
- * between passive and active sockets.
+ * Now we handle all errors in the same way (unless the show_econnreset
+ * socket option is enabled). We just have to distinguish between passive
+ * and active sockets.
*/
DEBUGF(("driver_failure_eof(%ld) in %s, line %d\r\n",
(long)desc->inet.port, __FILE__, __LINE__));
if (desc->inet.active) {
- tcp_closed_message(desc);
- inet_reply_error_am(INETP(desc), am_closed);
+ if (show_econnreset) {
+ tcp_error_message(desc, err);
+ tcp_closed_message(desc);
+ inet_reply_error(INETP(desc), err);
+ } else {
+ tcp_closed_message(desc);
+ inet_reply_error_am(INETP(desc), am_closed);
+ }
if (desc->inet.exitf)
driver_exit(desc->inet.port, 0);
else
- desc_close(INETP(desc));
+ tcp_desc_close(desc);
} else {
- tcp_clear_output(desc);
- tcp_clear_input(desc);
tcp_close_check(desc);
- erl_inet_close(INETP(desc));
+ tcp_desc_close(desc);
if (desc->inet.caller) {
- inet_reply_error_am(INETP(desc), am_closed);
+ if (show_econnreset)
+ inet_reply_error(INETP(desc), err);
+ else
+ inet_reply_error_am(INETP(desc), am_closed);
}
else {
/* No blocking send op to reply to right now.
@@ -10481,10 +10561,54 @@ static int tcp_send_error(tcp_descriptor* desc, int err)
* in the receive operation.
*/
desc->tcp_add_flags |= TCP_ADDF_DELAYED_CLOSE_RECV;
+
+ if (show_econnreset) {
+ /* Return {error, econnreset} instead of {error, closed}
+ * on send or receive operations.
+ */
+ desc->tcp_add_flags |= TCP_ADDF_DELAYED_ECONNRESET;
+ }
}
return -1;
}
+static int tcp_send_error(tcp_descriptor* desc, int err)
+{
+ /* EPIPE errors usually occur in one of three ways:
+ * 1. We write to a socket when we've already shutdown() the write side. On
+ * Windows the error returned for this is ESHUTDOWN rather than EPIPE.
+ * 2. The TCP peer sends us an RST through no fault of our own (perhaps
+ * by aborting the connection using SO_LINGER) and we then attempt
+ * to write to the socket. On Linux and Windows we would actually
+ * receive an ECONNRESET error for this, but on the BSDs, Darwin,
+ * Illumos and presumably Solaris, it's an EPIPE.
+ * 3. We cause the TCP peer to send us an RST by writing to a socket
+ * after we receive a FIN from them. Our first write will be
+ * successful, but if the they have closed the connection (rather
+ * than just shutting down the write side of it) this will cause their
+ * OS to send us an RST. Then, when we attempt to write to the socket
+ * a second time, we will get an EPIPE error. On Windows we get an
+ * ECONNABORTED.
+ *
+ * What we are going to do here is to treat all EPIPE messages that aren't
+ * of type 1 as ECONNRESET errors. This will allow users who have the
+ * show_econnreset socket option enabled to receive {error, econnreset} on
+ * both send and recv operations to indicate that an RST has been received.
+ */
+#ifdef __WIN_32__
+ if (err == ECONNABORTED)
+ err = ECONNRESET;
+#endif
+ if (err == EPIPE && !(desc->tcp_add_flags & TCP_ADDF_SHUTDOWN_WR_DONE))
+ err = ECONNRESET;
+ return tcp_send_or_shutdown_error(desc, err);
+}
+
+static int tcp_shutdown_error(tcp_descriptor* desc, int err)
+{
+ return tcp_send_or_shutdown_error(desc, err);
+}
+
/*
** Send non-blocking vector data
*/
@@ -10685,49 +10809,21 @@ static int tcp_send(tcp_descriptor* desc, char* ptr, ErlDrvSizeT len)
return 0;
}
-#ifdef __OSE__
-
-static void tcp_inet_drv_output_ose(ErlDrvData data, ErlDrvEvent event)
+/* shutdown on the socket:
+** Assume caller has confirmed TCP_ADDF_PENDING_SHUTDOWN is set.
+*/
+static void tcp_shutdown_async(tcp_descriptor* desc)
{
- union SIGNAL *event_sig = erl_drv_ose_get_signal(event);
+ int how;
- 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;
- }
- }
+ how = (desc->tcp_add_flags & TCP_ADDF_PENDING_SHUT_WR) ?
+ TCP_SHUT_WR : TCP_SHUT_RDWR;
+ if (IS_SOCKET_ERROR(sock_shutdown(INETP(desc)->s, how)))
+ tcp_shutdown_error(desc, sock_errno());
+ else
+ desc->tcp_add_flags |= TCP_ADDF_SHUTDOWN_WR_DONE;
}
-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);
@@ -10737,7 +10833,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 ?
@@ -10766,12 +10861,13 @@ static int tcp_inet_output(tcp_descriptor* desc, HANDLE event)
#ifndef SO_ERROR
{
- int sz = sizeof(desc->inet.remote);
- int code = sock_peer(desc->inet.s,
- (struct sockaddr*) &desc->inet.remote, &sz);
-
+ int sz, code;
+ sz = sizeof(desc->inet.remote);
+ sys_memzero((char *) &desc->inet.remote, sz);
+ code = sock_peer(desc->inet.s,
+ (struct sockaddr*) &desc->inet.remote, &sz);
if (IS_SOCKET_ERROR(code)) {
- desc->inet.state = INET_STATE_BOUND; /* restore state */
+ desc->inet.state = INET_STATE_OPEN; /* restore state */
ret = async_error(INETP(desc), sock_errno());
goto done;
}
@@ -10784,7 +10880,7 @@ static int tcp_inet_output(tcp_descriptor* desc, HANDLE event)
(void *)&error, &sz);
if ((code < 0) || error) {
- desc->inet.state = INET_STATE_BOUND; /* restore state */
+ desc->inet.state = INET_STATE_OPEN; /* restore state */
ret = async_error(INETP(desc), error);
goto done;
}
@@ -10803,16 +10899,11 @@ 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));
+ if (desc->tcp_add_flags & TCP_ADDF_PENDING_SHUTDOWN)
+ tcp_shutdown_async(desc);
goto done;
}
vsize = vsize > MAX_VSIZE ? MAX_VSIZE : vsize;
@@ -10835,12 +10926,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) {
@@ -11077,13 +11162,12 @@ static ErlDrvSSizeT packet_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf,
case INET_AF_INET: af = AF_INET; break;
#if defined(HAVE_IN6) && defined(AF_INET6)
case INET_AF_INET6: af = AF_INET6; break;
-#else
- case INET_AF_INET6:
- return ctl_xerror("eafnosupport", rbuf, rsize);
- break;
+#endif
+#ifdef HAVE_SYS_UN_H
+ case INET_AF_LOCAL: af = AF_UNIX; break;
#endif
default:
- return ctl_error(EINVAL, rbuf, rsize);
+ return ctl_xerror(str_eafnosupport, rbuf, rsize);
}
switch (buf[1]) {
case INET_TYPE_STREAM: type = SOCK_STREAM; break;
@@ -11116,23 +11200,23 @@ static ErlDrvSSizeT packet_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf,
return replen;
- case INET_REQ_FDOPEN: { /* pass in an open (and bound) socket */
+ case INET_REQ_FDOPEN: { /* pass in an open (and optionally bound) socket */
SOCKET s;
+ int bound;
DEBUGF(("packet inet_ctl(%ld): FDOPEN\r\n", (long)desc->port));
- if (len != 6) {
+ if (len != 6 && len != 10) {
return ctl_error(EINVAL, rbuf, rsize);
}
switch (buf[0]) {
case INET_AF_INET: af = AF_INET; break;
#if defined(HAVE_IN6) && defined(AF_INET6)
case INET_AF_INET6: af = AF_INET6; break;
-#else
- case INET_AF_INET6:
- return ctl_xerror("eafnosupport", rbuf, rsize);
- break;
+#endif
+#ifdef HAVE_SYS_UN_H
+ case INET_AF_LOCAL: af = AF_UNIX; break;
#endif
default:
- return ctl_error(EINVAL, rbuf, rsize);
+ return ctl_xerror(str_eafnosupport, rbuf, rsize);
}
switch (buf[1]) {
case INET_TYPE_STREAM: type = SOCK_STREAM; break;
@@ -11144,7 +11228,11 @@ static ErlDrvSSizeT packet_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf,
return ctl_error(EINVAL, rbuf, rsize);
}
s = (SOCKET)get_int32(buf+2);
- replen = inet_ctl_fdopen(desc, af, type, s, rbuf, rsize);
+
+ if (len == 6) bound = 1;
+ else bound = get_int32(buf+2+4);
+
+ replen = inet_ctl_fdopen(desc, af, type, s, bound, rbuf, rsize);
if ((*rbuf)[0] != INET_REP_ERROR) {
if (desc->active)
@@ -11193,11 +11281,10 @@ static ErlDrvSSizeT packet_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf,
if (!IS_OPEN(desc))
return ctl_xerror(EXBADPORT, rbuf, rsize);
- if (!IS_BOUND(desc))
- return ctl_xerror(EXBADSEQ, rbuf, rsize);
#ifdef HAVE_SCTP
if (IS_SCTP(desc)) {
inet_address remote;
+ char *xerror;
if (IS_CONNECTING(desc))
return ctl_error(EINVAL, rbuf, rsize);
@@ -11209,8 +11296,9 @@ static ErlDrvSSizeT packet_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf,
/* For SCTP, we do not set the peer's addr in desc->remote, as
multiple peers are possible: */
- if (inet_set_address(desc->sfamily, &remote, buf, &len) == NULL)
- return ctl_error(EINVAL, rbuf, rsize);
+ if ((xerror = inet_set_faddress
+ (desc->sfamily, &remote, &buf, &len)) != NULL)
+ return ctl_xerror(xerror, rbuf, rsize);
sock_select(desc, FD_CONNECT, 1);
code = sock_connect(desc->s, &remote.sa, len);
@@ -11246,12 +11334,13 @@ static ErlDrvSSizeT packet_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf,
else if (len < 6)
return ctl_error(EINVAL, rbuf, rsize);
else {
+ char *xerror;
/* Ignore timeout */
buf += 4;
len -= 4;
- if (inet_set_address(desc->sfamily,
- &desc->remote, buf, &len) == NULL)
- return ctl_error(EINVAL, rbuf, rsize);
+ if ((xerror = inet_set_faddress
+ (desc->sfamily, &desc->remote, &buf, &len)) != NULL)
+ return ctl_xerror(xerror, rbuf, rsize);
code = sock_connect(desc->s,
(struct sockaddr*) &desc->remote, len);
@@ -11281,8 +11370,6 @@ static ErlDrvSSizeT packet_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf,
return ctl_xerror(EXBADPORT, rbuf, rsize);
if (!IS_OPEN(desc))
return ctl_xerror(EXBADPORT, rbuf, rsize);
- if (!IS_BOUND(desc))
- return ctl_xerror(EXBADSEQ, rbuf, rsize);
if (len != 2)
return ctl_error(EINVAL, rbuf, rsize);
@@ -11317,11 +11404,13 @@ static ErlDrvSSizeT packet_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf,
while (curr < buf+len)
{
+ char *xerror;
/* List item format: see "inet_set_faddress": */
ErlDrvSizeT alen = buf + len - curr;
- curr = inet_set_faddress(desc->sfamily, &addr, curr, &alen);
- if (curr == NULL)
- return ctl_error(EINVAL, rbuf, rsize);
+ xerror = inet_set_faddress
+ (desc->sfamily, &addr, &curr, &alen);
+ if (xerror != NULL)
+ return ctl_xerror(xerror, rbuf, rsize);
/* Invoke the call: */
if (p_sctp_bindx(desc->s, (struct sockaddr *)&addr, 1,
@@ -11329,7 +11418,7 @@ static ErlDrvSSizeT packet_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf,
return ctl_error(sock_errno(), rbuf, rsize);
}
- desc->state = INET_STATE_BOUND;
+ desc->state = INET_STATE_OPEN;
return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize);
}
@@ -11346,8 +11435,6 @@ static ErlDrvSSizeT packet_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf,
return ctl_xerror(EXBADPORT, rbuf, rsize);
if (!IS_OPEN(desc))
return ctl_xerror(EXBADPORT, rbuf, rsize);
- if (!IS_BOUND(desc))
- return ctl_xerror(EXBADSEQ, rbuf, rsize);
if (! p_sctp_peeloff)
return ctl_error(ENOTSUP, rbuf, rsize);
@@ -11388,8 +11475,6 @@ static ErlDrvSSizeT packet_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf,
/* INPUT: Timeout(4), Length(4) */
if (!IS_OPEN(desc))
return ctl_xerror(EXBADPORT, rbuf, rsize);
- if (!IS_BOUND(desc))
- return ctl_error(EINVAL, rbuf, rsize);
if (desc->active || (len != 8))
return ctl_error(EINVAL, rbuf, rsize);
timeout = get_int32(buf);
@@ -11430,12 +11515,12 @@ static void packet_inet_timeout(ErlDrvData e)
/* THIS IS A "send*" REQUEST; on the Erlang side: "port_command".
-** input should be: P1 P0 Address buffer .
+** input should be: Family Address buffer .
** For UDP, buffer (after Address) is just data to be sent.
** For SCTP, buffer contains a list representing 2 items:
** (1) 6 parms for sctp_sndrcvinfo, as in sctp_get_sendparams();
** (2) 0+ real data bytes.
-** There is no destination address -- SCTYP send is performed over
+** There is no destination address -- SCTP send is performed over
** an existing association, using "sctp_sndrcvinfo" specified.
*/
static void packet_inet_command(ErlDrvData e, char* buf, ErlDrvSizeT len)
@@ -11444,6 +11529,7 @@ static void packet_inet_command(ErlDrvData e, char* buf, ErlDrvSizeT len)
inet_descriptor* desc = INETP(udesc);
char* ptr = buf;
char* qtr;
+ char* xerror;
ErlDrvSizeT sz;
int code;
inet_address other;
@@ -11454,10 +11540,6 @@ static void packet_inet_command(ErlDrvData e, char* buf, ErlDrvSizeT len)
inet_reply_error(desc, EINVAL);
return;
}
- if (!IS_BOUND(desc)) {
- inet_reply_error(desc, EINVAL);
- return;
- }
#ifdef HAVE_SCTP
if (IS_SCTP(desc))
@@ -11501,6 +11583,7 @@ static void packet_inet_command(ErlDrvData e, char* buf, ErlDrvSizeT len)
VALGRIND_MAKE_MEM_DEFINED(mhdr.msg_control, mhdr.msg_controllen); /*suppress "uninitialised bytes"*/
mhdr.msg_flags = 0; /* Not used with "sendmsg" */
+ inet_output_count(desc, data_len);
/* Now do the actual sending. NB: "flags" in "sendmsg" itself are NOT
used: */
code = sock_sendmsg(desc->s, &mhdr, 0);
@@ -11510,9 +11593,10 @@ static void packet_inet_command(ErlDrvData e, char* buf, ErlDrvSizeT len)
/* UDP socket. Even if it is connected, there is an address prefix
here -- ignored for connected sockets: */
sz = len;
- qtr = inet_set_address(desc->sfamily, &other, ptr, &sz);
- if (qtr == NULL) {
- inet_reply_error(desc, EINVAL);
+ qtr = ptr;
+ xerror = inet_set_faddress(desc->sfamily, &other, &qtr, &sz);
+ if (xerror != NULL) {
+ inet_reply_error_am(desc, driver_mk_atom(xerror));
return;
}
len -= (qtr - ptr);
@@ -11588,6 +11672,8 @@ static int packet_inet_input(udp_descriptor* udesc, HANDLE event)
while(packet_count--) {
unsigned int len = sizeof(other);
+ sys_memzero((char *) &other, sizeof(other));
+
/* udesc->i_buf is only kept between SCTP fragments */
if (udesc->i_buf == NULL) {
udesc->i_bufsz = desc->bufsz + len;
@@ -11783,7 +11869,7 @@ static int packet_inet_output(udp_descriptor* udesc, HANDLE event)
(struct sockaddr*) &desc->remote, &sz);
if (IS_SOCKET_ERROR(code)) {
- desc->state = INET_STATE_BOUND; /* restore state */
+ desc->state = INET_STATE_OPEN; /* restore state */
ret = async_error(desc, sock_errno());
goto done;
}
@@ -11796,7 +11882,7 @@ static int packet_inet_output(udp_descriptor* udesc, HANDLE event)
(void *)&error, &sz);
if ((code < 0) || error) {
- desc->state = INET_STATE_BOUND; /* restore state */
+ desc->state = INET_STATE_OPEN; /* restore state */
ret = async_error(desc, error);
goto done;
}
@@ -11877,115 +11963,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 {
@@ -11997,9 +11986,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)
@@ -12022,8 +12011,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) {
@@ -12039,32 +12030,16 @@ static MultiTimerData *add_multi_timer(MultiTimerData **first, ErlDrvPort port,
{
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;
- }
- }
- if (!p || p->when.megasecs > mtd->when.megasecs) {
- goto found;
- }
- for (; p!= NULL; s = p, p = p->next) {
- if (p->when.secs >= mtd->when.secs) {
- break;
- }
- }
- if (!p || p->when.secs > mtd->when.secs) {
- goto found;
- }
- for (; p!= NULL; s = p, p = p->next) {
- if (p->when.microsecs >= mtd->when.microsecs) {
+ if (p->when >= mtd->when) {
break;
}
}
- found:
+
if (!p) {
if (!s) {
*first = mtd;
@@ -12090,10 +12065,6 @@ static MultiTimerData *add_multi_timer(MultiTimerData **first, ErlDrvPort port,
}
return mtd;
}
-
-
-
-
/*-----------------------------------------------------------------------------
@@ -12211,7 +12182,7 @@ void erts_sock_close(erts_sock_t socket)
int erts_sock_connect(erts_sock_t socket, byte *ip_addr, int len, Uint16 port)
{
SOCKET s = (SOCKET) socket;
- char buf[2 + 4];
+ char buf[2 + 4], *p;
ErlDrvSizeT blen = 6;
inet_address addr;
@@ -12221,12 +12192,12 @@ int erts_sock_connect(erts_sock_t socket, byte *ip_addr, int len, Uint16 port)
put_int16(port, buf);
memcpy((void *) (buf + 2), (void *) ip_addr, 4);
- if (!inet_set_address(AF_INET, &addr, buf, &blen))
+ p = buf;
+ if (inet_set_address(AF_INET, &addr, &p, &blen) != NULL)
return 0;
- if (IS_SOCKET_ERROR(sock_connect(s,
- (struct sockaddr *) &addr,
- sizeof(struct sockaddr_in))))
+ if (IS_SOCKET_ERROR
+ (sock_connect(s, (struct sockaddr *) &addr, blen)))
return 0;
return 1;
}
diff --git a/erts/emulator/drivers/common/ram_file_drv.c b/erts/emulator/drivers/common/ram_file_drv.c
index 7f7cd7cd91..bcdfe6a186 100644
--- a/erts/emulator/drivers/common/ram_file_drv.c
+++ b/erts/emulator/drivers/common/ram_file_drv.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1997-2011. All Rights Reserved.
+ * Copyright Ericsson AB 1997-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/drivers/common/zlib_drv.c b/erts/emulator/drivers/common/zlib_drv.c
deleted file mode 100644
index 3143e4511d..0000000000
--- a/erts/emulator/drivers/common/zlib_drv.c
+++ /dev/null
@@ -1,662 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2003-2013. 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%
- */
-
-/*
- * ZLib interface for erlang
- *
- */
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-#include <stdio.h>
-#include <zlib.h>
-#include <errno.h>
-#include <string.h>
-
-#include "erl_driver.h"
-
-
-#define DEFLATE_INIT 1
-#define DEFLATE_INIT2 2
-#define DEFLATE_SETDICT 3
-#define DEFLATE_RESET 4
-#define DEFLATE_END 5
-#define DEFLATE_PARAMS 6
-#define DEFLATE 7
-
-#define INFLATE_INIT 8
-#define INFLATE_INIT2 9
-#define INFLATE_SETDICT 10
-#define INFLATE_SYNC 11
-#define INFLATE_RESET 12
-#define INFLATE_END 13
-#define INFLATE 14
-
-#define CRC32_0 15
-#define CRC32_1 16
-#define CRC32_2 17
-
-#define SET_BUFSZ 18
-#define GET_BUFSZ 19
-#define GET_QSIZE 20
-
-#define ADLER32_1 21
-#define ADLER32_2 22
-
-#define CRC32_COMBINE 23
-#define ADLER32_COMBINE 24
-
-#define DEFAULT_BUFSZ 4000
-
-static int zlib_init(void);
-static ErlDrvData zlib_start(ErlDrvPort port, char* buf);
-static void zlib_stop(ErlDrvData e);
-static void zlib_flush(ErlDrvData e);
-static ErlDrvSSizeT zlib_ctl(ErlDrvData drv_data, unsigned int command, char *buf,
- ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen);
-static void zlib_outputv(ErlDrvData drv_data, ErlIOVec *ev);
-
-ErlDrvEntry zlib_driver_entry = {
- zlib_init,
- zlib_start,
- zlib_stop,
- NULL, /* output */
- NULL, /* ready_input */
- NULL, /* ready_output */
- "zlib_drv",
- NULL, /* finish */
- NULL, /* handle */
- zlib_ctl,
- NULL, /* timeout */
- zlib_outputv,
- NULL, /* read_async */
- zlib_flush,
- NULL, /* call */
- NULL, /* event */
- ERL_DRV_EXTENDED_MARKER,
- ERL_DRV_EXTENDED_MAJOR_VERSION,
- ERL_DRV_EXTENDED_MINOR_VERSION,
- ERL_DRV_FLAG_USE_PORT_LOCKING,
- NULL, /* handle2 */
- NULL, /* process_exit */
-};
-
-typedef enum {
- ST_NONE = 0,
- ST_DEFLATE = 1,
- ST_INFLATE = 2
-} ZLibState;
-
-
-typedef struct {
- z_stream s;
- ZLibState state;
- ErlDrvBinary* bin;
- int binsz;
- int binsz_need;
- uLong crc;
- int inflate_eos_seen;
- int want_crc; /* 1 if crc is calculated on clear text */
- ErlDrvPort port; /* the associcated port */
-} ZLibData;
-
-static int zlib_inflate(ZLibData* d, int flush);
-static int zlib_deflate(ZLibData* d, int flush);
-
-#if defined(__WIN32__)
-static int i32(char* buf)
-#else
-static __inline__ int i32(char* buf)
-#endif
-{
- return (int) (
- (((int)((unsigned char*)buf)[0]) << 24) |
- (((int)((unsigned char*)buf)[1]) << 16) |
- (((int)((unsigned char*)buf)[2]) << 8) |
- (((int)((unsigned char*)buf)[3]) << 0));
-}
-
-static char* zlib_reason(int code, int* err)
-{
- switch(code) {
- case Z_OK:
- *err = 0;
- return "ok";
- case Z_STREAM_END:
- *err = 0;
- return "stream_end";
- case Z_ERRNO:
- *err = 1;
- return erl_errno_id(errno);
- case Z_STREAM_ERROR:
- *err = 1;
- return "stream_error";
- case Z_DATA_ERROR:
- *err = 1;
- return "data_error";
- case Z_MEM_ERROR:
- *err = 1;
- return "mem_error";
- case Z_BUF_ERROR:
- *err = 1;
- return "buf_error";
- case Z_VERSION_ERROR:
- *err = 1;
- return "version_error";
- default:
- *err = 1;
- return "unknown_error";
- }
-}
-
-
-static ErlDrvSSizeT zlib_return(int code, char** rbuf, ErlDrvSizeT rlen)
-{
- int msg_code = 0; /* 0=ok, 1=error */
- char* dst = *rbuf;
- char* src;
- ErlDrvSizeT len = 0;
-
- src = zlib_reason(code, &msg_code);
- *dst++ = msg_code;
- rlen--;
- len = 1;
-
- while((rlen > 0) && *src) {
- *dst++ = *src++;
- rlen--;
- len++;
- }
- return len;
-}
-
-static ErlDrvSSizeT zlib_value2(int msg_code, int value,
- char** rbuf, ErlDrvSizeT rlen)
-{
- char* dst = *rbuf;
-
- if (rlen < 5) {
- return -1;
- }
- *dst++ = msg_code;
- *dst++ = (value >> 24) & 0xff;
- *dst++ = (value >> 16) & 0xff;
- *dst++ = (value >> 8) & 0xff;
- *dst++ = value & 0xff;
- return 5;
-}
-
-static ErlDrvSSizeT zlib_value(int value, char** rbuf, ErlDrvSizeT rlen)
-{
- return zlib_value2(2, value, rbuf, rlen);
-}
-
-static int zlib_output_init(ZLibData* d)
-{
- if (d->bin != NULL)
- driver_free_binary(d->bin);
- if ((d->bin = driver_alloc_binary(d->binsz_need)) == NULL)
- return -1;
- d->binsz = d->binsz_need;
- d->s.next_out = (unsigned char*)d->bin->orig_bytes;
- d->s.avail_out = d->binsz;
- return 0;
-}
-
-/*
- * Send compressed or uncompressed data
- * and restart output procesing
- */
-static int zlib_output(ZLibData* d)
-{
- if (d->bin != NULL) {
- int len = d->binsz - d->s.avail_out;
- if (len > 0) {
- if (driver_output_binary(d->port, NULL, 0, d->bin, 0, len) < 0)
- return -1;
- }
- driver_free_binary(d->bin);
- d->bin = NULL;
- d->binsz = 0;
- }
- return zlib_output_init(d);
-}
-
-static int zlib_inflate(ZLibData* d, int flush)
-{
- int res = Z_OK;
-
- if ((d->bin == NULL) && (zlib_output_init(d) < 0)) {
- errno = ENOMEM;
- return Z_ERRNO;
- }
-
- while ((driver_sizeq(d->port) > 0) && (res != Z_STREAM_END)) {
- int vlen;
- SysIOVec* iov = driver_peekq(d->port, &vlen);
- int len;
- int possibly_more_output = 0;
-
- d->s.next_in = iov[0].iov_base;
- d->s.avail_in = iov[0].iov_len;
- while((possibly_more_output || (d->s.avail_in > 0)) && (res != Z_STREAM_END)) {
- res = inflate(&d->s, Z_NO_FLUSH);
- if (res == Z_NEED_DICT) {
- /* Essential to eat the header bytes that zlib has looked at */
- len = iov[0].iov_len - d->s.avail_in;
- driver_deq(d->port, len);
- return res;
- }
- if (res == Z_BUF_ERROR) {
- /* Was possible more output, but actually not */
- res = Z_OK;
- }
- else if (res < 0) {
- return res;
- }
- if (d->s.avail_out != 0) {
- possibly_more_output = 0;
- } else {
- if (d->want_crc)
- d->crc = crc32(d->crc, (unsigned char*)d->bin->orig_bytes,
- d->binsz - d->s.avail_out);
- zlib_output(d);
- possibly_more_output = 1;
- }
- }
- len = iov[0].iov_len - d->s.avail_in;
- driver_deq(d->port, len);
- }
-
- if (d->want_crc) {
- d->crc = crc32(d->crc, (unsigned char*) d->bin->orig_bytes,
- d->binsz - d->s.avail_out);
- }
- zlib_output(d);
- if (res == Z_STREAM_END) {
- d->inflate_eos_seen = 1;
- }
- return res;
-}
-
-static int zlib_deflate(ZLibData* d, int flush)
-{
- int res = Z_OK;
-
- if ((d->bin == NULL) && (zlib_output_init(d) < 0)) {
- errno = ENOMEM;
- return Z_ERRNO;
- }
-
- while ((driver_sizeq(d->port) > 0) && (res != Z_STREAM_END)) {
- int vlen;
- SysIOVec* iov = driver_peekq(d->port, &vlen);
- int len;
-
- d->s.next_in = iov[0].iov_base;
- d->s.avail_in = iov[0].iov_len;
-
- while((d->s.avail_in > 0) && (res != Z_STREAM_END)) {
- if ((res = deflate(&d->s, Z_NO_FLUSH)) < 0) {
- return res;
- }
- if (d->s.avail_out == 0) {
- zlib_output(d);
- }
- }
- len = iov[0].iov_len - d->s.avail_in;
- if (d->want_crc) {
- d->crc = crc32(d->crc, iov[0].iov_base, len);
- }
- driver_deq(d->port, len);
- }
-
- if (flush != Z_NO_FLUSH) {
- if ((res = deflate(&d->s, flush)) < 0) {
- return res;
- }
- if (flush == Z_FINISH) {
- while (d->s.avail_out < d->binsz) {
- zlib_output(d);
- if (res == Z_STREAM_END) {
- break;
- }
- if ((res = deflate(&d->s, flush)) < 0) {
- return res;
- }
- }
- } else {
- while (d->s.avail_out == 0) {
- zlib_output(d);
- if ((res = deflate(&d->s, flush)) < 0) {
- return res;
- }
- }
- if (d->s.avail_out < d->binsz) {
- zlib_output(d);
- }
- }
- }
- return res;
-}
-
-
-
-static void* zlib_alloc(void* data, unsigned int items, unsigned int size)
-{
- return (void*) driver_alloc(items*size);
-}
-
-static void zlib_free(void* data, void* addr)
-{
- driver_free(addr);
-}
-
-static int zlib_init()
-{
- return 0;
-}
-
-static ErlDrvData zlib_start(ErlDrvPort port, char* buf)
-{
- ZLibData* d;
-
- if ((d = (ZLibData*) driver_alloc(sizeof(ZLibData))) == NULL)
- return ERL_DRV_ERROR_GENERAL;
-
- memset(&d->s, 0, sizeof(z_stream));
-
- d->s.zalloc = zlib_alloc;
- d->s.zfree = zlib_free;
- d->s.opaque = d;
- d->s.data_type = Z_BINARY;
-
- d->port = port;
- d->state = ST_NONE;
- d->bin = NULL;
- d->binsz = 0;
- d->binsz_need = DEFAULT_BUFSZ;
- d->crc = crc32(0L, Z_NULL, 0);
- d->inflate_eos_seen = 0;
- d->want_crc = 0;
- return (ErlDrvData)d;
-}
-
-
-static void zlib_stop(ErlDrvData e)
-{
- ZLibData* d = (ZLibData*)e;
-
- if (d->state == ST_DEFLATE)
- deflateEnd(&d->s);
- else if (d->state == ST_INFLATE)
- inflateEnd(&d->s);
-
- if (d->bin != NULL)
- driver_free_binary(d->bin);
-
- driver_free(d);
-}
-
-static void zlib_flush(ErlDrvData drv_data)
-{
- ZLibData* d = (ZLibData*) drv_data;
-
- driver_deq(d->port, driver_sizeq(d->port));
-}
-
-static ErlDrvSSizeT zlib_ctl(ErlDrvData drv_data, unsigned int command, char *buf,
- ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen)
-{
- ZLibData* d = (ZLibData*)drv_data;
- int res;
-
- switch(command) {
- case DEFLATE_INIT:
- if (len != 4) goto badarg;
- if (d->state != ST_NONE) goto badarg;
- res = deflateInit(&d->s, i32(buf));
- if (res == Z_OK) {
- d->state = ST_DEFLATE;
- d->want_crc = 0;
- d->crc = crc32(0L, Z_NULL, 0);
- }
- return zlib_return(res, rbuf, rlen);
-
- case DEFLATE_INIT2: {
- int wbits;
-
- if (len != 20) goto badarg;
- if (d->state != ST_NONE) goto badarg;
- wbits = i32(buf+8);
- res = deflateInit2(&d->s, i32(buf), i32(buf+4), wbits,
- i32(buf+12), i32(buf+16));
- if (res == Z_OK) {
- d->state = ST_DEFLATE;
- d->want_crc = (wbits < 0);
- d->crc = crc32(0L, Z_NULL, 0);
- }
- return zlib_return(res, rbuf, rlen);
- }
-
- case DEFLATE_SETDICT:
- if (d->state != ST_DEFLATE) goto badarg;
- res = deflateSetDictionary(&d->s, (unsigned char*)buf, len);
- if (res == Z_OK) {
- return zlib_value(d->s.adler, rbuf, rlen);
- } else {
- return zlib_return(res, rbuf, rlen);
- }
-
- case DEFLATE_RESET:
- if (len != 0) goto badarg;
- if (d->state != ST_DEFLATE) goto badarg;
- driver_deq(d->port, driver_sizeq(d->port));
- res = deflateReset(&d->s);
- return zlib_return(res, rbuf, rlen);
-
- case DEFLATE_END:
- if (len != 0) goto badarg;
- if (d->state != ST_DEFLATE) goto badarg;
- driver_deq(d->port, driver_sizeq(d->port));
- res = deflateEnd(&d->s);
- d->state = ST_NONE;
- return zlib_return(res, rbuf, rlen);
-
- case DEFLATE_PARAMS:
- if (len != 8) goto badarg;
- if (d->state != ST_DEFLATE) goto badarg;
- res = deflateParams(&d->s, i32(buf), i32(buf+4));
- return zlib_return(res, rbuf, rlen);
-
- case DEFLATE:
- if (d->state != ST_DEFLATE) goto badarg;
- if (len != 4) goto badarg;
- res = zlib_deflate(d, i32(buf));
- return zlib_return(res, rbuf, rlen);
-
- case INFLATE_INIT:
- if (len != 0) goto badarg;
- if (d->state != ST_NONE) goto badarg;
- res = inflateInit(&d->s);
- if (res == Z_OK) {
- d->state = ST_INFLATE;
- d->inflate_eos_seen = 0;
- d->want_crc = 0;
- d->crc = crc32(0L, Z_NULL, 0);
- }
- return zlib_return(res, rbuf, rlen);
-
- case INFLATE_INIT2: {
- int wbits;
-
- if (len != 4) goto badarg;
- if (d->state != ST_NONE) goto badarg;
- wbits = i32(buf);
- res = inflateInit2(&d->s, wbits);
- if (res == Z_OK) {
- d->state = ST_INFLATE;
- d->inflate_eos_seen = 0;
- d->want_crc = (wbits < 0);
- d->crc = crc32(0L, Z_NULL, 0);
- }
- return zlib_return(res, rbuf, rlen);
- }
-
- case INFLATE_SETDICT:
- if (d->state != ST_INFLATE) goto badarg;
- res = inflateSetDictionary(&d->s, (unsigned char*)buf, len);
- return zlib_return(res, rbuf, rlen);
-
- case INFLATE_SYNC:
- if (d->state != ST_INFLATE) goto badarg;
- if (len != 0) goto badarg;
- if (driver_sizeq(d->port) == 0) {
- res = Z_BUF_ERROR;
- } else {
- int vlen;
- SysIOVec* iov = driver_peekq(d->port, &vlen);
-
- d->s.next_in = iov[0].iov_base;
- d->s.avail_in = iov[0].iov_len;
- res = inflateSync(&d->s);
- }
- return zlib_return(res, rbuf, rlen);
-
- case INFLATE_RESET:
- if (d->state != ST_INFLATE) goto badarg;
- if (len != 0) goto badarg;
- driver_deq(d->port, driver_sizeq(d->port));
- res = inflateReset(&d->s);
- d->inflate_eos_seen = 0;
- return zlib_return(res, rbuf, rlen);
-
- case INFLATE_END:
- if (d->state != ST_INFLATE) goto badarg;
- if (len != 0) goto badarg;
- driver_deq(d->port, driver_sizeq(d->port));
- res = inflateEnd(&d->s);
- if (res == Z_OK && d->inflate_eos_seen == 0) {
- res = Z_DATA_ERROR;
- }
- d->state = ST_NONE;
- return zlib_return(res, rbuf, rlen);
-
- case INFLATE:
- if (d->state != ST_INFLATE) goto badarg;
- if (len != 4) goto badarg;
- res = zlib_inflate(d, i32(buf));
- if (res == Z_NEED_DICT) {
- return zlib_value2(3, d->s.adler, rbuf, rlen);
- } else {
- return zlib_return(res, rbuf, rlen);
- }
-
- case GET_QSIZE:
- return zlib_value(driver_sizeq(d->port), rbuf, rlen);
-
- case GET_BUFSZ:
- return zlib_value(d->binsz_need, rbuf, rlen);
-
- case SET_BUFSZ: {
- int need;
- if (len != 4) goto badarg;
- need = i32(buf);
- if ((need < 16) || (need > 0x00ffffff))
- goto badarg;
- if (d->binsz_need != need) {
- d->binsz_need = need;
- if (d->bin != NULL) {
- if (d->s.avail_out == d->binsz) {
- driver_free_binary(d->bin);
- d->bin = NULL;
- d->binsz = 0;
- }
- else
- zlib_output(d);
- }
- }
- return zlib_return(Z_OK, rbuf, rlen);
- }
-
- case CRC32_0:
- return zlib_value(d->crc, rbuf, rlen);
-
- case CRC32_1: {
- uLong crc = crc32(0L, Z_NULL, 0);
- crc = crc32(crc, (unsigned char*) buf, len);
- return zlib_value(crc, rbuf, rlen);
- }
-
- case CRC32_2: {
- uLong crc;
- if (len < 4) goto badarg;
- crc = (unsigned int) i32(buf);
- crc = crc32(crc, (unsigned char*) buf+4, len-4);
- return zlib_value(crc, rbuf, rlen);
- }
-
- case ADLER32_1: {
- uLong adler = adler32(0L, Z_NULL, 0);
- adler = adler32(adler, (unsigned char*) buf, len);
- return zlib_value(adler, rbuf, rlen);
- }
-
- case ADLER32_2: {
- uLong adler;
- if (len < 4) goto badarg;
- adler = (unsigned int) i32(buf);
- adler = adler32(adler, (unsigned char*) buf+4, len-4);
- return zlib_value(adler, rbuf, rlen);
- }
-
- case CRC32_COMBINE: {
- uLong crc, crc1, crc2, len2;
- if (len != 12) goto badarg;
- crc1 = (unsigned int) i32(buf);
- crc2 = (unsigned int) i32(buf+4);
- len2 = (unsigned int) i32(buf+8);
- crc = crc32_combine(crc1, crc2, len2);
- return zlib_value(crc, rbuf, rlen);
- }
-
- case ADLER32_COMBINE: {
- uLong adler, adler1, adler2, len2;
- if (len != 12) goto badarg;
- adler1 = (unsigned int) i32(buf);
- adler2 = (unsigned int) i32(buf+4);
- len2 = (unsigned int) i32(buf+8);
- adler = adler32_combine(adler1, adler2, len2);
- return zlib_value(adler, rbuf, rlen);
- }
- }
-
- badarg:
- errno = EINVAL;
- return zlib_return(Z_ERRNO, rbuf, rlen);
-}
-
-
-
-static void zlib_outputv(ErlDrvData drv_data, ErlIOVec *ev)
-{
- ZLibData* d = (ZLibData*) drv_data;
-
- driver_enqv(d->port, ev, 0);
-}
diff --git a/erts/emulator/drivers/ose/ose_efile.c b/erts/emulator/drivers/ose/ose_efile.c
deleted file mode 100644
index 035ff81a9b..0000000000
--- a/erts/emulator/drivers/ose/ose_efile.c
+++ /dev/null
@@ -1,1124 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1997-2012. 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%
- */
-/*
- * 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 4929b53856..0000000000
--- a/erts/emulator/drivers/ose/ose_signal_drv.c
+++ /dev/null
@@ -1,896 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2013-2013. 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%
- */
-#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 8af2ce6af3..0000000000
--- a/erts/emulator/drivers/ose/ttsl_drv.c
+++ /dev/null
@@ -1,68 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1996-2013. 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%
- */
-/*
- * 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/bin_drv.c b/erts/emulator/drivers/unix/bin_drv.c
index 1827187d57..4b633bb0cf 100644
--- a/erts/emulator/drivers/unix/bin_drv.c
+++ b/erts/emulator/drivers/unix/bin_drv.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2009. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2016. 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.
+ * 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%
*/
diff --git a/erts/emulator/drivers/unix/multi_drv.c b/erts/emulator/drivers/unix/multi_drv.c
index 822c96730c..eddc57d4d4 100644
--- a/erts/emulator/drivers/unix/multi_drv.c
+++ b/erts/emulator/drivers/unix/multi_drv.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2009. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2016. 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.
+ * 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%
*/
@@ -20,7 +21,7 @@
/* Purpose: Multidriver interface
This is an example of a driver which allows multiple instances of itself.
I.e have one erlang process execute open_port(multi......) and
- at the same time have an other erlang process open an other port
+ at the same time have another erlang process open another port
running multi there as well.
*/
diff --git a/erts/emulator/drivers/unix/sig_drv.c b/erts/emulator/drivers/unix/sig_drv.c
index aab5d63a40..03d87b289b 100644
--- a/erts/emulator/drivers/unix/sig_drv.c
+++ b/erts/emulator/drivers/unix/sig_drv.c
@@ -1,23 +1,24 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2009. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2017. 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.
+ * 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: demonstrate how to include interupt handlers in erlang */
+/* Purpose: demonstrate how to include interrupt handlers in erlang */
#ifdef HAVE_CONFIG_H
# include "config.h"
diff --git a/erts/emulator/drivers/unix/ttsl_drv.c b/erts/emulator/drivers/unix/ttsl_drv.c
index 491e0a090e..2a508b02eb 100644
--- a/erts/emulator/drivers/unix/ttsl_drv.c
+++ b/erts/emulator/drivers/unix/ttsl_drv.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -32,6 +33,10 @@ static ErlDrvData ttysl_start(ErlDrvPort, char*);
#ifdef HAVE_TERMCAP /* else make an empty driver that can not be opened */
+#ifndef WANT_NONBLOCKING
+#define WANT_NONBLOCKING
+#endif
+
#include "sys.h"
#include <ctype.h>
#include <stdlib.h>
@@ -39,6 +44,7 @@ static ErlDrvData ttysl_start(ErlDrvPort, char*);
#include <string.h>
#include <signal.h>
#include <fcntl.h>
+#include <limits.h>
#include <locale.h>
#include <unistd.h>
#include <termios.h>
@@ -57,6 +63,14 @@ static ErlDrvData ttysl_start(ErlDrvPort, char*);
#include <langinfo.h>
#endif
+#if defined IOV_MAX
+#define MAXIOV IOV_MAX
+#elif defined UIO_MAXIOV
+#define MAXIOV UIO_MAXIOV
+#else
+#define MAXIOV 16
+#endif
+
#define TRUE 1
#define FALSE 0
@@ -80,27 +94,29 @@ static volatile int cols_needs_update = FALSE;
#define OP_INSC 2
#define OP_DELC 3
#define OP_BEEP 4
+#define OP_PUTC_SYNC 5
/* Control op */
#define CTRL_OP_GET_WINSIZE 100
#define CTRL_OP_GET_UNICODE_STATE 101
#define CTRL_OP_SET_UNICODE_STATE 102
-
+/* We use 1024 as the buf size as that was the default buf size of FILE streams
+ on all platforms that I checked. */
+#define TTY_BUFFSIZE 1024
static int lbuf_size = BUFSIZ;
static Uint32 *lbuf; /* The current line buffer */
static int llen; /* The current line length */
static int lpos; /* The current "cursor position" in the line buffer */
-
+ /* NOTE: not the same as column position a char may not take a"
+ * column to display or it might take many columns
+ */
/*
* Tags used in line buffer to show that these bytes represent special characters,
* Max unicode is 0x0010ffff, so we have lots of place for meta tags...
*/
#define CONTROL_TAG 0x10000000U /* Control character, value in first position */
#define ESCAPED_TAG 0x01000000U /* Escaped character, value in first position */
-#ifdef HAVE_WCWIDTH
-#define WIDE_TAG 0x02000000U /* Wide character, value in first position */
-#endif
#define TAG_MASK 0xFF000000U
#define MAXSIZE (1 << 16)
@@ -113,13 +129,19 @@ static int lpos; /* The current "cursor position" in the line buf
/* Main interface functions. */
static void ttysl_stop(ErlDrvData);
static void ttysl_from_erlang(ErlDrvData, char*, ErlDrvSizeT);
+static void ttysl_to_tty(ErlDrvData, ErlDrvEvent);
+static void ttysl_flush_tty(ErlDrvData);
static void ttysl_from_tty(ErlDrvData, ErlDrvEvent);
static void ttysl_stop_select(ErlDrvEvent, void*);
static Sint16 get_sint16(char*);
static ErlDrvPort ttysl_port;
static int ttysl_fd;
-static FILE *ttysl_out;
+static int ttysl_terminate = 0;
+static int ttysl_send_ok = 0;
+static ErlDrvBinary *putcbuf;
+static int putcpos;
+static int putclen;
/* Functions that work on the line buffer. */
static int start_lbuf(void);
@@ -133,6 +155,8 @@ static int insert_buf(byte*,int);
static int write_buf(Uint32 *,int);
static int outc(int c);
static int move_cursor(int,int);
+static int cp_pos_to_col(int cp_pos);
+
/* Termcap functions. */
static int start_termcap(void);
@@ -176,7 +200,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
@@ -201,22 +225,22 @@ struct erl_drv_entry ttsl_driver_entry = {
IF_IMPL(ttysl_stop),
IF_IMPL(ttysl_from_erlang),
IF_IMPL(ttysl_from_tty),
- NULL,
- "tty_sl",
- NULL,
- NULL,
+ IF_IMPL(ttysl_to_tty),
+ "tty_sl", /* driver_name */
+ NULL, /* finish */
+ NULL, /* handle */
IF_IMPL(ttysl_control),
NULL, /* timeout */
NULL, /* outputv */
NULL, /* ready_async */
- NULL, /* flush */
+ IF_IMPL(ttysl_flush_tty),
NULL, /* call */
NULL, /* event */
ERL_DRV_EXTENDED_MARKER,
ERL_DRV_EXTENDED_MAJOR_VERSION,
ERL_DRV_EXTENDED_MINOR_VERSION,
0, /* ERL_DRV_FLAGs */
- NULL,
+ NULL, /* handle2 */
NULL, /* process_exit */
IF_IMPL(ttysl_stop_select)
};
@@ -238,7 +262,7 @@ 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
return 0;
@@ -254,36 +278,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;
@@ -291,13 +325,13 @@ 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;
}
- /* Open the terminal and set the terminal */
- ttysl_out = fdopen(ttysl_fd, "w");
+ SET_NONBLOCKING(ttysl_fd);
#ifdef PRIMITIVE_UTF8_CHECK
setlocale(LC_CTYPE, ""); /* Set international environment,
@@ -313,12 +347,12 @@ 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"));
- sys_sigset(SIGCONT, cont);
- sys_sigset(SIGWINCH, winch);
+ DEBUGLOG(("ttysl_start: utf8_mode is %s",(utf8_mode) ? "on" : "off"));
+ sys_signal(SIGCONT, cont);
+ sys_signal(SIGWINCH, winch);
driver_select(port, (ErlDrvEvent)(UWord)ttysl_fd, ERL_DRV_READ|ERL_DRV_USE, 1);
ttysl_port = port;
@@ -326,6 +360,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 */
}
@@ -396,16 +431,19 @@ 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();
tty_reset(ttysl_fd);
- driver_select(ttysl_port, (ErlDrvEvent)(UWord)ttysl_fd, ERL_DRV_READ|ERL_DRV_USE, 0);
- sys_sigset(SIGCONT, SIG_DFL);
- sys_sigset(SIGWINCH, SIG_DFL);
+ driver_select(ttysl_port, (ErlDrvEvent)(UWord)ttysl_fd,
+ ERL_DRV_WRITE|ERL_DRV_READ|ERL_DRV_USE, 0);
+ sys_signal(SIGCONT, SIG_DFL);
+ sys_signal(SIGWINCH, SIG_DFL);
}
ttysl_port = (ErlDrvPort)-1;
ttysl_fd = -1;
+ ttysl_terminate = 0;
/* return TRUE; */
}
@@ -593,12 +631,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 */
@@ -606,7 +645,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) {
@@ -616,21 +655,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;
}
}
@@ -640,22 +679,42 @@ 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);
}
static void ttysl_from_erlang(ErlDrvData ttysl_data, char* buf, ErlDrvSizeT count)
{
+ ErlDrvSizeT sz;
+
+ sz = driver_sizeq(ttysl_port);
+
+ putclen = count > TTY_BUFFSIZE ? TTY_BUFFSIZE : count;
+ putcbuf = driver_alloc_binary(putclen);
+ putcpos = 0;
+
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
+ controlling process for each command call. We delay
+ sending ok if the driver queue exceeds a certain size.
+ We do not set ourselves as a busy port, as this
+ could be very bad for user_drv, if it gets blocked on
+ 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);
@@ -678,10 +737,114 @@ static void ttysl_from_erlang(ErlDrvData ttysl_data, char* buf, ErlDrvSizeT coun
/* Unknown op, just ignore. */
break;
}
- fflush(ttysl_out);
+
+ driver_enq_bin(ttysl_port,putcbuf,0,putcpos);
+ driver_free_binary(putcbuf);
+
+ if (sz == 0) {
+ for (;;) {
+ int written, qlen;
+ SysIOVec *iov;
+
+ iov = driver_peekq(ttysl_port,&qlen);
+ if (iov)
+ written = writev(ttysl_fd, iov, qlen > MAXIOV ? MAXIOV : qlen);
+ else
+ written = 0;
+ if (written < 0) {
+ if (errno == ERRNO_BLOCK || errno == EINTR) {
+ driver_select(ttysl_port,(ErlDrvEvent)(long)ttysl_fd,
+ 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;
+ }
+ } else {
+ if (driver_deq(ttysl_port, written) == 0)
+ break;
+ }
+ }
+ }
+
+ if (buf[0] == OP_PUTC_SYNC) {
+ if (driver_sizeq(ttysl_port) > TTY_BUFFSIZE && !ttysl_terminate) {
+ /* We delay sending the ack until the buffer has been consumed */
+ ttysl_send_ok = 1;
+ } else {
+ ErlDrvTermData spec[] = {
+ ERL_DRV_PORT, driver_mk_port(ttysl_port),
+ ERL_DRV_ATOM, driver_mk_atom("ok"),
+ ERL_DRV_TUPLE, 2
+ };
+ ASSERT(ttysl_send_ok == 0);
+ erl_drv_output_term(driver_mk_port(ttysl_port), spec,
+ sizeof(spec) / sizeof(spec[0]));
+ }
+ }
+
return; /* TRUE; */
}
+static void ttysl_to_tty(ErlDrvData ttysl_data, ErlDrvEvent fd) {
+ for (;;) {
+ int written, qlen;
+ SysIOVec *iov;
+ 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
+ written = 0;
+ if (written < 0) {
+ 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;
+ } else {
+ sz = driver_deq(ttysl_port, written);
+ if (sz < TTY_BUFFSIZE && ttysl_send_ok) {
+ ErlDrvTermData spec[] = {
+ ERL_DRV_PORT, driver_mk_port(ttysl_port),
+ ERL_DRV_ATOM, driver_mk_atom("ok"),
+ ERL_DRV_TUPLE, 2
+ };
+ ttysl_send_ok = 0;
+ erl_drv_output_term(driver_mk_port(ttysl_port), spec,
+ sizeof(spec) / sizeof(spec[0]));
+ }
+ if (sz == 0) {
+ driver_select(ttysl_port,(ErlDrvEvent)(long)ttysl_fd,
+ ERL_DRV_WRITE,0);
+ if (ttysl_terminate) {
+ /* 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;
+ }
+ }
+ }
+
+ return;
+}
+
+static void ttysl_flush_tty(ErlDrvData ttysl_data) {
+ DEBUGLOG(("ttysl_flush_tty: .."));
+ ttysl_terminate = 1;
+ return;
+}
+
static void ttysl_from_tty(ErlDrvData ttysl_data, ErlDrvEvent fd)
{
byte b[1024];
@@ -698,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) {
@@ -711,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;
}
@@ -728,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);
}
}
@@ -770,10 +936,10 @@ static int put_chars(byte *s, int l)
int n;
n = insert_buf(s, l);
+ if (lpos > llen)
+ llen = lpos;
if (n > 0)
write_buf(lbuf + lpos - n, n);
- if (lpos > llen)
- llen = lpos;
return TRUE;
}
@@ -826,34 +992,36 @@ static int del_chars(int n)
{
int i, l, r;
int pos;
+ int gcs; /* deleted grapheme characters */
update_cols();
/* Step forward or backwards over n logical characters. */
pos = step_over_chars(n);
-
+ DEBUGLOG(("del_chars: %d from %d %d %d\n", n, lpos, pos, llen));
if (pos > lpos) {
l = pos - lpos; /* Buffer characters to delete */
r = llen - lpos - l; /* Characters after deleted */
+ gcs = cp_pos_to_col(pos) - cp_pos_to_col(lpos);
/* Fix up buffer and buffer pointers. */
if (r > 0)
memmove(lbuf + lpos, lbuf + pos, r * sizeof(Uint32));
llen -= l;
/* Write out characters after, blank the tail and jump back to lpos. */
write_buf(lbuf + lpos, r);
- for (i = l ; i > 0; --i)
+ for (i = gcs ; i > 0; --i)
outc(' ');
- if (COL(llen+l) == 0 && xn)
+ if (xn && COL(cp_pos_to_col(llen)+gcs) == 0)
{
outc(' ');
move_left(1);
}
- move_cursor(llen + l, lpos);
+ move_cursor(llen + gcs, lpos);
}
else if (pos < lpos) {
l = lpos - pos; /* Buffer characters */
r = llen - lpos; /* Characters after deleted */
- move_cursor(lpos, lpos-l); /* Move back */
+ gcs = -move_cursor(lpos, lpos-l); /* Move back */
/* Fix up buffer and buffer pointers. */
if (r > 0)
memmove(lbuf + pos, lbuf + lpos, r * sizeof(Uint32));
@@ -861,14 +1029,14 @@ static int del_chars(int n)
llen -= l;
/* Write out characters after, blank the tail and jump back to lpos. */
write_buf(lbuf + lpos, r);
- for (i = l ; i > 0; --i)
- outc(' ');
- if (COL(llen+l) == 0 && xn)
+ for (i = gcs ; i > 0; --i)
+ outc(' ');
+ if (xn && COL(cp_pos_to_col(llen)+gcs) == 0)
{
- outc(' ');
- move_left(1);
+ outc(' ');
+ move_left(1);
}
- move_cursor(llen + l, lpos);
+ move_cursor(llen + gcs, lpos);
}
return TRUE;
}
@@ -882,22 +1050,12 @@ static int step_over_chars(int n)
end = lbuf + llen;
c = lbuf + lpos;
for ( ; n > 0 && c < end; --n) {
-#ifdef HAVE_WCWIDTH
- while (*c & WIDE_TAG) {
- c++;
- }
-#endif
c++;
while (c < end && (*c & TAG_MASK) && ((*c & ~TAG_MASK) == 0))
c++;
}
for ( ; n < 0 && c > beg; n++) {
--c;
-#ifdef HAVE_WCWIDTH
- while (c > beg + 1 && (c[-1] & WIDE_TAG)) {
- --c;
- }
-#endif
while (c > beg && (*c & TAG_MASK) && ((*c & ~TAG_MASK) == 0))
--c;
}
@@ -923,15 +1081,6 @@ static int insert_buf(byte *s, int n)
++pos;
}
if ((utf8_mode && (ch >= 128 || isprint(ch))) || (ch <= 255 && isprint(ch))) {
-#ifdef HAVE_WCWIDTH
- int width;
- if ((width = wcwidth(ch)) > 1) {
- while (--width) {
- DEBUGLOG(("insert_buf: Wide(UTF-8):%d,%d",width,ch));
- lbuf[lpos++] = (WIDE_TAG | ((Uint32) ch));
- }
- }
-#endif
DEBUGLOG(("insert_buf: Printable(UTF-8):%d",ch));
lbuf[lpos++] = (Uint32) ch;
} else if (ch >= 128) { /* not utf8 mode */
@@ -945,15 +1094,14 @@ static int insert_buf(byte *s, int n)
lbuf[lpos++] = (CONTROL_TAG | ((Uint32) ch));
ch = 0;
} while (lpos % 8);
- } else if (ch == '\e' || ch == '\n' || ch == '\r') {
+ } else if (ch == '\e') {
+ DEBUGLOG(("insert_buf: ANSI Escape: \\e"));
+ lbuf[lpos++] = (CONTROL_TAG | ((Uint32) ch));
+ } else if (ch == '\n' || ch == '\r') {
write_buf(lbuf + buffpos, lpos - buffpos);
- if (ch == '\e') {
- outc('\e');
- } else {
outc('\r');
if (ch == '\n')
outc('\n');
- }
if (llen > lpos) {
memcpy(lbuf, lbuf + lpos, llen - lpos);
}
@@ -1001,14 +1149,17 @@ static int write_buf(Uint32 *s, int n)
}
--n;
++s;
- }
- else if (*s == (CONTROL_TAG | ((Uint32) '\t'))) {
+ } else if (*s == (CONTROL_TAG | ((Uint32) '\t'))) {
outc(lastput = ' ');
--n; s++;
while (n > 0 && *s == CONTROL_TAG) {
outc(lastput = ' ');
--n; s++;
}
+ } else if (*s == (CONTROL_TAG | ((Uint32) '\e'))) {
+ outc(lastput = '\e');
+ --n;
+ ++s;
} else if (*s & CONTROL_TAG) {
outc('^');
outc(lastput = ((byte) ((*s == 0177) ? '?' : *s | 0x40)));
@@ -1019,7 +1170,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);
@@ -1028,30 +1179,26 @@ 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;
if (octbuff != octtmp) {
driver_free(octbuff);
}
-#ifdef HAVE_WCWIDTH
- } else if (*s & WIDE_TAG) {
- --n; s++;
-#endif
} else {
- DEBUGLOG(("Very unexpected character %d",(int) *s));
+ DEBUGLOG(("write_buf: Very unexpected character %d",(int) *s));
++n;
--s;
}
}
/* Check landed in first column of new line and have 'xn' bug. */
n = s - lbuf;
- if (COL(n) == 0 && xn && n != 0) {
+ if (xn && n != 0 && COL(cp_pos_to_col(n)) == 0) {
if (n >= llen) {
outc(' ');
} else if (lastput == 0) { /* A multibyte UTF8 character */
@@ -1070,17 +1217,30 @@ static int write_buf(Uint32 *s, int n)
/* The basic procedure for outputting one character. */
static int outc(int c)
{
- return (int)putc(c, ttysl_out);
+ putcbuf->orig_bytes[putcpos++] = c;
+ if (putcpos == putclen) {
+ driver_enq_bin(ttysl_port,putcbuf,0,putclen);
+ driver_free_binary(putcbuf);
+ putcpos = 0;
+ putclen = TTY_BUFFSIZE;
+ putcbuf = driver_alloc_binary(BUFSIZ);
+ }
+ return 1;
}
-static int move_cursor(int from, int to)
+static int move_cursor(int from_pos, int to_pos)
{
+ int from_col, to_col;
int dc, dl;
-
update_cols();
- dc = COL(to) - COL(from);
- dl = LINE(to) - LINE(from);
+ from_col = cp_pos_to_col(from_pos);
+ to_col = cp_pos_to_col(to_pos);
+
+ dc = COL(to_col) - COL(from_col);
+ dl = LINE(to_col) - LINE(from_col);
+ DEBUGLOG(("move_cursor: from %d %d to %d %d => %d %d\n",
+ from_pos, from_col, to_pos, to_col, dl, dc));
if (dl > 0)
move_down(dl);
else if (dl < 0)
@@ -1089,7 +1249,66 @@ static int move_cursor(int from, int to)
move_right(dc);
else if (dc < 0)
move_left(-dc);
- return TRUE;
+ return to_col-from_col;
+}
+
+/*
+ * Returns the length of an ANSI escape code in a buffer, this function only consider
+ * color escape sequences like `\e[33m` or `\e[21;33m`. If a sequence has no valid
+ * terminator, the length is equal the number of characters between `\e` and the first
+ * invalid character, inclusive.
+ */
+
+static int ansi_escape_width(Uint32 *s, int max_length)
+{
+ int i;
+
+ if (*s != (CONTROL_TAG | ((Uint32) '\e'))) {
+ return 0;
+ } else if (max_length <= 1) {
+ return 1;
+ } else if (s[1] != '[') {
+ return 2;
+ }
+
+ for (i = 2; i < max_length && (s[i] == ';' || (s[i] >= '0' && s[i] <= '9')); i++);
+
+ return i + 1;
+}
+
+static int cp_pos_to_col(int cp_pos)
+{
+ /*
+ * If we don't have any character width information. Assume that
+ * code points are one column wide
+ */
+ int w = 1;
+ int col = 0;
+ int i = 0;
+ int j;
+
+ if (cp_pos > llen) {
+ col += cp_pos - llen;
+ cp_pos = llen;
+ }
+
+ while (i < cp_pos) {
+ j = ansi_escape_width(lbuf + i, llen - i);
+
+ if (j > 0) {
+ i += j;
+ } else {
+#ifdef HAVE_WCWIDTH
+ w = wcwidth(lbuf[i]);
+#endif
+ if (w > 0) {
+ col += w;
+ }
+ i++;
+ }
+ }
+
+ return col;
}
static int start_termcap(void)
@@ -1098,6 +1317,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)
@@ -1105,9 +1327,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;
@@ -1117,7 +1340,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;
}
@@ -1125,8 +1349,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);
@@ -1142,8 +1368,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);
@@ -1220,10 +1449,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. */
@@ -1276,6 +1508,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;
}
@@ -1286,20 +1519,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);
}
@@ -1314,17 +1552,19 @@ 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);
}
- sys_sigset(sig, SIG_DFL); /* Set signal handler to default */
+ sys_signal(sig, SIG_DFL); /* Set signal handler to default */
sys_sigrelease(sig); /* Allow 'sig' to come through */
kill(getpid(), sig); /* Send ourselves the signal */
sys_sigblock(sig); /* Reset to old mask */
- sys_sigset(sig, suspend); /* Reset signal handler */
+ 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);
}
@@ -1335,6 +1575,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 42f41c5f3d..f8341f788a 100644
--- a/erts/emulator/drivers/unix/unix_efile.c
+++ b/erts/emulator/drivers/unix/unix_efile.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1997-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1997-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -38,16 +39,21 @@
#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>
#endif
#if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__)
-#define DARWIN 1
+#define __DARWIN__ 1
#endif
-#if defined(DARWIN) || defined(HAVE_LINUX_FALLOC_H) || defined(HAVE_POSIX_FALLOCATE)
+#if defined(__DARWIN__) || defined(HAVE_LINUX_FALLOC_H) || defined(HAVE_POSIX_FALLOCATE)
#include <fcntl.h>
#endif
@@ -73,11 +79,10 @@
* 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)
+#define ISDIR(st) (S_ISDIR((st).st_mode))
+#define ISREG(st) (S_ISREG((st).st_mode))
+#define ISDEV(st) (S_ISCHR((st).st_mode) || S_ISBLK((st).st_mode))
+#define ISLNK(st) (S_ISLNK((st).st_mode))
#ifdef NO_UMASK
#define FILE_MODE 0644
#define DIR_MODE 0755
@@ -360,28 +365,6 @@ efile_openfile(Efile_error* errInfo, /* Where to return error codes. */
int fd;
int mode; /* Open mode. */
- if (stat(name, &statbuf) >= 0 && !ISREG(statbuf)) {
- /*
- * For UNIX only, here is some ugly code to allow
- * /dev/null to be opened as a file.
- *
- * Assumption: The i-node number for /dev/null cannot be zero.
- */
- static ino_t dev_null_ino = 0;
-
- if (dev_null_ino == 0) {
- struct stat nullstatbuf;
-
- if (stat("/dev/null", &nullstatbuf) >= 0) {
- dev_null_ino = nullstatbuf.st_ino;
- }
- }
- if (!(dev_null_ino && statbuf.st_ino == dev_null_ino)) {
- errno = EISDIR;
- return check_error(-1, errInfo);
- }
- }
-
switch (flags & (EFILE_MODE_READ|EFILE_MODE_WRITE)) {
case EFILE_MODE_READ:
mode = O_RDONLY;
@@ -400,16 +383,13 @@ efile_openfile(Efile_error* errInfo, /* Where to return error codes. */
return check_error(-1, errInfo);
}
-
if (flags & EFILE_MODE_APPEND) {
mode &= ~O_TRUNC;
mode |= O_APPEND;
}
-
if (flags & EFILE_MODE_EXCL) {
mode |= O_EXCL;
}
-
if (flags & EFILE_MODE_SYNC) {
#ifdef O_SYNC
mode |= O_SYNC;
@@ -419,15 +399,52 @@ efile_openfile(Efile_error* errInfo, /* Where to return error codes. */
#endif
}
- fd = open(name, mode, FILE_MODE);
+#ifdef HAVE_FSTAT
+ while (((fd = open(name, mode, FILE_MODE)) < 0) && (errno == EINTR));
+ if (!check_error(fd, errInfo)) return 0;
+#endif
- if (!check_error(fd, errInfo))
- return 0;
+ if (
+#ifdef HAVE_FSTAT
+ fstat(fd, &statbuf) < 0
+#else
+ stat(name, &statbuf) < 0
+#endif
+ ) {
+ /* statbuf is undefined: if the caller depends on it,
+ i.e. invoke_read_file(), fail the call immediately */
+ if (pSize && flags == EFILE_MODE_READ) {
+ check_error(-1, errInfo);
+#ifdef HAVE_FSTAT
+ efile_closefile(fd);
+#endif
+ return 0;
+ }
+ }
+ else if (! ISREG(statbuf)) {
+ struct stat nullstatbuf;
+ /*
+ * For UNIX only, here is some ugly code to allow
+ * /dev/null to be opened as a file.
+ */
+ if ( (stat("/dev/null", &nullstatbuf) < 0)
+ || (statbuf.st_ino != nullstatbuf.st_ino)
+ || (statbuf.st_dev != nullstatbuf.st_dev) ) {
+#ifdef HAVE_FSTAT
+ efile_closefile(fd);
+#endif
+ errno = EISDIR;
+ return check_error(-1, errInfo);
+ }
+ }
+
+#ifndef HAVE_FSTAT
+ while (((fd = open(name, mode, FILE_MODE)) < 0) && (errno == EINTR));
+ if (!check_error(fd, errInfo)) return 0;
+#endif
*pfd = fd;
- if (pSize) {
- *pSize = statbuf.st_size;
- }
+ if (pSize) *pSize = statbuf.st_size;
return 1;
}
@@ -449,14 +466,14 @@ efile_may_openfile(Efile_error* errInfo, char *name) {
void
efile_closefile(int fd)
{
- close(fd);
+ while((close(fd) < 0) && (errno == EINTR));
}
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);
@@ -470,11 +487,11 @@ efile_fsync(Efile_error *errInfo, /* Where to return error codes. */
#ifdef NO_FSYNC
undefined fsync /* XXX: Really? */
#else
-#if defined(DARWIN) && defined(F_FULLFSYNC)
+#if defined(__DARWIN__) && defined(F_FULLFSYNC)
return check_error(fcntl(fd, F_FULLFSYNC), errInfo);
#else
return check_error(fsync(fd), errInfo);
-#endif /* DARWIN */
+#endif /* __DARWIN__ */
#endif /* NO_FSYNC */
}
@@ -526,9 +543,9 @@ efile_fileinfo(Efile_error* errInfo, Efile_info* pInfo,
else
pInfo->type = FT_OTHER;
- pInfo->accessTime = statbuf.st_atime;
- pInfo->modifyTime = statbuf.st_mtime;
- pInfo->cTime = statbuf.st_ctime;
+ pInfo->accessTime = (Sint64)statbuf.st_atime;
+ pInfo->modifyTime = (Sint64)statbuf.st_mtime;
+ pInfo->cTime = (Sint64)statbuf.st_ctime;
pInfo->mode = statbuf.st_mode;
pInfo->links = statbuf.st_nlink;
@@ -567,8 +584,8 @@ efile_write_info(Efile_error *errInfo, Efile_info *pInfo, char *name)
}
}
- tval.actime = pInfo->accessTime;
- tval.modtime = pInfo->modifyTime;
+ tval.actime = (time_t)pInfo->accessTime;
+ tval.modtime = (time_t)pInfo->modifyTime;
return check_error(utime(name, &tval), errInfo);
}
@@ -627,12 +644,21 @@ efile_writev(Efile_error* errInfo, /* Where to return error codes */
do {
w = writev(fd, &iov[cnt], b);
} while (w < 0 && errno == EINTR);
+ if (w < 0 && errno == EINVAL) {
+ goto single_write;
+ }
} else
+ single_write:
/* Degenerated io vector - use regular write */
#endif
{
do {
- w = write(fd, iov[cnt].iov_base, iov[cnt].iov_len);
+ size_t iov_len = iov[cnt].iov_len;
+ size_t limit = 1024*1024*1024; /* 1GB */
+ if (iov_len > limit) {
+ iov_len = limit;
+ }
+ w = write(fd, iov[cnt].iov_base, iov_len);
} while (w < 0 && errno == EINTR);
ASSERT(w <= iov[cnt].iov_len ||
(w == -1 && errno != EINTR));
@@ -943,20 +969,24 @@ efile_sendfile(Efile_error* errInfo, int in_fd, int out_fd,
fdrec.sfv_len = SENDFILE_CHUNK_SIZE;
else
fdrec.sfv_len = *nbytes;
+
retval = sendfilev(out_fd, &fdrec, 1, &len);
- /* Sometimes sendfilev can return -1 and still send data.
- When that happens we just pretend that no error happend. */
- if (retval != -1 || errno == EAGAIN || errno == EINTR ||
- len != 0) {
+ if (retval == -1 && errno == EINVAL) {
+ /* On some solaris versions (I've seen it on SunOS 5.10),
+ using a sfv_len larger then a filesize will result in
+ a -1 && errno == EINVAL return. We translate this so
+ a successful send of the data.*/
+ retval = len;
+ }
+
+ if (retval != -1 || errno == EAGAIN || errno == EINTR) {
*offset += len;
*nbytes -= len;
written += len;
- if (errno != EAGAIN && errno != EINTR && len != 0)
- retval = len;
}
} while (len == SENDFILE_CHUNK_SIZE);
-#elif defined(DARWIN)
+#elif defined(__DARWIN__)
int retval;
off_t len;
do {
diff --git a/erts/emulator/drivers/vxworks/vxworks_resolv.c b/erts/emulator/drivers/vxworks/vxworks_resolv.c
index 8fcbb736f7..c2cdf4a90b 100644
--- a/erts/emulator/drivers/vxworks/vxworks_resolv.c
+++ b/erts/emulator/drivers/vxworks/vxworks_resolv.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1997-2009. All Rights Reserved.
+ * Copyright Ericsson AB 1997-2016. 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.
+ * 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%
*/
diff --git a/erts/emulator/drivers/win32/registry_drv.c b/erts/emulator/drivers/win32/registry_drv.c
index e908c956ae..a03a030df8 100644
--- a/erts/emulator/drivers/win32/registry_drv.c
+++ b/erts/emulator/drivers/win32/registry_drv.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1997-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1997-2016. 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.
+ * 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%
*/
diff --git a/erts/emulator/drivers/win32/ttsl_drv.c b/erts/emulator/drivers/win32/ttsl_drv.c
index 502cb58dfa..99e7fb25a4 100644
--- a/erts/emulator/drivers/win32/ttsl_drv.c
+++ b/erts/emulator/drivers/win32/ttsl_drv.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2016. 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.
+ * 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%
*/
@@ -46,6 +47,7 @@ static int rows; /* Number of rows available. */
#define OP_INSC 2
#define OP_DELC 3
#define OP_BEEP 4
+#define OP_PUTC_SYNC 5
/* Control op */
#define CTRL_OP_GET_WINSIZE 100
@@ -458,6 +460,7 @@ static void ttysl_from_erlang(ErlDrvData ttysl_data, char* buf, ErlDrvSizeT coun
switch (buf[0]) {
case OP_PUTC:
+ case OP_PUTC_SYNC:
DEBUGLOG(("OP: Putc(%I64u)",(unsigned long long)count-1));
if (check_buf_size((byte*)buf+1, count-1) == 0)
return;
@@ -481,6 +484,20 @@ static void ttysl_from_erlang(ErlDrvData ttysl_data, char* buf, ErlDrvSizeT coun
/* Unknown op, just ignore. */
break;
}
+
+ if (buf[0] == OP_PUTC_SYNC) {
+ /* On windows we do a blocking write to the tty so we just
+ send the ack immidiately. If at some point in the future
+ someone has a problem with tty output being blocking
+ this has to be changed. */
+ ErlDrvTermData spec[] = {
+ ERL_DRV_PORT, driver_mk_port(ttysl_port),
+ ERL_DRV_ATOM, driver_mk_atom("ok"),
+ ERL_DRV_TUPLE, 2
+ };
+ erl_drv_output_term(driver_mk_port(ttysl_port), spec,
+ sizeof(spec) / sizeof(spec[0]));
+ }
return;
}
diff --git a/erts/emulator/drivers/win32/win_con.c b/erts/emulator/drivers/win32/win_con.c
index 7b9cadd32b..0bcccfe405 100644
--- a/erts/emulator/drivers/win32/win_con.c
+++ b/erts/emulator/drivers/win32/win_con.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1997-2012. All Rights Reserved.
+ * Copyright Ericsson AB 1997-2016. 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.
+ * 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%
*/
@@ -278,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.
@@ -528,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/drivers/win32/win_con.h b/erts/emulator/drivers/win32/win_con.h
index d46af86ca5..7a642cd7ed 100644
--- a/erts/emulator/drivers/win32/win_con.h
+++ b/erts/emulator/drivers/win32/win_con.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2007-2009. All Rights Reserved.
+ * Copyright Ericsson AB 2007-2016. 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.
+ * 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%
*/
diff --git a/erts/emulator/drivers/win32/win_efile.c b/erts/emulator/drivers/win32/win_efile.c
index a321bb9641..2d366b5833 100644
--- a/erts/emulator/drivers/win32/win_efile.c
+++ b/erts/emulator/drivers/win32/win_efile.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1997-2014. All Rights Reserved.
+ * Copyright Ericsson AB 1997-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -1288,6 +1289,10 @@ do_fileinfo(Efile_call_state* state, Efile_info* pInfo,
{
HANDLE handle; /* Handle returned by CreateFile() */
BY_HANDLE_FILE_INFORMATION fileInfo; /* from CreateFile() */
+
+ /* We initialise nNumberOfLinks as GetFileInformationByHandle
+ does not always initialise this field */
+ fileInfo.nNumberOfLinks = 1;
if (handle = CreateFileW(name, GENERIC_READ, FILE_SHARE_FLAGS, NULL,
OPEN_EXISTING, 0, NULL)) {
GetFileInformationByHandle(handle, &fileInfo);
diff --git a/erts/emulator/hipe/TODO b/erts/emulator/hipe/TODO
index 624ab560e7..0c28616a30 100644
--- a/erts/emulator/hipe/TODO
+++ b/erts/emulator/hipe/TODO
@@ -1,18 +1,19 @@
%CopyrightBegin%
- Copyright Ericsson AB 2004-2009. All Rights Reserved.
+ Copyright Ericsson AB 2004-2016. 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/.
+ 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
- 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.
+ 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%
diff --git a/erts/emulator/hipe/elf64ppc.x b/erts/emulator/hipe/elf64ppc.x
index 299eed8192..f9b3e6795d 100644
--- a/erts/emulator/hipe/elf64ppc.x
+++ b/erts/emulator/hipe/elf64ppc.x
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2005-2009. All Rights Reserved.
+ * Copyright Ericsson AB 2005-2017. 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.
+ * 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%
*/
@@ -27,7 +28,7 @@ SEARCH_DIR("/mnt/archive/cross-ppc64/ppc64-unknown-linux/lib");
SECTIONS
{
/* Read-only sections, merged into text segment: */
- PROVIDE (__executable_start = 0x0180000); . = 0x01800000 + SIZEOF_HEADERS;
+ PROVIDE (__executable_start = 0x01800000); . = 0x01800000 + SIZEOF_HEADERS;
.interp : { *(.interp) }
.hash : { *(.hash) }
.dynsym : { *(.dynsym) }
diff --git a/erts/emulator/hipe/hipe_amd64.c b/erts/emulator/hipe/hipe_amd64.c
index b5dff06987..e3cff4a4ba 100644
--- a/erts/emulator/hipe/hipe_amd64.c
+++ b/erts/emulator/hipe/hipe_amd64.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2004-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2004-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -72,8 +73,8 @@ int hipe_patch_call(void *callAddress, void *destAddress, void *trampoline)
{
Sint rel32;
- if (trampoline)
- return -1;
+ ASSERT(trampoline == NULL);
+
rel32 = (Sint)destAddress - (Sint)callAddress - 4;
if ((Sint)(Sint32)rel32 != rel32)
return -1;
@@ -85,135 +86,14 @@ int hipe_patch_call(void *callAddress, void *destAddress, void *trampoline)
/*
* Memory allocator for executable code.
*
- * This is required on AMD64 because some Linux kernels
- * (including 2.6.10-rc1 and newer www.kernel.org ones)
- * default to non-executable memory mappings, causing
- * ordinary malloc() memory to be non-executable.
- *
- * Implementing this properly also allows us to ensure that
- * executable code ends up in the low 2GB of the address space,
- * as required by HiPE/AMD64's small code model.
+ * We use a dedicated allocator for executable code (from OTP 19.0)
+ * to make sure the memory we get is executable (PROT_EXEC)
+ * and to ensure that executable code ends up in the low 2GB
+ * of the address space, as required by HiPE/AMD64's small code model.
*/
-static unsigned int code_bytes;
-static char *code_next;
-
-#if 0 /* change to non-zero to get allocation statistics at exit() */
-static unsigned int total_mapped, nr_joins, nr_splits, total_alloc, nr_allocs, nr_large, total_lost;
-static unsigned int atexit_done;
-
-static void alloc_code_stats(void)
-{
- printf("\r\nalloc_code_stats: %u bytes mapped, %u joins, %u splits, %u bytes allocated, %u average alloc, %u large allocs, %u bytes lost\r\n",
- total_mapped, nr_joins, nr_splits, total_alloc, nr_allocs ? total_alloc/nr_allocs : 0, nr_large, total_lost);
-}
-
-static void atexit_alloc_code_stats(void)
-{
- if (!atexit_done) {
- atexit_done = 1;
- (void)atexit(alloc_code_stats);
- }
-}
-
-#define ALLOC_CODE_STATS(X) do{X;}while(0)
-#else
-#define ALLOC_CODE_STATS(X) do{}while(0)
-#endif
-
-/* FreeBSD 6.1 breakage */
-#if !defined(MAP_ANONYMOUS) && defined(MAP_ANON)
-#define MAP_ANONYMOUS MAP_ANON
-#endif
-
-static void morecore(unsigned int alloc_bytes)
-{
- unsigned int map_bytes;
- char *map_hint, *map_start;
-
- /* Page-align the amount to allocate. */
- map_bytes = (alloc_bytes + 4095) & ~4095;
-
- /* Round up small allocations. */
- if (map_bytes < 1024*1024)
- map_bytes = 1024*1024;
- else
- ALLOC_CODE_STATS(++nr_large);
-
- /* Create a new memory mapping, ensuring it is executable
- and in the low 2GB of the address space. Also attempt
- to make it adjacent to the previous mapping. */
- map_hint = code_next + code_bytes;
-#if !defined(MAP_32BIT)
- /* FreeBSD doesn't have MAP_32BIT, and it doesn't respect
- a plain map_hint (returns high mappings even though the
- hint refers to a free area), so we have to use both map_hint
- and MAP_FIXED to get addresses below the 2GB boundary.
- This is even worse than the Linux/ppc64 case.
- Similarly, Solaris 10 doesn't have MAP_32BIT,
- and it doesn't respect a plain map_hint. */
- if (!map_hint) /* first call */
- map_hint = (char*)(512*1024*1024); /* 0.5GB */
-#endif
- if ((unsigned long)map_hint & 4095)
- abort();
- map_start = mmap(map_hint, map_bytes,
- PROT_EXEC|PROT_READ|PROT_WRITE,
- MAP_PRIVATE|MAP_ANONYMOUS
-#if defined(MAP_32BIT)
- |MAP_32BIT
-#elif defined(__FreeBSD__) || defined(__sun__)
- |MAP_FIXED
-#endif
- ,
- -1, 0);
- ALLOC_CODE_STATS(fprintf(stderr, "%s: mmap(%p,%u,...) == %p\r\n", __FUNCTION__, map_hint, map_bytes, map_start));
-#if !defined(MAP_32BIT)
- if (map_start != MAP_FAILED &&
- (((unsigned long)map_start + (map_bytes-1)) & ~0x7FFFFFFFUL)) {
- fprintf(stderr, "mmap with hint %p returned code memory %p\r\n", map_hint, map_start);
- abort();
- }
-#endif
- if (map_start == MAP_FAILED) {
- perror("mmap");
- abort();
- }
- ALLOC_CODE_STATS(total_mapped += map_bytes);
-
- /* Merge adjacent mappings, so the trailing portion of the previous
- mapping isn't lost. In practice this is quite successful. */
- if (map_start == map_hint) {
- ALLOC_CODE_STATS(++nr_joins);
- code_bytes += map_bytes;
-#if !defined(MAP_32BIT)
- if (!code_next) /* first call */
- code_next = map_start;
-#endif
- } else {
- ALLOC_CODE_STATS(++nr_splits);
- ALLOC_CODE_STATS(total_lost += code_bytes);
- code_next = map_start;
- code_bytes = map_bytes;
- }
-
- ALLOC_CODE_STATS(atexit_alloc_code_stats());
-}
-
static void *alloc_code(unsigned int alloc_bytes)
{
- void *res;
-
- /* Align function entries. */
- alloc_bytes = (alloc_bytes + 3) & ~3;
-
- if (code_bytes < alloc_bytes)
- morecore(alloc_bytes);
- ALLOC_CODE_STATS(++nr_allocs);
- ALLOC_CODE_STATS(total_alloc += alloc_bytes);
- res = code_next;
- code_next += alloc_bytes;
- code_bytes -= alloc_bytes;
- return res;
+ return erts_alloc(ERTS_ALC_T_HIPE_EXEC, alloc_bytes);
}
void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *p)
@@ -224,18 +104,23 @@ void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *
return alloc_code(nrbytes);
}
-/* called from hipe_bif0.c:hipe_bifs_make_native_stub_2()
- and hipe_bif0.c:hipe_make_stub() */
-void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity)
+void hipe_free_code(void* code, unsigned int bytes)
+{
+ erts_free(ERTS_ALC_T_HIPE_EXEC, code);
+}
+
+/* Make stub for native code calling exported beam function.
+*/
+void *hipe_make_native_stub(void *callee_exp, unsigned int beamArity)
{
/*
* This creates a native code stub with the following contents:
*
- * movq $Address, P_BEAM_IP(%ebp) %% Actually two movl
+ * movq $Address, P_CALLEE_EXP(%ebp) %% Actually two movl
* movb $Arity, P_ARITY(%ebp)
* jmp callemu
*
- * The stub has variable size, depending on whether the P_BEAM_IP
+ * The stub has variable size, depending on whether the P_CALLEE_EXP
* and P_ARITY offsets fit in 8-bit signed displacements or not.
* The rel32 offset in the final jmp depends on its actual location,
* which also depends on the size of the previous instructions.
@@ -248,49 +133,51 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity)
codeSize = /* 23, 26, 29, or 32 bytes */
23 + /* 23 when all offsets are 8-bit */
- (P_BEAM_IP >= 128 ? 3 : 0) +
- ((P_BEAM_IP + 4) >= 128 ? 3 : 0) +
+ (P_CALLEE_EXP >= 128 ? 3 : 0) +
+ ((P_CALLEE_EXP + 4) >= 128 ? 3 : 0) +
(P_ARITY >= 128 ? 3 : 0);
codep = code = alloc_code(codeSize);
+ if (!code)
+ return NULL;
- /* movl $beamAddress, P_BEAM_IP(%ebp); 3 or 6 bytes, plus 4 */
+ /* movl $callee_exp, P_CALLEE_EXP(%ebp); 3 or 6 bytes, plus 4 */
codep[0] = 0xc7;
-#if P_BEAM_IP >= 128
+#if P_CALLEE_EXP >= 128
codep[1] = 0x85; /* disp32[EBP] */
- codep[2] = P_BEAM_IP & 0xFF;
- codep[3] = (P_BEAM_IP >> 8) & 0xFF;
- codep[4] = (P_BEAM_IP >> 16) & 0xFF;
- codep[5] = (P_BEAM_IP >> 24) & 0xFF;
+ codep[2] = P_CALLEE_EXP & 0xFF;
+ codep[3] = (P_CALLEE_EXP >> 8) & 0xFF;
+ codep[4] = (P_CALLEE_EXP >> 16) & 0xFF;
+ codep[5] = (P_CALLEE_EXP >> 24) & 0xFF;
codep += 6;
#else
codep[1] = 0x45; /* disp8[EBP] */
- codep[2] = P_BEAM_IP;
+ codep[2] = P_CALLEE_EXP;
codep += 3;
#endif
- codep[0] = ((unsigned long)beamAddress ) & 0xFF;
- codep[1] = ((unsigned long)beamAddress >> 8) & 0xFF;
- codep[2] = ((unsigned long)beamAddress >> 16) & 0xFF;
- codep[3] = ((unsigned long)beamAddress >> 24) & 0xFF;
+ codep[0] = ((unsigned long)callee_exp ) & 0xFF;
+ codep[1] = ((unsigned long)callee_exp >> 8) & 0xFF;
+ codep[2] = ((unsigned long)callee_exp >> 16) & 0xFF;
+ codep[3] = ((unsigned long)callee_exp >> 24) & 0xFF;
codep += 4;
- /* movl (shl 32 $beamAddress), P_BEAM_IP+4(%ebp); 3 or 6 bytes, plus 4 */
+ /* movl (shl 32 $callee_exp), P_CALLEE_EXP+4(%ebp); 3 or 6 bytes, plus 4 */
codep[0] = 0xc7;
-#if P_BEAM_IP+4 >= 128
+#if P_CALLEE_EXP+4 >= 128
codep[1] = 0x85; /* disp32[EBP] */
- codep[2] = (P_BEAM_IP+4) & 0xFF;
- codep[3] = ((P_BEAM_IP+4) >> 8) & 0xFF;
- codep[4] = ((P_BEAM_IP+4) >> 16) & 0xFF;
- codep[5] = ((P_BEAM_IP+4) >> 24) & 0xFF;
+ codep[2] = (P_CALLEE_EXP+4) & 0xFF;
+ codep[3] = ((P_CALLEE_EXP+4) >> 8) & 0xFF;
+ codep[4] = ((P_CALLEE_EXP+4) >> 16) & 0xFF;
+ codep[5] = ((P_CALLEE_EXP+4) >> 24) & 0xFF;
codep += 6;
#else
codep[1] = 0x45; /* disp8[EBP] */
- codep[2] = (P_BEAM_IP+4);
+ codep[2] = (P_CALLEE_EXP+4);
codep += 3;
#endif
- codep[0] = ((unsigned long)beamAddress >> 32) & 0xFF;
- codep[1] = ((unsigned long)beamAddress >> 40) & 0xFF;
- codep[2] = ((unsigned long)beamAddress >> 48) & 0xFF;
- codep[3] = ((unsigned long)beamAddress >> 56) & 0xFF;
+ codep[0] = ((unsigned long)callee_exp >> 32) & 0xFF;
+ codep[1] = ((unsigned long)callee_exp >> 40) & 0xFF;
+ codep[2] = ((unsigned long)callee_exp >> 48) & 0xFF;
+ codep[3] = ((unsigned long)callee_exp >> 56) & 0xFF;
codep += 4;
/* movb $beamArity, P_ARITY(%ebp); 3 or 6 bytes */
@@ -326,6 +213,11 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity)
return code;
}
+void hipe_free_native_stub(void* stub)
+{
+ erts_free(ERTS_ALC_T_HIPE_EXEC, stub);
+}
+
void hipe_arch_print_pcb(struct hipe_process_state *p)
{
#define U(n,x) \
diff --git a/erts/emulator/hipe/hipe_amd64.h b/erts/emulator/hipe/hipe_amd64.h
index bf41d238dd..750a26fcb9 100644
--- a/erts/emulator/hipe/hipe_amd64.h
+++ b/erts/emulator/hipe/hipe_amd64.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2004-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2004-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/hipe/hipe_amd64.tab b/erts/emulator/hipe/hipe_amd64.tab
index e039d74525..e5ff31b985 100644
--- a/erts/emulator/hipe/hipe_amd64.tab
+++ b/erts/emulator/hipe/hipe_amd64.tab
@@ -1,18 +1,19 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2004-2011. All Rights Reserved.
+# Copyright Ericsson AB 2004-2016. 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/.
+# 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
#
-# 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.
+# 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%
#
diff --git a/erts/emulator/hipe/hipe_amd64_abi.txt b/erts/emulator/hipe/hipe_amd64_abi.txt
index 8a34bfa67f..72aed13995 100644
--- a/erts/emulator/hipe/hipe_amd64_abi.txt
+++ b/erts/emulator/hipe/hipe_amd64_abi.txt
@@ -45,7 +45,7 @@ The first return value from a function is placed in %rax, the second
(if any) is placed in %rdx.
Notes:
-- Currently, NR_ARG_REGS==0.
+- Currently, NR_ARG_REGS == 4.
- C BIFs expect P in C parameter register 1: %rdi. By making Erlang
parameter registers 1-5 coincide with C parameter registers 2-6,
our BIF wrappers can simply move P to %rdi without having to shift
diff --git a/erts/emulator/hipe/hipe_amd64_asm.m4 b/erts/emulator/hipe/hipe_amd64_asm.m4
index 7c81040b8b..409fd0ef89 100644
--- a/erts/emulator/hipe/hipe_amd64_asm.m4
+++ b/erts/emulator/hipe/hipe_amd64_asm.m4
@@ -2,18 +2,19 @@ changecom(`/*', `*/')dnl
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2004-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2004-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -33,7 +34,35 @@ define(HEAP_LIMIT_IN_REGISTER,0)dnl global for HL
define(SIMULATE_NSP,0)dnl change to 1 to simulate call/ret insns
`#define AMD64_LEAF_WORDS 'LEAF_WORDS
-`#define LEAF_WORDS 'LEAF_WORDS
+`#define LEAF_WORDS 'LEAF_WORDS
+`#define AMD64_NR_ARG_REGS 'NR_ARG_REGS
+`#define NR_ARG_REGS 'NR_ARG_REGS
+
+`#define AMD64_HP_IN_REGISTER 'HP_IN_REGISTER
+`#if AMD64_HP_IN_REGISTER'
+`#define AMD64_HEAP_POINTER 15'
+define(HP,%r15)dnl Only change this together with above
+`#endif'
+
+`#define AMD64_FCALLS_IN_REGISTER 'FCALLS_IN_REGISTER
+`#if AMD64_FCALLS_IN_REGISTER'
+`#define AMD64_FCALLS_REGISTER 11'
+define(FCALLS,%r11)dnl This goes together with line above
+`#endif'
+
+`#define AMD64_HEAP_LIMIT_IN_REGISTER 'HEAP_LIMIT_IN_REGISTER
+`#if AMD64_HEAP_LIMIT_IN_REGISTER'
+`#define AMD64_HEAP_LIMIT_REGISTER 12'
+define(HEAP_LIMIT,%r12)dnl Change this together with line above
+`#endif'
+
+`#define AMD64_SIMULATE_NSP 'SIMULATE_NSP
+
+
+`#ifdef ASM'
+/*
+ * Only assembler stuff from here on (when included from *.S)
+ */
/*
* Workarounds for Darwin.
@@ -63,33 +92,24 @@ ifelse(OPSYS,darwin,``
*/
`#define P %rbp'
-`#define AMD64_HP_IN_REGISTER 'HP_IN_REGISTER
`#if AMD64_HP_IN_REGISTER
-#define AMD64_HEAP_POINTER 15'
-define(HP,%r15)dnl Only change this together with above
-`#define SAVE_HP movq 'HP`, P_HP(P)
+#define SAVE_HP movq 'HP`, P_HP(P)
#define RESTORE_HP movq P_HP(P), 'HP`
#else
#define SAVE_HP /*empty*/
#define RESTORE_HP /*empty*/
#endif'
-`#define AMD64_FCALLS_IN_REGISTER 'FCALLS_IN_REGISTER
`#if AMD64_FCALLS_IN_REGISTER
-#define AMD64_FCALLS_REGISTER 11'
-define(FCALLS,%r11)dnl This goes together with line above
-`#define SAVE_FCALLS movq 'FCALLS`, P_FCALLS(P)
+#define SAVE_FCALLS movq 'FCALLS`, P_FCALLS(P)
#define RESTORE_FCALLS movq P_FCALLS(P), 'FCALLS`
#else
#define SAVE_FCALLS /*empty*/
#define RESTORE_FCALLS /*empty*/
#endif'
-`#define AMD64_HEAP_LIMIT_IN_REGISTER 'HEAP_LIMIT_IN_REGISTER
`#if AMD64_HEAP_LIMIT_IN_REGISTER
-#define AMD64_HEAP_LIMIT_REGISTER 12'
-define(HEAP_LIMIT,%r12)dnl Change this together with line above
-`#define RESTORE_HEAP_LIMIT movq P_HP_LIMIT(P), 'HEAP_LIMIT`
+#define RESTORE_HEAP_LIMIT movq P_HP_LIMIT(P), 'HEAP_LIMIT`
#else
#define RESTORE_HEAP_LIMIT /*empty*/
#endif'
@@ -99,7 +119,22 @@ define(NSP,%rsp)dnl
`#define SAVE_CSP movq %rsp, P_CSP(P)
#define RESTORE_CSP movq P_CSP(P), %rsp'
-`#define AMD64_SIMULATE_NSP 'SIMULATE_NSP
+
+/*
+ * Debugging macros
+ *
+ * Keeps track of whether context has been saved in the debug build, allowing us
+ * to detect when the garbage collector is called when it shouldn't.
+ */
+`#ifdef DEBUG
+# define SET_GC_UNSAFE \
+ movq $1, P_GCUNSAFE(P)
+# define SET_GC_SAFE \
+ movq $0, P_GCUNSAFE(P)
+#else
+# define SET_GC_UNSAFE
+# define SET_GC_SAFE
+#endif'
/*
* Context switching macros.
@@ -114,12 +149,14 @@ define(NSP,%rsp)dnl
`#define SAVE_CACHED_STATE \
SAVE_HP; \
- SAVE_FCALLS'
+ SAVE_FCALLS; \
+ SET_GC_SAFE'
`#define RESTORE_CACHED_STATE \
RESTORE_HP; \
RESTORE_HEAP_LIMIT; \
- RESTORE_FCALLS'
+ RESTORE_FCALLS; \
+ SET_GC_UNSAFE'
`#define SWITCH_C_TO_ERLANG \
RESTORE_CACHED_STATE; \
@@ -132,8 +169,6 @@ define(NSP,%rsp)dnl
/*
* Argument (parameter) registers.
*/
-`#define AMD64_NR_ARG_REGS 'NR_ARG_REGS
-`#define NR_ARG_REGS 'NR_ARG_REGS
define(defarg,`define(ARG$1,`$2')dnl
#`define ARG'$1 $2'
@@ -237,6 +272,10 @@ define(NBIF_ARG,`ifelse(eval($3 >= NR_ARG_REGS),0,`NBIF_REG_ARG($1,$3)',`NBIF_ST
`/* #define NBIF_ARG_3_0 'NBIF_ARG(%rsi,3,0)` */'
`/* #define NBIF_ARG_3_1 'NBIF_ARG(%rdx,3,1)` */'
`/* #define NBIF_ARG_3_2 'NBIF_ARG(%rcx,3,2)` */'
+`/* #define NBIF_ARG_4_0 'NBIF_ARG(%rsi,4,0)` */'
+`/* #define NBIF_ARG_4_1 'NBIF_ARG(%rdx,4,1)` */'
+`/* #define NBIF_ARG_4_2 'NBIF_ARG(%rcx,4,2)` */'
+`/* #define NBIF_ARG_4_3 'NBIF_ARG(%r8,4,3)` */'
`/* #define NBIF_ARG_5_0 'NBIF_ARG(%rsi,5,0)` */'
`/* #define NBIF_ARG_5_1 'NBIF_ARG(%rdx,5,1)` */'
`/* #define NBIF_ARG_5_2 'NBIF_ARG(%rcx,5,2)` */'
@@ -261,6 +300,9 @@ define(NBIF_RET,`NBIF_RET_N(eval(RET_POP($1)))')dnl
`/* #define NBIF_RET_1 'NBIF_RET(1)` */'
`/* #define NBIF_RET_2 'NBIF_RET(2)` */'
`/* #define NBIF_RET_3 'NBIF_RET(3)` */'
+`/* #define NBIF_RET_4 'NBIF_RET(4)` */'
`/* #define NBIF_RET_5 'NBIF_RET(5)` */'
+`#endif /* ASM */'
+
`#endif /* HIPE_AMD64_ASM_H */'
diff --git a/erts/emulator/hipe/hipe_amd64_bifs.m4 b/erts/emulator/hipe/hipe_amd64_bifs.m4
index 0de69a617f..aff10f1528 100644
--- a/erts/emulator/hipe/hipe_amd64_bifs.m4
+++ b/erts/emulator/hipe/hipe_amd64_bifs.m4
@@ -2,23 +2,24 @@ changecom(`/*', `*/')dnl
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2004-2012. All Rights Reserved.
+ * Copyright Ericsson AB 2004-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
-
+#`define ASM'
include(`hipe/hipe_amd64_asm.m4')
#`include' "config.h"
#`include' "hipe_literals.h"
@@ -39,18 +40,22 @@ define(HANDLE_GOT_MBUF,`
jmp 2b')
`#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP)
-# define CALL_BIF(F) movq $CSYM(F), P_BIF_CALLEE(P); call CSYM(hipe_debug_bif_wrapper)
+# define CALL_BIF(F) \
+ movq CSYM(nbif_impl_##F)@GOTPCREL(%rip), %r11; \
+ movq %r11, P_BIF_CALLEE(P); \
+ call CSYM(hipe_debug_bif_wrapper)
#else
-# define CALL_BIF(F) call CSYM(F)
+# define CALL_BIF(F) call CSYM(nbif_impl_##F)
#endif'
/*
* standard_bif_interface_1(nbif_name, cbif_name)
* standard_bif_interface_2(nbif_name, cbif_name)
* standard_bif_interface_3(nbif_name, cbif_name)
+ * standard_bif_interface_4(nbif_name, cbif_name)
* standard_bif_interface_0(nbif_name, cbif_name)
*
- * Generate native interface for a BIF with 0-3 parameters and
+ * Generate native interface for a BIF with 0-4 parameters and
* standard failure mode.
*/
define(standard_bif_interface_1,
@@ -151,6 +156,42 @@ ASYM($1):
TYPE_FUNCTION(ASYM($1))
#endif')
+define(standard_bif_interface_4,
+`
+#ifndef HAVE_$1
+#`define' HAVE_$1
+ TEXT
+ .align 4
+ GLOBAL(ASYM($1))
+ASYM($1):
+ /* set up the parameters */
+ movq P, %rdi
+ NBIF_ARG(%rsi,4,0)
+ NBIF_ARG(%rdx,4,1)
+ NBIF_ARG(%rcx,4,2)
+ NBIF_ARG(%r8,4,3)
+
+ /* make the call on the C stack */
+ SWITCH_ERLANG_TO_C
+ pushq %r8
+ pushq %rcx
+ pushq %rdx
+ pushq %rsi
+ movq %rsp, %rsi /* Eterm* BIF__ARGS */
+ CALL_BIF($2)
+ add $(4*8), %rsp
+ TEST_GOT_MBUF
+ SWITCH_C_TO_ERLANG
+
+ /* throw exception if failure, otherwise return */
+ TEST_GOT_EXN
+ jz nbif_4_simple_exception
+ NBIF_RET(4)
+ HANDLE_GOT_MBUF(4)
+ SET_SIZE(ASYM($1))
+ TYPE_FUNCTION(ASYM($1))
+#endif')
+
define(standard_bif_interface_0,
`
#ifndef HAVE_$1
@@ -422,6 +463,43 @@ ASYM($1):
#endif')
/*
+ * nogc_bif_interface_1(nbif_name, cbif_name)
+ *
+ * Generate native interface for a bif with implicit P
+ * The bif can fail but cannot do GC.
+ */
+
+define(nogc_bif_interface_1,
+`
+#ifndef HAVE_$1
+#`define' HAVE_$1
+ TEXT
+ .align 4
+ GLOBAL(ASYM($1))
+ASYM($1):
+ /* set up the parameters */
+ movq P, %rdi
+ NBIF_ARG(%rsi,1,0)
+
+ /* make the call on the C stack */
+ SWITCH_ERLANG_TO_C
+ pushq %rsi
+ movq %rsp, %rsi /* Eterm* BIF__ARGS */
+ sub $(8), %rsp /* stack frame 16-byte alignment */
+ CALL_BIF($2)
+ add $(1*8 + 8), %rsp
+ SWITCH_C_TO_ERLANG
+
+ /* throw exception if failure, otherwise return */
+ TEST_GOT_EXN
+ jz nbif_1_simple_exception
+ NBIF_RET(1)
+ SET_SIZE(ASYM($1))
+ TYPE_FUNCTION(ASYM($1))
+#endif')
+
+
+/*
* noproc_primop_interface_0(nbif_name, cbif_name)
* noproc_primop_interface_1(nbif_name, cbif_name)
* noproc_primop_interface_2(nbif_name, cbif_name)
@@ -554,15 +632,12 @@ noproc_primop_interface_0(nbif_handle_fp_exception, erts_restore_fpu)
#endif /* NO_FPE_SIGNALS */
/*
- * Implement gc_bif_interface_0 as nofail_primop_interface_0.
- */
-define(gc_bif_interface_0,`nofail_primop_interface_0($1, $2)')
-
-/*
- * Implement gc_bif_interface_N as standard_bif_interface_N (N=1,2).
+ * Implement gc_bif_interface_N as standard_bif_interface_N.
*/
+define(gc_bif_interface_0,`standard_bif_interface_0($1, $2)')
define(gc_bif_interface_1,`standard_bif_interface_1($1, $2)')
define(gc_bif_interface_2,`standard_bif_interface_2($1, $2)')
+define(gc_bif_interface_3,`standard_bif_interface_3($1, $2)')
/*
* Implement gc_nofail_primop_interface_1 as nofail_primop_interface_1.
diff --git a/erts/emulator/hipe/hipe_amd64_gc.h b/erts/emulator/hipe/hipe_amd64_gc.h
index c5a6fee6fe..6b95d54904 100644
--- a/erts/emulator/hipe/hipe_amd64_gc.h
+++ b/erts/emulator/hipe/hipe_amd64_gc.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2004-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2004-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/hipe/hipe_amd64_glue.S b/erts/emulator/hipe/hipe_amd64_glue.S
index 8816906870..f3404888d5 100644
--- a/erts/emulator/hipe/hipe_amd64_glue.S
+++ b/erts/emulator/hipe/hipe_amd64_glue.S
@@ -1,26 +1,26 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2004-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2004-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
-
+#define ASM
#include "hipe_amd64_asm.h"
#include "hipe_literals.h"
-#define ASM
#include "hipe_mode_switch.h"
/*
@@ -94,6 +94,7 @@ ASYM(nbif_return):
.nosave_exit:
/* switch to C stack */
SWITCH_ERLANG_TO_C_QUICK
+ SET_GC_SAFE
/* restore C callee-save registers, drop frame, return */
movq (%rsp), %rbp # kills P
movq 8(%rsp), %rbx
@@ -109,7 +110,7 @@ ASYM(nbif_return):
* stub (hipe_x86_loader.erl) which should look as follows:
*
* stub for f/N:
- * movq $<f's BEAM code address>, P_BEAM_IP(P)
+ * movq $<f's export entry address>, P_CALLEE_EXP(P)
* movb $<N>, P_ARITY(P)
* jmp nbif_callemu
*
@@ -119,7 +120,7 @@ ASYM(nbif_return):
GLOBAL(ASYM(nbif_callemu))
ASYM(nbif_callemu):
STORE_ARG_REGS
- movl $HIPE_MODE_SWITCH_RES_CALL, %eax
+ movl $HIPE_MODE_SWITCH_RES_CALL_EXPORTED, %eax
jmp .suspend_exit
/*
@@ -322,6 +323,7 @@ ASYM(nbif_fail):
GLOBAL(nbif_1_gc_after_bif)
GLOBAL(nbif_2_gc_after_bif)
GLOBAL(nbif_3_gc_after_bif)
+ GLOBAL(nbif_4_gc_after_bif)
.align 4
nbif_0_gc_after_bif:
xorl %edx, %edx
@@ -337,6 +339,10 @@ nbif_2_gc_after_bif:
.align 4
nbif_3_gc_after_bif:
movl $3, %edx
+ jmp .gc_after_bif
+ .align 4
+nbif_4_gc_after_bif:
+ movl $4, %edx
/*FALLTHROUGH*/
.align 4
.gc_after_bif:
@@ -360,6 +366,7 @@ nbif_3_gc_after_bif:
GLOBAL(nbif_1_simple_exception)
GLOBAL(nbif_2_simple_exception)
GLOBAL(nbif_3_simple_exception)
+ GLOBAL(nbif_4_simple_exception)
.align 4
nbif_0_simple_exception:
xorl %eax, %eax
@@ -375,6 +382,10 @@ nbif_2_simple_exception:
.align 4
nbif_3_simple_exception:
movl $3, %eax
+ jmp .nbif_simple_exception
+ .align 4
+nbif_4_simple_exception:
+ movl $4, %eax
/*FALLTHROUGH*/
.align 4
.nbif_simple_exception:
@@ -388,6 +399,7 @@ nbif_3_simple_exception:
movl %eax, P_NARITY(P) # Note: narity is a 32-bit field
/* find and prepare to invoke the handler */
SWITCH_ERLANG_TO_C_QUICK # The cached state is clean and need not be saved.
+ SET_GC_SAFE
movq P, %rdi
call CSYM(hipe_handle_exception) # Note: hipe_handle_exception() conses
SWITCH_C_TO_ERLANG # %rsp updated by hipe_find_handler()
diff --git a/erts/emulator/hipe/hipe_amd64_glue.h b/erts/emulator/hipe/hipe_amd64_glue.h
index 36508467fa..089658f4b5 100644
--- a/erts/emulator/hipe/hipe_amd64_glue.h
+++ b/erts/emulator/hipe/hipe_amd64_glue.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2004-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2004-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/hipe/hipe_amd64_primops.h b/erts/emulator/hipe/hipe_amd64_primops.h
index 55cb0eadb8..94c39a9433 100644
--- a/erts/emulator/hipe/hipe_amd64_primops.h
+++ b/erts/emulator/hipe/hipe_amd64_primops.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2005-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2005-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/hipe/hipe_arch.h b/erts/emulator/hipe/hipe_arch.h
index 04ed980126..059b8e7f29 100644
--- a/erts/emulator/hipe/hipe_arch.h
+++ b/erts/emulator/hipe/hipe_arch.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2003-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2003-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -29,22 +30,31 @@ extern void hipe_patch_load_fe(Uint *address, Uint value);
extern int hipe_patch_insn(void *address, Uint value, Eterm type);
extern int hipe_patch_call(void *callAddress, void *destAddress, void *trampoline);
-extern void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity);
+extern void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, struct process *p);
+extern void hipe_free_code(void*, unsigned int);
+extern void *hipe_make_native_stub(void *exp, unsigned int beamArity);
+extern void hipe_free_native_stub(void*);
+
#if defined(__sparc__)
#include "hipe_sparc.h"
+#include "hipe_sparc_asm.h"
#endif
#if defined(__i386__)
#include "hipe_x86.h"
+#include "hipe_x86_asm.h"
#endif
#if defined(__x86_64__)
#include "hipe_amd64.h"
+#include "hipe_amd64_asm.h"
#endif
#if defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__)
#include "hipe_ppc.h"
+#include "hipe_ppc_asm.h"
#endif
#if defined(__arm__)
#include "hipe_arm.h"
+#include "hipe_arm_asm.h"
#endif
#if !defined(AEXTERN)
diff --git a/erts/emulator/hipe/hipe_arm.c b/erts/emulator/hipe/hipe_arm.c
index 3db3ffe9b1..b61939724c 100644
--- a/erts/emulator/hipe/hipe_arm.c
+++ b/erts/emulator/hipe/hipe_arm.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2005-2012. All Rights Reserved.
+ * Copyright Ericsson AB 2005-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -24,7 +25,6 @@
#endif
#include "global.h"
#include "erl_binary.h"
-#include <sys/mman.h>
#include "hipe_arch.h"
#include "hipe_native_bif.h" /* nbif_callemu() */
@@ -56,30 +56,6 @@ void hipe_flush_icache_word(void *address)
hipe_flush_icache_range(address, 4);
}
-/*
- * Management of 32MB code segments for regular code and trampolines.
- */
-
-#define SEGMENT_NRBYTES (32*1024*1024) /* named constant, _not_ a tunable */
-
-static struct segment {
- unsigned int *base; /* [base,base+32MB[ */
- unsigned int *code_pos; /* INV: base <= code_pos <= tramp_pos */
- unsigned int *tramp_pos; /* INV: tramp_pos <= base+32MB */
- /* On ARM we always allocate a trampoline at base+32MB-8 for
- nbif_callemu, so tramp_pos <= base+32MB-8. */
-} curseg;
-
-#define in_area(ptr,start,nbytes) \
- ((UWord)((char*)(ptr) - (char*)(start)) < (nbytes))
-
-static void *new_code_mapping(void)
-{
- return mmap(0, SEGMENT_NRBYTES,
- PROT_EXEC|PROT_READ|PROT_WRITE,
- MAP_PRIVATE|MAP_ANONYMOUS,
- -1, 0);
-}
static int check_callees(Eterm callees)
{
@@ -106,126 +82,53 @@ static int check_callees(Eterm callees)
return arity;
}
-static unsigned int *try_alloc(Uint nrwords, int nrcallees, Eterm callees, unsigned int **trampvec)
-{
- unsigned int *base, *address, *tramp_pos, nrfreewords;
- int trampnr;
- Eterm mfa, m, f;
- unsigned int a, *trampoline;
-
- m = NIL; f = NIL; a = 0; /* silence stupid compiler warning */
- tramp_pos = curseg.tramp_pos;
- address = curseg.code_pos;
- nrfreewords = tramp_pos - address;
- if (nrwords > nrfreewords)
- return NULL;
- curseg.code_pos = address + nrwords;
- nrfreewords -= nrwords;
+#define TRAMPOLINE_WORDS 2
- base = curseg.base;
- for (trampnr = 1; trampnr <= nrcallees; ++trampnr) {
- mfa = tuple_val(callees)[trampnr];
- if (is_atom(mfa))
- trampoline = hipe_primop_get_trampoline(mfa);
- else {
- m = tuple_val(mfa)[1];
- f = tuple_val(mfa)[2];
- a = unsigned_val(tuple_val(mfa)[3]);
- trampoline = hipe_mfa_get_trampoline(m, f, a);
- }
- if (!in_area(trampoline, base, SEGMENT_NRBYTES)) {
- if (nrfreewords < 2)
- return NULL;
- nrfreewords -= 2;
- tramp_pos = trampoline = tramp_pos - 2;
- trampoline[0] = 0xE51FF004; /* ldr pc, [pc,#-4] */
- trampoline[1] = 0; /* callee's address */
- hipe_flush_icache_range(trampoline, 2*sizeof(int));
- if (is_atom(mfa))
- hipe_primop_set_trampoline(mfa, trampoline);
- else
- hipe_mfa_set_trampoline(m, f, a, trampoline);
- }
- trampvec[trampnr-1] = trampoline;
+static void generate_trampolines(Uint32* address,
+ int nrcallees, Eterm callees,
+ Uint32** trampvec)
+{
+ Uint32* trampoline = address;
+ int i;
+
+ for (i = 0; i < nrcallees; ++i) {
+ trampoline[0] = 0xE51FF004; /* ldr pc, [pc,#-4] */
+ trampoline[1] = 0; /* callee's address */
+ trampvec[i] = trampoline;
+ trampoline += TRAMPOLINE_WORDS;
}
- curseg.tramp_pos = tramp_pos;
- return address;
+ hipe_flush_icache_range(address, nrcallees*2*sizeof(Uint32));
}
void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *p)
{
- Uint nrwords;
+ Uint code_words;
int nrcallees;
Eterm trampvecbin;
- unsigned int **trampvec;
- unsigned int *address;
- unsigned int *base;
- struct segment oldseg;
+ Uint32 **trampvec;
+ Uint32 *address;
if (nrbytes & 0x3)
return NULL;
- nrwords = nrbytes >> 2;
+ code_words = nrbytes / sizeof(Uint32);
nrcallees = check_callees(callees);
if (nrcallees < 0)
return NULL;
- trampvecbin = new_binary(p, NULL, nrcallees*sizeof(unsigned int*));
- trampvec = (unsigned int**)binary_bytes(trampvecbin);
+ trampvecbin = new_binary(p, NULL, nrcallees*sizeof(Uint32*));
+ trampvec = (Uint32**)binary_bytes(trampvecbin);
- address = try_alloc(nrwords, nrcallees, callees, trampvec);
- if (!address) {
- base = new_code_mapping();
- if (base == MAP_FAILED)
- return NULL;
- oldseg = curseg;
- curseg.base = base;
- curseg.code_pos = base;
- curseg.tramp_pos = (unsigned int*)((char*)base + SEGMENT_NRBYTES);
- curseg.tramp_pos -= 2;
- curseg.tramp_pos[0] = 0xE51FF004; /* ldr pc, [pc,#-4] */
- curseg.tramp_pos[1] = (unsigned int)&nbif_callemu;
+ address = erts_alloc(ERTS_ALC_T_HIPE_EXEC,
+ (code_words + nrcallees*TRAMPOLINE_WORDS)*sizeof(Uint32));
- address = try_alloc(nrwords, nrcallees, callees, trampvec);
- if (!address) {
- munmap(base, SEGMENT_NRBYTES);
- curseg = oldseg;
- return NULL;
- }
- /* commit to new segment, ignore leftover space in old segment */
- }
+ generate_trampolines(address + code_words, nrcallees, callees, trampvec);
*trampolines = trampvecbin;
return address;
}
-static unsigned int *alloc_stub(Uint nrwords, unsigned int **tramp_callemu)
+void hipe_free_code(void* code, unsigned int bytes)
{
- unsigned int *address;
- unsigned int *base;
- struct segment oldseg;
-
- address = try_alloc(nrwords, 0, NIL, NULL);
- if (!address) {
- base = new_code_mapping();
- if (base == MAP_FAILED)
- return NULL;
- oldseg = curseg;
- curseg.base = base;
- curseg.code_pos = base;
- curseg.tramp_pos = (unsigned int*)((char*)base + SEGMENT_NRBYTES);
- curseg.tramp_pos -= 2;
- curseg.tramp_pos[0] = 0xE51FF004; /* ldr pc, [pc,#-4] */
- curseg.tramp_pos[1] = (unsigned int)&nbif_callemu;
-
- address = try_alloc(nrwords, 0, NIL, NULL);
- if (!address) {
- munmap(base, SEGMENT_NRBYTES);
- curseg = oldseg;
- return NULL;
- }
- /* commit to new segment, ignore leftover space in old segment */
- }
- *tramp_callemu = (unsigned int*)((char*)curseg.base + SEGMENT_NRBYTES) - 2;
- return address;
+ erts_free(ERTS_ALC_T_HIPE_EXEC, code);
}
/*
@@ -260,50 +163,73 @@ int hipe_patch_insn(void *address, Uint32 value, Eterm type)
return 0;
}
-/* called from hipe_bif0.c:hipe_bifs_make_native_stub_2()
- and hipe_bif0.c:hipe_make_stub() */
-void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity)
+/* Make stub for native code calling exported beam function
+*/
+void *hipe_make_native_stub(void *callee_exp, unsigned int beamArity)
{
unsigned int *code;
- unsigned int *tramp_callemu;
int callemu_offset;
+ int is_short_jmp;
/*
* Native code calls BEAM via a stub looking as follows:
*
* mov r0, #beamArity
- * ldr r8, [pc,#0] // beamAddress
+ * ldr r8, [pc,#0] // callee_exp
* b nbif_callemu
- * .long beamAddress
+ * .long callee_exp
+ *
+ * or if nbif_callemu is too far away:
+ *
+ * mov r0, #beamArity
+ * ldr r8, [pc,#0] // callee_exp
+ * ldr pc, [pc,#0] // nbif_callemu
+ * .long callee_exp
+ * .long nbif_callemu
*
* I'm using r0 and r8 since they aren't used for
- * parameter passing in native code. The branch to
- * nbif_callemu may need to go via a trampoline.
- * (Trampolines are allowed to modify r12, but they don't.)
+ * parameter passing in native code.
*/
- code = alloc_stub(4, &tramp_callemu);
+ code = erts_alloc(ERTS_ALC_T_HIPE_EXEC, 5*sizeof(Uint32));
+ if (!code)
+ return NULL;
callemu_offset = ((int)&nbif_callemu - ((int)&code[2] + 8)) >> 2;
- if (!(callemu_offset >= -0x00800000 && callemu_offset <= 0x007FFFFF)) {
- callemu_offset = ((int)tramp_callemu - ((int)&code[2] + 8)) >> 2;
- if (!(callemu_offset >= -0x00800000 && callemu_offset <= 0x007FFFFF))
- abort();
+ is_short_jmp = (callemu_offset >= -0x00800000 &&
+ callemu_offset <= 0x007FFFFF);
+#ifdef DEBUG
+ if (is_short_jmp && (callemu_offset % 3)==0) {
+ is_short_jmp = 0;
}
+#endif
/* mov r0, #beamArity */
code[0] = 0xE3A00000 | (beamArity & 0xFF);
- /* ldr r8, [pc,#0] // beamAddress */
+ /* ldr r8, [pc,#0] // callee_exp */
code[1] = 0xE59F8000;
- /* b nbif_callemu */
- code[2] = 0xEA000000 | (callemu_offset & 0x00FFFFFF);
- /* .long beamAddress */
- code[3] = (unsigned int)beamAddress;
+ if (is_short_jmp) {
+ /* b nbif_callemu */
+ code[2] = 0xEA000000 | (callemu_offset & 0x00FFFFFF);
+ }
+ else {
+ /* ldr pc, [pc,#0] // nbif_callemu */
+ code[2] = 0xE59FF000;
+ /* .long nbif_callemu */
+ code[4] = (unsigned int)&nbif_callemu;
+ }
+ /* .long callee_exp */
+ code[3] = (unsigned int)callee_exp;
- hipe_flush_icache_range(code, 4*sizeof(int));
+ hipe_flush_icache_range(code, 5*sizeof(Uint32));
return code;
}
+void hipe_free_native_stub(void* stub)
+{
+ erts_free(ERTS_ALC_T_HIPE_EXEC, stub);
+}
+
static void patch_b(Uint32 *address, Sint32 offset, Uint32 AA)
{
Uint32 oldI = *address;
diff --git a/erts/emulator/hipe/hipe_arm.h b/erts/emulator/hipe/hipe_arm.h
index 19f2a986cf..b5fe6317c9 100644
--- a/erts/emulator/hipe/hipe_arm.h
+++ b/erts/emulator/hipe/hipe_arm.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2005-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2005-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -40,8 +41,4 @@ static __inline__ int hipe_word32_address_ok(void *address)
extern void hipe_arm_inc_stack(void);
-/* for hipe_bifs_enter_code_2 */
-extern void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *p);
-#define HIPE_ALLOC_CODE(n,c,t,p) hipe_alloc_code((n),(c),(t),(p))
-
#endif /* HIPE_ARM_H */
diff --git a/erts/emulator/hipe/hipe_arm.tab b/erts/emulator/hipe/hipe_arm.tab
index 49b89d6748..152319edbd 100644
--- a/erts/emulator/hipe/hipe_arm.tab
+++ b/erts/emulator/hipe/hipe_arm.tab
@@ -1,18 +1,19 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2005-2011. All Rights Reserved.
+# Copyright Ericsson AB 2005-2016. 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/.
+# 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
#
-# 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.
+# 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%
#
diff --git a/erts/emulator/hipe/hipe_arm_asm.m4 b/erts/emulator/hipe/hipe_arm_asm.m4
index 85dc84973d..68a6faa70b 100644
--- a/erts/emulator/hipe/hipe_arm_asm.m4
+++ b/erts/emulator/hipe/hipe_arm_asm.m4
@@ -2,18 +2,19 @@ changecom(`/*', `*/')dnl
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2005-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2005-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -29,6 +30,14 @@ define(LEAF_WORDS,16)dnl number of stack words for leaf functions
define(NR_ARG_REGS,3)dnl admissible values are 0 to 6, inclusive
`#define ARM_LEAF_WORDS 'LEAF_WORDS
+`#define ARM_NR_ARG_REGS 'NR_ARG_REGS
+`#define NR_ARG_REGS 'NR_ARG_REGS
+
+
+`#ifdef ASM'
+/*
+ * Only assembler stuff from here on (when included from *.S)
+ */
/*
* Reserved registers.
@@ -39,6 +48,24 @@ define(NR_ARG_REGS,3)dnl admissible values are 0 to 6, inclusive
`#define TEMP_LR r8'
/*
+ * Debugging macros
+ *
+ * Keeps track of whether context has been saved in the debug build, allowing us
+ * to detect when the garbage collector is called when it shouldn't.
+ */
+`#ifdef DEBUG
+# define SET_GC_UNSAFE(SCRATCH) \
+ mov SCRATCH, #1; \
+ str SCRATCH, [P, #P_GCUNSAFE]
+# define SET_GC_SAFE(SCRATCH) \
+ mov SCRATCH, #0; \
+ str SCRATCH, [P, #P_GCUNSAFE]
+#else
+# define SET_GC_UNSAFE(SCRATCH)
+# define SET_GC_SAFE(SCRATCH)
+#endif'
+
+/*
* Context switching macros.
*
* RESTORE_CONTEXT and RESTORE_CONTEXT_QUICK do not affect
@@ -50,12 +77,14 @@ define(NR_ARG_REGS,3)dnl admissible values are 0 to 6, inclusive
`#define RESTORE_CONTEXT_QUICK \
mov lr, TEMP_LR'
-`#define SAVE_CACHED_STATE \
- str HP, [P, #P_HP]; \
- str NSP, [P, #P_NSP]'
+`#define SAVE_CACHED_STATE \
+ str HP, [P, #P_HP]; \
+ str NSP, [P, #P_NSP]; \
+ SET_GC_SAFE(HP)'
-`#define RESTORE_CACHED_STATE \
- ldr HP, [P, #P_HP]; \
+`#define RESTORE_CACHED_STATE \
+ SET_GC_UNSAFE(HP); \
+ ldr HP, [P, #P_HP]; \
ldr NSP, [P, #P_NSP]'
`#define SAVE_CONTEXT_BIF \
@@ -66,19 +95,19 @@ define(NR_ARG_REGS,3)dnl admissible values are 0 to 6, inclusive
ldr HP, [P, #P_HP]'
`#define SAVE_CONTEXT_GC \
+ SET_GC_SAFE(TEMP_LR); \
mov TEMP_LR, lr; \
str lr, [P, #P_NRA]; \
str NSP, [P, #P_NSP]; \
str HP, [P, #P_HP]'
`#define RESTORE_CONTEXT_GC \
+ SET_GC_UNSAFE(HP); \
ldr HP, [P, #P_HP]'
/*
* Argument (parameter) registers.
*/
-`#define ARM_NR_ARG_REGS 'NR_ARG_REGS
-`#define NR_ARG_REGS 'NR_ARG_REGS
define(defarg,`define(ARG$1,`$2')dnl
#`define ARG'$1 $2'
@@ -157,6 +186,10 @@ define(NBIF_ARG,`ifelse(eval($3 >= NR_ARG_REGS),0,`NBIF_REG_ARG($1,$3)',`NBIF_ST
`/* #define NBIF_ARG_3_0 'NBIF_ARG(r1,3,0)` */'
`/* #define NBIF_ARG_3_1 'NBIF_ARG(r2,3,1)` */'
`/* #define NBIF_ARG_3_2 'NBIF_ARG(r3,3,2)` */'
+`/* #define NBIF_ARG_4_0 'NBIF_ARG(r1,4,0)` */'
+`/* #define NBIF_ARG_4_1 'NBIF_ARG(r2,4,1)` */'
+`/* #define NBIF_ARG_4_2 'NBIF_ARG(r3,4,2)` */'
+`/* #define NBIF_ARG_4_3 'NBIF_ARG(r4,4,3)` */'
`/* #define NBIF_ARG_5_0 'NBIF_ARG(r1,5,0)` */'
`/* #define NBIF_ARG_5_1 'NBIF_ARG(r2,5,1)` */'
`/* #define NBIF_ARG_5_2 'NBIF_ARG(r3,5,2)` */'
@@ -180,6 +213,7 @@ define(NBIF_RET,`NBIF_RET_N(eval(RET_POP($1)))')dnl
`/* #define NBIF_RET_1 'NBIF_RET(1)` */'
`/* #define NBIF_RET_2 'NBIF_RET(2)` */'
`/* #define NBIF_RET_3 'NBIF_RET(3)` */'
+`/* #define NBIF_RET_4 'NBIF_RET(4)` */'
`/* #define NBIF_RET_5 'NBIF_RET(5)` */'
dnl
@@ -195,4 +229,6 @@ define(QUICK_CALL_RET,`NBIF_POP_N(eval(RET_POP($2)))b $1')dnl
`/* #define QUICK_CALL_RET_F_3 'QUICK_CALL_RET(F,3)` */'
`/* #define QUICK_CALL_RET_F_5 'QUICK_CALL_RET(F,5)` */'
+`#endif /* ASM */'
+
`#endif /* HIPE_ARM_ASM_H */'
diff --git a/erts/emulator/hipe/hipe_arm_bifs.m4 b/erts/emulator/hipe/hipe_arm_bifs.m4
index bd8bc5ab6b..a9097dabde 100644
--- a/erts/emulator/hipe/hipe_arm_bifs.m4
+++ b/erts/emulator/hipe/hipe_arm_bifs.m4
@@ -2,34 +2,37 @@ changecom(`/*', `*/')dnl
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2005-2012. All Rights Reserved.
+ * Copyright Ericsson AB 2005-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
+#`define ASM'
include(`hipe/hipe_arm_asm.m4')
#`include' "config.h"
#`include' "hipe_literals.h"
.text
.p2align 2
+ .arm
`#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP)
-# define CALL_BIF(F) ldr r14, =F; str r14, [r0, #P_BIF_CALLEE]; bl hipe_debug_bif_wrapper
+# define CALL_BIF(F) ldr r14, =nbif_impl_##F; str r14, [r0, #P_BIF_CALLEE]; bl hipe_debug_bif_wrapper
#else
-# define CALL_BIF(F) bl F
+# define CALL_BIF(F) bl nbif_impl_##F
#endif'
define(TEST_GOT_MBUF,`ldr r1, [P, #P_MBUF] /* `TEST_GOT_MBUF' */
@@ -40,9 +43,10 @@ define(TEST_GOT_MBUF,`ldr r1, [P, #P_MBUF] /* `TEST_GOT_MBUF' */
* standard_bif_interface_1(nbif_name, cbif_name)
* standard_bif_interface_2(nbif_name, cbif_name)
* standard_bif_interface_3(nbif_name, cbif_name)
+ * standard_bif_interface_4(nbif_name, cbif_name)
* standard_bif_interface_0(nbif_name, cbif_name)
*
- * Generate native interface for a BIF with 1-3 parameters and
+ * Generate native interface for a BIF with 0-4 parameters and
* standard failure mode.
*/
define(standard_bif_interface_1,
@@ -132,6 +136,39 @@ $1:
.type $1, %function
#endif')
+define(standard_bif_interface_4,
+`
+#ifndef HAVE_$1
+#`define' HAVE_$1
+ .global $1
+$1:
+ /* Set up C argument registers. */
+ mov r0, P
+ NBIF_ARG(r1,4,0)
+ NBIF_ARG(r2,4,1)
+ NBIF_ARG(r3,4,2)
+ NBIF_ARG(r4,4,3)
+
+ /* Save caller-save registers and call the C function. */
+ SAVE_CONTEXT_BIF
+ str r1, [r0, #P_ARG0] /* Store BIF__ARGS in def_arg_reg[] */
+ str r2, [r0, #P_ARG1]
+ str r3, [r0, #P_ARG2]
+ str r4, [r0, #P_ARG3]
+ add r1, r0, #P_ARG0
+ CALL_BIF($2)
+ TEST_GOT_MBUF(4)
+
+ /* Restore registers. Check for exception. */
+ cmp r0, #THE_NON_VALUE
+ RESTORE_CONTEXT_BIF
+ beq nbif_4_simple_exception
+ NBIF_RET(4)
+ .ltorg
+ .size $1, .-$1
+ .type $1, %function
+#endif')
+
define(standard_bif_interface_0,
`
#ifndef HAVE_$1
@@ -161,8 +198,9 @@ $1:
* gc_bif_interface_0(nbif_name, cbif_name)
* gc_bif_interface_1(nbif_name, cbif_name)
* gc_bif_interface_2(nbif_name, cbif_name)
+ * gc_bif_interface_3(nbif_name, cbif_name)
*
- * Generate native interface for a BIF with 0-2 parameters and
+ * Generate native interface for a BIF with 0-3 parameters and
* standard failure mode.
* The BIF may do a GC.
*/
@@ -242,6 +280,36 @@ $1:
.type $1, %function
#endif')
+define(gc_bif_interface_3,
+`
+#ifndef HAVE_$1
+#`define' HAVE_$1
+ .global $1
+$1:
+ /* Set up C argument registers. */
+ mov r0, P
+ NBIF_ARG(r1,3,0)
+ NBIF_ARG(r2,3,1)
+ NBIF_ARG(r3,3,2)
+
+ /* Save caller-save registers and call the C function. */
+ SAVE_CONTEXT_GC
+ str r1, [r0, #P_ARG0] /* Store BIF__ARGS in def_arg_reg[] */
+ str r2, [r0, #P_ARG1]
+ str r3, [r0, #P_ARG2]
+ add r1, r0, #P_ARG0
+ CALL_BIF($2)
+ TEST_GOT_MBUF(3)
+
+ /* Restore registers. Check for exception. */
+ cmp r0, #THE_NON_VALUE
+ RESTORE_CONTEXT_GC
+ beq nbif_3_simple_exception
+ NBIF_RET(3)
+ .size $1, .-$1
+ .type $1, %function
+#endif')
+
/*
* gc_nofail_primop_interface_1(nbif_name, cbif_name)
*
@@ -391,7 +459,14 @@ $1:
mov r0, P
/* Perform a quick save;call;restore;ret sequence. */
+#ifdef __thumb__
+ SAVE_CONTEXT_QUICK
+ bl $2
+ RESTORE_CONTEXT_QUICK
+ NBIF_RET(0)
+#else
QUICK_CALL_RET($2,0)
+#endif
.size $1, .-$1
.type $1, %function
#endif')
@@ -407,7 +482,14 @@ $1:
NBIF_ARG(r1,1,0)
/* Perform a quick save;call;restore;ret sequence. */
+#ifdef __thumb__
+ SAVE_CONTEXT_QUICK
+ bl $2
+ RESTORE_CONTEXT_QUICK
+ NBIF_RET(1)
+#else
QUICK_CALL_RET($2,1)
+#endif
.size $1, .-$1
.type $1, %function
#endif')
@@ -424,7 +506,14 @@ $1:
NBIF_ARG(r2,2,1)
/* Perform a quick save;call;restore;ret sequence. */
+#ifdef __thumb__
+ SAVE_CONTEXT_QUICK
+ bl $2
+ RESTORE_CONTEXT_QUICK
+ NBIF_RET(2)
+#else
QUICK_CALL_RET($2,2)
+#endif
.size $1, .-$1
.type $1, %function
#endif')
@@ -442,7 +531,14 @@ $1:
NBIF_ARG(r3,3,2)
/* Perform a quick save;call;restore;ret sequence. */
+#ifdef __thumb__
+ SAVE_CONTEXT_QUICK
+ bl $2
+ RESTORE_CONTEXT_QUICK
+ NBIF_RET(3)
+#else
QUICK_CALL_RET($2,3)
+#endif
.size $1, .-$1
.type $1, %function
#endif')
@@ -466,7 +562,14 @@ $1:
NBIF_ARG(r3,5,2)
/* Perform a quick save;call;restore;ret sequence. */
+#ifdef __thumb__
+ SAVE_CONTEXT_QUICK
+ bl $2
+ RESTORE_CONTEXT_QUICK
+ NBIF_RET(5)
+#else
QUICK_CALL_RET($2,5)
+#endif
.size $1, .-$1
.type $1, %function
#endif')
@@ -488,9 +591,16 @@ define(noproc_primop_interface_0,
#`define' HAVE_$1
.global $1
$1:
- /* XXX: this case is always trivial; how to suppress the branch? */
/* Perform a quick save;call;restore;ret sequence. */
+#ifdef __thumb__
+ SAVE_CONTEXT_QUICK
+ bl $2
+ RESTORE_CONTEXT_QUICK
+ NBIF_RET(0)
+#else
+ /* XXX: this case is always trivial; how to suppress the branch? */
QUICK_CALL_RET($2,0)
+#endif
.size $1, .-$1
.type $1, %function
#endif')
@@ -505,7 +615,14 @@ $1:
NBIF_ARG(r0,1,0)
/* Perform a quick save;call;restore;ret sequence. */
+#ifdef __thumb__
+ SAVE_CONTEXT_QUICK
+ bl $2
+ RESTORE_CONTEXT_QUICK
+ NBIF_RET(1)
+#else
QUICK_CALL_RET($2,1)
+#endif
.size $1, .-$1
.type $1, %function
#endif')
@@ -521,7 +638,14 @@ $1:
NBIF_ARG(r1,2,1)
/* Perform a quick save;call;restore;ret sequence. */
+#ifdef __thumb__
+ SAVE_CONTEXT_QUICK
+ bl $2
+ RESTORE_CONTEXT_QUICK
+ NBIF_RET(2)
+#else
QUICK_CALL_RET($2,2)
+#endif
.size $1, .-$1
.type $1, %function
#endif')
@@ -538,7 +662,14 @@ $1:
NBIF_ARG(r2,3,2)
/* Perform a quick save;call;restore;ret sequence. */
+#ifdef __thumb__
+ SAVE_CONTEXT_QUICK
+ bl $2
+ RESTORE_CONTEXT_QUICK
+ NBIF_RET(3)
+#else
QUICK_CALL_RET($2,3)
+#endif
.size $1, .-$1
.type $1, %function
#endif')
@@ -558,7 +689,14 @@ $1:
str r4, [sp, #0]
/* Perform a quick save;call;restore;ret sequence. */
+#ifdef __thumb__
+ SAVE_CONTEXT_QUICK
+ bl $2
+ RESTORE_CONTEXT_QUICK
+ NBIF_RET(5)
+#else
QUICK_CALL_RET($2,5)
+#endif
.size $1, .-$1
.type $1, %function
#endif')
diff --git a/erts/emulator/hipe/hipe_arm_gc.h b/erts/emulator/hipe/hipe_arm_gc.h
index 787c6fef3e..e8eb900978 100644
--- a/erts/emulator/hipe/hipe_arm_gc.h
+++ b/erts/emulator/hipe/hipe_arm_gc.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2005-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2005-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/hipe/hipe_arm_glue.S b/erts/emulator/hipe/hipe_arm_glue.S
index 2e2b8604a6..5b7f8ad52d 100644
--- a/erts/emulator/hipe/hipe_arm_glue.S
+++ b/erts/emulator/hipe/hipe_arm_glue.S
@@ -1,30 +1,31 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2005-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2005-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
-
+#define ASM
#include "hipe_arm_asm.h"
#include "hipe_literals.h"
-#define ASM
#include "hipe_mode_switch.h"
.text
.p2align 2
+ .arm
/*
* Enter Erlang from C.
@@ -70,6 +71,7 @@
* Emulated code recursively calls native code.
*/
.global hipe_arm_call_to_native
+ .type hipe_arm_call_to_native, %function
hipe_arm_call_to_native:
ENTER_FROM_C
/* get argument registers */
@@ -85,6 +87,7 @@ hipe_arm_call_to_native:
* This is where native code returns to emulated code.
*/
.global nbif_return
+ .type nbif_return, %function
nbif_return:
str r0, [P, #P_ARG0] /* save retval */
mov r0, #HIPE_MODE_SWITCH_RES_RETURN
@@ -95,6 +98,7 @@ nbif_return:
* Emulated code returns to its native code caller.
*/
.global hipe_arm_return_to_native
+ .type hipe_arm_return_to_native, %function
hipe_arm_return_to_native:
ENTER_FROM_C
/* get return value */
@@ -111,6 +115,7 @@ hipe_arm_return_to_native:
* Emulated code tailcalls native code.
*/
.global hipe_arm_tailcall_to_native
+ .type hipe_arm_tailcall_to_native, %function
hipe_arm_tailcall_to_native:
ENTER_FROM_C
/* get argument registers */
@@ -125,6 +130,7 @@ hipe_arm_tailcall_to_native:
* Emulated code throws an exception to its native code caller.
*/
.global hipe_arm_throw_to_native
+ .type hipe_arm_throw_to_native, %function
hipe_arm_throw_to_native:
ENTER_FROM_C
/* invoke the handler */
@@ -135,24 +141,26 @@ hipe_arm_throw_to_native:
* which should look as follows:
*
* stub for f/N:
- * <set r8 to f's BEAM code address>
+ * <set r8 to f's export entry address>
* <set r0 to N>
* b nbif_callemu
*
* XXX: Different stubs for different number of register parameters?
*/
.global nbif_callemu
+ .type nbif_callemu, %function
nbif_callemu:
- str r8, [P, #P_BEAM_IP]
+ str r8, [P, #P_CALLEE_EXP]
str r0, [P, #P_ARITY]
STORE_ARG_REGS
- mov r0, #HIPE_MODE_SWITCH_RES_CALL
+ mov r0, #HIPE_MODE_SWITCH_RES_CALL_EXPORTED
b .suspend_exit
/*
* nbif_apply
*/
.global nbif_apply
+ .type nbif_apply, %function
nbif_apply:
STORE_ARG_REGS
mov r0, #HIPE_MODE_SWITCH_RES_APPLY
@@ -169,6 +177,7 @@ nbif_apply:
*/
#if NR_ARG_REGS >= 6
.global nbif_ccallemu6
+ .type nbif_ccallemu6, %function
nbif_ccallemu6:
str ARG5, [P, #P_ARG5]
#if NR_ARG_REGS > 6
@@ -181,6 +190,7 @@ nbif_ccallemu6:
#if NR_ARG_REGS >= 5
.global nbif_ccallemu5
+ .type nbif_ccallemu5, %function
nbif_ccallemu5:
str ARG4, [P, #P_ARG4]
#if NR_ARG_REGS > 5
@@ -193,6 +203,7 @@ nbif_ccallemu5:
#if NR_ARG_REGS >= 4
.global nbif_ccallemu4
+ .type nbif_ccallemu4, %function
nbif_ccallemu4:
str ARG3, [P, #P_ARG3]
#if NR_ARG_REGS > 4
@@ -205,6 +216,7 @@ nbif_ccallemu4:
#if NR_ARG_REGS >= 3
.global nbif_ccallemu3
+ .type nbif_ccallemu3, %function
nbif_ccallemu3:
str ARG2, [P, #P_ARG2]
#if NR_ARG_REGS > 3
@@ -217,6 +229,7 @@ nbif_ccallemu3:
#if NR_ARG_REGS >= 2
.global nbif_ccallemu2
+ .type nbif_ccallemu2, %function
nbif_ccallemu2:
str ARG1, [P, #P_ARG1]
#if NR_ARG_REGS > 2
@@ -229,6 +242,7 @@ nbif_ccallemu2:
#if NR_ARG_REGS >= 1
.global nbif_ccallemu1
+ .type nbif_ccallemu1, %function
nbif_ccallemu1:
str ARG0, [P, #P_ARG0]
#if NR_ARG_REGS > 1
@@ -240,6 +254,7 @@ nbif_ccallemu1:
#endif
.global nbif_ccallemu0
+ .type nbif_ccallemu0, %function
nbif_ccallemu0:
/* We use r1 not ARG0 here because ARG0 is not
defined when NR_ARG_REGS == 0. */
@@ -254,6 +269,7 @@ nbif_ccallemu0:
* This is where native code suspends.
*/
.global nbif_suspend_0
+ .type nbif_suspend_0, %function
nbif_suspend_0:
mov r0, #HIPE_MODE_SWITCH_RES_SUSPEND
b .suspend_exit
@@ -262,6 +278,7 @@ nbif_suspend_0:
* Suspend from a receive (waiting for a message)
*/
.global nbif_suspend_msg
+ .type nbif_suspend_msg, %function
nbif_suspend_msg:
mov r0, #HIPE_MODE_SWITCH_RES_WAIT
b .suspend_exit
@@ -272,6 +289,7 @@ nbif_suspend_msg:
* else { return 0; }
*/
.global nbif_suspend_msg_timeout
+ .type nbif_suspend_msg_timeout, %function
nbif_suspend_msg_timeout:
ldr r1, [P, #P_FLAGS]
mov r0, #HIPE_MODE_SWITCH_RES_WAIT_TIMEOUT
@@ -286,30 +304,45 @@ nbif_suspend_msg_timeout:
* This is the default exception handler for native code.
*/
.global nbif_fail
+ .type nbif_fail, %function
nbif_fail:
mov r0, #HIPE_MODE_SWITCH_RES_THROW
b .flush_exit /* no need to save RA */
.global nbif_0_gc_after_bif
- .global nbif_1_gc_after_bif
- .global nbif_2_gc_after_bif
- .global nbif_3_gc_after_bif
+ .type nbif_0_gc_after_bif, %function
nbif_0_gc_after_bif:
mov r1, #0
b .gc_after_bif
+
+ .global nbif_1_gc_after_bif
+ .type nbif_1_gc_after_bif, %function
nbif_1_gc_after_bif:
mov r1, #1
b .gc_after_bif
+
+ .global nbif_2_gc_after_bif
+ .type nbif_2_gc_after_bif, %function
nbif_2_gc_after_bif:
mov r1, #2
b .gc_after_bif
+
+ .global nbif_3_gc_after_bif
+ .type nbif_3_gc_after_bif, %function
nbif_3_gc_after_bif:
mov r1, #3
+ b .gc_after_bif
+
+ .global nbif_4_gc_after_bif
+ .type nbif_4_gc_after_bif, %function
+nbif_4_gc_after_bif:
+ mov r1, #4
/*FALLTHROUGH*/
.gc_after_bif:
str r1, [P, #P_NARITY]
str TEMP_LR, [P, #P_NRA]
str NSP, [P, #P_NSP]
+ SET_GC_SAFE(TEMP_LR)
mov TEMP_LR, lr
mov r3, #0 /* Pass 0 in arity */
mov r2, #0 /* Pass NULL in regs */
@@ -317,6 +350,7 @@ nbif_3_gc_after_bif:
mov r0, P
bl erts_gc_after_bif_call
mov lr, TEMP_LR
+ SET_GC_UNSAFE(TEMP_LR)
ldr TEMP_LR, [P, #P_NRA]
mov r1, #0
str r1, [P, #P_NARITY]
@@ -330,20 +364,33 @@ nbif_3_gc_after_bif:
* TEMP_LR contains a copy of LR
*/
.global nbif_0_simple_exception
+ .type nbif_0_simple_exception, %function
nbif_0_simple_exception:
mov r1, #0
b .nbif_simple_exception
+
.global nbif_1_simple_exception
+ .type nbif_1_simple_exception, %function
nbif_1_simple_exception:
mov r1, #1
b .nbif_simple_exception
+
.global nbif_2_simple_exception
+ .type nbif_2_simple_exception, %function
nbif_2_simple_exception:
mov r1, #2
b .nbif_simple_exception
+
.global nbif_3_simple_exception
+ .type nbif_3_simple_exception, %function
nbif_3_simple_exception:
mov r1, #3
+ b .nbif_simple_exception
+
+ .global nbif_4_simple_exception
+ .type nbif_4_simple_exception, %function
+nbif_4_simple_exception:
+ mov r1, #4
/*FALLTHROUGH*/
.nbif_simple_exception:
ldr r0, [P, #P_FREASON]
@@ -359,6 +406,7 @@ nbif_3_simple_exception:
str NSP, [P, #P_NSP]
str TEMP_LR, [P, #P_NRA]
str r1, [P, #P_NARITY]
+ SET_GC_SAFE(r0)
/* find and prepare to invoke the handler */
mov r0, P
bl hipe_handle_exception /* Note: hipe_handle_exception() conses */
@@ -378,6 +426,7 @@ nbif_3_simple_exception:
str NSP, [P, #P_NSP]
str r1, [P, #P_NARITY]
str TEMP_LR, [P, #P_NRA]
+ SET_GC_SAFE(NSP)
b .nosave_exit
/*
@@ -385,6 +434,7 @@ nbif_3_simple_exception:
* the gray/white stack boundary
*/
.global nbif_stack_trap_ra
+ .type nbif_stack_trap_ra, %function
nbif_stack_trap_ra: /* a return address, not a function */
# This only handles a single return value.
# If we have more, we need to save them in the PCB.
@@ -401,6 +451,7 @@ nbif_stack_trap_ra: /* a return address, not a function */
* Caller saved its LR in TEMP_LR (== TEMP1) before calling us.
*/
.global hipe_arm_inc_stack
+ .type hipe_arm_inc_stack, %function
hipe_arm_inc_stack:
STORE_ARG_REGS
mov TEMP_ARG0, lr
diff --git a/erts/emulator/hipe/hipe_arm_glue.h b/erts/emulator/hipe/hipe_arm_glue.h
index 165f73320d..dffc5aef03 100644
--- a/erts/emulator/hipe/hipe_arm_glue.h
+++ b/erts/emulator/hipe/hipe_arm_glue.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2005-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2005-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/hipe/hipe_arm_primops.h b/erts/emulator/hipe/hipe_arm_primops.h
index 2a1a87b862..c080b67699 100644
--- a/erts/emulator/hipe/hipe_arm_primops.h
+++ b/erts/emulator/hipe/hipe_arm_primops.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2005-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2005-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/hipe/hipe_bif0.c b/erts/emulator/hipe/hipe_bif0.c
index 2497d51df1..94bc563fda 100644
--- a/erts/emulator/hipe/hipe_bif0.c
+++ b/erts/emulator/hipe/hipe_bif0.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -43,6 +44,7 @@
#include "hipe_mode_switch.h"
#include "hipe_native_bif.h"
#include "hipe_bif0.h"
+#include "hipe_load.h"
/* We need hipe_literals.h for HIPE_SYSTEM_CRC, but it redefines
a few constants. #undef them here to avoid warnings. */
#undef F_TIMO
@@ -53,6 +55,7 @@
#define BeamOpCode(Op) ((Uint)BeamOp(Op))
+
int term_to_Sint32(Eterm term, Sint *sp)
{
Sint val;
@@ -89,25 +92,6 @@ static Eterm address_to_term(const void *address, Process *p)
/*
* BIFs for reading and writing memory. Used internally by HiPE.
*/
-#if 0 /* XXX: unused */
-BIF_RETTYPE hipe_bifs_read_u8_1(BIF_ALIST_1)
-{
- unsigned char *address = term_to_address(BIF_ARG_1);
- if (!address)
- BIF_ERROR(BIF_P, BADARG);
- BIF_RET(make_small(*address));
-}
-#endif
-
-#if 0 /* XXX: unused */
-BIF_RETTYPE hipe_bifs_read_u32_1(BIF_ALIST_1)
-{
- Uint32 *address = term_to_address(BIF_ARG_1);
- if (!address || !hipe_word32_address_ok(address))
- BIF_ERROR(BIF_P, BADARG);
- BIF_RET(Uint_to_term(*address, BIF_P));
-}
-#endif
BIF_RETTYPE hipe_bifs_write_u8_2(BIF_ALIST_2)
{
@@ -120,22 +104,6 @@ BIF_RETTYPE hipe_bifs_write_u8_2(BIF_ALIST_2)
BIF_RET(NIL);
}
-#if 0 /* XXX: unused */
-BIF_RETTYPE hipe_bifs_write_s32_2(BIF_ALIST_2)
-{
- Sint32 *address;
- Sint value;
-
- address = term_to_address(BIF_ARG_1);
- if (!address || !hipe_word32_address_ok(address))
- BIF_ERROR(BIF_P, BADARG);
- if (!term_to_Sint32(BIF_ARG_2, &value))
- BIF_ERROR(BIF_P, BADARG);
- *address = value;
- BIF_RET(NIL);
-}
-#endif
-
BIF_RETTYPE hipe_bifs_write_u32_2(BIF_ALIST_2)
{
Uint32 *address;
@@ -408,15 +376,28 @@ BIF_RETTYPE hipe_bifs_ref_set_2(BIF_ALIST_2)
}
/*
+ * BIFs for loading code.
+ */
+
+static HipeLoaderState *get_loader_state(Eterm term)
+{
+ if (!is_internal_magic_ref(term)) return NULL;
+
+ return hipe_get_loader_state(erts_magic_ref2bin(term));
+}
+
+
+/*
* Allocate memory and copy machine code to it.
*/
-BIF_RETTYPE hipe_bifs_enter_code_2(BIF_ALIST_2)
+BIF_RETTYPE hipe_bifs_enter_code_3(BIF_ALIST_3)
{
Uint nrbytes;
void *bytes;
void *address;
Eterm trampolines;
Eterm *hp;
+ HipeLoaderState *stp;
#ifndef DEBUG
ERTS_DECLARE_DUMMY(Uint bitoffs);
ERTS_DECLARE_DUMMY(Uint bitsize);
@@ -425,24 +406,31 @@ BIF_RETTYPE hipe_bifs_enter_code_2(BIF_ALIST_2)
Uint bitsize;
#endif
- if (is_not_binary(BIF_ARG_1))
+ if (is_not_binary(BIF_ARG_1) ||
+ (!(stp = get_loader_state(BIF_ARG_3))))
BIF_ERROR(BIF_P, BADARG);
nrbytes = binary_size(BIF_ARG_1);
ERTS_GET_BINARY_BYTES(BIF_ARG_1, bytes, bitoffs, bitsize);
ASSERT(bitoffs == 0);
ASSERT(bitsize == 0);
trampolines = NIL;
-#ifdef HIPE_ALLOC_CODE
- address = HIPE_ALLOC_CODE(nrbytes, BIF_ARG_2, &trampolines, BIF_P);
- if (!address)
- BIF_ERROR(BIF_P, BADARG);
-#else
- if (is_not_nil(BIF_ARG_2))
- BIF_ERROR(BIF_P, BADARG);
- address = erts_alloc(ERTS_ALC_T_HIPE, nrbytes);
-#endif
+ address = hipe_alloc_code(nrbytes, BIF_ARG_2, &trampolines, BIF_P);
+ if (!address) {
+ Uint nrcallees;
+
+ if (is_tuple(BIF_ARG_2))
+ nrcallees = arityval(tuple_val(BIF_ARG_2)[0]);
+ else
+ nrcallees = 0;
+ // XXX: Is there any reason to not just BIF_ERROR, so that the runtime
+ // survives?
+ 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);
hipe_flush_icache_range(address, nrbytes);
+ stp->text_segment = address;
+ stp->text_segment_size = nrbytes;
hp = HAlloc(BIF_P, 3);
hp[0] = make_arityval(2);
hp[1] = address_to_term(address, BIF_P);
@@ -450,26 +438,36 @@ BIF_RETTYPE hipe_bifs_enter_code_2(BIF_ALIST_2)
BIF_RET(make_tuple(hp));
}
+#define IS_POWER_OF_TWO(Val) (((Val) > 0) && (((Val) & ((Val)-1)) == 0))
+
/*
* Allocate memory for arbitrary non-Erlang data.
*/
-BIF_RETTYPE hipe_bifs_alloc_data_2(BIF_ALIST_2)
+BIF_RETTYPE hipe_bifs_alloc_data_3(BIF_ALIST_3)
{
- Uint align, nrbytes;
- void *block;
+ Uint align;
+ HipeLoaderState *stp;
+ void *aligned_block;
if (is_not_small(BIF_ARG_1) || is_not_small(BIF_ARG_2) ||
- (align = unsigned_val(BIF_ARG_1),
- align != sizeof(long) && align != sizeof(double)))
+ (!(stp = get_loader_state(BIF_ARG_3))) ||
+ (align = unsigned_val(BIF_ARG_1), !IS_POWER_OF_TWO(align)))
+ BIF_ERROR(BIF_P, BADARG);
+
+ if (stp->data_segment_size || stp->data_segment)
BIF_ERROR(BIF_P, BADARG);
- nrbytes = unsigned_val(BIF_ARG_2);
- if (nrbytes == 0)
+
+ stp->data_segment_size = unsigned_val(BIF_ARG_2);
+ if (stp->data_segment_size == 0)
BIF_RET(make_small(0));
- block = erts_alloc(ERTS_ALC_T_HIPE, nrbytes);
- if ((unsigned long)block & (align-1))
- fprintf(stderr, "%s: erts_alloc(%lu) returned %p which is not %lu-byte aligned\r\n",
- __FUNCTION__, (unsigned long)nrbytes, block, (unsigned long)align);
- BIF_RET(address_to_term(block, BIF_P));
+
+ stp->data_segment_size += align-1; /* Make room to align the pointer */
+ stp->data_segment = erts_alloc(ERTS_ALC_T_HIPE_LL, stp->data_segment_size);
+
+ /* Align the pointer */
+ aligned_block = (void*)((UWord)(stp->data_segment + align - 1)
+ & ~(UWord)(align-1));
+ BIF_RET(address_to_term(aligned_block, BIF_P));
}
/*
@@ -520,7 +518,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
@@ -529,6 +527,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;
}
@@ -539,7 +539,10 @@ 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;
- hash_init(ERTS_ALC_T_HIPE, &const_term_table, "const_term_table", 97, f);
+ 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_LL, &const_term_table, "const_term_table", 97, f);
}
BIF_RETTYPE hipe_bifs_merge_term_1(BIF_ALIST_1)
@@ -560,13 +563,13 @@ BIF_RETTYPE hipe_bifs_merge_term_1(BIF_ALIST_1)
BIF_RET(val);
}
-struct mfa {
+struct hipe_mfa {
Eterm mod;
Eterm fun;
Uint ari;
};
-static int term_to_mfa(Eterm term, struct mfa *mfa)
+static int term_to_mfa(Eterm term, struct hipe_mfa *mfa)
{
Eterm mod, fun, a;
Uint ari;
@@ -600,31 +603,28 @@ static void print_mfa(Eterm mod, Eterm fun, unsigned int ari)
}
#endif
-/*
- * Convert {M,F,A} to pointer to first insn after initial func_info.
- */
-static Uint *hipe_find_emu_address(Eterm mod, Eterm name, unsigned int arity)
+static ErtsCodeInfo* 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];
- ASSERT(code_ptr[0] == BeamOpCode(op_i_func_info_IaaI));
- if (code_ptr[3] == name && code_ptr[4] == arity)
- return code_ptr+5;
+ ErtsCodeInfo *ci = code_hdr->functions[i];
+ ASSERT(ci->op == BeamOpCode(op_i_func_info_IaaI));
+ if (ci->mfa.function == name && ci->mfa.arity == arity)
+ return ci;
}
return NULL;
}
-Uint *hipe_bifs_find_pc_from_mfa(Eterm term)
+ErtsCodeInfo* hipe_bifs_find_pc_from_mfa(Eterm term)
{
- struct mfa mfa;
+ struct hipe_mfa mfa;
if (!term_to_mfa(term, &mfa))
return NULL;
@@ -633,45 +633,26 @@ Uint *hipe_bifs_find_pc_from_mfa(Eterm term)
BIF_RETTYPE hipe_bifs_fun_to_address_1(BIF_ALIST_1)
{
- Eterm *pc = hipe_bifs_find_pc_from_mfa(BIF_ARG_1);
- if (!pc)
+ ErtsCodeInfo* ci = hipe_bifs_find_pc_from_mfa(BIF_ARG_1);
+ if (!ci)
BIF_ERROR(BIF_P, BADARG);
- BIF_RET(address_to_term(pc, BIF_P));
+ BIF_RET(address_to_term(erts_codeinfo_to_code(ci), BIF_P));
}
-static void *hipe_get_emu_address(Eterm m, Eterm f, unsigned int arity, int is_remote)
+BIF_RETTYPE hipe_bifs_commit_patch_load_1(BIF_ALIST_1)
{
- void *address = NULL;
- if (!is_remote)
- address = hipe_find_emu_address(m, f, arity);
- if (!address) {
- /* if not found, stub it via the export entry */
- /* no lock needed around erts_export_get_or_make_stub() */
- Export *export_entry = erts_export_get_or_make_stub(m, f, arity);
- address = export_entry->addressv[erts_active_code_ix()];
- }
- return address;
-}
-
-#if 0 /* XXX: unused */
-BIF_RETTYPE hipe_bifs_get_emu_address_1(BIF_ALIST_1)
-{
- struct mfa mfa;
- void *address;
+ if (!erts_commit_hipe_patch_load(BIF_ARG_1))
+ BIF_ERROR(BIF_P, BADARG);
- if (!term_to_mfa(BIF_ARG_1, &mfa))
- BIF_ERROR(BIF_P, BADARG);
- address = hipe_get_emu_address(mfa.mod, mfa.fun, mfa.ari);
- BIF_RET(address_to_term(address, BIF_P));
+ BIF_RET(am_ok);
}
-#endif
BIF_RETTYPE hipe_bifs_set_native_address_3(BIF_ALIST_3)
{
- Eterm *pc;
+ ErtsCodeInfo *ci;
void *address;
int is_closure;
- struct mfa mfa;
+ struct hipe_mfa mfa;
switch (BIF_ARG_3) {
case am_false:
@@ -691,58 +672,26 @@ BIF_RETTYPE hipe_bifs_set_native_address_3(BIF_ALIST_3)
simply have called hipe_bifs_find_pc_from_mfa(). */
if (!term_to_mfa(BIF_ARG_1, &mfa))
BIF_ERROR(BIF_P, BADARG);
- pc = hipe_find_emu_address(mfa.mod, mfa.fun, mfa.ari);
+ ci = hipe_find_emu_address(mfa.mod, mfa.fun, mfa.ari);
- if (pc) {
- hipe_mfa_save_orig_beam_op(mfa.mod, mfa.fun, mfa.ari, pc);
-#if HIPE
-#ifdef DEBUG_LINKER
- printf("%s: ", __FUNCTION__);
- print_mfa(mfa.mod, mfa.fun, mfa.ari);
- printf(": planting call trap to %p at BEAM pc %p\r\n", address, pc);
-#endif
- hipe_set_call_trap(pc, address, is_closure);
+ if (ci) {
+ DBG_TRACE_MFA(mfa.mod,mfa.fun,mfa.ari, "set beam call trap at %p -> %p",
+ erts_codeinfo_to_code(ci), address);
+ hipe_set_call_trap(ci, address, is_closure);
BIF_RET(am_true);
-#endif
}
-#ifdef DEBUG_LINKER
- printf("%s: ", __FUNCTION__);
- print_mfa(mfa.mod, mfa.fun, mfa.ari);
- printf(": no BEAM pc found\r\n");
-#endif
+ DBG_TRACE_MFA(mfa.mod,mfa.fun,mfa.ari, "failed set call trap to %p, no beam code found", address);
BIF_RET(am_false);
}
-#if 0 /* XXX: unused */
-/*
- * hipe_bifs_address_to_fun(Address)
- * - Address is the address of the start of a emu function's code
- * - returns {Module, Function, Arity}
- */
-BIF_RETTYPE hipe_bifs_address_to_fun_1(BIF_ALIST_1)
+BIF_RETTYPE hipe_bifs_enter_sdesc_2(BIF_ALIST_2)
{
- Eterm *pc;
- Eterm *funcinfo;
- Eterm *hp;
+ struct hipe_sdesc *sdesc;
+ HipeLoaderState* stp;
- pc = term_to_address(BIF_ARG_1);
- if (!pc)
+ stp = get_loader_state(BIF_ARG_2);
+ if (!stp)
BIF_ERROR(BIF_P, BADARG);
- funcinfo = find_function_from_pc(pc);
- if (!funcinfo)
- BIF_RET(am_false);
- hp = HAlloc(BIF_P, 4);
- hp[0] = make_arityval(3);
- hp[1] = funcinfo[0];
- hp[2] = funcinfo[1];
- hp[3] = make_small(funcinfo[2]);
- BIF_RET(make_tuple(hp));
-}
-#endif
-
-BIF_RETTYPE hipe_bifs_enter_sdesc_1(BIF_ALIST_1)
-{
- struct sdesc *sdesc;
sdesc = hipe_decode_sdesc(BIF_ARG_1);
if (!sdesc) {
@@ -753,6 +702,13 @@ BIF_RETTYPE hipe_bifs_enter_sdesc_1(BIF_ALIST_1)
fprintf(stderr, "%s: duplicate entry!\r\n", __FUNCTION__);
BIF_ERROR(BIF_P, BADARG);
}
+
+ /*
+ * Link into list of sdesc's in same module instance
+ */
+ sdesc->next_in_modi = stp->new_hipe_sdesc;
+ stp->new_hipe_sdesc = sdesc;
+
BIF_RET(NIL);
}
@@ -768,13 +724,13 @@ struct nbif {
};
static struct nbif nbifs[BIF_SIZE] = {
-#define BIF_LIST(MOD,FUN,ARY,CFUN,IX) \
+#define BIF_LIST(MOD,FUN,ARY,BIF,CFUN,IX) \
{ {0,0}, MOD, FUN, ARY, &nbif_##CFUN },
#include "erl_bif_list.h"
#undef BIF_LIST
};
-#define NBIF_HASH(m,f,a) ((m)*(f)+(a))
+#define NBIF_HASH(m,f,a) (atom_val(m) ^ atom_val(f) ^ (a))
static Hash nbif_table;
static HashValue nbif_hash(struct nbif *x)
@@ -801,6 +757,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);
@@ -852,9 +811,6 @@ BIF_RETTYPE hipe_bifs_bif_address_3(BIF_ALIST_3)
struct primop {
HashBucket bucket; /* bucket.hvalue == atom_val(name) */
const void *address;
-#if defined(__arm__)
- void *trampoline;
-#endif
};
static struct primop primops[] = {
@@ -894,8 +850,11 @@ 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);
+ hash_init(ERTS_ALC_T_HIPE_LL, &primop_table, "primop_table", 50, f);
for (i = 0; i < sizeof(primops)/sizeof(primops[0]); ++i)
hash_put(&primop_table, &primops[i]);
@@ -910,29 +869,6 @@ static struct primop *primop_table_get(Eterm name)
return hash_get(&primop_table, &tmpl);
}
-#if defined(__arm__)
-static struct primop *primop_table_put(Eterm name)
-{
- struct primop tmpl;
-
- init_primop_table();
- tmpl.bucket.hvalue = atom_val(name);
- return hash_put(&primop_table, &tmpl);
-}
-
-void *hipe_primop_get_trampoline(Eterm name)
-{
- struct primop *primop = primop_table_get(name);
- return primop ? primop->trampoline : NULL;
-}
-
-void hipe_primop_set_trampoline(Eterm name, void *trampoline)
-{
- struct primop *primop = primop_table_put(name);
- primop->trampoline = trampoline;
-}
-#endif
-
/*
* hipe_bifs_primop_address(Atom) -> address or false
*/
@@ -948,37 +884,6 @@ BIF_RETTYPE hipe_bifs_primop_address_1(BIF_ALIST_1)
BIF_RET(address_to_term(primop->address, BIF_P));
}
-#if 0 /* XXX: unused */
-/*
- * hipe_bifs_gbif_address(F,A) -> address or false
- */
-#define GBIF_LIST(ATOM,ARY,CFUN) extern Eterm gbif_##CFUN(void);
-#include "hipe_gbif_list.h"
-#undef GBIF_LIST
-
-BIF_RETTYPE hipe_bifs_gbif_address_2(BIF_ALIST_2)
-{
- Uint arity;
- void *address;
-
- if (is_not_atom(BIF_ARG_1) || is_not_small(BIF_ARG_2))
- BIF_RET(am_false); /* error or false, does it matter? */
- arity = signed_val(BIF_ARG_2);
- /* XXX: replace with a hash table later */
- do { /* trick to let us use 'break' instead of 'goto' */
-#define GBIF_LIST(ATOM,ARY,CFUN) if (BIF_ARG_1 == ATOM && arity == ARY) { address = CFUN; break; }
-#include "hipe_gbif_list.h"
-#undef GBIF_LIST
- printf("\r\n%s: guard BIF ", __FUNCTION__);
- fflush(stdout);
- erts_printf("%T", BIF_ARG_1);
- printf("/%lu isn't listed in hipe_gbif_list.h\r\n", arity);
- BIF_RET(am_false);
- } while (0);
- BIF_RET(address_to_term(address, BIF_P));
-}
-#endif
-
BIF_RETTYPE hipe_bifs_atom_to_word_1(BIF_ALIST_1)
{
if (is_not_atom(BIF_ARG_1))
@@ -992,7 +897,8 @@ BIF_RETTYPE hipe_bifs_term_to_word_1(BIF_ALIST_1)
}
/* XXX: this is really a primop, not a BIF */
-BIF_RETTYPE hipe_conv_big_to_float(BIF_ALIST_1)
+/* Called via standard_bif_interface_1 */
+BIF_RETTYPE nbif_impl_hipe_conv_big_to_float(NBIF_ALIST_1)
{
Eterm res;
Eterm *hp;
@@ -1022,83 +928,19 @@ BIF_RETTYPE hipe_conv_big_to_float(BIF_ALIST_1)
*/
void hipe_emulate_fpe(Process* p)
{
- if (!finite(p->hipe.float_result)) {
+ if (!isfinite(p->hipe.float_result)) {
p->fp_exception = 1;
}
}
#endif
-#if 0 /* XXX: unused */
-/*
- * At least parts of this should be inlined in native code.
- * The rest could be made a primop used by both the emulator and
- * native code...
- */
-BIF_RETTYPE hipe_bifs_make_fun_3(BIF_ALIST_3)
+void hipe_emasculate_binary(Eterm bin)
{
- Eterm free_vars;
- Eterm mod;
- Eterm *tp;
- Uint index;
- Uint uniq;
- Uint num_free;
- Eterm tmp_var;
- Uint *tmp_ptr;
- unsigned needed;
- ErlFunThing *funp;
- Eterm *hp;
- int i;
-
- if (is_not_list(BIF_ARG_1) && is_not_nil(BIF_ARG_1))
- BIF_ERROR(BIF_P, BADARG);
- free_vars = BIF_ARG_1;
-
- if (is_not_atom(BIF_ARG_2))
- BIF_ERROR(BIF_P, BADARG);
- mod = BIF_ARG_2;
-
- if (is_not_tuple(BIF_ARG_3) ||
- (arityval(*tuple_val(BIF_ARG_3)) != 3))
- BIF_ERROR(BIF_P, BADARG);
- tp = tuple_val(BIF_ARG_3);
-
- if (term_to_Uint(tp[1], &index) == 0)
- BIF_ERROR(BIF_P, BADARG);
- if (term_to_Uint(tp[2], &uniq) == 0)
- BIF_ERROR(BIF_P, BADARG);
- if (term_to_Uint(tp[3], &num_free) == 0)
- BIF_ERROR(BIF_P, BADARG);
-
- needed = ERL_FUN_SIZE + num_free;
- funp = (ErlFunThing *) HAlloc(BIF_P, needed);
- hp = funp->env;
-
- funp->thing_word = HEADER_FUN;
-
- /* Need a ErlFunEntry *fe
- * fe->refc++;
- * funp->fe = fe;
- */
-
- funp->num_free = num_free;
- funp->creator = BIF_P->id;
- for (i = 0; i < num_free; i++) {
- if (is_nil(free_vars))
- BIF_ERROR(BIF_P, BADARG);
- tmp_ptr = list_val(free_vars);
- tmp_var = CAR(tmp_ptr);
- free_vars = CDR(tmp_ptr);
- *hp++ = tmp_var;
- }
- if (is_not_nil(free_vars))
- BIF_ERROR(BIF_P, BADARG);
-
- funp->next = MSO(BIF_P).funs;
- MSO(BIF_P).funs = funp;
-
- BIF_RET(make_fun(funp));
+ ProcBin* pb = (ProcBin *) boxed_val(bin);
+ ASSERT(pb->thing_word == HEADER_PROC_BIN);
+ ASSERT(pb->flags != 0);
+ erts_emasculate_writable_binary(pb);
}
-#endif
/*
* args: Module, {Uniq, Index, BeamAddress}
@@ -1136,7 +978,7 @@ BIF_RETTYPE hipe_bifs_get_fe_2(BIF_ALIST_2)
atom_buf[0] = '\0';
strncat(atom_buf, (char*)atom_tab(i)->name, atom_tab(i)->len);
- printf("no fun entry for %s %ld:%ld\n", atom_buf, uniq, index);
+ printf("no fun entry for %s %ld:%ld\n", atom_buf, (unsigned long)uniq, (unsigned long)index);
BIF_ERROR(BIF_P, BADARG);
}
BIF_RET(address_to_term((void *)fe, BIF_P));
@@ -1158,51 +1000,40 @@ BIF_RETTYPE hipe_bifs_set_native_address_in_fe_2(BIF_ALIST_2)
BIF_ERROR(BIF_P, BADARG);
fe->native_address = native_address;
- if (erts_refc_dectest(&fe->refc, 0) == 0)
+ if (erts_smp_refc_dectest(&fe->refc, 0) == 0)
erts_erase_fun_entry(fe);
BIF_RET(am_true);
}
-#if 0 /* XXX: unused */
-BIF_RETTYPE hipe_bifs_make_native_stub_2(BIF_ALIST_2)
-{
- void *beamAddress;
- Uint beamArity;
- void *stubAddress;
-
- if ((beamAddress = term_to_address(BIF_ARG_1)) == 0 ||
- is_not_small(BIF_ARG_2) ||
- (beamArity = unsigned_val(BIF_ARG_2)) >= 256)
- BIF_ERROR(BIF_P, BADARG);
- stubAddress = hipe_make_native_stub(beamAddress, beamArity);
- BIF_RET(address_to_term(stubAddress, BIF_P));
-}
-#endif
+struct hipe_ref_head {
+ struct hipe_ref_head* next;
+ struct hipe_ref_head* prev;
+};
/*
- * MFA info hash table:
+ * An exported function called from or implemented by native code
* - maps MFA to native code entry point
- * - the MFAs it calls (refers_to)
- * - the references to it (referred_from)
+ * - all references to it (callers)
* - maps MFA to most recent trampoline [if powerpc or arm]
*/
struct hipe_mfa_info {
+ HashBucket mod2mfa;
struct {
unsigned long hvalue;
struct hipe_mfa_info *next;
} bucket;
Eterm m; /* atom */
Eterm f; /* atom */
- unsigned int a;
+ unsigned int a : sizeof(int)*8 - 1;
+ unsigned int is_stub : 1; /* if beam or not (yet) loaded */
void *remote_address;
- void *local_address;
- Eterm *beam_code;
- Uint orig_beam_op;
- struct hipe_mfa_info_list *refers_to;
- struct ref *referred_from;
-#if defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) || defined(__arm__)
- void *trampoline;
+ void *new_address;
+ struct hipe_ref_head callers; /* sentinel in list of hipe_ref's */
+ struct hipe_mfa_info* next_in_mod;
+#ifdef DEBUG
+ Export* dbg_export;
#endif
+
};
static struct {
@@ -1217,30 +1048,127 @@ static struct {
* they create a new stub for the mfa, which forces locking.
* XXX: Redesign apply et al to avoid those updates.
*/
- erts_smp_mtx_t lock;
+ erts_smp_rwmtx_t lock;
} hipe_mfa_info_table;
+Hash mod2mfa_tab; /* map from module atom to list of hipe_mfa_info */
+
+static HashValue mod2mfa_hash(struct hipe_mfa_info* mfa)
+{
+ return mfa->mod2mfa.hvalue;
+}
+
+static int mod2mfa_cmp(HashBucket* tmpl, struct hipe_mfa_info* mfa)
+{
+ return tmpl->hvalue != mfa->mod2mfa.hvalue;
+}
+
+static struct hipe_mfa_info* mod2mfa_alloc(struct hipe_mfa_info* tmpl)
+{
+ return tmpl; /* hash_put always use mfa itself at template */
+}
+
+static void mod2mfa_free(struct hipe_mfa_info* mfa)
+{
+}
+
+static void mod2mfa_tab_init(void)
+{
+ HashFunctions f;
+ static int init_done = 0;
+
+ if (init_done)
+ return;
+ init_done = 1;
+
+ f.hash = (H_FUN) mod2mfa_hash;
+ f.cmp = (HCMP_FUN) mod2mfa_cmp;
+ f.alloc = (HALLOC_FUN) mod2mfa_alloc;
+ f.free = (HFREE_FUN) mod2mfa_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_HIPE_LL, &mod2mfa_tab, "mod2mfa_tab", 50, f);
+}
+
+static struct hipe_mfa_info* mod2mfa_get(Module* modp)
+{
+ HashBucket tmpl;
+ tmpl.hvalue = modp->module;
+ return hash_get(&mod2mfa_tab, &tmpl);
+}
+
+static struct hipe_mfa_info* mod2mfa_put(struct hipe_mfa_info* mfa)
+{
+ mfa->mod2mfa.hvalue = atom_val(mfa->m);
+ return hash_put(&mod2mfa_tab, mfa);
+}
+
+
+
+/*
+ * An external native call site M:F(...)
+ * to be patched when the callee changes.
+ */
+struct hipe_ref {
+ struct hipe_ref_head head; /* list of refs to same calleee */
+ void *address;
+#if defined(__arm__) || defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__)
+ void *trampoline;
+#endif
+ unsigned int flags;
+ struct hipe_ref* next_from_modi; /* list of refs from same module instance */
+#if defined(DEBUG)
+ struct hipe_mfa_info* callee;
+ Eterm caller_m, caller_f, caller_a;
+#endif
+};
+#define REF_FLAG_IS_LOAD_MFA 1 /* bit 0: 0 == call, 1 == load_mfa */
+
+
static inline void hipe_mfa_info_table_init_lock(void)
{
- erts_smp_mtx_init(&hipe_mfa_info_table.lock, "hipe_mfait_lock");
+ erts_smp_rwmtx_init(&hipe_mfa_info_table.lock, "hipe_mfait_lock", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
}
-static inline void hipe_mfa_info_table_lock(void)
+static inline void hipe_mfa_info_table_rlock(void)
{
- erts_smp_mtx_lock(&hipe_mfa_info_table.lock);
+ erts_smp_rwmtx_rlock(&hipe_mfa_info_table.lock);
}
-static inline void hipe_mfa_info_table_unlock(void)
+static inline void hipe_mfa_info_table_runlock(void)
{
- erts_smp_mtx_unlock(&hipe_mfa_info_table.lock);
+ erts_smp_rwmtx_runlock(&hipe_mfa_info_table.lock);
}
-#define HIPE_MFA_HASH(M,F,A) ((M) * (F) + (A))
+static inline void hipe_mfa_info_table_rwlock(void)
+{
+ erts_smp_rwmtx_rwlock(&hipe_mfa_info_table.lock);
+}
+
+static inline void hipe_mfa_info_table_rwunlock(void)
+{
+ erts_smp_rwmtx_rwunlock(&hipe_mfa_info_table.lock);
+}
+
+static ERTS_INLINE
+struct hipe_mfa_info* mod2mfa_get_safe(Module* modp)
+{
+ struct hipe_mfa_info* mfa;
+ hipe_mfa_info_table_rlock();
+ mfa = mod2mfa_get(modp);
+ hipe_mfa_info_table_runlock();
+ return mfa;
+}
+
+#define HIPE_MFA_HASH(M,F,A) (atom_val(M) ^ atom_val(F) ^ (A))
static struct hipe_mfa_info **hipe_mfa_info_table_alloc_bucket(unsigned int size)
{
unsigned long nbytes = size * sizeof(struct hipe_mfa_info*);
- struct hipe_mfa_info **bucket = erts_alloc(ERTS_ALC_T_HIPE, nbytes);
+ struct hipe_mfa_info **bucket = erts_alloc(ERTS_ALC_T_HIPE_LL, nbytes);
sys_memzero(bucket, nbytes);
return bucket;
}
@@ -1269,25 +1197,25 @@ static void hipe_mfa_info_table_grow(void)
b = next;
}
}
- erts_free(ERTS_ALC_T_HIPE, old_bucket);
+ erts_free(ERTS_ALC_T_HIPE_LL, old_bucket);
}
static struct hipe_mfa_info *hipe_mfa_info_table_alloc(Eterm m, Eterm f, unsigned int arity)
{
struct hipe_mfa_info *res;
- res = (struct hipe_mfa_info*)erts_alloc(ERTS_ALC_T_HIPE, sizeof(*res));
+ res = (struct hipe_mfa_info*)erts_alloc(ERTS_ALC_T_HIPE_LL, sizeof(*res));
res->m = m;
res->f = f;
res->a = arity;
+ res->is_stub = 0;
res->remote_address = NULL;
- res->local_address = NULL;
- res->beam_code = NULL;
- res->orig_beam_op = 0;
- res->refers_to = NULL;
- res->referred_from = NULL;
-#if defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) || defined(__arm__)
- res->trampoline = NULL;
+ res->new_address = NULL;
+ res->callers.next = &res->callers;
+ res->callers.prev = &res->callers;
+ res->next_in_mod = NULL;
+#ifdef DEBUG
+ res->dbg_export = NULL;
#endif
return res;
@@ -1305,6 +1233,8 @@ void hipe_mfa_info_table_init(void)
hipe_mfa_info_table.bucket = hipe_mfa_info_table_alloc_bucket(size);
hipe_mfa_info_table_init_lock();
+
+ mod2mfa_tab_init();
}
static inline struct hipe_mfa_info *hipe_mfa_info_table_get_locked(Eterm m, Eterm f, unsigned int arity)
@@ -1316,37 +1246,34 @@ static inline struct hipe_mfa_info *hipe_mfa_info_table_get_locked(Eterm m, Eter
h = HIPE_MFA_HASH(m, f, arity);
i = h & hipe_mfa_info_table.mask;
p = hipe_mfa_info_table.bucket[i];
- for (; p; p = p->bucket.next)
- /* XXX: do we want to compare p->bucket.hvalue as well? */
- if (p->m == m && p->f == f && p->a == arity)
- return p;
+ for (; p; p = p->bucket.next) {
+ if (p->bucket.hvalue == h) {
+ if (p->m == m && p->f == f && p->a == arity)
+ return p;
+ }
+ else ASSERT(!(p->m == m && p->f == f && p->a == arity));
+ }
return NULL;
}
-#if 0 /* XXX: unused */
-void *hipe_mfa_find_na(Eterm m, Eterm f, unsigned int arity)
-{
- const struct hipe_mfa_info *p;
-
- p = hipe_mfa_info_table_get(m, f, arity);
- return p ? p->address : NULL;
-}
-#endif
-
-static struct hipe_mfa_info *hipe_mfa_info_table_put_locked(Eterm m, Eterm f, unsigned int arity)
+static struct hipe_mfa_info *hipe_mfa_info_table_put_rwlocked(Eterm m, Eterm f, unsigned int arity)
{
unsigned long h;
unsigned int i;
struct hipe_mfa_info *p;
+ struct hipe_mfa_info *first_in_mod;
unsigned int size;
h = HIPE_MFA_HASH(m, f, arity);
i = h & hipe_mfa_info_table.mask;
p = hipe_mfa_info_table.bucket[i];
- for (; p; p = p->bucket.next)
- /* XXX: do we want to compare p->bucket.hvalue as well? */
- if (p->m == m && p->f == f && p->a == arity)
- return p;
+ for (; p; p = p->bucket.next) {
+ if (p->bucket.hvalue == h) {
+ if (p->m == m && p->f == f && p->a == arity)
+ return p;
+ }
+ else ASSERT(!(p->m == m && p->f == f && p->a == arity));
+ }
p = hipe_mfa_info_table_alloc(m, f, arity);
p->bucket.hvalue = h;
p->bucket.next = hipe_mfa_info_table.bucket[i];
@@ -1355,190 +1282,139 @@ static struct hipe_mfa_info *hipe_mfa_info_table_put_locked(Eterm m, Eterm f, un
size = 1 << hipe_mfa_info_table.log2size;
if (hipe_mfa_info_table.used > (4*size/5)) /* rehash at 80% */
hipe_mfa_info_table_grow();
- return p;
-}
-static void hipe_mfa_set_na(Eterm m, Eterm f, unsigned int arity, void *address, int is_exported)
-{
- struct hipe_mfa_info *p;
+ first_in_mod = mod2mfa_put(p);
+ if (p != first_in_mod) {
+ p->next_in_mod = first_in_mod->next_in_mod;
+ first_in_mod->next_in_mod = p;
+ }
+ else {
+ p->next_in_mod = NULL;
+ }
- hipe_mfa_info_table_lock();
- p = hipe_mfa_info_table_put_locked(m, f, arity);
-#ifdef DEBUG_LINKER
- printf("%s: ", __FUNCTION__);
- print_mfa(m, f, arity);
- printf(": changing address from %p to %p\r\n", p->local_address, address);
-#endif
- p->local_address = address;
- if (is_exported)
- p->remote_address = address;
- hipe_mfa_info_table_unlock();
+ DBG_TRACE_MFA(m,f,arity, "hipe_mfa_info allocated at %p", p);
+
+ return p;
}
-#if defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) || defined(__arm__)
-void *hipe_mfa_get_trampoline(Eterm m, Eterm f, unsigned int arity)
+static void remove_mfa_info(struct hipe_mfa_info* rm)
{
+ unsigned int i;
struct hipe_mfa_info *p;
- void *trampoline;
-
- hipe_mfa_info_table_lock();
- p = hipe_mfa_info_table_put_locked(m, f, arity);
- trampoline = p->trampoline;
- hipe_mfa_info_table_unlock();
- return trampoline;
+ struct hipe_mfa_info **prevp;
+
+ i = rm->bucket.hvalue & hipe_mfa_info_table.mask;
+ prevp = &hipe_mfa_info_table.bucket[i];
+ for (;;) {
+ p = *prevp;
+ ASSERT(p);
+ if (p == rm) {
+ *prevp = p->bucket.next;
+ ASSERT(hipe_mfa_info_table.used > 0);
+ hipe_mfa_info_table.used--;
+ return;
+ }
+ prevp = &p->bucket.next;
+ }
}
-void hipe_mfa_set_trampoline(Eterm m, Eterm f, unsigned int arity, void *trampoline)
+static void hipe_mfa_set_na(Eterm m, Eterm f, unsigned int arity, void *address)
{
struct hipe_mfa_info *p;
- hipe_mfa_info_table_lock();
- p = hipe_mfa_info_table_put_locked(m, f, arity);
- p->trampoline = trampoline;
- hipe_mfa_info_table_unlock();
+ hipe_mfa_info_table_rwlock();
+ p = hipe_mfa_info_table_put_rwlocked(m, f, arity);
+ DBG_TRACE_MFA(m,f,arity,"set native address in hipe_mfa_info at %p", p);
+ p->new_address = address;
+
+ hipe_mfa_info_table_rwunlock();
}
-#endif
BIF_RETTYPE hipe_bifs_set_funinfo_native_address_3(BIF_ALIST_3)
{
- struct mfa mfa;
+ struct hipe_mfa mfa;
void *address;
- int is_exported;
- if (!term_to_mfa(BIF_ARG_1, &mfa))
- BIF_ERROR(BIF_P, BADARG);
- address = term_to_address(BIF_ARG_2);
- if (!address)
- BIF_ERROR(BIF_P, BADARG);
- if (BIF_ARG_3 == am_true)
- is_exported = 1;
- else if (BIF_ARG_3 == am_false)
- is_exported = 0;
- else
+ switch (BIF_ARG_3) {
+ case am_true: /* is_exported */
+ if (!term_to_mfa(BIF_ARG_1, &mfa))
+ BIF_ERROR(BIF_P, BADARG);
+ address = term_to_address(BIF_ARG_2);
+ if (!address)
+ BIF_ERROR(BIF_P, BADARG);
+ hipe_mfa_set_na(mfa.mod, mfa.fun, mfa.ari, address);
+ break;
+ case am_false:
+ break; /* ignore local functions */
+ default:
BIF_ERROR(BIF_P, BADARG);
- hipe_mfa_set_na(mfa.mod, mfa.fun, mfa.ari, address, is_exported);
+ }
BIF_RET(NIL);
}
-BIF_RETTYPE hipe_bifs_invalidate_funinfo_native_addresses_1(BIF_ALIST_1)
+
+/* Ask if we need to block all threads
+ * while loading/deleting code for this module?
+ */
+int hipe_need_blocking(Module* modp)
{
- Eterm lst;
- struct mfa mfa;
struct hipe_mfa_info *p;
- hipe_mfa_info_table_lock();
- lst = BIF_ARG_1;
- while (is_list(lst)) {
- if (!term_to_mfa(CAR(list_val(lst)), &mfa))
- break;
- lst = CDR(list_val(lst));
- p = hipe_mfa_info_table_get_locked(mfa.mod, mfa.fun, mfa.ari);
- if (p) {
- p->remote_address = NULL;
- p->local_address = NULL;
- if (p->beam_code) {
-#ifdef DEBUG_LINKER
- printf("%s: ", __FUNCTION__);
- print_mfa(mfa.mod, mfa.fun, mfa.ari);
- printf(": removing call trap from BEAM pc %p (new op %#lx)\r\n",
- p->beam_code, p->orig_beam_op);
-#endif
- p->beam_code[0] = p->orig_beam_op;
- p->beam_code = NULL;
- p->orig_beam_op = 0;
- } else {
-#ifdef DEBUG_LINKER
- printf("%s: ", __FUNCTION__);
- print_mfa(mfa.mod, mfa.fun, mfa.ari);
- printf(": no call trap to remove\r\n");
-#endif
- }
+ /* Need to block if we have at least one native caller to this module
+ * or native code to make unaccessible.
+ */
+ hipe_mfa_info_table_rlock();
+ for (p = mod2mfa_get(modp); p; p = p->next_in_mod) {
+ ASSERT(!p->new_address);
+ if (p->callers.next != &p->callers || !p->is_stub) {
+ break;
}
}
- hipe_mfa_info_table_unlock();
- if (is_not_nil(lst))
- BIF_ERROR(BIF_P, BADARG);
- BIF_RET(NIL);
+ hipe_mfa_info_table_runlock();
+ return (p != NULL);
}
-void hipe_mfa_save_orig_beam_op(Eterm mod, Eterm fun, unsigned int ari, Eterm *pc)
+static void *hipe_get_na_try_locked(Eterm m, Eterm f, unsigned int a)
{
- Uint orig_beam_op;
struct hipe_mfa_info *p;
- orig_beam_op = pc[0];
- if (orig_beam_op != BeamOpCode(op_hipe_trap_call_closure) &&
- orig_beam_op != BeamOpCode(op_hipe_trap_call)) {
- hipe_mfa_info_table_lock();
- p = hipe_mfa_info_table_put_locked(mod, fun, ari);
-#ifdef DEBUG_LINKER
- printf("%s: ", __FUNCTION__);
- print_mfa(mod, fun, ari);
- printf(": saving orig op %#lx from BEAM pc %p\r\n", orig_beam_op, pc);
-#endif
- p->beam_code = pc;
- p->orig_beam_op = orig_beam_op;
- hipe_mfa_info_table_unlock();
- } else {
-#ifdef DEBUG_LINKER
- printf("%s: ", __FUNCTION__);
- print_mfa(mod, fun, ari);
- printf(": orig op %#lx already saved\r\n", orig_beam_op);
-#endif
- }
+ p = hipe_mfa_info_table_get_locked(m, f, a);
+ return p ? p->remote_address : NULL;
}
-static void *hipe_make_stub(Eterm m, Eterm f, unsigned int arity, int is_remote)
+static void *hipe_get_na_slow_rwlocked(Eterm m, Eterm f, unsigned int a)
{
- void *BEAMAddress;
- void *StubAddress;
+ struct hipe_mfa_info *p = hipe_mfa_info_table_put_rwlocked(m, f, a);
-#if 0
- if (is_not_atom(m) || is_not_atom(f) || arity > 255)
- return NULL;
-#endif
- BEAMAddress = hipe_get_emu_address(m, f, arity, is_remote);
- StubAddress = hipe_make_native_stub(BEAMAddress, arity);
-#if 0
- hipe_mfa_set_na(m, f, arity, StubAddress);
+ if (!p->remote_address) {
+ Export* export_entry = erts_export_get_or_make_stub(m, f, a);
+ void* stubAddress = hipe_make_native_stub(export_entry, a);
+ if (!stubAddress)
+ erts_exit(ERTS_ERROR_EXIT, "hipe_make_stub: code allocation failed\r\n");
+
+ p->remote_address = stubAddress;
+ p->is_stub = 1;
+#ifdef DEBUG
+ p->dbg_export = export_entry;
#endif
- return StubAddress;
+ }
+ return p->remote_address;
}
-static void *hipe_get_na_nofail_locked(Eterm m, Eterm f, unsigned int a, int is_remote)
+static void *hipe_get_na_nofail(Eterm m, Eterm f, unsigned int a)
{
- struct hipe_mfa_info *p;
void *address;
- p = hipe_mfa_info_table_get_locked(m, f, a);
- if (p) {
- /* find address, predicting for a runtime apply call */
- address = p->remote_address;
- if (!is_remote)
- address = p->local_address;
- if (address)
- return address;
-
- /* bummer, install stub, checking if one already existed */
- address = p->remote_address;
- if (address)
- return address;
- } else
- p = hipe_mfa_info_table_put_locked(m, f, a);
- address = hipe_make_stub(m, f, a, is_remote);
- /* XXX: how to tell if a BEAM MFA is exported or not? */
- p->remote_address = address;
- return address;
-}
-
-static void *hipe_get_na_nofail(Eterm m, Eterm f, unsigned int a, int is_remote)
-{
- void *p;
+ hipe_mfa_info_table_rlock();
+ address = hipe_get_na_try_locked(m, f, a);
+ hipe_mfa_info_table_runlock();
+ if (address)
+ return address;
- hipe_mfa_info_table_lock();
- p = hipe_get_na_nofail_locked(m, f, a, is_remote);
- hipe_mfa_info_table_unlock();
- return p;
+ hipe_mfa_info_table_rwlock();
+ address = hipe_get_na_slow_rwlocked(m, f, a);
+ hipe_mfa_info_table_rwunlock();
+ return address;
}
/* used for apply/3 in hipe_mode_switch */
@@ -1546,11 +1422,12 @@ void *hipe_get_remote_na(Eterm m, Eterm f, unsigned int a)
{
if (is_not_atom(m) || is_not_atom(f) || a > 255)
return NULL;
- return hipe_get_na_nofail(m, f, a, 1);
+ return hipe_get_na_nofail(m, f, a);
}
/* primop, but called like a BIF for error handling purposes */
-BIF_RETTYPE hipe_find_na_or_make_stub(BIF_ALIST_3)
+/* Called via standard_bif_interface_3 */
+BIF_RETTYPE nbif_impl_hipe_find_na_or_make_stub(NBIF_ALIST_3)
{
Uint arity;
void *address;
@@ -1558,30 +1435,25 @@ BIF_RETTYPE hipe_find_na_or_make_stub(BIF_ALIST_3)
if (is_not_atom(BIF_ARG_1) || is_not_atom(BIF_ARG_2))
BIF_ERROR(BIF_P, BADARG);
arity = unsigned_val(BIF_ARG_3); /* no error check */
- address = hipe_get_na_nofail(BIF_ARG_1, BIF_ARG_2, arity, 1);
+ address = hipe_get_na_nofail(BIF_ARG_1, BIF_ARG_2, arity);
BIF_RET((Eterm)address); /* semi-Ok */
}
-BIF_RETTYPE hipe_bifs_find_na_or_make_stub_2(BIF_ALIST_2)
+BIF_RETTYPE hipe_bifs_find_na_or_make_stub_1(BIF_ALIST_1)
{
- struct mfa mfa;
+ struct hipe_mfa mfa;
void *address;
- int is_remote;
if (!term_to_mfa(BIF_ARG_1, &mfa))
BIF_ERROR(BIF_P, BADARG);
- if (BIF_ARG_2 == am_true)
- is_remote = 1;
- else if (BIF_ARG_2 == am_false)
- is_remote = 0;
- else
- BIF_ERROR(BIF_P, BADARG);
- address = hipe_get_na_nofail(mfa.mod, mfa.fun, mfa.ari, is_remote);
+
+ address = hipe_get_na_nofail(mfa.mod, mfa.fun, mfa.ari);
BIF_RET(address_to_term(address, BIF_P));
}
/* primop, but called like a BIF for error handling purposes */
-BIF_RETTYPE hipe_nonclosure_address(BIF_ALIST_2)
+/* Called via standard_bif_interface_2 */
+BIF_RETTYPE nbif_impl_hipe_nonclosure_address(NBIF_ALIST_2)
{
Eterm hdr, m, f;
void *address;
@@ -1591,14 +1463,14 @@ BIF_RETTYPE hipe_nonclosure_address(BIF_ALIST_2)
hdr = *boxed_val(BIF_ARG_1);
if (is_export_header(hdr)) {
Export *ep = (Export*)(export_val(BIF_ARG_1)[1]);
- unsigned int actual_arity = ep->code[2];
+ unsigned int actual_arity = ep->info.mfa.arity;
if (actual_arity != BIF_ARG_2)
goto badfun;
- m = ep->code[0];
- f = ep->code[1];
+ m = ep->info.mfa.module;
+ f = ep->info.mfa.function;
} else
goto badfun;
- address = hipe_get_na_nofail(m, f, BIF_ARG_2, 1);
+ address = hipe_get_na_nofail(m, f, BIF_ARG_2);
BIF_RET((Eterm)address);
badfun:
@@ -1609,73 +1481,31 @@ BIF_RETTYPE hipe_nonclosure_address(BIF_ALIST_2)
int hipe_find_mfa_from_ra(const void *ra, Eterm *m, Eterm *f, unsigned int *a)
{
- struct hipe_mfa_info *mfa;
- long mfa_offset, ra_offset;
- struct hipe_mfa_info **bucket;
- unsigned int i, nrbuckets;
-
- /* Note about locking: the table is only updated from the
- loader, which runs with the rest of the system suspended. */
- /* XXX: alas not true; see comment at hipe_mfa_info_table.lock */
- hipe_mfa_info_table_lock();
- bucket = hipe_mfa_info_table.bucket;
- nrbuckets = 1 << hipe_mfa_info_table.log2size;
- mfa = NULL;
- mfa_offset = LONG_MAX;
- for (i = 0; i < nrbuckets; ++i) {
- struct hipe_mfa_info *b = bucket[i];
- while (b != NULL) {
- ra_offset = (char*)ra - (char*)b->local_address;
- if (ra_offset > 0 && ra_offset < mfa_offset) {
- mfa_offset = ra_offset;
- mfa = b;
- }
- b = b->bucket.next;
- }
- }
- if (mfa) {
- *m = mfa->m;
- *f = mfa->f;
- *a = mfa->a;
- }
- hipe_mfa_info_table_unlock();
- return mfa ? 1 : 0;
-}
+ const struct hipe_sdesc* sdesc = hipe_find_sdesc((unsigned long)ra);
-/*
- * Patch Reference Handling.
- */
-struct hipe_mfa_info_list {
- struct hipe_mfa_info *mfa;
- struct hipe_mfa_info_list *next;
-};
+ if (!sdesc || sdesc->m_aix == atom_val(am_Empty))
+ return 0;
-struct ref {
- struct hipe_mfa_info *caller_mfa;
- void *address;
- void *trampoline;
- unsigned int flags;
- struct ref *next;
-};
-#define REF_FLAG_IS_LOAD_MFA 1 /* bit 0: 0 == call, 1 == load_mfa */
-#define REF_FLAG_IS_REMOTE 2 /* bit 1: 0 == local, 1 == remote */
-#define REF_FLAG_PENDING_REDIRECT 4 /* bit 2: 1 == pending redirect */
-#define REF_FLAG_PENDING_REMOVE 8 /* bit 3: 1 == pending remove */
+ *m = make_atom(sdesc->m_aix);
+ *f = make_atom(sdesc->f_aix);
+ *a = sdesc->a;
+ return 1;
+}
-/* add_ref(CalleeMFA, {CallerMFA,Address,'call'|'load_mfa',Trampoline,'remote'|'local'})
+
+/* add_ref(CalleeMFA, {CallerMFA,Address,'call'|'load_mfa',Trampoline,LoaderState})
*/
BIF_RETTYPE hipe_bifs_add_ref_2(BIF_ALIST_2)
{
- struct mfa callee;
+ struct hipe_mfa callee;
Eterm *tuple;
- struct mfa caller;
+ struct hipe_mfa caller;
void *address;
void *trampoline;
unsigned int flags;
struct hipe_mfa_info *callee_mfa;
- struct hipe_mfa_info *caller_mfa;
- struct hipe_mfa_info_list *refers_to;
- struct ref *ref;
+ struct hipe_ref *ref;
+ HipeLoaderState* stp;
if (!term_to_mfa(BIF_ARG_1, &callee))
goto badarg;
@@ -1706,192 +1536,302 @@ BIF_RETTYPE hipe_bifs_add_ref_2(BIF_ALIST_2)
if (!trampoline)
goto badarg;
}
- switch (tuple[5]) {
- case am_local:
- break;
- case am_remote:
- flags |= REF_FLAG_IS_REMOTE;
- break;
- default:
- goto badarg;
- }
- hipe_mfa_info_table_lock();
- callee_mfa = hipe_mfa_info_table_put_locked(callee.mod, callee.fun, callee.ari);
- caller_mfa = hipe_mfa_info_table_put_locked(caller.mod, caller.fun, caller.ari);
+ stp = get_loader_state(tuple[5]);
+ if (!stp)
+ goto badarg;
- refers_to = erts_alloc(ERTS_ALC_T_HIPE, sizeof(*refers_to));
- refers_to->mfa = callee_mfa;
- refers_to->next = caller_mfa->refers_to;
- caller_mfa->refers_to = refers_to;
+ hipe_mfa_info_table_rwlock();
+ callee_mfa = hipe_mfa_info_table_put_rwlocked(callee.mod, callee.fun, callee.ari);
- ref = erts_alloc(ERTS_ALC_T_HIPE, sizeof(*ref));
- ref->caller_mfa = caller_mfa;
+ ref = erts_alloc(ERTS_ALC_T_HIPE_LL, sizeof(struct hipe_ref));
ref->address = address;
+#if defined(__arm__) || defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__)
ref->trampoline = trampoline;
+#endif
ref->flags = flags;
- ref->next = callee_mfa->referred_from;
- callee_mfa->referred_from = ref;
- hipe_mfa_info_table_unlock();
- BIF_RET(NIL);
+ /*
+ * Link into list of refs to same callee
+ */
+ ASSERT(callee_mfa->callers.next->prev == &callee_mfa->callers);
+ ASSERT(callee_mfa->callers.prev->next == &callee_mfa->callers);
+ ref->head.next = callee_mfa->callers.next;
+ ref->head.prev = &callee_mfa->callers;
+ ref->head.next->prev = &ref->head;
+ ref->head.prev->next = &ref->head;
+
+ /*
+ * Link into list of refs from same module instance
+ */
+ ref->next_from_modi = stp->new_hipe_refs;
+ stp->new_hipe_refs = ref;
+
+#if defined(DEBUG)
+ ref->callee = callee_mfa;
+ ref->caller_m = caller.mod;
+ ref->caller_f = caller.fun;
+ ref->caller_a = caller.ari;
+#endif
+ hipe_mfa_info_table_rwunlock();
+
+ DBG_TRACE_MFA(caller.mod, caller.fun, caller.ari, "add_ref at %p TO %T:%T/%u (from %p)",
+ ref, callee.mod, callee.fun, callee.ari, ref->address);
+ DBG_TRACE_MFA(callee.mod, callee.fun, callee.ari, "add_ref at %p FROM %T:%T/%u (from %p)",
+ ref, caller.mod, caller.fun, caller.ari, ref->address);
+ BIF_RET(am_ok);
badarg:
BIF_ERROR(BIF_P, BADARG);
}
-/* Given a CalleeMFA, mark each ref to it as pending-redirect.
- * This ensures that remove_refs_from() won't remove them: any
- * removal is instead done at the end of redirect_referred_from().
- */
-BIF_RETTYPE hipe_bifs_mark_referred_from_1(BIF_ALIST_1) /* get_refs_from */
+
+static void unlink_mfa_from_mod(struct hipe_mfa_info* unlink_me)
{
- struct mfa mfa;
- const struct hipe_mfa_info *p;
- struct ref *ref;
+ struct hipe_mfa_info* p;
- if (!term_to_mfa(BIF_ARG_1, &mfa))
- BIF_ERROR(BIF_P, BADARG);
- hipe_mfa_info_table_lock();
- p = hipe_mfa_info_table_get_locked(mfa.mod, mfa.fun, mfa.ari);
- if (p)
- for (ref = p->referred_from; ref != NULL; ref = ref->next)
- ref->flags |= REF_FLAG_PENDING_REDIRECT;
- hipe_mfa_info_table_unlock();
- BIF_RET(NIL);
+ p = hash_get(&mod2mfa_tab, unlink_me);
+ ASSERT(p);
+ if (p == unlink_me) {
+ hash_erase(&mod2mfa_tab, p);
+ if (p->next_in_mod)
+ mod2mfa_put(p->next_in_mod);
+ }
+ else {
+ struct hipe_mfa_info** prevp;
+
+ do {
+ prevp = &p->next_in_mod;
+ p = *prevp;
+ ASSERT(p && p->m == unlink_me->m);
+ } while (p != unlink_me);
+
+ *prevp = p->next_in_mod;
+ }
}
-/* Called by init:restart after unloading all hipe compiled modules
- * to work around bug causing execution of deallocated beam code.
- * Can be removed when delete/purge of native modules works better.
- * Test: Do init:restart in debug compiled vm with hipe compiled kernel.
- */
-static void hipe_purge_all_refs(void)
+static void purge_mfa(struct hipe_mfa_info* p)
{
- struct hipe_mfa_info **bucket;
- unsigned int i, nrbuckets;
-
- hipe_mfa_info_table_lock();
-
- bucket = hipe_mfa_info_table.bucket;
- nrbuckets = 1 << hipe_mfa_info_table.log2size;
- for (i = 0; i < nrbuckets; ++i) {
- while (bucket[i] != NULL) {
- struct hipe_mfa_info* mfa = bucket[i];
- bucket[i] = mfa->bucket.next;
-
- while (mfa->refers_to) {
- struct hipe_mfa_info_list *to = mfa->refers_to;
- mfa->refers_to = to->next;
- erts_free(ERTS_ALC_T_HIPE, to);
- }
- while (mfa->referred_from) {
- struct ref* from = mfa->referred_from;
- mfa->referred_from = from->next;
- erts_free(ERTS_ALC_T_HIPE, from);
- }
- erts_free(ERTS_ALC_T_HIPE, mfa);
- }
+ ASSERT(p->is_stub);
+ remove_mfa_info(p);
+ hipe_free_native_stub(p->remote_address);
+ erts_free(ERTS_ALC_T_HIPE_LL, p);
+}
+
+int hipe_purge_need_blocking(Module* modp)
+{
+ /* SVERK: Verify if this is really necessary */
+ if (modp->old.hipe_code) {
+ if (modp->old.hipe_code->first_hipe_ref ||
+ modp->old.hipe_code->first_hipe_sdesc)
+ return 1;
}
- hipe_mfa_info_table_unlock();
+ if (!modp->curr.code_hdr) {
+ return mod2mfa_get_safe(modp) != NULL;
+ }
+ return 0;
}
-BIF_RETTYPE hipe_bifs_remove_refs_from_1(BIF_ALIST_1)
+void hipe_purge_refs(struct hipe_ref* first_ref, Eterm caller_module,
+ int is_blocking)
+{
+ struct hipe_ref* ref = first_ref;
+
+ ERTS_SMP_LC_ASSERT(is_blocking == erts_smp_thr_progress_is_blocking());
+
+ while (ref) {
+ struct hipe_ref* free_ref = ref;
+
+ DBG_TRACE_MFA(ref->caller_m, ref->caller_f, ref->caller_a, "PURGE ref at %p to %T:%T/%u", ref,
+ ref->callee->m, ref->callee->f, ref->callee->a);
+ DBG_TRACE_MFA(ref->callee->m, ref->callee->f, ref->callee->a, "PURGE ref at %p from %T:%T/%u", ref,
+ ref->caller_m, ref->caller_f, ref->caller_a);
+ ASSERT(ref->caller_m == caller_module);
+
+ /*
+ * Unlink from other refs to same callee
+ */
+ ASSERT(ref->head.next->prev == &ref->head);
+ ASSERT(ref->head.prev->next == &ref->head);
+ ASSERT(ref->head.next != &ref->head);
+ ASSERT(ref->head.prev != &ref->head);
+ ref->head.next->prev = ref->head.prev;
+ ref->head.prev->next = ref->head.next;
+
+ /*
+ * Was this the last ref to that callee?
+ */
+ if (ref->head.next == ref->head.prev) {
+ struct hipe_mfa_info* p = ErtsContainerStruct(ref->head.next, struct hipe_mfa_info, callers);
+ if (p->is_stub) {
+ if (!is_blocking)
+ hipe_mfa_info_table_rwlock();
+ unlink_mfa_from_mod(p);
+ purge_mfa(p);
+ if (!is_blocking)
+ hipe_mfa_info_table_rwunlock();
+ }
+ }
+
+ ref = ref->next_from_modi;
+ erts_free(ERTS_ALC_T_HIPE_LL, free_ref);
+ }
+}
+
+void hipe_purge_sdescs(struct hipe_sdesc* first_sdesc, Eterm module,
+ int is_blocking)
{
- struct mfa mfa;
- struct hipe_mfa_info *caller_mfa, *callee_mfa;
- struct hipe_mfa_info_list *refers_to, *tmp_refers_to;
- struct ref **prev, *ref;
+ struct hipe_sdesc* sdesc = first_sdesc;
+
+ ERTS_SMP_LC_ASSERT(is_blocking == erts_smp_thr_progress_is_blocking());
+
+ ERTS_SMP_LC_ASSERT(is_blocking); /*XXX Fix safe sdesc destruction */
+
+ while (sdesc) {
+ struct hipe_sdesc* free_sdesc = sdesc;
+
+ DBG_TRACE_MFA(make_atom(sdesc->m_aix), make_atom(sdesc->f_aix), sdesc->a, "PURGE sdesc at %p", (void*)sdesc->bucket.hvalue);
+ ASSERT(make_atom(sdesc->m_aix) == module);
- if (BIF_ARG_1 == am_all) {
- hipe_purge_all_refs();
- BIF_RET(am_ok);
+ sdesc = sdesc->next_in_modi;
+ hipe_destruct_sdesc(free_sdesc);
}
+}
- if (!term_to_mfa(BIF_ARG_1, &mfa))
- BIF_ERROR(BIF_P, BADARG);
- hipe_mfa_info_table_lock();
- caller_mfa = hipe_mfa_info_table_get_locked(mfa.mod, mfa.fun, mfa.ari);
- if (caller_mfa) {
- refers_to = caller_mfa->refers_to;
- while (refers_to) {
- callee_mfa = refers_to->mfa;
- prev = &callee_mfa->referred_from;
- ref = *prev;
- while (ref) {
- if (ref->caller_mfa == caller_mfa) {
- if (ref->flags & REF_FLAG_PENDING_REDIRECT) {
- ref->flags |= REF_FLAG_PENDING_REMOVE;
- prev = &ref->next;
- ref = ref->next;
- } else {
- struct ref *tmp = ref;
- ref = ref->next;
- *prev = ref;
- erts_free(ERTS_ALC_T_HIPE, tmp);
- }
- } else {
- prev = &ref->next;
- ref = ref->next;
- }
- }
- tmp_refers_to = refers_to;
- refers_to = refers_to->next;
- erts_free(ERTS_ALC_T_HIPE, tmp_refers_to);
- }
- caller_mfa->refers_to = NULL;
+
+void hipe_purge_module(Module* modp, int is_blocking)
+{
+ ASSERT(modp);
+
+ ERTS_SMP_LC_ASSERT(is_blocking == erts_smp_thr_progress_is_blocking());
+
+ DBG_TRACE_MFA(make_atom(modp->module), 0, 0, "hipe_purge_module");
+
+ if (modp->old.hipe_code) {
+ /*
+ * Remove all hipe_ref's (external calls) from the old module instance
+ */
+ if (modp->old.hipe_code->first_hipe_ref) {
+ ERTS_SMP_LC_ASSERT(is_blocking);
+
+ hipe_purge_refs(modp->old.hipe_code->first_hipe_ref,
+ make_atom(modp->module), is_blocking);
+ modp->old.hipe_code->first_hipe_ref = NULL;
+ }
+
+ /*
+ * Remove all hipe_sdesc's for the old module instance
+ */
+ if (modp->old.hipe_code->first_hipe_sdesc) {
+ ERTS_SMP_LC_ASSERT(is_blocking);
+
+ hipe_purge_sdescs(modp->old.hipe_code->first_hipe_sdesc,
+ make_atom(modp->module), is_blocking);
+ modp->old.hipe_code->first_hipe_sdesc = NULL;
+ }
+
+ hipe_free_module(modp->old.hipe_code);
+ modp->old.hipe_code = NULL;
+ }
+
+
+ /*
+ * Remove unreferred hipe_mfa_info's
+ * when all module instances are removed (like in init:restart)
+ */
+ if (is_blocking && modp->curr.code_hdr == NULL) {
+ struct hipe_mfa_info* was_first = mod2mfa_get(modp);
+ struct hipe_mfa_info* is_first = was_first;
+ struct hipe_mfa_info** prevp = &is_first;
+ struct hipe_mfa_info *p;
+
+ if (was_first) {
+ for (p = was_first ; p; p = *prevp) {
+ if (p->callers.next == &p->callers) {
+ *prevp = p->next_in_mod;
+ if (p != was_first)
+ purge_mfa(p);
+ }
+ else
+ prevp = &p->next_in_mod;
+ }
+ if (was_first != is_first) {
+ hash_erase(&mod2mfa_tab, was_first);
+ purge_mfa(was_first);
+ if (is_first)
+ mod2mfa_put(is_first);
+ }
+ }
}
- hipe_mfa_info_table_unlock();
- BIF_RET(am_ok);
}
-/* redirect_referred_from(CalleeMFA)
- * Redirect all pending-redirect refs in CalleeMFA's referred_from.
- * Then remove any pending-redirect && pending-remove refs from CalleeMFA's referred_from.
+/*
+ * Redirect all existing native calls to this module
*/
-BIF_RETTYPE hipe_bifs_redirect_referred_from_1(BIF_ALIST_1)
+void hipe_redirect_to_module(Module* modp)
{
- struct mfa mfa;
struct hipe_mfa_info *p;
- struct ref **prev, *ref;
- int is_remote, res;
- void *new_address;
-
- if (!term_to_mfa(BIF_ARG_1, &mfa))
- BIF_ERROR(BIF_P, BADARG);
- hipe_mfa_info_table_lock();
- p = hipe_mfa_info_table_get_locked(mfa.mod, mfa.fun, mfa.ari);
- if (p) {
- prev = &p->referred_from;
- ref = *prev;
- while (ref) {
- if (ref->flags & REF_FLAG_PENDING_REDIRECT) {
- is_remote = ref->flags & REF_FLAG_IS_REMOTE;
- new_address = hipe_get_na_nofail_locked(p->m, p->f, p->a, is_remote);
- if (ref->flags & REF_FLAG_IS_LOAD_MFA)
- res = hipe_patch_insn(ref->address, (Uint)new_address, am_load_mfa);
- else
- res = hipe_patch_call(ref->address, new_address, ref->trampoline);
- if (res)
- fprintf(stderr, "%s: patch failed\r\n", __FUNCTION__);
- ref->flags &= ~REF_FLAG_PENDING_REDIRECT;
- if (ref->flags & REF_FLAG_PENDING_REMOVE) {
- struct ref *tmp = ref;
- ref = ref->next;
- *prev = ref;
- erts_free(ERTS_ALC_T_HIPE, tmp);
- } else {
- prev = &ref->next;
- ref = ref->next;
- }
- } else {
- prev = &ref->next;
- ref = ref->next;
- }
+ struct hipe_ref_head* refh;
+
+ ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
+
+ for (p = mod2mfa_get(modp); p; p = p->next_in_mod) {
+ if (p->new_address) {
+ if (p->is_stub) {
+ hipe_free_native_stub(p->remote_address);
+ p->is_stub = 0;
+ }
+ DBG_TRACE_MFA(p->m, p->f, p->a, "Commit new_address %p", p->new_address);
+ p->remote_address = p->new_address;
+ p->new_address = NULL;
+#ifdef DEBUG
+ p->dbg_export = NULL;
+#endif
+ }
+ else if (!p->is_stub) {
+ Export* exp = erts_export_get_or_make_stub(p->m, p->f, p->a);
+ p->remote_address = hipe_make_native_stub(exp, p->a);
+ DBG_TRACE_MFA(p->m, p->f, p->a, "Commit stub %p", p->remote_address);
+ if (!p->remote_address)
+ erts_exit(ERTS_ERROR_EXIT, "hipe_make_stub: code allocation failed\r\n");
+ p->is_stub = 1;
+#ifdef DEBUG
+ p->dbg_export = exp;
+#endif
+ }
+ else {
+ DBG_TRACE_MFA(p->m, p->f, p->a, "Commit no-op, already stub");
+ ASSERT(p->remote_address && p->dbg_export);
+ }
+
+ DBG_TRACE_MFA(p->m,p->f,p->a,"START REDIRECT towards hipe_mfa_info at %p", p);
+ for (refh = p->callers.next; refh != &p->callers; refh = refh->next) {
+ struct hipe_ref* ref = (struct hipe_ref*) refh;
+ int res;
+
+ DBG_TRACE_MFA(p->m,p->f,p->a, " REDIRECT ref at %p FROM %T:%T/%u (%p -> %p)",
+ ref, ref->caller_m, ref->caller_f, ref->caller_a,
+ ref->address, p->remote_address);
+
+ DBG_TRACE_MFA(ref->caller_m, ref->caller_f, ref->caller_a,
+ " REDIRECT ref at %p TO %T:%T/%u (%p -> %p)",
+ ref, p->m,p->f,p->a, ref->address, p->remote_address);
+
+ if (ref->flags & REF_FLAG_IS_LOAD_MFA)
+ res = hipe_patch_insn(ref->address, (Uint)p->remote_address, am_load_mfa);
+ else {
+#if defined(__arm__) || defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__)
+ void* trampoline = ref->trampoline;
+#else
+ void* trampoline = NULL;
+#endif
+ res = hipe_patch_call(ref->address, p->remote_address, trampoline);
+ }
+ if (res)
+ fprintf(stderr, "%s: patch failed", __FUNCTION__);
}
+ DBG_TRACE_MFA(p->m,p->f,p->a,"DONE REDIRECT towards hipe_mfa_info at %p", p);
}
- hipe_mfa_info_table_unlock();
- BIF_RET(NIL);
}
BIF_RETTYPE hipe_bifs_check_crc_1(BIF_ALIST_1)
@@ -1900,18 +1840,16 @@ BIF_RETTYPE hipe_bifs_check_crc_1(BIF_ALIST_1)
if (!term_to_Uint(BIF_ARG_1, &crc))
BIF_ERROR(BIF_P, BADARG);
- if (crc == HIPE_SYSTEM_CRC)
+ if (crc == HIPE_ERTS_CHECKSUM)
BIF_RET(am_true);
BIF_RET(am_false);
}
-BIF_RETTYPE hipe_bifs_system_crc_1(BIF_ALIST_1)
+BIF_RETTYPE hipe_bifs_system_crc_0(BIF_ALIST_0)
{
Uint crc;
- if (!term_to_Uint(BIF_ARG_1, &crc))
- BIF_ERROR(BIF_P, BADARG);
- crc ^= (HIPE_SYSTEM_CRC ^ HIPE_LITERALS_CRC);
+ crc = HIPE_SYSTEM_CRC;
BIF_RET(Uint_to_term(crc, BIF_P));
}
@@ -1947,86 +1885,6 @@ void hipe_patch_address(Uint *address, Eterm patchtype, Uint value)
}
}
-struct modinfo {
- HashBucket bucket; /* bucket.hvalue == atom_val(the module name) */
- unsigned int code_size;
-};
-
-static Hash modinfo_table;
-
-static HashValue modinfo_hash(void *tmpl)
-{
- Eterm mod = (Eterm)tmpl;
- return atom_val(mod);
-}
-
-static int modinfo_cmp(void *tmpl, void *bucket)
-{
- /* bucket->hvalue == modinfo_hash(tmpl), so just return 0 (match) */
- return 0;
-}
-
-static void *modinfo_alloc(void *tmpl)
-{
- struct modinfo *p;
-
- p = (struct modinfo*)erts_alloc(ERTS_ALC_T_HIPE, sizeof(*p));
- p->code_size = 0;
- return &p->bucket;
-}
-
-static void init_modinfo_table(void)
-{
- HashFunctions f;
- static int init_done = 0;
-
- if (init_done)
- return;
- init_done = 1;
- f.hash = (H_FUN) modinfo_hash;
- f.cmp = (HCMP_FUN) modinfo_cmp;
- f.alloc = (HALLOC_FUN) modinfo_alloc;
- f.free = (HFREE_FUN) NULL;
- hash_init(ERTS_ALC_T_HIPE, &modinfo_table, "modinfo_table", 11, f);
-}
-
-BIF_RETTYPE hipe_bifs_update_code_size_3(BIF_ALIST_3)
-{
- struct modinfo *p;
- Sint code_size;
-
- init_modinfo_table();
-
- if (is_not_atom(BIF_ARG_1) ||
- is_not_small(BIF_ARG_3) ||
- (code_size = signed_val(BIF_ARG_3)) < 0)
- BIF_ERROR(BIF_P, BADARG);
-
- p = (struct modinfo*)hash_put(&modinfo_table, (void*)BIF_ARG_1);
-
- if (is_nil(BIF_ARG_2)) /* some MFAs, not whole module */
- p->code_size += code_size;
- else /* whole module */
- p->code_size = code_size;
- BIF_RET(NIL);
-}
-
-BIF_RETTYPE hipe_bifs_code_size_1(BIF_ALIST_1)
-{
- struct modinfo *p;
- unsigned int code_size;
-
- init_modinfo_table();
-
- if (is_not_atom(BIF_ARG_1))
- BIF_ERROR(BIF_P, BADARG);
-
- p = (struct modinfo*)hash_get(&modinfo_table, (void*)BIF_ARG_1);
-
- code_size = p ? p->code_size : 0;
- BIF_RET(make_small(code_size));
-}
-
BIF_RETTYPE hipe_bifs_patch_insn_3(BIF_ALIST_3)
{
Uint *address, value;
@@ -2062,3 +1920,23 @@ BIF_RETTYPE hipe_bifs_patch_call_3(BIF_ALIST_3)
BIF_ERROR(BIF_P, BADARG);
BIF_RET(NIL);
}
+
+BIF_RETTYPE hipe_bifs_alloc_loader_state_1(BIF_ALIST_1)
+{
+ Binary *magic;
+ Eterm *hp;
+ Eterm res;
+
+ if (is_not_atom(BIF_ARG_1))
+ BIF_ERROR(BIF_P, BADARG);
+
+ magic = hipe_alloc_loader_state(BIF_ARG_1);
+
+ if (!magic)
+ BIF_ERROR(BIF_P, BADARG);
+
+ hp = HAlloc(BIF_P, ERTS_MAGIC_REF_THING_SIZE);
+ res = erts_mk_magic_ref(&hp, &MSO(BIF_P), magic);
+ erts_refc_dec(&magic->intern.refc, 1);
+ BIF_RET(res);
+}
diff --git a/erts/emulator/hipe/hipe_bif0.h b/erts/emulator/hipe/hipe_bif0.h
index c512d66f9d..ee97e6fc64 100644
--- a/erts/emulator/hipe/hipe_bif0.h
+++ b/erts/emulator/hipe/hipe_bif0.h
@@ -2,18 +2,19 @@
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -25,23 +26,20 @@
#ifndef HIPE_BIF0_H
#define HIPE_BIF0_H
-extern Uint *hipe_bifs_find_pc_from_mfa(Eterm mfa);
+extern ErtsCodeInfo *hipe_bifs_find_pc_from_mfa(Eterm mfa);
extern void hipe_mfa_info_table_init(void);
extern void *hipe_get_remote_na(Eterm m, Eterm f, unsigned int a);
-extern BIF_RETTYPE hipe_find_na_or_make_stub(BIF_ALIST_3);
+extern BIF_RETTYPE nbif_impl_hipe_find_na_or_make_stub(NBIF_ALIST_3);
extern int hipe_find_mfa_from_ra(const void *ra, Eterm *m, Eterm *f, unsigned int *a);
-#if defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) || defined(__arm__)
-extern void *hipe_mfa_get_trampoline(Eterm m, Eterm f, unsigned int a);
-extern void hipe_mfa_set_trampoline(Eterm m, Eterm f, unsigned int a, void *trampoline);
-#endif
-#if defined(__arm__)
-extern void *hipe_primop_get_trampoline(Eterm name);
-extern void hipe_primop_set_trampoline(Eterm name, void *trampoline);
-#endif
/* needed in beam_load.c */
-void hipe_mfa_save_orig_beam_op(Eterm m, Eterm f, unsigned int a, Eterm *pc);
+int hipe_need_blocking(Module*);
+int hipe_purge_need_blocking(Module*);
+void hipe_purge_refs(struct hipe_ref*, Eterm, int is_blocking);
+void hipe_purge_sdescs(struct hipe_sdesc*, Eterm, int is_blocking);
+void hipe_purge_module(Module*, int is_blocking);
+void hipe_redirect_to_module(Module* modp);
/* these are also needed in hipe_amd64.c */
extern void *term_to_address(Eterm);
diff --git a/erts/emulator/hipe/hipe_bif0.tab b/erts/emulator/hipe/hipe_bif0.tab
index 2514b1c3a5..4f73770d24 100644
--- a/erts/emulator/hipe/hipe_bif0.tab
+++ b/erts/emulator/hipe/hipe_bif0.tab
@@ -1,18 +1,19 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2001-2011. All Rights Reserved.
+# Copyright Ericsson AB 2001-2017. 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/.
+# 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
#
-# 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.
+# 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%
#
@@ -43,23 +44,20 @@ bif hipe_bifs:ref/1
bif hipe_bifs:ref_get/1
bif hipe_bifs:ref_set/2
-bif hipe_bifs:enter_code/2
-bif hipe_bifs:alloc_data/2
+bif hipe_bifs:enter_code/3
+bif hipe_bifs:alloc_data/3
bif hipe_bifs:constants_size/0
bif hipe_bifs:merge_term/1
bif hipe_bifs:fun_to_address/1
-#bif hipe_bifs:get_emu_address/1
+bif hipe_bifs:commit_patch_load/1
bif hipe_bifs:set_native_address/3
#bif hipe_bifs:address_to_fun/1
bif hipe_bifs:set_funinfo_native_address/3
-bif hipe_bifs:invalidate_funinfo_native_addresses/1
-
-bif hipe_bifs:update_code_size/3
-bif hipe_bifs:code_size/1
+#bif hipe_bifs:invalidate_funinfo_native_addresses/1
-bif hipe_bifs:enter_sdesc/1
+bif hipe_bifs:enter_sdesc/2
bif hipe_bifs:bif_address/3
bif hipe_bifs:primop_address/1
@@ -72,11 +70,10 @@ bif hipe_bifs:term_to_word/1
bif hipe_bifs:get_fe/2
bif hipe_bifs:set_native_address_in_fe/2
-#bif hipe_bifs:make_native_stub/2
-bif hipe_bifs:find_na_or_make_stub/2
+bif hipe_bifs:find_na_or_make_stub/1
bif hipe_bifs:check_crc/1
-bif hipe_bifs:system_crc/1
+bif hipe_bifs:system_crc/0
bif hipe_bifs:get_rts_param/1
#bif hipe_bifs:tuple_to_float/1
@@ -85,9 +82,8 @@ bif hipe_bifs:patch_insn/3
bif hipe_bifs:patch_call/3
bif hipe_bifs:add_ref/2
-bif hipe_bifs:mark_referred_from/1
-bif hipe_bifs:remove_refs_from/1
-bif hipe_bifs:redirect_referred_from/1
+
+bif hipe_bifs:alloc_loader_state/1
# atoms used by add_ref/2
atom call
@@ -142,4 +138,6 @@ atom bs_get_utf16
atom bs_validate_unicode
atom bs_validate_unicode_retract
atom emulate_fpe
-
+atom emasculate_binary
+atom is_divisible
+atom is_unicode \ No newline at end of file
diff --git a/erts/emulator/hipe/hipe_bif1.c b/erts/emulator/hipe/hipe_bif1.c
index 56767ef04b..3d3df4fd48 100644
--- a/erts/emulator/hipe/hipe_bif1.c
+++ b/erts/emulator/hipe/hipe_bif1.c
@@ -2,18 +2,19 @@
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2012. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -38,73 +39,81 @@
BIF_RETTYPE hipe_bifs_call_count_on_1(BIF_ALIST_1)
{
+ ErtsCodeInfo *ci;
Eterm *pc;
struct hipe_call_count *hcc;
- pc = hipe_bifs_find_pc_from_mfa(BIF_ARG_1);
- if (!pc)
+ ci = hipe_bifs_find_pc_from_mfa(BIF_ARG_1);
+ if (!ci)
BIF_ERROR(BIF_P, BADARG);
- ASSERT(pc[-5] == BeamOpCode(op_i_func_info_IaaI));
+ ASSERT(ci->op == BeamOpCode(op_i_func_info_IaaI));
+ pc = erts_codeinfo_to_code(ci);
if (pc[0] == BeamOpCode(op_hipe_trap_call))
BIF_ERROR(BIF_P, BADARG);
if (pc[0] == BeamOpCode(op_hipe_call_count))
BIF_RET(NIL);
- hcc = erts_alloc(ERTS_ALC_T_HIPE, sizeof(*hcc));
+ hcc = erts_alloc(ERTS_ALC_T_HIPE_SL, sizeof(*hcc));
hcc->count = 0;
hcc->opcode = pc[0];
- pc[-4] = (Eterm)hcc;
+ ci->u.hcc = hcc;
pc[0] = BeamOpCode(op_hipe_call_count);
BIF_RET(am_true);
}
BIF_RETTYPE hipe_bifs_call_count_off_1(BIF_ALIST_1)
{
+ ErtsCodeInfo* ci;
Eterm *pc;
struct hipe_call_count *hcc;
unsigned count;
- pc = hipe_bifs_find_pc_from_mfa(BIF_ARG_1);
- if (!pc)
+ ci = hipe_bifs_find_pc_from_mfa(BIF_ARG_1);
+ if (!ci)
BIF_ERROR(BIF_P, BADARG);
- ASSERT(pc[-5] == BeamOpCode(op_i_func_info_IaaI));
+ ASSERT(ci->op == BeamOpCode(op_i_func_info_IaaI));
+ pc = erts_codeinfo_to_code(ci);
if (pc[0] != BeamOpCode(op_hipe_call_count))
BIF_RET(am_false);
- hcc = (struct hipe_call_count*)pc[-4];
+ hcc = ci->u.hcc;
count = hcc->count;
pc[0] = hcc->opcode;
- pc[-4] = (Eterm)NULL;
- erts_free(ERTS_ALC_T_HIPE, hcc);
+ ci->u.hcc = NULL;
+ erts_free(ERTS_ALC_T_HIPE_SL, hcc);
BIF_RET(make_small(count));
}
BIF_RETTYPE hipe_bifs_call_count_get_1(BIF_ALIST_1)
{
+ ErtsCodeInfo* ci;
Eterm *pc;
struct hipe_call_count *hcc;
- pc = hipe_bifs_find_pc_from_mfa(BIF_ARG_1);
- if (!pc)
+ ci = hipe_bifs_find_pc_from_mfa(BIF_ARG_1);
+ if (!ci)
BIF_ERROR(BIF_P, BADARG);
- ASSERT(pc[-5] == BeamOpCode(op_i_func_info_IaaI));
+ ASSERT(ci->op == BeamOpCode(op_i_func_info_IaaI));
+ pc = erts_codeinfo_to_code(ci);
if (pc[0] != BeamOpCode(op_hipe_call_count))
BIF_RET(am_false);
- hcc = (struct hipe_call_count*)pc[-4];
+ hcc = ci->u.hcc;
BIF_RET(make_small(hcc->count));
}
BIF_RETTYPE hipe_bifs_call_count_clear_1(BIF_ALIST_1)
{
+ ErtsCodeInfo* ci;
Eterm *pc;
struct hipe_call_count *hcc;
unsigned count;
- pc = hipe_bifs_find_pc_from_mfa(BIF_ARG_1);
- if (!pc)
+ ci = hipe_bifs_find_pc_from_mfa(BIF_ARG_1);
+ if (!ci)
BIF_ERROR(BIF_P, BADARG);
- ASSERT(pc[-5] == BeamOpCode(op_i_func_info_IaaI));
+ ASSERT(ci->op == BeamOpCode(op_i_func_info_IaaI));
+ pc = erts_codeinfo_to_code(ci);
if (pc[0] != BeamOpCode(op_hipe_call_count))
BIF_RET(am_false);
- hcc = (struct hipe_call_count*)pc[-4];
+ hcc = ci->u.hcc;
count = hcc->count;
hcc->count = 0;
BIF_RET(make_small(count));
@@ -123,810 +132,3 @@ BIF_RETTYPE hipe_bifs_trap_count_clear_0(BIF_ALIST_0)
hipe_trap_count = 0;
BIF_RET(make_small(count));
}
-
-/*****************************************************************************
- * BIFs for benchmarking. These only do useful things if
- * __BENCHMARK__ is defined in beam/benchmark.h. For documentation
- * about how to add new counters or maintain the existing counters,
- * see benchmark.h.
- *
- * If benchmarking is not enabled all BIFs will return false. If the
- * required benchmark feature is not enabled, the counter will remain
- * zero.
- *
- * process_info/0 -> { Number of live processes,
- * Processes spawned in total }
- *
- * Live processes are increased when a new process is created, and
- * decreased when a process dies. Processes spawned is increased
- * when a process is created.
- *
- *
- * process_info_clear/0 -> true
- *
- * Will reset the processes spawned-counters to zero. If this is
- * done at some improper time, live processes may become a negative
- * value. This is not a problem in itself, just as long as you know
- * about it.
- *
- *
- * message_info/0 -> { Messages sent,
- * Messages copied,
- * Ego messages (sender = receiver),
- * Words sent,
- * Words copied,
- * Words preallocated }
- *
- * Counting the words sent in a shared heap system will affect
- * runtime performance since it means that we have to calculate the
- * size of the mesage. With private heaps, this is done anyway and
- * will not affect performance.
- *
- *
- * message_info_clear/0 -> true
- *
- * Reset the message counters to zero.
- *
- *
- * message_sizes/0 -> true
- *
- * Displays a text-mode bar diagram with message sizes. There are no
- * guaranties that this is printed in a way the Erlang system is
- * supposed to print things.
- *
- *
- * gc_info/0 -> { Minor collections,
- * Major collections,
- * Used heap,
- * Allocated heap,
- * Max used heap,
- * Max allocated heap }
- *
- * Information about private heap garbage collections. Number of
- * minor and major collections, how much heap is used and allocated
- * and how much heap has been in use and allocated at most since the
- * counters were reset.
- *
- *
- * shared_gc_info/0 -> { Minor collections of the shared heap,
- * Major collections of the shared heap,
- * Used shared heap,
- * Allocated shared heap,
- * Max used shared heap,
- * Max allocated shared heap }
- *
- * The same as above, but for the shared heap / message area. Note,
- * that in a shared heap system the max used heap and max allocated
- * heap are mostly the same, since the heap allways is filled before
- * a garbage collection, and most garbage collections do not enlarge
- * the heap. The private heap numbers are much more interesting.
- *
- *
- * incremental_gc_info/0 -> { Complete minor GC cycles,
- * Complete major GC cycles,
- * Minor GC stages,
- * Major GC stages }
- *
- *
- * gc_info_clear/0 -> true
- *
- * Reset counters for both private and shared garbage collection.
- *
- *
- * BM Timers
- * ---------
- *
- * All timers returns tuples of the kind: { Minutes, Seconds, Milliseconds }
- * except for the max times in garbage collection where times are normally
- * small. The tuple is therefor: { Seconds, Milliseconds, Microseconds }
- *
- * system_timer/0 -> Mutator time
- *
- * This timer is not a real-time clock, it only runs when a process
- * is scheduled to run. You can not find out the accual time a
- * program has taken to run using this timer.
- *
- *
- * system_timer_clear/0 -> true
- *
- * Reset system timer to zero.
- *
- *
- * send_timer/0 -> { Send time,
- * Copy time,
- * Size time }
- *
- * Time spent in sending messages. The copy time and size time are
- * only active if the copying is needed in send. Copying of data
- * into ETS-tables etc is not timed with this timer.
- *
- *
- * send_timer_clear/0 -> true
- *
- * Reset send timers to zero.
- *
- *
- * gc_timer/0 -> { Time in minor collection,
- * Time in major collection,
- * Max time in minor collection (�s),
- * Max time in major collection (�s) }
- *
- * Total time spent in garbage collection of the private heaps. The
- * max times are for one separate collection.
- *
- *
- * shared_gc_timer/0 -> { Time in minor collection,
- * Time in major collection,
- * Max time in minor collection (�s),
- * Max time in major collection (�s) }
- *
- * Total time spent in garbage collection of the shared heap /
- * message area. The max times are for one separate collection.
- *
- *
- * gc_timer_clear/0 -> true
- *
- * Reset private and shared garbage collection timers to zero. Note,
- * that the max-times are also reset.
- *
- *
- * misc_timer/0 -> { Misc 0, Misc 1, Misc 2 }
- *
- * Timers for debug purposes. In a normal system, these timers are
- * never used. Add these timers at places where you want to time
- * something not covered here. Use BM_SWAP_TIMER(from,to) to start
- * one of the misc timers.
- *
- * ... code timed by the system timer ...
- * BM_SWAP_TIMER(system,misc1);
- * ... code we want to time ...
- * BM_SWAP_TIMER(misc1,system);
- * ... back on system time ...
- *
- *
- * misc_timer_clear/0 -> true
- *
- * Reset misc timers to zero.
- */
-
-BIF_RETTYPE hipe_bifs_process_info_0(BIF_ALIST_0)
-{
-#ifdef __BENCHMARK__
-#ifndef BM_COUNTERS
- Uint processes_busy = 0;
- Uint processes_spawned = 0;
-#endif
- Eterm *hp;
-
- hp = HAlloc(BIF_P, 3);
- BIF_RET(TUPLE2(hp,
- make_small(processes_busy),
- make_small(processes_spawned)));
-#else
- BIF_RET(am_false);
-#endif
-}
-
-BIF_RETTYPE hipe_bifs_process_info_clear_0(BIF_ALIST_0)
-{
-#ifdef __BENCHMARK__
-#ifdef BM_COUNTERS
- processes_spawned = 0;
-#endif
- BIF_RET(am_true);
-#else
- BIF_RET(am_false);
-#endif
-}
-
-BIF_RETTYPE hipe_bifs_message_info_0(BIF_ALIST_0)
-{
-#ifdef __BENCHMARK__
- Eterm *hp;
-#ifndef BM_COUNTERS
- unsigned long messages_sent = 0;
- unsigned long messages_copied = 0;
- unsigned long messages_ego = 0;
-#endif
-#ifndef BM_MESSAGE_SIZES
- unsigned long words_sent = 0;
- unsigned long words_copied = 0;
- unsigned long words_prealloc = 0;
-#endif
-
- hp = HAlloc(BIF_P, 7);
- BIF_RET(TUPLE6(hp,
- make_small(messages_sent),
- make_small(messages_copied),
- make_small(messages_ego),
- make_small(words_sent),
- make_small(words_copied),
- make_small(words_prealloc)));
-#else
- BIF_RET(am_false);
-#endif
-}
-
-BIF_RETTYPE hipe_bifs_message_info_clear_0(BIF_ALIST_0)
-{
-#ifdef __BENCHMARK__
-#ifdef BM_COUNTERS
- messages_sent = 0;
- messages_copied = 0;
- messages_ego = 0;
-#endif
-#ifdef BM_MESSAGE_SIZES
- words_sent = 0;
- words_copied = 0;
- words_prealloc = 0;
- {
- int i;
- for (i = 0; i < 1000; i++)
- message_sizes[i] = 0;
- }
-#endif
- BIF_RET(am_true);
-#else
- BIF_RET(am_false);
-#endif
-}
-
-BIF_RETTYPE hipe_bifs_message_sizes_0(BIF_ALIST_0)
-{
-#ifdef BM_MESSAGE_SIZES
- int i, j, max = 0;
- int tmp[12] = {0,0,0,0,0,0,0,0,0,0,0,0};
-
- for (i = 0; i < 65; i++) {
- tmp[0] += message_sizes[i];
- if (tmp[0] > max)
- max = tmp[0];
- }
- for (i = 65; i < 999; i++) {
- tmp[i / 100 + 1] += message_sizes[i];
- if (tmp[i / 100 + 1] > max)
- max = tmp[i / 100 + 1];
- }
- tmp[11] = message_sizes[999];
- if (tmp[11] > max)
- max = tmp[11];
- for (i = -1; i < 11; i++) {
- int num = (tmp[i + 1] * 50) / max;
- if (i == -1)
- printf("\n\r 0 - 64: (%6d) |", tmp[0]);
- else if (i == 0)
- printf("\n\r 65 - 99: (%6d) |", tmp[1]);
- else if (i == 10)
- printf("\n\r >= 1000: (%6d) |", tmp[11]);
- else
- printf("\n\r%3d - %3d: (%6d) |", i * 100, i * 100 + 99,
- tmp[i + 1]);
-
- for (j = 0; j < num; j++)
- printf(".");
- }
- printf("\n\r");
-
- BIF_RET(am_true);
-#else
- BIF_RET(am_false);
-#endif
-}
-
-BIF_RETTYPE hipe_bifs_gc_info_0(BIF_ALIST_0)
-{
-#ifdef __BENCHMARK__
-#ifndef BM_COUNTERS
- Uint minor_gc = 0;
- Uint major_gc = 0;
-#endif
-#ifndef BM_HEAP_SIZES
- Uint max_used_heap = 0;
- Uint max_allocated_heap = 0;
-#endif
- Eterm *hp;
- Uint used_heap = (BIF_P->htop - BIF_P->heap) +
- (OLD_HTOP(BIF_P) - OLD_HEAP(BIF_P)) +
- MBUF_SIZE(BIF_P);
-
- Uint alloc_heap = (BIF_P->hend - BIF_P->heap) +
- (OLD_HEND(BIF_P) - OLD_HEAP(BIF_P)) +
- MBUF_SIZE(BIF_P);
-
- hp = HAlloc(BIF_P, 7);
- BIF_RET(TUPLE6(hp,
- make_small((Uint)minor_gc),
- make_small((Uint)major_gc),
- make_small((Uint)used_heap),
- make_small((Uint)alloc_heap),
- make_small(max_used_heap),
- make_small(max_allocated_heap)));
-#else
- BIF_RET(am_false);
-#endif
-}
-
-BIF_RETTYPE hipe_bifs_shared_gc_info_0(BIF_ALIST_0)
-{
-#ifdef __BENCHMARK__
-#if !(defined(BM_COUNTERS))
- Uint minor_global_gc = 0;
- Uint major_global_gc = 0;
-#endif
-#ifndef BM_HEAP_SIZES
- Uint max_used_global_heap = 0;
- Uint max_allocated_global_heap = 0;
-#endif
- Eterm *hp;
-
- Uint tmp_used_heap = 0;
- Uint tmp_allocated_heap = 0;
-
- hp = HAlloc(BIF_P, 7);
- BIF_RET(TUPLE6(hp,
- make_small((uint)minor_global_gc),
- make_small((uint)major_global_gc),
- make_small(tmp_used_heap),
- make_small(tmp_allocated_heap),
- make_small(max_used_global_heap),
- make_small(max_allocated_global_heap)));
-#else
- BIF_RET(am_false);
-#endif
-}
-
-BIF_RETTYPE hipe_bifs_incremental_gc_info_0(BIF_ALIST_0)
-{
-#ifdef __BENCHMARK__
-#if !defined(BM_COUNTERS)
- Uint minor_gc_cycles = 0;
- Uint major_gc_cycles = 0;
- Uint minor_gc_stages = 0;
- Uint major_gc_stages = 0;
-#endif
- Eterm *hp;
-
- hp = HAlloc(BIF_P, 5);
- BIF_RET(TUPLE4(hp,
- make_small(minor_gc_cycles),
- make_small(major_gc_cycles),
- make_small(minor_gc_stages),
- make_small(major_gc_stages)));
-#else
- BIF_RET(am_false);
-#endif
-}
-
-BIF_RETTYPE hipe_bifs_gc_info_clear_0(BIF_ALIST_0)
-{
-#ifdef __BENCHMARK__
-
-#ifdef BM_COUNTERS
- minor_gc = 0;
- major_gc = 0;
-#endif
-
-#ifdef BM_HEAP_SIZES
- max_used_heap = 0;
- max_allocated_heap = 0;
- max_used_global_heap = 0;
- max_allocated_global_heap = 0;
-#endif
-
- BIF_RET(am_true);
-#else
- BIF_RET(am_false);
-#endif
-}
-
-BIF_RETTYPE hipe_bifs_pause_times_0(BIF_ALIST_0)
-{
-#ifdef BM_TIMERS
- int i;
- int total_time = 0, n = 0;
- int left = 0, right = 0, mid = 0;
-
- printf("Pause times in minor collection:\r\n");
- for (i = 0; i < MAX_PAUSE_TIME; i++) {
- if (pause_times[i] > 0) {
- printf("%d: %ld\r\n", i, pause_times[i]);
- total_time += pause_times[i] * i;
- n += pause_times[i];
-
- if (i > mid)
- right += pause_times[i];
-
- while (right > left) {
- left += pause_times[mid++];
- right -= pause_times[mid];
- }
- }
- }
-
- printf("Number of collections: %d\r\n", n);
- printf("Total collection time: %d\r\n", total_time);
- if (n > 0)
- printf("Mean pause time: %d\r\n", total_time / n);
-
- printf("Geometrical mean: %d\r\n", mid);
-
- total_time = 0; n = 0;
- left = 0; right = 0; mid = 0;
- printf("Pause times in major collection:\r\n");
- for (i = 0; i < MAX_PAUSE_TIME; i++) {
- if (pause_times_old[i] > 0) {
- printf("%d: %ld\r\n", i, pause_times_old[i]);
- total_time += pause_times_old[i] * i;
- n += pause_times_old[i];
- }
- }
-
- printf("Number of collections: %d\r\n", n);
- printf("Total collection time: %d\r\n", total_time);
- if (n > 0)
- printf("Mean pause time: %d\r\n", total_time / n);
-
- BIF_RET(am_true);
-#else
- BIF_RET(am_false);
-#endif
-}
-
-/* XXX: these macros have free variables */
-#ifdef BM_TIMERS
-#if USE_PERFCTR
-#define MAKE_TIME(_timer_) { \
- BM_TIMER_T tmp = _timer_##_time; \
- milli = (uint)(tmp - ((int)(tmp / 1000)) * 1000); \
- tmp /= 1000; \
- sec = (uint)(tmp - ((int)(tmp / 60)) * 60); \
- min = (uint)tmp / 60; }
-
-#define MAKE_MICRO_TIME(_timer_) { \
- BM_TIMER_T tmp = _timer_##_time * 1000; \
- micro = (uint)(tmp - ((int)(tmp / 1000)) * 1000); \
- tmp /= 1000; \
- milli = (uint)(tmp - ((int)(tmp / 1000)) * 1000); \
- sec = (uint)tmp / 1000; }
-
-#else
-#define MAKE_TIME(_timer_) { \
- BM_TIMER_T tmp = _timer_##_time / 1000000; \
- milli = tmp % 1000; \
- tmp /= 1000; \
- sec = tmp % 60; \
- min = tmp / 60; }
-
-#define MAKE_MICRO_TIME(_timer_) { \
- BM_TIMER_T tmp = _timer_##_time / 1000; \
- micro = tmp % 1000; \
- tmp /= 1000; \
- milli = tmp % 1000; \
- sec = tmp / 1000; }
-
-#endif
-#else
-#define MAKE_TIME(_timer_)
-#define MAKE_MICRO_TIME(_timer_)
-#endif
-
-BIF_RETTYPE hipe_bifs_system_timer_0(BIF_ALIST_0)
-{
-#ifdef __BENCHMARK__
- uint min = 0;
- uint sec = 0;
- uint milli = 0;
- Eterm *hp;
-
- hp = HAlloc(BIF_P, 4);
- MAKE_TIME(system);
- BIF_RET(TUPLE3(hp,
- make_small(min),
- make_small(sec),
- make_small(milli)));
-#else
- BIF_RET(am_false);
-#endif
-}
-
-BIF_RETTYPE hipe_bifs_system_timer_clear_0(BIF_ALIST_0)
-{
-#ifdef BM_TIMERS
- system_time = 0;
- BIF_RET(am_true);
-#else
- BIF_RET(am_false);
-#endif
-}
-
-BIF_RETTYPE hipe_bifs_send_timer_0(BIF_ALIST_0)
-{
-#ifdef __BENCHMARK__
- uint min = 0;
- uint sec = 0;
- uint milli = 0;
- Eterm *hp;
- Eterm sendtime, copytime, sizetime;
-
- hp = HAlloc(BIF_P, 4 * 4);
-
- MAKE_TIME(send);
- sendtime = TUPLE3(hp,
- make_small(min),
- make_small(sec),
- make_small(milli));
- hp += 4;
-
- MAKE_TIME(copy);
- copytime = TUPLE3(hp,
- make_small(min),
- make_small(sec),
- make_small(milli));
- hp += 4;
-
- MAKE_TIME(size);
- sizetime = TUPLE3(hp,
- make_small(min),
- make_small(sec),
- make_small(milli));
- hp += 4;
- BIF_RET(TUPLE3(hp, sendtime, copytime, sizetime));
-#else
- BIF_RET(am_false);
-#endif
-}
-
-BIF_RETTYPE hipe_bifs_send_timer_clear_0(BIF_ALIST_0)
-{
-#ifdef BM_TIMERS
- send_time = 0;
- copy_time = 0;
- size_time = 0;
- BIF_RET(am_true);
-#else
- BIF_RET(am_false);
-#endif
-}
-
-BIF_RETTYPE hipe_bifs_gc_timer_0(BIF_ALIST_0)
-{
-#ifdef __BENCHMARK__
- Eterm *hp;
- uint min = 0;
- uint sec = 0;
- uint milli = 0;
- uint micro = 0;
- Eterm minor, major, max_min, max_maj;
-
- hp = HAlloc(BIF_P, 4 * 4 + 5);
-
- MAKE_TIME(minor_gc);
- minor = TUPLE3(hp,
- make_small(min),
- make_small(sec),
- make_small(milli));
- hp += 4;
-
- MAKE_TIME(major_gc);
- major = TUPLE3(hp,
- make_small(min),
- make_small(sec),
- make_small(milli));
- hp += 4;
-
- MAKE_MICRO_TIME(max_minor);
- max_min = TUPLE3(hp,
- make_small(sec),
- make_small(milli),
- make_small(micro));
- hp += 4;
-
- MAKE_MICRO_TIME(max_major);
- max_maj = TUPLE3(hp,
- make_small(sec),
- make_small(milli),
- make_small(micro));
- hp += 4;
-
- BIF_RET(TUPLE4(hp, minor, major, max_min, max_maj));
-#else
- BIF_RET(am_false);
-#endif
-}
-
-BIF_RETTYPE hipe_bifs_shared_gc_timer_0(BIF_ALIST_0)
-{
-#ifdef __BENCHMARK__
- Eterm *hp;
- uint min = 0;
- uint sec = 0;
- uint milli = 0;
- uint micro = 0;
- Eterm minor, major, max_min, max_maj;
-
- hp = HAlloc(BIF_P, 4 * 4 + 5);
-
- MAKE_TIME(minor_global_gc);
- minor = TUPLE3(hp,
- make_small(min),
- make_small(sec),
- make_small(milli));
- hp += 4;
-
- MAKE_TIME(major_global_gc);
- major = TUPLE3(hp,
- make_small(min),
- make_small(sec),
- make_small(milli));
- hp += 4;
-
- MAKE_MICRO_TIME(max_global_minor);
- max_min = TUPLE3(hp,
- make_small(sec),
- make_small(milli),
- make_small(micro));
- hp += 4;
-
- MAKE_MICRO_TIME(max_global_major);
- max_maj = TUPLE3(hp,
- make_small(sec),
- make_small(milli),
- make_small(micro));
- hp += 4;
-
- BIF_RET(TUPLE4(hp, minor, major, max_min, max_maj));
-#else
- BIF_RET(am_false);
-#endif
-}
-
-BIF_RETTYPE hipe_bifs_gc_timer_clear_0(BIF_ALIST_0)
-{
-#ifdef BM_TIMERS
- minor_gc_time = 0;
- major_gc_time = 0;
- max_minor_time = 0;
- max_major_time = 0;
- minor_global_gc_time = 0;
- major_global_gc_time = 0;
- max_global_minor_time = 0;
- max_global_major_time = 0;
- BIF_RET(am_true);
-#else
- BIF_RET(am_false);
-#endif
-}
-
-BIF_RETTYPE hipe_bifs_misc_timer_0(BIF_ALIST_0)
-{
-#ifdef __BENCHMARK__
- uint min = 0;
- uint sec = 0;
- uint milli = 0;
- Eterm *hp;
- Eterm misctime1, misctime2, misctime3;
-
- hp = HAlloc(BIF_P, 4 * 4);
-
- MAKE_TIME(misc0);
- misctime1 = TUPLE3(hp,
- make_small(min),
- make_small(sec),
- make_small(milli));
- hp += 4;
-
- MAKE_TIME(misc1);
- misctime2 = TUPLE3(hp,
- make_small(min),
- make_small(sec),
- make_small(milli));
- hp += 4;
-
- MAKE_TIME(misc2);
- misctime3 = TUPLE3(hp,
- make_small(min),
- make_small(sec),
- make_small(milli));
- hp += 4;
- BIF_RET(TUPLE3(hp, misctime1, misctime2, misctime3));
-#else
- BIF_RET(am_false);
-#endif
-}
-
-BIF_RETTYPE hipe_bifs_misc_timer_clear_0(BIF_ALIST_0)
-{
-#ifdef BM_TIMERS
- misc0_time = 0;
- misc1_time = 0;
- misc2_time = 0;
- BIF_RET(am_true);
-#else
- BIF_RET(am_false);
-#endif
-}
-
-#undef MAKE_TIME
-#undef MAKE_MICRO_TIME
-
-/*
- * HiPE hrvtime().
- * These implementations are currently available:
- * + On Linux with the perfctr extension we can use the process'
- * virtualised time-stamp counter. To enable this mode you must
- * pass `--with-perfctr=/path/to/perfctr' when configuring.
- * + The fallback, which is the same as {X,_} = runtime(statistics).
- */
-
-static double fallback_get_hrvtime(void)
-{
- unsigned long ms_user;
-
- elapsed_time_both(&ms_user, NULL, NULL, NULL);
- return (double)ms_user;
-}
-
-#if USE_PERFCTR
-
-#include "hipe_perfctr.h"
-static int hrvtime_started; /* 0: closed, +1: perfctr, -1: fallback */
-#define hrvtime_is_started() (hrvtime_started != 0)
-
-static void start_hrvtime(void)
-{
- if (hipe_perfctr_hrvtime_open() >= 0)
- hrvtime_started = 1;
- else
- hrvtime_started = -1;
-}
-
-static void stop_hrvtime(void)
-{
- if (hrvtime_started > 0)
- hipe_perfctr_hrvtime_close();
- hrvtime_started = 0;
-}
-
-static double get_hrvtime(void)
-{
- if (hrvtime_started > 0)
- return hipe_perfctr_hrvtime_get();
- else
- return fallback_get_hrvtime();
-}
-
-#else /* !USE_PERFCTR */
-
-/*
- * Fallback, if nothing better exists.
- * This is the same as {X,_} = statistics(runtime), which uses
- * times(2) on Unix systems.
- */
-
-#define hrvtime_is_started() 1
-#define start_hrvtime() do{}while(0)
-#define stop_hrvtime() do{}while(0)
-#define get_hrvtime() fallback_get_hrvtime()
-
-#endif /* !USE_PERFCTR */
-
-BIF_RETTYPE hipe_bifs_get_hrvtime_0(BIF_ALIST_0)
-{
- Eterm *hp;
- Eterm res;
- FloatDef f;
-
- if (!hrvtime_is_started())
- start_hrvtime();
- f.fd = get_hrvtime();
- hp = HAlloc(BIF_P, FLOAT_SIZE_OBJECT);
- res = make_float(hp);
- PUT_DOUBLE(f, hp);
- BIF_RET(res);
-}
-
-BIF_RETTYPE hipe_bifs_stop_hrvtime_0(BIF_ALIST_0)
-{
- stop_hrvtime();
- BIF_RET(am_true);
-}
diff --git a/erts/emulator/hipe/hipe_bif1.h b/erts/emulator/hipe/hipe_bif1.h
index 89241fb835..e12bb1a1f3 100644
--- a/erts/emulator/hipe/hipe_bif1.h
+++ b/erts/emulator/hipe/hipe_bif1.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/hipe/hipe_bif1.tab b/erts/emulator/hipe/hipe_bif1.tab
index eb445d56f7..4be0ad0e9c 100644
--- a/erts/emulator/hipe/hipe_bif1.tab
+++ b/erts/emulator/hipe/hipe_bif1.tab
@@ -1,18 +1,19 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2001-2009. All Rights Reserved.
+# Copyright Ericsson AB 2001-2016. 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.
+# 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%
#
@@ -26,24 +27,3 @@ bif hipe_bifs:call_count_get/1
bif hipe_bifs:call_count_clear/1
bif hipe_bifs:trap_count_get/0
bif hipe_bifs:trap_count_clear/0
-bif hipe_bifs:process_info/0
-bif hipe_bifs:process_info_clear/0
-bif hipe_bifs:message_info/0
-bif hipe_bifs:message_info_clear/0
-bif hipe_bifs:message_sizes/0
-bif hipe_bifs:gc_info/0
-bif hipe_bifs:shared_gc_info/0
-bif hipe_bifs:incremental_gc_info/0
-bif hipe_bifs:gc_info_clear/0
-bif hipe_bifs:pause_times/0
-bif hipe_bifs:system_timer/0
-bif hipe_bifs:system_timer_clear/0
-bif hipe_bifs:send_timer/0
-bif hipe_bifs:send_timer_clear/0
-bif hipe_bifs:gc_timer/0
-bif hipe_bifs:shared_gc_timer/0
-bif hipe_bifs:gc_timer_clear/0
-bif hipe_bifs:misc_timer/0
-bif hipe_bifs:misc_timer_clear/0
-bif hipe_bifs:get_hrvtime/0
-bif hipe_bifs:stop_hrvtime/0
diff --git a/erts/emulator/hipe/hipe_bif2.c b/erts/emulator/hipe/hipe_bif2.c
index 054911e822..e04d3d32d1 100644
--- a/erts/emulator/hipe/hipe_bif2.c
+++ b/erts/emulator/hipe/hipe_bif2.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2012. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -154,7 +155,7 @@ BIF_RETTYPE hipe_bifs_modeswitch_debug_off_0(BIF_ALIST_0)
#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP)
-BIF_RETTYPE hipe_debug_bif_wrapper(BIF_ALIST_1);
+BIF_RETTYPE hipe_debug_bif_wrapper(NBIF_ALIST_1);
# define ERTS_SMP_REQ_PROC_MAIN_LOCK(P) \
if ((P)) erts_proc_lc_require_lock((P), ERTS_PROC_LOCK_MAIN,\
@@ -162,13 +163,13 @@ BIF_RETTYPE hipe_debug_bif_wrapper(BIF_ALIST_1);
# define ERTS_SMP_UNREQ_PROC_MAIN_LOCK(P) \
if ((P)) erts_proc_lc_unrequire_lock((P), ERTS_PROC_LOCK_MAIN)
-BIF_RETTYPE hipe_debug_bif_wrapper(BIF_ALIST_1)
+BIF_RETTYPE hipe_debug_bif_wrapper(NBIF_ALIST_1)
{
- typedef BIF_RETTYPE Bif(BIF_ALIST_1);
- Bif* fp = (Bif*) (BIF_P->hipe.bif_callee);
+ typedef BIF_RETTYPE nBif(NBIF_ALIST_1);
+ nBif* fp = (nBif*) (BIF_P->hipe.bif_callee);
BIF_RETTYPE res;
ERTS_SMP_UNREQ_PROC_MAIN_LOCK(BIF_P);
- res = (*fp)(BIF_P, BIF__ARGS);
+ res = (*fp)(NBIF_CALL_ARGS);
ERTS_SMP_REQ_PROC_MAIN_LOCK(BIF_P);
return res;
}
diff --git a/erts/emulator/hipe/hipe_bif2.tab b/erts/emulator/hipe/hipe_bif2.tab
index 1b659cfa90..bbcb577be0 100644
--- a/erts/emulator/hipe/hipe_bif2.tab
+++ b/erts/emulator/hipe/hipe_bif2.tab
@@ -1,18 +1,19 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2001-2012. All Rights Reserved.
+# Copyright Ericsson AB 2001-2016. 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.
+# 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%
#
diff --git a/erts/emulator/hipe/hipe_bif64.c b/erts/emulator/hipe/hipe_bif64.c
index baaf5af2cd..a1a3c81bfe 100644
--- a/erts/emulator/hipe/hipe_bif64.c
+++ b/erts/emulator/hipe/hipe_bif64.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/hipe/hipe_bif64.h b/erts/emulator/hipe/hipe_bif64.h
index 6d494886ec..a97ce311d3 100644
--- a/erts/emulator/hipe/hipe_bif64.h
+++ b/erts/emulator/hipe/hipe_bif64.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/hipe/hipe_bif64.tab b/erts/emulator/hipe/hipe_bif64.tab
index 228318af39..eefca379a0 100644
--- a/erts/emulator/hipe/hipe_bif64.tab
+++ b/erts/emulator/hipe/hipe_bif64.tab
@@ -1,18 +1,19 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2004-2011. All Rights Reserved.
+# Copyright Ericsson AB 2004-2016. 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/.
+# 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
#
-# 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.
+# 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%
#
diff --git a/erts/emulator/hipe/hipe_bif_list.m4 b/erts/emulator/hipe/hipe_bif_list.m4
index 0997d81b2f..b86f2dafdc 100644
--- a/erts/emulator/hipe/hipe_bif_list.m4
+++ b/erts/emulator/hipe/hipe_bif_list.m4
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2004-2014. All Rights Reserved.
+ * Copyright Ericsson AB 2004-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -70,6 +71,32 @@
****************************************************************/
/*
+ * NOTE:
+ * Beam BIFs have the prototype:
+ * Eterm (*BIF)(Process *c_p, Eterm *regs, UWord *I)
+ * Native BIFs have the prototype:
+ * Eterm (*BIF)(Process *c_p, Eterm *regs)
+ *
+ * Beam BIFs expect 'I' to contain current instruction
+ * pointer when called from beam, and expect 'I' to
+ * contain a pointer to the export entry of the BIF
+ * when called from native code. In order to facilitate
+ * this, beam BIFs are called via wrapper functions
+ * when called from native code. These wrapper functions
+ * are auto-generated (by utils/make_tables) and have
+ * the function names nbif_impl_<BIF>.
+ *
+ * The standard_bif_interface_*() and
+ * gc_bif_interface_*() will add the prefix and
+ * thus call nbif_impl_<cbif_name>. That is, all
+ * functions (true BIFs as well as other c-functions)
+ * called via these interfaces have to be named
+ * nbif_impl_<FUNC>.
+ */
+
+/*
+ * See NOTE above!
+ *
* standard_bif_interface_0(nbif_name, cbif_name)
* standard_bif_interface_1(nbif_name, cbif_name)
* standard_bif_interface_2(nbif_name, cbif_name)
@@ -92,9 +119,12 @@
*/
/*
+ * See NOTE above!
+ *
* gc_bif_interface_0(nbif_name, cbif_name)
* gc_bif_interface_1(nbif_name, cbif_name)
* gc_bif_interface_2(nbif_name, cbif_name)
+ * gc_bif_interface_3(nbif_name, cbif_name)
*
* A BIF which may do a GC or walk the native stack.
* May read NSP, NSP_LIMIT, NRA, HP, HP_LIMIT, and FCALLS.
@@ -151,9 +181,9 @@ standard_bif_interface_0(nbif_ports_0, ports_0)
* BIFs and primops that may do a GC (change heap limit and walk the native stack).
* XXX: erase/1 and put/2 cannot fail
*/
-gc_bif_interface_2(nbif_erts_internal_check_process_code_2, hipe_erts_internal_check_process_code_2)
+gc_bif_interface_1(nbif_erts_internal_check_process_code_1, hipe_erts_internal_check_process_code_1)
gc_bif_interface_1(nbif_erase_1, erase_1)
-gc_bif_interface_0(nbif_garbage_collect_0, garbage_collect_0)
+gc_bif_interface_1(nbif_erts_internal_garbage_collect_1, erts_internal_garbage_collect_1)
gc_nofail_primop_interface_1(nbif_gc_1, hipe_gc)
gc_bif_interface_2(nbif_put_2, put_2)
@@ -192,6 +222,8 @@ 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)
+noproc_primop_interface_1(nbif_is_unicode, hipe_is_unicode)
/*
* Mbox primops with implicit P parameter.
@@ -216,7 +248,11 @@ nofail_primop_interface_3(nbif_bs_get_float_2, erts_bs_get_float_2)
standard_bif_interface_3(nbif_bs_put_utf8, hipe_bs_put_utf8)
standard_bif_interface_3(nbif_bs_put_utf16be, hipe_bs_put_utf16be)
standard_bif_interface_3(nbif_bs_put_utf16le, hipe_bs_put_utf16le)
+ifdef(`nogc_bif_interface_1',`
+nogc_bif_interface_1(nbif_bs_validate_unicode, hipe_bs_validate_unicode)
+',`
standard_bif_interface_1(nbif_bs_validate_unicode, hipe_bs_validate_unicode)
+')
/*
* Bit-syntax primops without any P parameter.
@@ -244,12 +280,14 @@ nocons_nofail_primop_interface_5(nbif_bs_put_big_integer, hipe_bs_put_big_intege
noproc_primop_interface_5(nbif_bs_put_big_integer, hipe_bs_put_big_integer)
')dnl
-gc_bif_interface_0(nbif_check_get_msg, hipe_check_get_msg)
+nofail_primop_interface_0(nbif_check_get_msg, hipe_check_get_msg)
#`ifdef' NO_FPE_SIGNALS
nocons_nofail_primop_interface_0(nbif_emulate_fpe, hipe_emulate_fpe)
#endif
+noproc_primop_interface_1(nbif_emasculate_binary, hipe_emasculate_binary)
+
/*
* SMP-specific stuff
*/
@@ -259,21 +297,35 @@ noproc_primop_interface_1(nbif_atomic_inc, hipe_atomic_inc)
',)dnl
/*
- * Standard BIFs.
- * BIF_LIST(ModuleAtom,FunctionAtom,Arity,CFun,Index)
+ * BIFs that disable GC while trapping are called via a wrapper
+ * to reserve stack space for the "trap frame".
+ * They occasionally need to call the garbage collector in order to make room
+ * for the trap frame on the BEAM stack.
*/
+gc_bif_interface_1(nbif_term_to_binary_1, hipe_wrapper_term_to_binary_1)
+gc_bif_interface_2(nbif_term_to_binary_2, hipe_wrapper_term_to_binary_2)
+gc_bif_interface_1(nbif_binary_to_term_1, hipe_wrapper_binary_to_term_1)
+gc_bif_interface_2(nbif_binary_to_term_2, hipe_wrapper_binary_to_term_2)
+gc_bif_interface_1(nbif_binary_to_list_1, hipe_wrapper_binary_to_list_1)
+gc_bif_interface_3(nbif_binary_to_list_3, hipe_wrapper_binary_to_list_3)
+gc_bif_interface_1(nbif_bitstring_to_list_1, hipe_wrapper_bitstring_to_list_1)
+gc_bif_interface_1(nbif_list_to_binary_1, hipe_wrapper_list_to_binary_1)
+gc_bif_interface_1(nbif_iolist_to_binary_1, hipe_wrapper_iolist_to_binary_1)
+gc_bif_interface_1(nbif_binary_list_to_bin_1, hipe_wrapper_binary_list_to_bin_1)
+gc_bif_interface_1(nbif_list_to_bitstring_1, hipe_wrapper_list_to_bitstring_1)
+gc_bif_interface_2(nbif_send_2, hipe_wrapper_send_2)
+gc_bif_interface_3(nbif_send_3, hipe_wrapper_send_3)
+gc_bif_interface_2(nbif_ebif_bang_2, hipe_wrapper_ebif_bang_2)
+gc_bif_interface_2(nbif_maps_merge_2, hipe_wrapper_maps_merge_2)
-/* BIFs that disable GC while trapping are called via a wrapper
- * to reserve stack space for the "trap frame".
+
+/*
+ * Standard BIFs.
+ * BIF_LIST(ModuleAtom,FunctionAtom,Arity,CFun,Index)
*/
-define(CFUN,`ifelse($1,term_to_binary_1,hipe_wrapper_term_to_binary_1,
-ifelse($1,term_to_binary_2,hipe_wrapper_term_to_binary_2,
-ifelse($1,erts_internal_binary_to_term_1,hipe_wrapper_erts_internal_binary_to_term_1,
-ifelse($1,erts_internal_binary_to_term_2,hipe_wrapper_erts_internal_binary_to_term_2,
-$1))))')
-define(BIF_LIST,`standard_bif_interface_$3(nbif_$4, CFUN($4))')
-include(TARGET/`erl_bif_list.h')
+define(BIF_LIST,`standard_bif_interface_$3(nbif_$5, $5)')
+include(TTF_DIR/`erl_bif_list.h')
/*
* Guard BIFs.
diff --git a/erts/emulator/hipe/hipe_debug.c b/erts/emulator/hipe/hipe_debug.c
index 32694a8f97..cfe60b379e 100644
--- a/erts/emulator/hipe/hipe_debug.c
+++ b/erts/emulator/hipe/hipe_debug.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -61,10 +62,12 @@ static void print_beam_pc(BeamInstr *pc)
} else if (pc == &beam_apply[1]) {
printf("normal-process-exit");
} else {
- BeamInstr *mfa = find_function_from_pc(pc);
- if (mfa)
+ ErtsCodeMFA *cmfa = find_function_from_pc(pc);
+ if (cmfa)
erts_printf("%T:%T/%bpu + 0x%bpx",
- mfa[0], mfa[1], mfa[2], pc - &mfa[3]);
+ cmfa->module, cmfa->function,
+ cmfa->arity,
+ pc - erts_codemfa_to_code(cmfa));
else
printf("?");
}
@@ -132,7 +135,9 @@ static void print_heap(Eterm *pos, Eterm *end)
printf("From: 0x%0*lx to 0x%0*lx\n\r",
2*(int)sizeof(long), (unsigned long)pos,
2*(int)sizeof(long), (unsigned long)end);
- printf(" | H E A P |\r\n");
+ printf(" | %*s H E A P %*s |\r\n",
+ 2*(int)sizeof(long)-1, "",
+ 2*(int)sizeof(long)-1, "");
printf(" | %*s | %*s |\r\n",
2+2*(int)sizeof(long), "Address",
2+2*(int)sizeof(long), "Contents");
@@ -155,8 +160,10 @@ static void print_heap(Eterm *pos, Eterm *end)
++pos;
--ari;
}
- } else
+ } else {
+ fflush(stdout);
erts_printf("%.30T", val);
+ }
printf("\r\n");
}
printf(" |%s|%s|\r\n", dashes, dashes);
@@ -172,8 +179,10 @@ void hipe_print_pcb(Process *p)
printf("P: 0x%0*lx\r\n", 2*(int)sizeof(long), (unsigned long)p);
printf("-----------------------------------------------\r\n");
printf("Offset| Name | Value | *Value |\r\n");
+#undef U
#define U(n,x) \
printf(" % 4d | %s | 0x%0*lx | |\r\n", (int)offsetof(Process,x), n, 2*(int)sizeof(long), (unsigned long)p->x)
+#undef P
#define P(n,x) \
printf(" % 4d | %s | 0x%0*lx | 0x%0*lx |\r\n", (int)offsetof(Process,x), n, 2*(int)sizeof(long), (unsigned long)p->x, 2*(int)sizeof(long), p->x ? (unsigned long)*(p->x) : -1UL)
@@ -192,7 +201,7 @@ void hipe_print_pcb(Process *p)
U("rcount ", rcount);
U("id ", common.id);
U("reds ", reds);
- U("tracer_pr..", common.tracer_proc);
+ U("tracer ", common.tracer);
U("trace_fla..", common.trace_flags);
U("group_lea..", group_leader);
U("flags ", flags);
@@ -211,10 +220,10 @@ void hipe_print_pcb(Process *p)
U("seq..clock ", seq_trace_clock);
U("seq..astcnt", seq_trace_lastcnt);
U("seq..token ", seq_trace_token);
- U("intial[0] ", initial[0]);
- U("intial[1] ", initial[1]);
- U("intial[2] ", initial[2]);
- P("current ", current);
+ U("intial.mod ", u.initial.module);
+ U("intial.fun ", u.initial.function);
+ U("intial.ari ", u.initial.arity);
+ U("current ", current);
P("cp ", cp);
P("i ", i);
U("catches ", catches);
@@ -231,7 +240,7 @@ void hipe_print_pcb(Process *p)
U("nsp ", hipe.nsp);
U("nstack ", hipe.nstack);
U("nstend ", hipe.nstend);
- U("ncallee ", hipe.ncallee);
+ U("ncallee ", hipe.u.ncallee);
hipe_arch_print_pcb(&p->hipe);
#endif /* HIPE */
#undef U
diff --git a/erts/emulator/hipe/hipe_debug.h b/erts/emulator/hipe/hipe_debug.h
index a28597000a..c510eac949 100644
--- a/erts/emulator/hipe/hipe_debug.h
+++ b/erts/emulator/hipe/hipe_debug.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/hipe/hipe_gbif_list.h b/erts/emulator/hipe/hipe_gbif_list.h
index 69dbab7ab9..424b001298 100644
--- a/erts/emulator/hipe/hipe_gbif_list.h
+++ b/erts/emulator/hipe/hipe_gbif_list.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/hipe/hipe_gc.c b/erts/emulator/hipe/hipe_gc.c
index 86c4068072..1a4a4c7952 100644
--- a/erts/emulator/hipe/hipe_gc.c
+++ b/erts/emulator/hipe/hipe_gc.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2004-2012. All Rights Reserved.
+ * Copyright Ericsson AB 2004-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -22,6 +23,9 @@
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
+
+#define ERL_WANT_GC_INTERNALS__
+
#include "global.h"
#include "erl_gc.h"
@@ -34,7 +38,7 @@ Eterm *fullsweep_nstack(Process *p, Eterm *n_htop)
/* known nstack walk state */
Eterm *nsp;
Eterm *nsp_end;
- const struct sdesc *sdesc;
+ const struct hipe_sdesc *sdesc;
unsigned int sdesc_size;
unsigned long ra;
unsigned int i;
@@ -42,9 +46,7 @@ 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;
+ ASSERT(!p->hipe.gc_is_unsafe);
if (!p->hipe.nstack) {
ASSERT(!p->hipe.nsp && !p->hipe.nstend);
@@ -62,11 +64,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) {
@@ -93,19 +90,17 @@ 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)) {
- MOVE_BOXED(ptr, val, n_htop, nsp_i);
+ } else if (!erts_is_literal(gval, ptr)) {
+ move_boxed(&ptr, val, &n_htop, nsp_i);
}
} else if (is_list(gval)) {
Eterm *ptr = list_val(gval);
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)) {
- ASSERT(within(ptr, p));
- MOVE_CONS(ptr, val, n_htop, nsp_i);
+ } else if (!erts_is_literal(gval, ptr)) {
+ ASSERT(erts_dbg_within_proc(ptr, p, NULL));
+ move_cons(&ptr, val, &n_htop, nsp_i);
}
}
}
@@ -128,18 +123,22 @@ void gensweep_nstack(Process *p, Eterm **ptr_old_htop, Eterm **ptr_n_htop)
/* known nstack walk state */
Eterm *nsp;
Eterm *nsp_end;
- const struct sdesc *sdesc;
+ const struct hipe_sdesc *sdesc;
unsigned int sdesc_size;
unsigned long ra;
unsigned int i;
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;
+
+ ASSERT(!p->hipe.gc_is_unsafe);
if (!p->hipe.nstack) {
ASSERT(!p->hipe.nsp && !p->hipe.nstend);
@@ -164,9 +163,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)) {
@@ -205,22 +205,22 @@ 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)) {
- MOVE_BOXED(ptr, val, old_htop, nsp_i);
- } else if (in_area(ptr, heap, heap_size)) {
- ASSERT(within(ptr, p));
- MOVE_BOXED(ptr, val, n_htop, nsp_i);
+ } else if (ErtsInArea(ptr, mature, mature_size)) {
+ move_boxed(&ptr, val, &old_htop, nsp_i);
+ } else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) {
+ ASSERT(erts_dbg_within_proc(ptr, p, NULL));
+ move_boxed(&ptr, val, &n_htop, nsp_i);
}
} else if (is_list(gval)) {
Eterm *ptr = list_val(gval);
Eterm val = *ptr;
if (IS_MOVED_CONS(val)) {
*nsp_i = ptr[1];
- } else if (in_area(ptr, heap, mature_size)) {
- MOVE_CONS(ptr, val, old_htop, nsp_i);
- } else if (in_area(ptr, heap, heap_size)) {
- ASSERT(within(ptr, p));
- MOVE_CONS(ptr, val, n_htop, nsp_i);
+ } else if (ErtsInArea(ptr, mature, mature_size)) {
+ move_cons(&ptr, val, &old_htop, nsp_i);
+ } else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) {
+ ASSERT(erts_dbg_within_proc(ptr, p, NULL));
+ move_cons(&ptr, val, &n_htop, nsp_i);
}
}
}
@@ -237,3 +237,155 @@ void gensweep_nstack(Process *p, Eterm **ptr_old_htop, Eterm **ptr_n_htop)
}
abort();
}
+
+Eterm *sweep_literals_nstack(Process *p, Eterm *old_htop, char *area,
+ Uint area_size)
+{
+ /* known nstack walk state */
+ Eterm *nsp;
+ Eterm *nsp_end;
+ const struct hipe_sdesc *sdesc;
+ /* arch-specific nstack walk state */
+ struct nstack_walk_state walk_state;
+
+ ASSERT(!p->hipe.gc_is_unsafe);
+
+ if (!p->hipe.nstack) {
+ ASSERT(!p->hipe.nsp && !p->hipe.nstend);
+ return old_htop;
+ }
+ if (!nstack_walk_init_check(p))
+ return old_htop;
+
+ ASSERT(p->hipe.nsp && p->hipe.nstend);
+ nsp = nstack_walk_nsp_begin(p);
+ nsp_end = nstack_walk_nsp_end(p);
+ sdesc = nstack_walk_init_sdesc_ignore_trap(p, &walk_state);
+
+ while (!nstack_walk_nsp_reached_end(nsp, nsp_end)) {
+ unsigned long ra;
+ unsigned sdesc_size = nstack_walk_frame_size(sdesc);
+ unsigned i = 0;
+ unsigned mask = sdesc->livebits[0];
+ for (;;) {
+ if (mask & 1) {
+ Eterm *nsp_i = nstack_walk_frame_index(nsp, i);
+ Eterm gval = *nsp_i;
+ if (is_boxed(gval)) {
+ Eterm *ptr = boxed_val(gval);
+ Eterm val = *ptr;
+ if (IS_MOVED_BOXED(val)) {
+ ASSERT(is_boxed(val));
+ *nsp_i = val;
+ } else if (ErtsInArea(ptr, area, area_size)) {
+ move_boxed(&ptr, val, &old_htop, nsp_i);
+ }
+ } else if (is_list(gval)) {
+ Eterm *ptr = list_val(gval);
+ Eterm val = *ptr;
+ if (IS_MOVED_CONS(val)) {
+ *nsp_i = ptr[1];
+ } else if (ErtsInArea(ptr, area, area_size)) {
+ move_cons(&ptr, val, &old_htop, nsp_i);
+ }
+ }
+ }
+ if (++i >= sdesc_size)
+ break;
+ if (i & 31)
+ mask >>= 1;
+ else
+ mask = sdesc->livebits[i >> 5];
+ }
+ ra = nstack_walk_frame_ra(nsp, sdesc);
+ if (ra == (unsigned long)nbif_stack_trap_ra)
+ ra = (unsigned long)p->hipe.ngra;
+ sdesc = hipe_find_sdesc(ra);
+ nsp = nstack_walk_next_frame(nsp, sdesc_size);
+ }
+ return old_htop;
+}
+
+int
+nstack_any_heap_ref_ptrs(Process *rp, char* mod_start, Uint mod_size)
+{
+ Eterm *nsp;
+ Eterm *nsp_end;
+ const struct hipe_sdesc *sdesc;
+ /* arch-specific nstack walk state */
+ struct nstack_walk_state walk_state;
+
+ ASSERT(!rp->hipe.gc_is_unsafe);
+
+ if (!rp->hipe.nstack || !nstack_walk_init_check(rp)) return 0;
+ ASSERT(rp->hipe.nsp && rp->hipe.nstend);
+ nsp = nstack_walk_nsp_begin(rp);
+ nsp_end = nstack_walk_nsp_end(rp);
+ sdesc = nstack_walk_init_sdesc_ignore_trap(rp, &walk_state);
+
+ while (!nstack_walk_nsp_reached_end(nsp, nsp_end)) {
+ unsigned long ra;
+ unsigned sdesc_size = nstack_walk_frame_size(sdesc);
+ unsigned i = 0;
+ unsigned mask = sdesc->livebits[0];
+ for (;;) {
+ if (mask & 1) {
+ Eterm *nsp_i = nstack_walk_frame_index(nsp, i);
+ Eterm val = *nsp_i;
+ switch (primary_tag(val)) {
+ case TAG_PRIMARY_BOXED:
+ case TAG_PRIMARY_LIST:
+ if (ErtsInArea(val, mod_start, mod_size)) {
+ return 1;
+ }
+ break;
+ }
+ }
+ if (++i >= sdesc_size)
+ break;
+ if (i & 31)
+ mask >>= 1;
+ else
+ mask = sdesc->livebits[i >> 5];
+ }
+ ra = nstack_walk_frame_ra(nsp, sdesc);
+ if (ra == (unsigned long)nbif_stack_trap_ra)
+ ra = (unsigned long)rp->hipe.ngra;
+ sdesc = hipe_find_sdesc(ra);
+ nsp = nstack_walk_next_frame(nsp, sdesc_size);
+ }
+ return 0;
+}
+
+int
+nstack_any_cps_in_segment(Process *p, char* seg_start, Uint seg_size)
+{
+ Eterm *nsp;
+ Eterm *nsp_end;
+ const struct hipe_sdesc *sdesc;
+ /* arch-specific nstack walk state */
+ struct nstack_walk_state walk_state;
+
+ if (!p->hipe.nstack || !nstack_walk_init_check(p))
+ return 0;
+ ASSERT(p->hipe.nsp && p->hipe.nstend);
+ nsp = nstack_walk_nsp_begin(p);
+ nsp_end = nstack_walk_nsp_end(p);
+ sdesc = nstack_walk_init_sdesc_ignore_trap(p, &walk_state);
+
+ /* Check the topmost frame */
+ if (ErtsInArea(sdesc->bucket.hvalue, seg_start, seg_size))
+ return 1;
+
+ while (!nstack_walk_nsp_reached_end(nsp, nsp_end)) {
+ unsigned sdesc_size = nstack_walk_frame_size(sdesc);
+ unsigned long ra = nstack_walk_frame_ra(nsp, sdesc);
+ if (ra == (unsigned long)nbif_stack_trap_ra)
+ ra = (unsigned long)p->hipe.ngra;
+ if (ErtsInArea(ra, seg_start, seg_size))
+ return 1;
+ sdesc = hipe_find_sdesc(ra);
+ nsp = nstack_walk_next_frame(nsp, sdesc_size);
+ }
+ return 0;
+}
diff --git a/erts/emulator/hipe/hipe_gc.h b/erts/emulator/hipe/hipe_gc.h
index 0d5614c9cf..5b5eb29175 100644
--- a/erts/emulator/hipe/hipe_gc.h
+++ b/erts/emulator/hipe/hipe_gc.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2004-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2004-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/hipe/hipe_load.c b/erts/emulator/hipe/hipe_load.c
new file mode 100644
index 0000000000..27d7bb9dee
--- /dev/null
+++ b/erts/emulator/hipe/hipe_load.c
@@ -0,0 +1,106 @@
+/*
+ * %CopyrightBegin%
+
+ *
+ * Copyright Ericsson AB 2016-2017. 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%
+ */
+/*
+ * hipe_load.c
+ *
+ * HiPE atomic code loader
+ */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include "sys.h"
+#include "global.h"
+#include "erl_binary.h"
+#include "hipe_load.h"
+#include "hipe_bif0.h"
+
+void hipe_free_loader_state(HipeLoaderState *stp)
+{
+ if (stp->module == NIL) return;
+
+ // TODO: Needs to be freed separately. We'd like have a unified executable
+ // code allocator, so postpone this for now.
+ /* if (stp->text_segment) */
+ /* erts_free(ERTS_ALC_T_HIPE, stp->text_segment); */
+ stp->text_segment = NULL;
+ stp->text_segment_size = 0;
+
+ if (stp->data_segment)
+ erts_free(ERTS_ALC_T_HIPE_LL, stp->data_segment);
+ stp->data_segment = NULL;
+ stp->data_segment_size = 0;
+
+ if (stp->new_hipe_refs) {
+ hipe_purge_refs(stp->new_hipe_refs, stp->module, 0);
+ stp->new_hipe_refs = NULL;
+ }
+ if (stp->new_hipe_sdesc) {
+ hipe_purge_sdescs(stp->new_hipe_sdesc, stp->module, 0);
+ stp->new_hipe_sdesc = NULL;
+ }
+
+ stp->module = NIL;
+}
+
+static int
+hipe_loader_state_dtor(Binary* magic)
+{
+ HipeLoaderState* stp = ERTS_MAGIC_BIN_DATA(magic);
+
+ ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(magic) == hipe_loader_state_dtor);
+
+ hipe_free_loader_state(stp);
+ return 1;
+}
+
+Binary *hipe_alloc_loader_state(Eterm module)
+{
+ HipeLoaderState *stp;
+ Binary *magic;
+
+ if (is_not_atom(module)) return NULL;
+
+ magic = erts_create_magic_binary(sizeof(HipeLoaderState),
+ hipe_loader_state_dtor);
+ erts_refc_inc(&magic->intern.refc, 1);
+ stp = ERTS_MAGIC_BIN_DATA(magic);
+
+ stp->module = module;
+ stp->text_segment = NULL;
+ stp->text_segment_size = 0;
+ stp->data_segment = NULL;
+ stp->data_segment_size = 0;
+
+ stp->new_hipe_refs = NULL;
+ stp->new_hipe_sdesc = NULL;
+
+ return magic;
+}
+
+HipeLoaderState *
+hipe_get_loader_state(Binary *magic)
+{
+ if (ERTS_MAGIC_BIN_DESTRUCTOR(magic) != hipe_loader_state_dtor)
+ return NULL;
+
+ return (HipeLoaderState*) ERTS_MAGIC_BIN_DATA(magic);
+}
diff --git a/erts/emulator/hipe/hipe_load.h b/erts/emulator/hipe/hipe_load.h
new file mode 100644
index 0000000000..40c8a8aa2a
--- /dev/null
+++ b/erts/emulator/hipe/hipe_load.h
@@ -0,0 +1,48 @@
+/*
+ * %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%
+ */
+/*
+ * hipe_load.h
+ *
+ * HiPE atomic code loader
+ */
+#ifndef HIPE_LOAD_H
+#define HIPE_LOAD_H
+
+#include "global.h"
+
+typedef struct hipe_loader_state {
+ Eterm module; /* Module name, atom */
+
+ void *text_segment;
+ Uint text_segment_size;
+
+ void *data_segment;
+ Uint data_segment_size;
+
+ struct hipe_ref* new_hipe_refs;
+ struct hipe_sdesc* new_hipe_sdesc;
+
+} HipeLoaderState;
+
+extern Binary *hipe_alloc_loader_state(Eterm module);
+extern void hipe_free_loader_state(HipeLoaderState*);
+extern HipeLoaderState *hipe_get_loader_state(Binary *binary);
+
+#endif /* HIPE_LOAD_H */
diff --git a/erts/emulator/hipe/hipe_mkliterals.c b/erts/emulator/hipe/hipe_mkliterals.c
index 0e287908b1..4573980e1e 100644
--- a/erts/emulator/hipe/hipe_mkliterals.c
+++ b/erts/emulator/hipe/hipe_mkliterals.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2012. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -268,9 +269,6 @@ static const struct literal {
/* freason codes */
{ "FREASON_TRAP", TRAP },
- /* special Erlang constants */
- { "THE_NON_VALUE", (int)THE_NON_VALUE },
-
/* funs */
#ifdef HIPE
{ "EFE_NATIVE_ADDRESS", offsetof(struct erl_fun_entry, native_address) },
@@ -437,9 +435,6 @@ static const struct rts_param rts_params[] = {
presence or absence of struct erl_fun_thing's "next" field. */
{ 5, "EFT_CREATOR", 1, offsetof(struct erl_fun_thing, creator) },
{ 6, "EFT_FE", 1, offsetof(struct erl_fun_thing, fe) },
-#ifdef HIPE
- { 7, "EFT_NATIVE_ADDRESS", 1, offsetof(struct erl_fun_thing, native_address) },
-#endif
{ 8, "EFT_ARITY", 1, offsetof(struct erl_fun_thing, arity) },
{ 9, "EFT_NUM_FREE", 1, offsetof(struct erl_fun_thing, num_free) },
{ 10, "EFT_ENV", 1, offsetof(struct erl_fun_thing, env[0]) },
@@ -498,8 +493,8 @@ static const struct rts_param rts_params[] = {
{ 38, "P_ARG4", 1, offsetof(struct process, def_arg_reg[4]) },
{ 39, "P_ARG5", 1, offsetof(struct process, def_arg_reg[5]) },
{ 40, "P_NSP", 1, offsetof(struct process, hipe.nsp) },
- { 41, "P_NCALLEE", 1, offsetof(struct process, hipe.ncallee) },
- { 42, "P_CLOSURE", 1, offsetof(struct process, hipe.closure) },
+ { 41, "P_NCALLEE", 1, offsetof(struct process, hipe.u.ncallee) },
+ { 42, "P_CLOSURE", 1, offsetof(struct process, hipe.u.closure) },
{ 43, "P_NSP_LIMIT", 1, offsetof(struct process, hipe.nstack) },
{ 44, "P_CSP",
#if defined(__i386__) || defined(__x86_64__)
@@ -524,6 +519,15 @@ static const struct rts_param rts_params[] = {
},
{ 49, "P_MSG_FIRST", 1, offsetof(struct process, msg.first) },
{ 50, "P_MSG_SAVE", 1, offsetof(struct process, msg.save) },
+ { 51, "P_CALLEE_EXP", 1, offsetof(struct process, hipe.u.callee_exp) },
+
+ { 52, "THE_NON_VALUE", 1, (int)THE_NON_VALUE },
+
+ { 53, "P_GCUNSAFE",
+#ifdef DEBUG
+ 1, offsetof(struct process, hipe.gc_is_unsafe)
+#endif
+ },
};
#define NR_PARAMS ARRAY_SIZE(rts_params)
@@ -541,6 +545,8 @@ static void compute_crc(void)
crc_value = crc_update_int(crc_value, &literals[i].value);
crc_value &= 0x07FFFFFF;
literals_crc = crc_value;
+
+ crc_value = crc_init();
for (i = 0; i < NR_PARAMS; ++i)
if (rts_params[i].is_defined)
crc_value = crc_update_int(crc_value, &rts_params[i].value);
@@ -626,6 +632,7 @@ static int do_c(FILE *fp, const char* this_exe)
print_params(fp, c_define_param);
fprintf(fp, "#define HIPE_LITERALS_CRC %uU\n", literals_crc);
fprintf(fp, "#define HIPE_SYSTEM_CRC %uU\n", system_crc);
+ fprintf(fp, "#define HIPE_ERTS_CHECKSUM (HIPE_LITERALS_CRC ^ HIPE_SYSTEM_CRC)\n");
fprintf(fp, "\n");
fprintf(fp, "#define RTS_PARAMS_CASES");
print_params(fp, c_case_param);
@@ -643,13 +650,14 @@ static int do_e(FILE *fp, const char* this_exe)
fprintf(fp, "\n");
print_params(fp, e_define_param);
fprintf(fp, "\n");
+ fprintf(fp, "-define(HIPE_LITERALS_CRC, %u).\n", literals_crc);
if (is_xcomp) {
fprintf(fp, "-define(HIPE_SYSTEM_CRC, %u).\n", system_crc);
}
else {
- fprintf(fp, "-define(HIPE_SYSTEM_CRC, hipe_bifs:system_crc(%u)).\n",
- literals_crc);
+ fprintf(fp, "-define(HIPE_SYSTEM_CRC, hipe_bifs:system_crc()).\n");
}
+ fprintf(fp, "-define(HIPE_ERTS_CHECKSUM, (?HIPE_LITERALS_CRC bxor ?HIPE_SYSTEM_CRC)).\n");
return 0;
}
diff --git a/erts/emulator/hipe/hipe_mode_switch.c b/erts/emulator/hipe/hipe_mode_switch.c
index 4ddc2790b1..ba7ae1e6a8 100644
--- a/erts/emulator/hipe/hipe_mode_switch.c
+++ b/erts/emulator/hipe/hipe_mode_switch.c
@@ -2,18 +2,19 @@
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -58,6 +59,7 @@
* TODO: check PCB consistency at native BIF calls
*/
int hipe_modeswitch_debug = 0;
+extern BeamInstr beam_exit[];
#define HIPE_DEBUG 0
@@ -107,7 +109,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) \
@@ -140,7 +142,6 @@ void hipe_check_pcb(Process *p, const char *file, unsigned line)
#endif /* HIPE_DEBUG > 0 */
/* ensure that at least nwords words are available on the native stack */
-static void hipe_check_nstack(Process *p, unsigned nwords);
#if defined(__sparc__)
#include "hipe_sparc_glue.h"
@@ -159,7 +160,7 @@ static void hipe_check_nstack(Process *p, unsigned nwords);
Uint hipe_beam_pc_return[1]; /* needed in hipe_debug.c */
Uint hipe_beam_pc_throw[1]; /* needed in hipe_debug.c */
Uint hipe_beam_pc_resume[1]; /* needed by hipe_set_timeout() */
-static Eterm hipe_beam_catch_throw;
+Eterm hipe_beam_catch_throw;
void hipe_mode_switch_init(void)
{
@@ -175,58 +176,42 @@ void hipe_mode_switch_init(void)
hipe_mfa_info_table_init();
}
-void hipe_set_call_trap(Uint *bfun, void *nfun, int is_closure)
+void hipe_set_call_trap(ErtsCodeInfo* ci, void *nfun, int is_closure)
{
- HIPE_ASSERT(bfun[-5] == BeamOpCode(op_i_func_info_IaaI));
+ BeamInstr* bfun = erts_codeinfo_to_code(ci);
+ HIPE_ASSERT(ci->op == BeamOpCode(op_i_func_info_IaaI));
bfun[0] =
is_closure
? BeamOpCode(op_hipe_trap_call_closure)
: BeamOpCode(op_hipe_trap_call);
- bfun[-4] = (Uint)nfun;
-}
-
-void hipe_reserve_beam_trap_frame(Process *p, Eterm reg[], unsigned arity)
-{
- /* ensure that at least 2 words are available on the BEAM stack */
- if ((p->stop - 2) < p->htop) {
- DPRINTF("calling gc to reserve BEAM stack size");
- p->fcalls -= erts_garbage_collect(p, 2, reg, arity);
- ASSERT(!((p->stop - 2) < p->htop));
- }
- p->stop -= 2;
- p->stop[0] = NIL;
- p->stop[1] = NIL;
+ ci->u.ncallee = (void (*)(void)) nfun;
}
static __inline__ void
hipe_push_beam_trap_frame(Process *p, Eterm reg[], unsigned arity)
{
- if (p->flags & F_DISABLE_GC) {
+ if (&p->stop[1] < p->hend && p->stop[1] == hipe_beam_catch_throw) {
/* Trap frame already reserved */
- ASSERT(p->stop[0] == NIL && p->stop[1] == NIL);
+ ASSERT(p->stop[0] == NIL);
}
else {
+ 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;
+ p->stop[1] = hipe_beam_catch_throw;
}
- p->stop[1] = hipe_beam_catch_throw;
p->stop[0] = make_cp(p->cp);
++p->catches;
p->cp = hipe_beam_pc_return;
}
-void hipe_unreserve_beam_trap_frame(Process *p)
-{
- ASSERT(p->stop[0] == NIL && p->stop[1] == NIL);
- p->stop += 2;
-}
-
static __inline__ void hipe_pop_beam_trap_frame(Process *p)
{
+ ASSERT(p->stop[1] == hipe_beam_catch_throw);
p->cp = cp_val(p->stop[0]);
--p->catches;
p->stop += 2;
@@ -235,15 +220,37 @@ static __inline__ void hipe_pop_beam_trap_frame(Process *p)
Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[])
{
unsigned result;
-#if NR_ARG_REGS > 5
- /* When NR_ARG_REGS > 5, we need to protect the process' input
- reduction count (which BEAM stores in def_arg_reg[5]) from
- being clobbered by the arch glue code. */
Eterm reds_in = p->def_arg_reg[5];
-#endif
-#if NR_ARG_REGS > 4
- Eterm o_reds = p->def_arg_reg[4];
-#endif
+ /*
+ * Process is in the normal case scheduled out when reduction
+ * count reach zero. When "save calls" is enabled reduction
+ * count is subtracted with CONTEXT_REDS, i.e. initial reduction
+ * count will be zero or less and process is scheduled out
+ * when -CONTEXT_REDS is reached.
+ *
+ * HiPE does not support the "save calls" feature, so we switch
+ * to using a positive reduction counter when executing in
+ * hipe mode, but need to restore the "save calls" when
+ * returning to beam. We also need to hide the save calls buffer
+ * from BIFs. We do that by moving the saved calls buf to
+ * suspended saved calls buf.
+ *
+ * Beam has initial reduction count in stored in p->def_arg_reg[5].
+ *
+ * Beam expects -neg_o_reds to be found in p->def_arg_reg[4]
+ * on return to beam.
+ */
+
+ {
+ struct saved_calls *scb = ERTS_PROC_SET_SAVED_CALLS_BUF(p, NULL);
+ if (scb) {
+ reds_in += CONTEXT_REDS;
+ p->fcalls += CONTEXT_REDS;
+ ERTS_PROC_SET_SUSPENDED_SAVED_CALLS_BUF(p, scb);
+ }
+ }
+
+ p->flags |= F_HIPE_MODE; /* inform bifs where we are comming from... */
p->i = NULL;
/* Set current_function to undefined. stdlib hibernate tests rely on it. */
@@ -257,14 +264,14 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[])
/* BEAM calls a native code function */
unsigned arity = cmd >> 8;
- /* p->hipe.ncallee set in beam_emu */
+ /* p->hipe.u.ncallee set in beam_emu */
if (p->cp == hipe_beam_pc_return) {
/* Native called BEAM, which now tailcalls native. */
hipe_pop_beam_trap_frame(p);
result = hipe_tailcall_to_native(p, arity, reg);
break;
}
- DPRINTF("calling %#lx/%u", (long)p->hipe.ncallee, arity);
+ DPRINTF("calling %#lx/%u", (long)p->hipe.u.ncallee, arity);
result = hipe_call_to_native(p, arity, reg);
break;
}
@@ -282,18 +289,18 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[])
arity -= funp->num_free; /* arity == #formals */
reg[arity] = fun;
++arity; /* correct for having added the closure */
- /* HIPE_ASSERT(p->hipe.ncallee == (void(*)(void))funp->native_address); */
+ /* HIPE_ASSERT(p->hipe.u.ncallee == (void(*)(void))funp->native_address); */
/* just like a normal call from now on */
- /* p->hipe.ncallee set in beam_emu */
+ /* p->hipe.u.ncallee set in beam_emu */
if (p->cp == hipe_beam_pc_return) {
/* Native called BEAM, which now tailcalls native. */
hipe_pop_beam_trap_frame(p);
result = hipe_tailcall_to_native(p, arity, reg);
break;
}
- DPRINTF("calling %#lx/%u", (long)p->hipe.ncallee, arity);
+ DPRINTF("calling %#lx/%u", (long)p->hipe.u.ncallee, arity);
result = hipe_call_to_native(p, arity, reg);
break;
}
@@ -333,7 +340,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));
@@ -396,13 +403,13 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[])
if (is_recursive)
hipe_push_beam_trap_frame(p, reg, p->arity);
- result = HIPE_MODE_SWITCH_RES_CALL;
+ result = HIPE_MODE_SWITCH_RES_CALL_BEAM;
break;
}
- case HIPE_MODE_SWITCH_RES_CALL: {
+ case HIPE_MODE_SWITCH_RES_CALL_EXPORTED: {
/* Native code calls or tailcalls BEAM.
*
- * p->i is the callee's BEAM code
+ * p->hipe.u.callee_exp is the callee's export entry
* p->arity is the callee's arity
* p->def_arg_reg[] contains the register parameters
* p->hipe.nsp[] contains the stacked parameters
@@ -422,15 +429,15 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[])
* F(A1, ..., AN, FV1, ..., FVM, Closure)
* (Where Ai is argument i and FVj is free variable j)
*
- * p->hipe.closure contains the closure
+ * p->hipe.u.closure contains the closure
* p->def_arg_reg[] contains the register parameters
* p->hipe.nsp[] contains the stacked parameters
*/
ErlFunThing *closure;
unsigned num_free, arity, i, is_recursive;
- HIPE_ASSERT(is_fun(p->hipe.closure));
- closure = (ErlFunThing*)fun_val(p->hipe.closure);
+ HIPE_ASSERT(is_fun(p->hipe.u.closure));
+ closure = (ErlFunThing*)fun_val(p->hipe.u.closure);
num_free = closure->num_free;
arity = closure->fe->arity;
@@ -460,10 +467,10 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[])
p->i = closure->fe->address;
/* Change result code to the faster plain CALL type. */
- result = HIPE_MODE_SWITCH_RES_CALL;
+ result = HIPE_MODE_SWITCH_RES_CALL_BEAM;
}
/* Append the closure as the last parameter. Don't increment arity. */
- reg[arity] = p->hipe.closure;
+ reg[arity] = p->hipe.u.closure;
if (is_recursive) {
/* BEAM called native, which now calls BEAM.
@@ -498,12 +505,25 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[])
erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_MSG_RECEIVE);
do_schedule:
{
-#if !(NR_ARG_REGS > 5)
- int reds_in = p->def_arg_reg[5];
+ struct saved_calls *scb;
+
+ scb = ERTS_PROC_SET_SUSPENDED_SAVED_CALLS_BUF(p, NULL);
+ if (scb)
+ ERTS_PROC_SET_SAVED_CALLS_BUF(p, scb);
+
+ /* The process may have died while it was executing,
+ if so we return out from native code to the interpreter */
+ if (erts_smp_atomic32_read_nob(&p->state) & ERTS_PSFLG_EXITING)
+ p->i = beam_exit;
+#ifdef DEBUG
+ ASSERT(p->debug_reds_in == reds_in);
#endif
+ p->flags &= ~F_HIPE_MODE;
+
ERTS_SMP_UNREQ_PROC_MAIN_LOCK(p);
- p = schedule(p, reds_in - p->fcalls);
+ p = erts_schedule(NULL, p, reds_in - p->fcalls);
ERTS_SMP_REQ_PROC_MAIN_LOCK(p);
+ ASSERT(!(p->flags & F_HIPE_MODE));
#ifdef ERTS_SMP
p->hipe_smp.have_receive_locks = 0;
reg = p->scheduler_data->x_reg_array;
@@ -518,30 +538,34 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[])
reg[i] = argp[i];
}
{
-#if !(NR_ARG_REGS > 5)
- Eterm reds_in;
-#endif
-#if !(NR_ARG_REGS > 4)
- Eterm o_reds;
-#endif
+ struct saved_calls *scb;
reds_in = p->fcalls;
- o_reds = 0;
- if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) {
- o_reds = reds_in;
- reds_in = 0;
- p->fcalls = 0;
- }
- p->def_arg_reg[4] = o_reds;
p->def_arg_reg[5] = reds_in;
+#ifdef DEBUG
+ p->debug_reds_in = reds_in;
+#endif
if (p->i == hipe_beam_pc_resume) {
+ p->flags |= F_HIPE_MODE; /* inform bifs where we are comming from... */
+ scb = ERTS_PROC_SET_SAVED_CALLS_BUF(p, NULL);
+ if (scb)
+ ERTS_PROC_SET_SUSPENDED_SAVED_CALLS_BUF(p, scb);
p->i = NULL;
p->arity = 0;
goto do_resume;
}
+
+ scb = ERTS_PROC_GET_SAVED_CALLS_BUF(p);
+ if (!scb)
+ p->def_arg_reg[4] = 0;
+ else {
+ p->def_arg_reg[4] = CONTEXT_REDS;
+ p->fcalls = -CONTEXT_REDS + reds_in;
+ }
}
+
HIPE_CHECK_PCB(p);
- result = HIPE_MODE_SWITCH_RES_CALL;
+ result = HIPE_MODE_SWITCH_RES_CALL_BEAM;
p->def_arg_reg[3] = result;
return p;
}
@@ -569,7 +593,7 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[])
address = hipe_get_remote_na(mfa[0], mfa[1], arity);
if (!address)
goto do_apply_fail;
- p->hipe.ncallee = (void(*)(void)) address;
+ p->hipe.u.ncallee = (void(*)(void)) address;
result = hipe_tailcall_to_native(p, arity, reg);
goto do_return_from_native;
do_apply_fail:
@@ -577,16 +601,31 @@ 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);
+ }
+
+ {
+ struct saved_calls *scb = ERTS_PROC_SET_SUSPENDED_SAVED_CALLS_BUF(p, NULL);
+ if (!scb)
+ p->def_arg_reg[4] = 0;
+ else {
+ p->def_arg_reg[4] = CONTEXT_REDS;
+ p->fcalls -= CONTEXT_REDS;
+ ERTS_PROC_SET_SAVED_CALLS_BUF(p, scb);
+ }
}
+
HIPE_CHECK_PCB(p);
p->def_arg_reg[3] = result;
-#if NR_ARG_REGS > 4
- p->def_arg_reg[4] = o_reds;
-#endif
#if NR_ARG_REGS > 5
+ /*
+ * When NR_ARG_REGS > 5, we need to protect the process' input
+ * reduction count (which BEAM stores in def_arg_reg[5]) from
+ * being clobbered by the arch glue code.
+ */
p->def_arg_reg[5] = reds_in;
#endif
+ p->flags &= ~F_HIPE_MODE;
return p;
}
@@ -599,7 +638,6 @@ static unsigned hipe_next_nstack_size(unsigned size)
}
#if 0 && defined(HIPE_NSTACK_GROWS_UP)
-#define hipe_nstack_avail(p) ((p)->hipe.nstend - (p)->hipe.nsp)
void hipe_inc_nstack(Process *p)
{
Eterm *old_nstack = p->hipe.nstack;
@@ -623,12 +661,11 @@ void hipe_inc_nstack(Process *p)
#endif
#if defined(HIPE_NSTACK_GROWS_DOWN)
-#define hipe_nstack_avail(p) ((unsigned)((p)->hipe.nsp - (p)->hipe.nstack))
void hipe_inc_nstack(Process *p)
{
unsigned old_size = p->hipe.nstend - p->hipe.nstack;
unsigned new_size = hipe_next_nstack_size(old_size);
- Eterm *new_nstack = erts_alloc(ERTS_ALC_T_HIPE, new_size*sizeof(Eterm));
+ Eterm *new_nstack = erts_alloc(ERTS_ALC_T_HIPE_STK, new_size*sizeof(Eterm));
unsigned used_size = p->hipe.nstend - p->hipe.nsp;
sys_memcpy(new_nstack+new_size-used_size, p->hipe.nsp, used_size*sizeof(Eterm));
@@ -637,7 +674,7 @@ void hipe_inc_nstack(Process *p)
if (p->hipe.nstblacklim)
p->hipe.nstblacklim = new_nstack + new_size - (p->hipe.nstend - p->hipe.nstblacklim);
if (p->hipe.nstack)
- erts_free(ERTS_ALC_T_HIPE, p->hipe.nstack);
+ erts_free(ERTS_ALC_T_HIPE_STK, p->hipe.nstack);
p->hipe.nstack = new_nstack;
p->hipe.nstend = new_nstack + new_size;
p->hipe.nsp = new_nstack + new_size - used_size;
@@ -647,7 +684,7 @@ void hipe_inc_nstack(Process *p)
void hipe_empty_nstack(Process *p)
{
if (p->hipe.nstack) {
- erts_free(ERTS_ALC_T_HIPE, p->hipe.nstack);
+ erts_free(ERTS_ALC_T_HIPE_STK, p->hipe.nstack);
}
p->hipe.nstgraylim = NULL;
p->hipe.nsp = NULL;
@@ -655,18 +692,9 @@ void hipe_empty_nstack(Process *p)
p->hipe.nstend = NULL;
}
-static void hipe_check_nstack(Process *p, unsigned nwords)
+void hipe_set_closure_stub(ErlFunEntry *fe)
{
- while (hipe_nstack_avail(p) < nwords)
- hipe_inc_nstack(p);
-}
-
-void hipe_set_closure_stub(ErlFunEntry *fe, unsigned num_free)
-{
- unsigned arity;
-
- arity = fe->arity;
- fe->native_address = (Eterm*) hipe_closure_stub_address(arity);
+ fe->native_address = (Eterm*) hipe_closure_stub_address(fe->arity);
}
Eterm hipe_build_stacktrace(Process *p, struct StackTrace *s)
diff --git a/erts/emulator/hipe/hipe_mode_switch.h b/erts/emulator/hipe/hipe_mode_switch.h
index 06721e3c04..3c042913f6 100644
--- a/erts/emulator/hipe/hipe_mode_switch.h
+++ b/erts/emulator/hipe/hipe_mode_switch.h
@@ -2,18 +2,19 @@
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -31,7 +32,7 @@
/* result codes for beam_emu <- hipe_mode_switch() return */
#define HIPE_MODE_SWITCH_RES_RETURN 4
-#define HIPE_MODE_SWITCH_RES_CALL 5
+#define HIPE_MODE_SWITCH_RES_CALL_EXPORTED 5
#define HIPE_MODE_SWITCH_RES_THROW 6
/* additional result codes for hipe_mode_switch() <- native return */
@@ -45,6 +46,8 @@
#define HIPE_MODE_SWITCH_RES_APPLY 13 /* mode_switch <- native */
+#define HIPE_MODE_SWITCH_RES_CALL_BEAM 14
+
#ifndef ASM
#include "error.h"
@@ -52,20 +55,65 @@
extern int hipe_modeswitch_debug;
void hipe_mode_switch_init(void);
-void hipe_set_call_trap(Uint *bfun, void *nfun, int is_closure);
+void hipe_set_call_trap(ErtsCodeInfo*, void *nfun, int is_closure);
Process *hipe_mode_switch(Process*, unsigned, Eterm*);
void hipe_inc_nstack(Process *p);
void hipe_empty_nstack(Process *p);
-void hipe_set_closure_stub(ErlFunEntry *fe, unsigned num_free);
+void hipe_set_closure_stub(ErlFunEntry *fe);
Eterm hipe_build_stacktrace(Process *p, struct StackTrace *s);
-void hipe_reserve_beam_trap_frame(Process*, Eterm reg[], unsigned arity);
-void hipe_unreserve_beam_trap_frame(Process*);
+ERTS_GLB_INLINE void hipe_reserve_beam_trap_frame(Process*, Eterm reg[], unsigned arity);
+ERTS_GLB_INLINE void hipe_unreserve_beam_trap_frame(Process*);
extern Uint hipe_beam_pc_return[];
extern Uint hipe_beam_pc_throw[];
extern Uint hipe_beam_pc_resume[];
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+#include "erl_gc.h"
+#include "hipe_stack.h"
+
+#if defined(__sparc__)
+#include "hipe_sparc_glue.h"
+#elif defined(__i386__)
+#include "hipe_x86_glue.h"
+#elif defined(__x86_64__)
+#include "hipe_amd64_glue.h"
+#elif defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__)
+#include "hipe_ppc_glue.h"
+#elif defined(__arm__)
+#include "hipe_arm_glue.h"
+#endif
+
+extern Eterm hipe_beam_catch_throw;
+
+ERTS_GLB_INLINE void hipe_reserve_beam_trap_frame(Process *p, Eterm reg[], unsigned arity)
+{
+ if (!hipe_bifcall_from_native_is_recursive(p))
+ return;
+
+ /* ensure that at least 2 words are available on the BEAM stack */
+ if ((p->stop - 2) < p->htop) {
+ erts_garbage_collect(p, 2, reg, arity);
+ ASSERT(!((p->stop - 2) < p->htop));
+ }
+ p->stop -= 2;
+ p->stop[0] = NIL;
+ p->stop[1] = hipe_beam_catch_throw;
+}
+
+ERTS_GLB_INLINE void hipe_unreserve_beam_trap_frame(Process *p)
+{
+ if (!hipe_bifcall_from_native_is_recursive(p))
+ return;
+
+ ASSERT(p->stop[0] == NIL && p->stop[1] == hipe_beam_catch_throw);
+ p->stop += 2;
+}
+
+#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
+
#endif /* ASM */
#endif /* HIPE_MODE_SWITCH_H */
diff --git a/erts/emulator/hipe/hipe_module.c b/erts/emulator/hipe/hipe_module.c
new file mode 100644
index 0000000000..45d47272ed
--- /dev/null
+++ b/erts/emulator/hipe/hipe_module.c
@@ -0,0 +1,35 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2016-2017. 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 "hipe_arch.h"
+#include "hipe_module.h"
+
+void hipe_free_module(HipeModule *mod)
+{
+ hipe_free_code(mod->text_segment, mod->text_segment_size);
+ if (mod->data_segment) /* Some modules lack data segments */
+ erts_free(ERTS_ALC_T_HIPE_LL, mod->data_segment);
+
+ erts_free(ERTS_ALC_T_HIPE_LL, mod);
+}
diff --git a/erts/emulator/hipe/hipe_module.h b/erts/emulator/hipe/hipe_module.h
new file mode 100644
index 0000000000..b489f567cb
--- /dev/null
+++ b/erts/emulator/hipe/hipe_module.h
@@ -0,0 +1,45 @@
+/*
+ * %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%
+ */
+/*
+ * hipe_module.h
+ *
+ *
+ */
+#ifndef HIPE_MODULE_H
+#define HIPE_MODULE_H
+
+/* Forward-declare type to resolve circular dependency with module.h */
+typedef struct hipe_module HipeModule;
+
+#include "global.h"
+
+struct hipe_module {
+ void *text_segment;
+ Uint text_segment_size;
+ void *data_segment;
+
+ struct hipe_ref* first_hipe_ref; /* all external hipe calls from this module */
+ struct hipe_sdesc* first_hipe_sdesc; /* all stack descriptors for this module */
+};
+
+extern void hipe_free_module(HipeModule *mod);
+
+#endif /* HIPE_MODULE_H */
diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c
index 7d343dd91e..e1c22701d0 100644
--- a/erts/emulator/hipe/hipe_native_bif.c
+++ b/erts/emulator/hipe/hipe_native_bif.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -41,8 +42,8 @@
*/
/* for -Wmissing-prototypes :-( */
-extern Eterm hipe_erts_internal_check_process_code_2(BIF_ALIST_2);
-extern Eterm hipe_show_nstack_1(BIF_ALIST_1);
+extern Eterm nbif_impl_hipe_erts_internal_check_process_code_1(NBIF_ALIST_1);
+extern Eterm nbif_impl_hipe_show_nstack_1(NBIF_ALIST_1);
/* Used when a BIF can trigger a stack walk. */
static __inline__ void hipe_set_narity(Process *p, unsigned int arity)
@@ -50,22 +51,24 @@ static __inline__ void hipe_set_narity(Process *p, unsigned int arity)
p->hipe.narity = arity;
}
-Eterm hipe_erts_internal_check_process_code_2(BIF_ALIST_2)
+/* Called via standard_bif_interface_2 */
+Eterm nbif_impl_hipe_erts_internal_check_process_code_1(NBIF_ALIST_1)
{
Eterm ret;
- hipe_set_narity(BIF_P, 2);
- ret = erts_internal_check_process_code_2(BIF_P, BIF__ARGS);
+ hipe_set_narity(BIF_P, 1);
+ ret = nbif_impl_erts_internal_check_process_code_1(NBIF_CALL_ARGS);
hipe_set_narity(BIF_P, 0);
return ret;
}
-Eterm hipe_show_nstack_1(BIF_ALIST_1)
+/* Called via standard_bif_interface_1 */
+Eterm nbif_impl_hipe_show_nstack_1(NBIF_ALIST_1)
{
Eterm ret;
hipe_set_narity(BIF_P, 1);
- ret = hipe_bifs_show_nstack_1(BIF_P, BIF__ARGS);
+ ret = nbif_impl_hipe_bifs_show_nstack_1(NBIF_CALL_ARGS);
hipe_set_narity(BIF_P, 0);
return ret;
}
@@ -79,7 +82,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);
}
@@ -88,13 +91,10 @@ void hipe_gc(Process *p, Eterm need)
* has begun.
* XXX: BUG: native code should check return status
*/
-BIF_RETTYPE hipe_set_timeout(BIF_ALIST_1)
+BIF_RETTYPE nbif_impl_hipe_set_timeout(NBIF_ALIST_1)
{
Process* p = BIF_P;
Eterm timeout_value = BIF_ARG_1;
-#if !defined(ARCH_64)
- Uint time_val;
-#endif
/* XXX: This should be converted to follow BEAM conventions,
* but that requires some compiler changes.
*
@@ -102,7 +102,8 @@ BIF_RETTYPE hipe_set_timeout(BIF_ALIST_1)
* p->def_arg_reg[0] and p->i are both defined and used.
* If a message arrives, BEAM resumes at p->i.
* If a timeout fires, BEAM resumes at p->def_arg_reg[0].
- * (See set_timer() and timeout_proc() in erl_process.c.)
+ * (See erts_set_proc_timer() and proc_timeout_common() in
+ * erl_hl_timer.c.)
*
* Here we set p->def_arg_reg[0] to hipe_beam_pc_resume.
* Assuming our caller invokes suspend immediately after
@@ -135,28 +136,21 @@ BIF_RETTYPE hipe_set_timeout(BIF_ALIST_1)
*/
if (p->flags & (F_INSLPQUEUE | F_TIMO))
return NIL; /* caller had better call nbif_suspend ASAP! */
- if (is_small(timeout_value) && signed_val(timeout_value) >= 0 &&
-#if defined(ARCH_64)
- (unsigned_val(timeout_value) >> 32) == 0
-#else
- 1
-#endif
- ) {
- set_timer(p, unsigned_val(timeout_value));
- } else if (timeout_value == am_infinity) {
+
+ if (timeout_value == am_infinity) {
/* p->flags |= F_TIMO; */ /* XXX: nbif_suspend_msg_timeout */
-#if !defined(ARCH_64)
- } else if (term_to_Uint(timeout_value, &time_val)) {
- set_timer(p, time_val);
-#endif
- } else {
+ }
+ else {
+ int tres = erts_set_proc_timer_term(p, timeout_value);
+ if (tres != 0) { /* Wrong time */
#ifdef ERTS_SMP
- if (p->hipe_smp.have_receive_locks) {
- p->hipe_smp.have_receive_locks = 0;
- erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_MSG_RECEIVE);
- }
+ if (p->hipe_smp.have_receive_locks) {
+ p->hipe_smp.have_receive_locks = 0;
+ erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_MSG_RECEIVE);
+ }
#endif
- BIF_ERROR(p, EXC_TIMEOUT_VALUE);
+ BIF_ERROR(p, EXC_TIMEOUT_VALUE);
+ }
}
return NIL; /* caller had better call nbif_suspend ASAP! */
}
@@ -165,13 +159,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 erl_cancel_timer() */
- free_message(msgp);
+ CANCEL_TIMER(p); /* calls erts_cancel_proc_timer() */
+ 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)
@@ -179,7 +182,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
}
@@ -225,11 +228,6 @@ void hipe_handle_exception(Process *c_p)
ASSERT(c_p->freason != TRAP); /* Should have been handled earlier. */
- if (c_p->mbuf) {
- erts_printf("%s line %u: p==%p, p->mbuf==%p\n", __FUNCTION__, __LINE__, c_p, c_p->mbuf);
- /* erts_garbage_collect(c_p, 0, NULL, 0); */
- }
-
/*
* Check if we have an arglist for the top level call. If so, this
* is encoded in Value, so we have to dig out the real Value as well
@@ -258,11 +256,6 @@ void hipe_handle_exception(Process *c_p)
/* Synthesized to avoid having to generate code for it. */
c_p->def_arg_reg[0] = exception_tag[GET_EXC_CLASS(c_p->freason)];
- if (c_p->mbuf) {
- /* erts_printf("%s line %u: p==%p, p->mbuf==%p, p->lastbif==%p\n", __FUNCTION__, __LINE__, c_p, c_p->mbuf, c_p->hipe.lastbif); */
- erts_garbage_collect(c_p, 0, NULL, 0);
- }
-
hipe_find_handler(c_p);
}
@@ -279,10 +272,10 @@ static struct StackTrace *get_trace_from_exc(Eterm exc)
* This does what the (misnamed) Beam instruction 'raise_ss' does,
* namely, a proper re-throw of an exception that was caught by 'try'.
*/
-
-BIF_RETTYPE hipe_rethrow(BIF_ALIST_2)
+/* Called via standard_bif_interface_2 */
+BIF_RETTYPE nbif_impl_hipe_rethrow(NBIF_ALIST_2)
{
- Process* c_p = BIF_P;
+ Process *c_p = BIF_P;
Eterm exc = BIF_ARG_1;
Eterm value = BIF_ARG_2;
@@ -330,9 +323,6 @@ char *hipe_bs_allocate(int len)
Binary *bptr;
bptr = erts_bin_nrml_alloc(len);
- bptr->flags = 0;
- bptr->orig_size = len;
- erts_smp_atomic_init_nob(&bptr->refc, 1);
return bptr->orig_bytes;
}
@@ -341,7 +331,6 @@ Binary *hipe_bs_reallocate(Binary* oldbptr, int newsize)
Binary *bptr;
bptr = erts_bin_realloc(oldbptr, newsize);
- bptr->orig_size = newsize;
return bptr;
}
@@ -409,7 +398,7 @@ Eterm hipe_bs_utf8_size(Eterm arg)
return make_small(4);
}
-BIF_RETTYPE hipe_bs_put_utf8(BIF_ALIST_3)
+BIF_RETTYPE nbif_impl_hipe_bs_put_utf8(NBIF_ALIST_3)
{
Process* p = BIF_P;
Eterm arg = BIF_ARG_1;
@@ -470,7 +459,7 @@ Eterm hipe_bs_put_utf16(Process *p, Eterm arg, byte *base, unsigned int offset,
return new_offset;
}
-BIF_RETTYPE hipe_bs_put_utf16be(BIF_ALIST_3)
+BIF_RETTYPE nbif_impl_hipe_bs_put_utf16be(NBIF_ALIST_3)
{
Process *p = BIF_P;
Eterm arg = BIF_ARG_1;
@@ -479,7 +468,7 @@ BIF_RETTYPE hipe_bs_put_utf16be(BIF_ALIST_3)
return hipe_bs_put_utf16(p, arg, base, offset, 0);
}
-BIF_RETTYPE hipe_bs_put_utf16le(BIF_ALIST_3)
+BIF_RETTYPE nbif_impl_hipe_bs_put_utf16le(NBIF_ALIST_3)
{
Process *p = BIF_P;
Eterm arg = BIF_ARG_1;
@@ -497,7 +486,7 @@ static int validate_unicode(Eterm arg)
return 1;
}
-BIF_RETTYPE hipe_bs_validate_unicode(BIF_ALIST_1)
+BIF_RETTYPE nbif_impl_hipe_bs_validate_unicode(NBIF_ALIST_1)
{
Process *p = BIF_P;
Eterm arg = BIF_ARG_1;
@@ -506,6 +495,12 @@ BIF_RETTYPE hipe_bs_validate_unicode(BIF_ALIST_1)
return NIL;
}
+Uint hipe_is_unicode(Eterm arg)
+{
+ return (Uint) validate_unicode(arg);
+}
+
+
int hipe_bs_validate_unicode_retract(ErlBinMatchBuffer* mb, Eterm arg)
{
if (!validate_unicode(arg)) {
@@ -515,12 +510,26 @@ int hipe_bs_validate_unicode_retract(ErlBinMatchBuffer* mb, Eterm arg)
return 1;
}
+/* Called via standard_bif_interface_2 */
+BIF_RETTYPE nbif_impl_hipe_is_divisible(NBIF_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:
@@ -542,25 +551,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);
}
/*
@@ -586,7 +599,7 @@ void hipe_clear_timeout(Process *c_p)
}
#endif
if (IS_TRACED_FL(c_p, F_TRACE_RECEIVE)) {
- trace_receive(c_p, am_timeout);
+ trace_receive(c_p, am_clock_service, am_timeout, NULL);
}
c_p->flags &= ~F_TIMO;
JOIN_MESSAGE(c_p);
diff --git a/erts/emulator/hipe/hipe_native_bif.h b/erts/emulator/hipe/hipe_native_bif.h
index 3f460a5a5c..1127d4ac56 100644
--- a/erts/emulator/hipe/hipe_native_bif.h
+++ b/erts/emulator/hipe/hipe_native_bif.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -66,38 +67,45 @@ AEXTERN(Eterm,nbif_bs_put_utf16be,(Process*,Eterm,byte*,unsigned int));
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(Uint,nbif_is_unicode,(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));
AEXTERN(Eterm,nbif_eq_2,(void));
-BIF_RETTYPE hipe_nonclosure_address(BIF_ALIST_2);
-BIF_RETTYPE hipe_conv_big_to_float(BIF_ALIST_1);
+BIF_RETTYPE nbif_impl_hipe_nonclosure_address(NBIF_ALIST_2);
+BIF_RETTYPE nbif_impl_hipe_conv_big_to_float(NBIF_ALIST_1);
void hipe_fclearerror_error(Process*);
void hipe_select_msg(Process*);
void hipe_gc(Process*, Eterm);
-BIF_RETTYPE hipe_set_timeout(BIF_ALIST_1);
+BIF_RETTYPE nbif_impl_hipe_set_timeout(NBIF_ALIST_1);
void hipe_handle_exception(Process*);
-BIF_RETTYPE hipe_rethrow(BIF_ALIST_2);
+BIF_RETTYPE nbif_impl_hipe_rethrow(NBIF_ALIST_2);
char *hipe_bs_allocate(int);
Binary *hipe_bs_reallocate(Binary*, int);
int hipe_bs_put_small_float(Process*, Eterm, Uint, byte*, unsigned, unsigned);
void hipe_bs_put_bits(Eterm, Uint, byte*, unsigned, unsigned);
Eterm hipe_bs_utf8_size(Eterm);
-BIF_RETTYPE hipe_bs_put_utf8(BIF_ALIST_3);
+BIF_RETTYPE nbif_impl_hipe_bs_put_utf8(NBIF_ALIST_3);
Eterm hipe_bs_utf16_size(Eterm);
-BIF_RETTYPE hipe_bs_put_utf16be(BIF_ALIST_3);
-BIF_RETTYPE hipe_bs_put_utf16le(BIF_ALIST_3);
-BIF_RETTYPE hipe_bs_validate_unicode(BIF_ALIST_1);
+BIF_RETTYPE nbif_impl_hipe_bs_put_utf16be(NBIF_ALIST_3);
+BIF_RETTYPE nbif_impl_hipe_bs_put_utf16le(NBIF_ALIST_3);
+BIF_RETTYPE nbif_impl_hipe_bs_validate_unicode(NBIF_ALIST_1);
+Uint hipe_is_unicode(Eterm);
struct erl_bin_match_buffer;
int hipe_bs_validate_unicode_retract(struct erl_bin_match_buffer*, Eterm);
+BIF_RETTYPE nbif_impl_hipe_is_divisible(NBIF_ALIST_2);
#ifdef NO_FPE_SIGNALS
AEXTERN(void,nbif_emulate_fpe,(Process*));
void hipe_emulate_fpe(Process*);
#endif
+AEXTERN(void,nbif_emasculate_binary,(Eterm));
+void hipe_emasculate_binary(Eterm);
+
/*
* Stuff that is different in SMP and non-SMP.
*/
@@ -123,7 +131,7 @@ void hipe_atomic_inc(int*);
void hipe_clear_timeout(Process*);
#endif
-#define BIF_LIST(M,F,A,C,I) AEXTERN(Eterm,nbif_##C,(void));
+#define BIF_LIST(M,F,A,B,C,I) AEXTERN(Eterm,nbif_##C,(void));
#include "erl_bif_list.h"
#undef BIF_LIST
diff --git a/erts/emulator/hipe/hipe_ops.tab b/erts/emulator/hipe/hipe_ops.tab
index 50c3a4ae2f..96e4c0da91 100644
--- a/erts/emulator/hipe/hipe_ops.tab
+++ b/erts/emulator/hipe/hipe_ops.tab
@@ -1,18 +1,19 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2001-2011. All Rights Reserved.
+# Copyright Ericsson AB 2001-2016. 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/.
+# 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
#
-# 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.
+# 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%
#
diff --git a/erts/emulator/hipe/hipe_perfctr.c b/erts/emulator/hipe/hipe_perfctr.c
deleted file mode 100644
index 371b3fb097..0000000000
--- a/erts/emulator/hipe/hipe_perfctr.c
+++ /dev/null
@@ -1,229 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2004-2011. 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%
- */
-
-
-#ifdef HAVE_CONFIG_H
-#include "config.h"
-#endif
-#include "sys.h"
-#include "error.h"
-#include "global.h"
-#include "bif.h"
-#include "big.h"
-#include "erl_binary.h"
-#include "hipe_perfctr.h"
-#include "libperfctr.h"
-
-static struct vperfctr *vperfctr;
-static unsigned int have_rdtsc;
-static double tsc_to_ms;
-static unsigned int tsc_on; /* control calls must set tsc_on if have_rdtsc is true */
-static unsigned int nractrs;
-static unsigned int users;
-#define USER_BIFS (1<<0)
-#define USER_HRVTIME (1<<1)
-
-static int hipe_perfctr_open(unsigned int user)
-{
- struct perfctr_info info;
-
- if (!vperfctr) {
- vperfctr = vperfctr_open();
- if (!vperfctr)
- return -1;
- if (vperfctr_info(vperfctr, &info) >= 0) {
- tsc_to_ms = (double)(info.tsc_to_cpu_mult ? : 1) / (double)info.cpu_khz;
- have_rdtsc = (info.cpu_features & PERFCTR_FEATURE_RDTSC) ? 1 : 0;
- }
- tsc_on = 0;
- nractrs = 0;
- }
- users |= user;
- return 0;
-}
-
-static void hipe_perfctr_reset(void)
-{
- struct vperfctr_control control;
-
- memset(&control, 0, sizeof control);
- if (have_rdtsc)
- control.cpu_control.tsc_on = 1;
- nractrs = 0;
- if (vperfctr_control(vperfctr, &control) >= 0)
- tsc_on = 1;
-}
-
-static void hipe_perfctr_close(unsigned int user)
-{
- if (!vperfctr)
- return;
- users &= ~user;
- switch (users) {
- case 0:
- vperfctr_unlink(vperfctr);
- vperfctr_close(vperfctr);
- vperfctr = NULL;
- tsc_on = 0;
- nractrs = 0;
- break;
- case USER_HRVTIME:
- hipe_perfctr_reset();
- }
-}
-
-/*
- * Interface for HiPE's hrvtime code.
- */
-
-int hipe_perfctr_hrvtime_open(void)
-{
- if (hipe_perfctr_open(USER_HRVTIME) < 0)
- return -1;
- if (have_rdtsc) {
- if (!tsc_on)
- hipe_perfctr_reset(); /* note: updates tsc_on */
- if (tsc_on)
- return 0;
- }
- hipe_perfctr_hrvtime_close();
- return -1;
-}
-
-void hipe_perfctr_hrvtime_close(void)
-{
- hipe_perfctr_close(USER_HRVTIME);
-}
-
-double hipe_perfctr_hrvtime_get(void)
-{
- return (double)vperfctr_read_tsc(vperfctr) * tsc_to_ms;
-}
-
-/*
- * BIF interface for user-programmable performance counters.
- */
-
-BIF_RETTYPE hipe_bifs_vperfctr_open_0(BIF_ALIST_0)
-{
- if (hipe_perfctr_open(USER_BIFS) < 0)
- BIF_RET(am_false); /* arity 0 BIFs can't fail :-( */
- BIF_RET(am_true);
-}
-
-BIF_RETTYPE hipe_bifs_vperfctr_close_0(BIF_ALIST_0)
-{
- hipe_perfctr_close(USER_BIFS);
- BIF_RET(NIL);
-}
-
-static Eterm ull_to_integer(unsigned long long x, Process *p)
-{
- unsigned long long tmpx;
- unsigned int ds, i;
- size_t sz;
- Eterm *hp;
- ErtsDigit *xp;
-
- if (x <= (unsigned long long)MAX_SMALL)
- return make_small(x);
-
- /* Calculate number of digits. */
- ds = 0;
- tmpx = x;
- do {
- ++ds;
- tmpx = (tmpx >> (D_EXP / 2)) >> (D_EXP / 2);
- } while (tmpx != 0);
-
- sz = BIG_NEED_SIZE(ds); /* number of words including arity */
- hp = HAlloc(p, sz);
- *hp = make_pos_bignum_header(sz-1);
-
- xp = (ErtsDigit*)(hp+1);
- i = 0;
- do {
- xp[i++] = (ErtsDigit)x;
- x = (x >> (D_EXP / 2)) >> (D_EXP / 2);
- } while (i < ds);
- while (i & (BIG_DIGITS_PER_WORD-1))
- xp[i++] = 0;
-
- return make_big(hp);
-}
-
-BIF_RETTYPE hipe_bifs_vperfctr_info_0(BIF_ALIST_0)
-{
- struct perfctr_info info;
-
- if (!vperfctr || vperfctr_info(vperfctr, &info) < 0)
- BIF_RET(am_false); /* arity 0 BIFs can't fail :-( */
- BIF_RET(new_binary(BIF_P, (void*)&info, sizeof info));
-}
-
-BIF_RETTYPE hipe_bifs_vperfctr_read_tsc_0(BIF_ALIST_0)
-{
- unsigned long long val;
-
- if (!vperfctr || !tsc_on)
- BIF_RET(am_false); /* arity 0 BIFs can't fail :-( */
- val = vperfctr_read_tsc(vperfctr);
- BIF_RET(ull_to_integer(val, BIF_P));
-}
-
-BIF_RETTYPE hipe_bifs_vperfctr_read_pmc_1(BIF_ALIST_1)
-{
- Uint pmc;
- unsigned long long val;
-
- if (!vperfctr ||
- is_not_small(BIF_ARG_1) ||
- (pmc = unsigned_val(BIF_ARG_1), pmc >= nractrs))
- BIF_RET(am_false); /* for consistency with the arity 0 BIFs */
- val = vperfctr_read_pmc(vperfctr, pmc);
- BIF_RET(ull_to_integer(val, BIF_P));
-}
-
-BIF_RETTYPE hipe_bifs_vperfctr_control_1(BIF_ALIST_1)
-{
- void *bytes;
- struct vperfctr_control control;
- Uint bitoffs;
- Uint bitsize;
-
- if (!vperfctr)
- BIF_ERROR(BIF_P, BADARG);
- if (is_not_binary(BIF_ARG_1))
- BIF_ERROR(BIF_P, BADARG);
- if (binary_size(BIF_ARG_1) != sizeof control)
- BIF_ERROR(BIF_P, BADARG);
- ERTS_GET_BINARY_BYTES(BIF_ARG_1, bytes, bitoffs, bitsize);
- ASSERT(bitoffs == 0);
- ASSERT(bitsize == 0);
- memcpy(&control, bytes, sizeof control);
- if (have_rdtsc)
- control.cpu_control.tsc_on = 1;
- if (vperfctr_control(vperfctr, &control) < 0) {
- hipe_perfctr_reset();
- BIF_ERROR(BIF_P, BADARG);
- }
- tsc_on = control.cpu_control.tsc_on;
- nractrs = control.cpu_control.nractrs;
- BIF_RET(NIL);
-}
diff --git a/erts/emulator/hipe/hipe_perfctr.tab b/erts/emulator/hipe/hipe_perfctr.tab
deleted file mode 100644
index eaecea4651..0000000000
--- a/erts/emulator/hipe/hipe_perfctr.tab
+++ /dev/null
@@ -1,25 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 2004-2011. 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%
-#
-
-bif hipe_bifs:vperfctr_open/0
-bif hipe_bifs:vperfctr_close/0
-bif hipe_bifs:vperfctr_info/0
-bif hipe_bifs:vperfctr_read_tsc/0
-bif hipe_bifs:vperfctr_read_pmc/1
-bif hipe_bifs:vperfctr_control/1
diff --git a/erts/emulator/hipe/hipe_ppc.c b/erts/emulator/hipe/hipe_ppc.c
index 2d8fd61e1e..4413748936 100644
--- a/erts/emulator/hipe/hipe_ppc.c
+++ b/erts/emulator/hipe/hipe_ppc.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2004-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2004-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -24,7 +25,6 @@
#endif
#include "global.h"
#include "erl_binary.h"
-#include <sys/mman.h>
#include "hipe_arch.h"
#include "hipe_native_bif.h" /* nbif_callemu() */
@@ -67,34 +67,6 @@ void hipe_flush_icache_range(void *address, unsigned int nbytes)
asm volatile("sync\n\tisync");
}
-/*
- * Management of 32MB code segments for regular code and trampolines.
- */
-
-#define SEGMENT_NRBYTES (32*1024*1024) /* named constant, _not_ a tunable */
-
-static struct segment {
- unsigned int *base; /* [base,base+32MB[ */
- unsigned int *code_pos; /* INV: base <= code_pos <= tramp_pos */
- unsigned int *tramp_pos; /* INV: tramp_pos <= base+32MB */
-} curseg;
-
-#define in_area(ptr,start,nbytes) \
- ((UWord)((char*)(ptr) - (char*)(start)) < (nbytes))
-
-/* Darwin breakage */
-#if !defined(MAP_ANONYMOUS) && defined(MAP_ANON)
-#define MAP_ANONYMOUS MAP_ANON
-#endif
-
-static void *new_code_mapping(void)
-{
- return mmap(0, SEGMENT_NRBYTES,
- PROT_EXEC|PROT_READ|PROT_WRITE,
- MAP_PRIVATE|MAP_ANONYMOUS,
- -1, 0);
-}
-
static int check_callees(Eterm callees)
{
Eterm *tuple;
@@ -118,126 +90,71 @@ static int check_callees(Eterm callees)
return arity;
}
-static unsigned int *try_alloc(Uint nrwords, int nrcallees, Eterm callees, unsigned int **trampvec)
+
+static void generate_trampolines(Uint32* address,
+ int nrcallees, Eterm callees,
+ Uint32** trampvec)
{
- unsigned int *base, *address, *tramp_pos, nrfreewords;
- int trampnr;
+ Uint32* trampoline = address;
+ int i;
- tramp_pos = curseg.tramp_pos;
- address = curseg.code_pos;
- nrfreewords = tramp_pos - address;
- if (nrwords > nrfreewords)
- return NULL;
- curseg.code_pos = address + nrwords;
- nrfreewords -= nrwords;
-
- base = curseg.base;
- for (trampnr = 1; trampnr <= nrcallees; ++trampnr) {
- Eterm mfa = tuple_val(callees)[trampnr];
- Eterm m = tuple_val(mfa)[1];
- Eterm f = tuple_val(mfa)[2];
- unsigned int a = unsigned_val(tuple_val(mfa)[3]);
- unsigned int *trampoline = hipe_mfa_get_trampoline(m, f, a);
- if (!in_area(trampoline, base, SEGMENT_NRBYTES)) {
+ for (i = 0; i < nrcallees; ++i) {
#if defined(__powerpc64__)
- if (nrfreewords < 7)
- return NULL;
- nrfreewords -= 7;
- tramp_pos = trampoline = tramp_pos - 7;
- trampoline[0] = 0x3D600000; /* addis r11,r0,0 */
- trampoline[1] = 0x616B0000; /* ori r11,r11,0 */
- trampoline[2] = 0x796B07C6; /* rldicr r11,r11,32,31 */
- trampoline[3] = 0x656B0000; /* oris r11,r11,0 */
- trampoline[4] = 0x616B0000; /* ori r11,r11,0 */
- trampoline[5] = 0x7D6903A6; /* mtctr r11 */
- trampoline[6] = 0x4E800420; /* bctr */
- hipe_flush_icache_range(trampoline, 7*sizeof(int));
+# define TRAMPOLINE_WORDS 7
+ trampoline[0] = 0x3D600000; /* addis r11,r0,0 */
+ trampoline[1] = 0x616B0000; /* ori r11,r11,0 */
+ trampoline[2] = 0x796B07C6; /* rldicr r11,r11,32,31 */
+ trampoline[3] = 0x656B0000; /* oris r11,r11,0 */
+ trampoline[4] = 0x616B0000; /* ori r11,r11,0 */
+ trampoline[5] = 0x7D6903A6; /* mtctr r11 */
+ trampoline[6] = 0x4E800420; /* bctr */
#else
- if (nrfreewords < 4)
- return NULL;
- nrfreewords -= 4;
- tramp_pos = trampoline = tramp_pos - 4;
- trampoline[0] = 0x39600000; /* addi r11,r0,0 */
- trampoline[1] = 0x3D6B0000; /* addis r11,r11,0 */
- trampoline[2] = 0x7D6903A6; /* mtctr r11 */
- trampoline[3] = 0x4E800420; /* bctr */
- hipe_flush_icache_range(trampoline, 4*sizeof(int));
+# define TRAMPOLINE_WORDS 4
+ trampoline[0] = 0x39600000; /* addi r11,r0,0 */
+ trampoline[1] = 0x3D6B0000; /* addis r11,r11,0 */
+ trampoline[2] = 0x7D6903A6; /* mtctr r11 */
+ trampoline[3] = 0x4E800420; /* bctr */
#endif
- hipe_mfa_set_trampoline(m, f, a, trampoline);
- }
- trampvec[trampnr-1] = trampoline;
+ trampvec[i] = trampoline;
+ trampoline += TRAMPOLINE_WORDS;
}
- curseg.tramp_pos = tramp_pos;
- return address;
+ hipe_flush_icache_range(address, nrcallees*TRAMPOLINE_WORDS*sizeof(Uint32));
}
void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *p)
{
- Uint nrwords;
+ Uint code_words;
int nrcallees;
Eterm trampvecbin;
- unsigned int **trampvec;
- unsigned int *address;
- unsigned int *base;
- struct segment oldseg;
+ Uint32 **trampvec;
+ Uint32 *address;
if (nrbytes & 0x3)
return NULL;
- nrwords = nrbytes >> 2;
+ code_words = nrbytes / sizeof(Uint32);
nrcallees = check_callees(callees);
if (nrcallees < 0)
return NULL;
- trampvecbin = new_binary(p, NULL, nrcallees*sizeof(unsigned int*));
- trampvec = (unsigned int**)binary_bytes(trampvecbin);
-
- address = try_alloc(nrwords, nrcallees, callees, trampvec);
- if (!address) {
- base = new_code_mapping();
- if (base == MAP_FAILED)
- return NULL;
- oldseg = curseg;
- curseg.base = base;
- curseg.code_pos = base;
- curseg.tramp_pos = (unsigned int*)((char*)base + SEGMENT_NRBYTES);
-
- address = try_alloc(nrwords, nrcallees, callees, trampvec);
- if (!address) {
- munmap(base, SEGMENT_NRBYTES);
- curseg = oldseg;
- return NULL;
- }
- /* commit to new segment, ignore leftover space in old segment */
- }
+ trampvecbin = new_binary(p, NULL, nrcallees*sizeof(Uint32*));
+ trampvec = (Uint32**)binary_bytes(trampvecbin);
+
+ address = erts_alloc(ERTS_ALC_T_HIPE_EXEC,
+ (code_words + nrcallees*TRAMPOLINE_WORDS)*sizeof(Uint32));
+
+ generate_trampolines(address + code_words, nrcallees, callees, trampvec);
*trampolines = trampvecbin;
return address;
}
-static unsigned int *alloc_stub(Uint nrwords)
+void hipe_free_code(void* code, unsigned int bytes)
{
- unsigned int *address;
- unsigned int *base;
- struct segment oldseg;
-
- address = try_alloc(nrwords, 0, NIL, NULL);
- if (!address) {
- base = new_code_mapping();
- if (base == MAP_FAILED)
- return NULL;
- oldseg = curseg;
- curseg.base = base;
- curseg.code_pos = base;
- curseg.tramp_pos = (unsigned int*)((char*)base + SEGMENT_NRBYTES);
-
- address = try_alloc(nrwords, 0, NIL, NULL);
- if (!address) {
- munmap(base, SEGMENT_NRBYTES);
- curseg = oldseg;
- return NULL;
- }
- /* commit to new segment, ignore leftover space in old segment */
- }
- return address;
+ erts_free(ERTS_ALC_T_HIPE_EXEC, code);
+}
+
+void hipe_free_native_stub(void* stub)
+{
+ erts_free(ERTS_ALC_T_HIPE_EXEC, stub);
}
static void patch_imm16(Uint32 *address, unsigned int imm16)
@@ -285,31 +202,33 @@ int hipe_patch_insn(void *address, Uint64 value, Eterm type)
}
}
-void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity)
+void *hipe_make_native_stub(void *callee_exp, unsigned int beamArity)
{
- unsigned int *code;
+ Uint32 *code;
if ((unsigned long)&nbif_callemu & ~0x01FFFFFCUL)
abort();
- code = alloc_stub(7);
+ code = erts_alloc(ERTS_ALC_T_HIPE_EXEC, 7*sizeof(Uint32));
+ if (!code)
+ return NULL;
- /* addis r12,0,beamAddress@highest */
- code[0] = 0x3d800000 | (((unsigned long)beamAddress >> 48) & 0xffff);
- /* ori r12,r12,beamAddress@higher */
- code[1] = 0x618c0000 | (((unsigned long)beamAddress >> 32) & 0xffff);
+ /* addis r12,0,callee_exp@highest */
+ code[0] = 0x3d800000 | (((unsigned long)callee_exp >> 48) & 0xffff);
+ /* ori r12,r12,callee_exp@higher */
+ code[1] = 0x618c0000 | (((unsigned long)callee_exp >> 32) & 0xffff);
/* sldi r12,r12,32 (rldicr r12,r12,32,31) */
code[2] = 0x798c07c6;
- /* oris r12,r12,beamAddress@h */
- code[3] = 0x658c0000 | (((unsigned long)beamAddress >> 16) & 0xffff);
- /* ori r12,r12,beamAddress@l */
- code[4] = 0x618c0000 | ((unsigned long)beamAddress & 0xffff);
+ /* oris r12,r12,callee_exp@h */
+ code[3] = 0x658c0000 | (((unsigned long)callee_exp >> 16) & 0xffff);
+ /* ori r12,r12,callee_exp@l */
+ code[4] = 0x618c0000 | ((unsigned long)callee_exp & 0xffff);
/* addi r0,0,beamArity */
code[5] = 0x38000000 | (beamArity & 0x7FFF);
/* ba nbif_callemu */
code[6] = 0x48000002 | (unsigned long)&nbif_callemu;
- hipe_flush_icache_range(code, 7*sizeof(int));
+ hipe_flush_icache_range(code, 7*sizeof(Uint32));
return code;
}
@@ -355,18 +274,16 @@ int hipe_patch_insn(void *address, Uint32 value, Eterm type)
return 0;
}
-/* called from hipe_bif0.c:hipe_bifs_make_native_stub_2()
- and hipe_bif0.c:hipe_make_stub() */
-void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity)
+void *hipe_make_native_stub(void *callee_exp, unsigned int beamArity)
{
- unsigned int *code;
+ Uint32 *code;
/*
* Native code calls BEAM via a stub looking as follows:
*
- * addi r12,0,beamAddress@l
+ * addi r12,0,callee_exp@l
* addi r0,0,beamArity
- * addis r12,r12,beamAddress@ha
+ * addis r12,r12,callee_exp@ha
* ba nbif_callemu
*
* I'm using r0 and r12 since the standard SVR4 ABI allows
@@ -382,18 +299,20 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity)
if ((unsigned long)&nbif_callemu & ~0x01FFFFFCUL)
abort();
- code = alloc_stub(4);
+ code = erts_alloc(ERTS_ALC_T_HIPE_EXEC, 4*sizeof(Uint32));
+ if (!code)
+ return NULL;
- /* addi r12,0,beamAddress@l */
- code[0] = 0x39800000 | ((unsigned long)beamAddress & 0xFFFF);
+ /* addi r12,0,callee_exp@l */
+ code[0] = 0x39800000 | ((unsigned long)callee_exp & 0xFFFF);
/* addi r0,0,beamArity */
code[1] = 0x38000000 | (beamArity & 0x7FFF);
- /* addis r12,r12,beamAddress@ha */
- code[2] = 0x3D8C0000 | at_ha((unsigned long)beamAddress);
+ /* addis r12,r12,callee_exp@ha */
+ code[2] = 0x3D8C0000 | at_ha((unsigned long)callee_exp);
/* ba nbif_callemu */
code[3] = 0x48000002 | (unsigned long)&nbif_callemu;
- hipe_flush_icache_range(code, 4*sizeof(int));
+ hipe_flush_icache_range(code, 4*sizeof(Uint32));
return code;
}
diff --git a/erts/emulator/hipe/hipe_ppc.h b/erts/emulator/hipe/hipe_ppc.h
index 66000c1846..e86c122fb1 100644
--- a/erts/emulator/hipe/hipe_ppc.h
+++ b/erts/emulator/hipe/hipe_ppc.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2004-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2004-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -64,10 +65,6 @@ AEXTERN(void,hipe_ppc_inc_stack,(void));
extern void hipe_ppc_inc_stack(void); /* we don't have the AEXTERN() fallback :-( */
#endif
-/* for hipe_bifs_enter_code_2 */
-extern void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *p);
-#define HIPE_ALLOC_CODE(n,c,t,p) hipe_alloc_code((n),(c),(t),(p))
-
#if !defined(__powerpc64__)
extern const unsigned int fconv_constant[];
#endif
diff --git a/erts/emulator/hipe/hipe_ppc.tab b/erts/emulator/hipe/hipe_ppc.tab
index 38b7f46d3a..274612d9ce 100644
--- a/erts/emulator/hipe/hipe_ppc.tab
+++ b/erts/emulator/hipe/hipe_ppc.tab
@@ -1,18 +1,19 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2004-2011. All Rights Reserved.
+# Copyright Ericsson AB 2004-2016. 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/.
+# 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
#
-# 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.
+# 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%
#
diff --git a/erts/emulator/hipe/hipe_ppc64.tab b/erts/emulator/hipe/hipe_ppc64.tab
index 0a390a3bb8..a291185b57 100644
--- a/erts/emulator/hipe/hipe_ppc64.tab
+++ b/erts/emulator/hipe/hipe_ppc64.tab
@@ -1,18 +1,19 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2005-2011. All Rights Reserved.
+# Copyright Ericsson AB 2005-2016. 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.
+# 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%
#
diff --git a/erts/emulator/hipe/hipe_ppc_asm.m4 b/erts/emulator/hipe/hipe_ppc_asm.m4
index 343402f9f0..be25d65725 100644
--- a/erts/emulator/hipe/hipe_ppc_asm.m4
+++ b/erts/emulator/hipe/hipe_ppc_asm.m4
@@ -2,18 +2,19 @@ changecom(`/*', `*/')dnl
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2004-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2004-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -23,6 +24,22 @@ changecom(`/*', `*/')dnl
#define HIPE_PPC_ASM_H'
/*
+ * Tunables.
+ */
+define(LEAF_WORDS,16)dnl number of stack words for leaf functions
+define(NR_ARG_REGS,4)dnl admissible values are 0 to 6, inclusive
+
+`#define PPC_LEAF_WORDS 'LEAF_WORDS
+`#define PPC_NR_ARG_REGS 'NR_ARG_REGS
+`#define NR_ARG_REGS 'NR_ARG_REGS
+
+
+`#ifdef ASM'
+/*
+ * Only assembler stuff from here on (when included from *.S)
+ */
+
+/*
* Handle 32 vs 64-bit.
*/
ifelse(ARCH,ppc64,`
@@ -53,13 +70,6 @@ define(WSIZE,4)dnl
`#define STORE 'STORE
`#define CMPI 'CMPI
-/*
- * Tunables.
- */
-define(LEAF_WORDS,16)dnl number of stack words for leaf functions
-define(NR_ARG_REGS,4)dnl admissible values are 0 to 6, inclusive
-
-`#define PPC_LEAF_WORDS 'LEAF_WORDS
/*
* Workarounds for Darwin.
@@ -193,8 +203,6 @@ NAME: \
/*
* Argument (parameter) registers.
*/
-`#define PPC_NR_ARG_REGS 'NR_ARG_REGS
-`#define NR_ARG_REGS 'NR_ARG_REGS
define(defarg,`define(ARG$1,`$2')dnl
#`define ARG'$1 $2'
@@ -273,6 +281,10 @@ define(NBIF_ARG,`ifelse(eval($3 >= NR_ARG_REGS),0,`NBIF_REG_ARG($1,$3)',`NBIF_ST
`/* #define NBIF_ARG_3_0 'NBIF_ARG(r3,3,0)` */'
`/* #define NBIF_ARG_3_1 'NBIF_ARG(r3,3,1)` */'
`/* #define NBIF_ARG_3_2 'NBIF_ARG(r3,3,2)` */'
+`/* #define NBIF_ARG_4_0 'NBIF_ARG(r3,4,0)` */'
+`/* #define NBIF_ARG_4_1 'NBIF_ARG(r3,4,1)` */'
+`/* #define NBIF_ARG_4_2 'NBIF_ARG(r3,4,2)` */'
+`/* #define NBIF_ARG_4_3 'NBIF_ARG(r3,4,3)` */'
`/* #define NBIF_ARG_5_0 'NBIF_ARG(r3,5,0)` */'
`/* #define NBIF_ARG_5_1 'NBIF_ARG(r3,5,1)` */'
`/* #define NBIF_ARG_5_2 'NBIF_ARG(r3,5,2)` */'
@@ -294,6 +306,7 @@ define(NBIF_RET,`NBIF_RET_N(eval(RET_POP($1)))')dnl
`/* #define NBIF_RET_1 'NBIF_RET(1)` */'
`/* #define NBIF_RET_2 'NBIF_RET(2)` */'
`/* #define NBIF_RET_3 'NBIF_RET(3)` */'
+`/* #define NBIF_RET_4 'NBIF_RET(4)` */'
`/* #define NBIF_RET_5 'NBIF_RET(5)` */'
dnl
@@ -309,4 +322,6 @@ define(QUICK_CALL_RET,`NBIF_POP_N(eval(RET_POP($2)))b $1')dnl
`/* #define QUICK_CALL_RET_F_3 'QUICK_CALL_RET(F,3)` */'
`/* #define QUICK_CALL_RET_F_5 'QUICK_CALL_RET(F,5)` */'
+`#endif /* ASM */'
+
`#endif /* HIPE_PPC_ASM_H */'
diff --git a/erts/emulator/hipe/hipe_ppc_bifs.m4 b/erts/emulator/hipe/hipe_ppc_bifs.m4
index 7cc2b5c7b6..79a8bef77d 100644
--- a/erts/emulator/hipe/hipe_ppc_bifs.m4
+++ b/erts/emulator/hipe/hipe_ppc_bifs.m4
@@ -2,31 +2,33 @@ changecom(`/*', `*/')dnl
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2004-2012. All Rights Reserved.
+ * Copyright Ericsson AB 2004-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
+#`define ASM'
include(`hipe/hipe_ppc_asm.m4')
#`include' "config.h"
#`include' "hipe_literals.h"
`#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP)
-# define CALL_BIF(F) STORE_IA(CSYM(F), P_BIF_CALLEE(P), r29); bl CSYM(hipe_debug_bif_wrapper)
+# define CALL_BIF(F) STORE_IA(CSYM(nbif_impl_##F), P_BIF_CALLEE(P), r29); bl CSYM(hipe_debug_bif_wrapper)
#else
-# define CALL_BIF(F) bl CSYM(F)
+# define CALL_BIF(F) bl CSYM(nbif_impl_##F)
#endif'
.text
@@ -45,9 +47,10 @@ define(HANDLE_GOT_MBUF,`
* standard_bif_interface_1(nbif_name, cbif_name)
* standard_bif_interface_2(nbif_name, cbif_name)
* standard_bif_interface_3(nbif_name, cbif_name)
+ * standard_bif_interface_4(nbif_name, cbif_name)
* standard_bif_interface_0(nbif_name, cbif_name)
*
- * Generate native interface for a BIF with 0-3 parameters and
+ * Generate native interface for a BIF with 0-4 parameters and
* standard failure mode.
*/
define(standard_bif_interface_1,
@@ -143,6 +146,41 @@ ASYM($1):
TYPE_FUNCTION(ASYM($1))
#endif')
+define(standard_bif_interface_4,
+`
+#ifndef HAVE_$1
+#`define' HAVE_$1
+ GLOBAL(ASYM($1))
+ASYM($1):
+ /* Set up C argument registers. */
+ mr r3, P
+ NBIF_ARG(r4,4,0)
+ NBIF_ARG(r5,4,1)
+ NBIF_ARG(r6,4,2)
+ NBIF_ARG(r7,4,3)
+
+ /* Save caller-save registers and call the C function. */
+ SAVE_CONTEXT_BIF
+ STORE r4, P_ARG0(r3) /* Store BIF__ARGS in def_arg_reg[] */
+ STORE r5, P_ARG1(r3)
+ STORE r6, P_ARG2(r3)
+ STORE r7, P_ARG3(r3)
+ addi r4, r3, P_ARG0
+ CALL_BIF($2)
+ TEST_GOT_MBUF
+
+ /* Restore registers. Check for exception. */
+ CMPI r3, THE_NON_VALUE
+ RESTORE_CONTEXT_BIF
+ beq- 1f
+ NBIF_RET(4)
+1: /* workaround for bc:s small offset operand */
+ b CSYM(nbif_4_simple_exception)
+ HANDLE_GOT_MBUF(4)
+ SET_SIZE(ASYM($1))
+ TYPE_FUNCTION(ASYM($1))
+#endif')
+
define(standard_bif_interface_0,
`
#ifndef HAVE_$1
@@ -174,8 +212,9 @@ ASYM($1):
* gc_bif_interface_0(nbif_name, cbif_name)
* gc_bif_interface_1(nbif_name, cbif_name)
* gc_bif_interface_2(nbif_name, cbif_name)
+ * gc_bif_interface_3(nbif_name, cbif_name)
*
- * Generate native interface for a BIF with 0-2 parameters and
+ * Generate native interface for a BIF with 0-3 parameters and
* standard failure mode.
* The BIF may do a GC.
*/
@@ -262,6 +301,39 @@ ASYM($1):
TYPE_FUNCTION(ASYM($1))
#endif')
+define(gc_bif_interface_3,
+`
+#ifndef HAVE_$1
+#`define' HAVE_$1
+ GLOBAL(ASYM($1))
+ASYM($1):
+ /* Set up C argument registers. */
+ mr r3, P
+ NBIF_ARG(r4,3,0)
+ NBIF_ARG(r5,3,1)
+ NBIF_ARG(r6,3,2)
+
+ /* Save caller-save registers and call the C function. */
+ SAVE_CONTEXT_GC
+ STORE r4, P_ARG0(r3) /* Store BIF__ARGS in def_arg_reg[] */
+ STORE r5, P_ARG1(r3)
+ STORE r6, P_ARG2(r3)
+ addi r4, r3, P_ARG0
+ CALL_BIF($2)
+ TEST_GOT_MBUF
+
+ /* Restore registers. Check for exception. */
+ CMPI r3, THE_NON_VALUE
+ RESTORE_CONTEXT_GC
+ beq- 1f
+ NBIF_RET(3)
+1: /* workaround for bc:s small offset operand */
+ b CSYM(nbif_3_simple_exception)
+ HANDLE_GOT_MBUF(3)
+ SET_SIZE(ASYM($1))
+ TYPE_FUNCTION(ASYM($1))
+#endif')
+
/*
* gc_nofail_primop_interface_1(nbif_name, cbif_name)
*
diff --git a/erts/emulator/hipe/hipe_ppc_gc.h b/erts/emulator/hipe/hipe_ppc_gc.h
index 823ba0ad06..a6ec1338ff 100644
--- a/erts/emulator/hipe/hipe_ppc_gc.h
+++ b/erts/emulator/hipe/hipe_ppc_gc.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2004-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2004-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/hipe/hipe_ppc_glue.S b/erts/emulator/hipe/hipe_ppc_glue.S
index 6f0217c738..44351dc06c 100644
--- a/erts/emulator/hipe/hipe_ppc_glue.S
+++ b/erts/emulator/hipe/hipe_ppc_glue.S
@@ -1,26 +1,26 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2004-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2004-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
-
+#define ASM
#include "hipe_ppc_asm.h"
#include "hipe_literals.h"
-#define ASM
#include "hipe_mode_switch.h"
.text
@@ -296,7 +296,7 @@ CSYM(hipe_ppc_throw_to_native):
* which should look as follows:
*
* stub for f/N:
- * <set r12 to f's BEAM code address>
+ * <set r12 to f's export entry address>
* <set r0 to N>
* b nbif_callemu
*
@@ -312,10 +312,10 @@ CSYM(hipe_ppc_throw_to_native):
*/
GLOBAL(ASYM(nbif_callemu))
ASYM(nbif_callemu):
- STORE r12, P_BEAM_IP(P)
+ STORE r12, P_CALLEE_EXP(P)
STORE r0, P_ARITY(P)
STORE_ARG_REGS
- li r3, HIPE_MODE_SWITCH_RES_CALL
+ li r3, HIPE_MODE_SWITCH_RES_CALL_EXPORTED
b .suspend_exit
/*
@@ -463,10 +463,12 @@ ASYM(nbif_fail):
OPD(nbif_1_gc_after_bif)
OPD(nbif_2_gc_after_bif)
OPD(nbif_3_gc_after_bif)
+ OPD(nbif_4_gc_after_bif)
GLOBAL(CSYM(nbif_0_gc_after_bif))
GLOBAL(CSYM(nbif_1_gc_after_bif))
GLOBAL(CSYM(nbif_2_gc_after_bif))
GLOBAL(CSYM(nbif_3_gc_after_bif))
+ GLOBAL(CSYM(nbif_4_gc_after_bif))
CSYM(nbif_0_gc_after_bif):
li r4, 0
b .gc_after_bif
@@ -478,6 +480,9 @@ CSYM(nbif_2_gc_after_bif):
b .gc_after_bif
CSYM(nbif_3_gc_after_bif):
li r4, 3
+ b .gc_after_bif
+CSYM(nbif_4_gc_after_bif):
+ li r4, 4
/*FALLTHROUGH*/
.gc_after_bif:
stw r4, P_NARITY(P) /* Note: narity is a 32-bit field */
@@ -506,20 +511,29 @@ CSYM(nbif_3_gc_after_bif):
CSYM(nbif_0_simple_exception):
li r4, 0
b .nbif_simple_exception
+
OPD(nbif_1_simple_exception)
GLOBAL(CSYM(nbif_1_simple_exception))
CSYM(nbif_1_simple_exception):
li r4, 1
b .nbif_simple_exception
+
OPD(nbif_2_simple_exception)
GLOBAL(CSYM(nbif_2_simple_exception))
CSYM(nbif_2_simple_exception):
li r4, 2
b .nbif_simple_exception
+
OPD(nbif_3_simple_exception)
GLOBAL(CSYM(nbif_3_simple_exception))
CSYM(nbif_3_simple_exception):
li r4, 3
+ b .nbif_simple_exception
+
+ OPD(nbif_4_simple_exception)
+ GLOBAL(CSYM(nbif_4_simple_exception))
+CSYM(nbif_4_simple_exception):
+ li r4, 4
/*FALLTHROUGH*/
.nbif_simple_exception:
LOAD r3, P_FREASON(P)
diff --git a/erts/emulator/hipe/hipe_ppc_glue.h b/erts/emulator/hipe/hipe_ppc_glue.h
index f9c4460e60..2bfa10298c 100644
--- a/erts/emulator/hipe/hipe_ppc_glue.h
+++ b/erts/emulator/hipe/hipe_ppc_glue.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2004-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2004-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/hipe/hipe_ppc_primops.h b/erts/emulator/hipe/hipe_ppc_primops.h
index 7dba0afc88..540605de9f 100644
--- a/erts/emulator/hipe/hipe_ppc_primops.h
+++ b/erts/emulator/hipe/hipe_ppc_primops.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2005-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2005-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/hipe/hipe_primops.h b/erts/emulator/hipe/hipe_primops.h
index 52b4681cfe..77f0dfe7e5 100644
--- a/erts/emulator/hipe/hipe_primops.h
+++ b/erts/emulator/hipe/hipe_primops.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2005-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2005-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -65,8 +66,11 @@ PRIMOP_LIST(am_bs_put_utf16be, &nbif_bs_put_utf16be)
PRIMOP_LIST(am_bs_put_utf16le, &nbif_bs_put_utf16le)
PRIMOP_LIST(am_bs_get_utf16, &nbif_bs_get_utf16)
PRIMOP_LIST(am_bs_validate_unicode, &nbif_bs_validate_unicode)
+PRIMOP_LIST(am_is_unicode, &nbif_is_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)
@@ -80,6 +84,7 @@ PRIMOP_LIST(am_fclearerror_error, &nbif_fclearerror_error)
#ifdef NO_FPE_SIGNALS
PRIMOP_LIST(am_emulate_fpe, &nbif_emulate_fpe)
#endif
+PRIMOP_LIST(am_emasculate_binary, &nbif_emasculate_binary)
PRIMOP_LIST(am_debug_native_called, &nbif_hipe_bifs_debug_native_called)
#if defined(__sparc__)
diff --git a/erts/emulator/hipe/hipe_process.h b/erts/emulator/hipe/hipe_process.h
index 4ee99d78a2..cc92bf653c 100644
--- a/erts/emulator/hipe/hipe_process.h
+++ b/erts/emulator/hipe/hipe_process.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -23,14 +24,17 @@
#define HIPE_PROCESS_H
#include "erl_alloc.h"
+#include "export.h"
struct hipe_process_state {
Eterm *nsp; /* Native stack pointer. */
Eterm *nstack; /* Native stack block start. */
Eterm *nstend; /* Native stack block end (start+size). */
- /* XXX: ncallee and closure could share space in a union */
- void (*ncallee)(void); /* Native code callee (label) to invoke. */
- Eterm closure; /* Used to pass a closure from native code. */
+ union {
+ void (*ncallee)(void); /* Native code callee (label) to invoke. */
+ Eterm closure; /* Used to pass a closure from native code. */
+ Export* callee_exp; /* Used to pass export entry from native code */
+ }u;
Eterm *nstgraylim; /* Gray/white stack boundary. */
Eterm *nstblacklim; /* Black/gray stack boundary. Must exist if
graylim exists. Ignored if no graylim. */
@@ -48,6 +52,9 @@ struct hipe_process_state {
#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP)
void (*bif_callee)(void); /* When calling BIF's via debug wrapper */
#endif
+#ifdef DEBUG
+ UWord gc_is_unsafe; /* Nonzero when GC-required state is on stack */
+#endif
};
extern void hipe_arch_print_pcb(struct hipe_process_state *p);
@@ -64,12 +71,15 @@ static __inline__ void hipe_init_process(struct hipe_process_state *p)
p->nra = NULL;
#endif
p->narity = 0;
+#ifdef DEBUG
+ p->gc_is_unsafe = 0;
+#endif
}
static __inline__ void hipe_delete_process(struct hipe_process_state *p)
{
if (p->nstack)
- erts_free(ERTS_ALC_T_HIPE, (void*)p->nstack);
+ erts_free(ERTS_ALC_T_HIPE_STK, (void*)p->nstack);
}
#ifdef ERTS_SMP
diff --git a/erts/emulator/hipe/hipe_risc_gc.h b/erts/emulator/hipe/hipe_risc_gc.h
index 947eb5956b..f019434f67 100644
--- a/erts/emulator/hipe/hipe_risc_gc.h
+++ b/erts/emulator/hipe/hipe_risc_gc.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2008-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2008-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -26,7 +27,7 @@
/* arch wrapper includes hipe_${arch}_asm.h to define NR_ARG_REGS */
struct nstack_walk_state {
- const struct sdesc *sdesc0; /* .sdesc0 must be a pointer rvalue */
+ const struct hipe_sdesc *sdesc0; /* .sdesc0 must be a pointer rvalue */
};
static inline int nstack_walk_init_check(const Process *p)
@@ -42,15 +43,28 @@ static inline Eterm *nstack_walk_nsp_begin(const Process *p)
return p->hipe.nsp + nstkarity;
}
-static inline const struct sdesc*
+static inline const struct hipe_sdesc*
nstack_walk_init_sdesc(const Process *p, struct nstack_walk_state *state)
{
- const struct sdesc *sdesc = hipe_find_sdesc((unsigned long)p->hipe.nra);
+ const struct hipe_sdesc *sdesc = hipe_find_sdesc((unsigned long)p->hipe.nra);
+ state->sdesc0 = sdesc;
+ return sdesc;
+}
+
+static inline const struct hipe_sdesc*
+nstack_walk_init_sdesc_ignore_trap(const Process *p,
+ struct nstack_walk_state *state)
+{
+ unsigned long ra = (unsigned long)p->hipe.nra;
+ const struct hipe_sdesc *sdesc;
+ if (ra == (unsigned long)&nbif_stack_trap_ra)
+ ra = (unsigned long)p->hipe.ngra;
+ sdesc = hipe_find_sdesc(ra);
state->sdesc0 = sdesc;
return sdesc;
}
-static inline void nstack_walk_update_trap(Process *p, const struct sdesc *sdesc0)
+static inline void nstack_walk_update_trap(Process *p, const struct hipe_sdesc *sdesc0)
{
Eterm *nsp = p->hipe.nsp;
p->hipe.nsp = nstack_walk_nsp_begin(p);
@@ -89,7 +103,7 @@ static inline int nstack_walk_nsp_reached_end(const Eterm *nsp, const Eterm *nsp
return nsp >= nsp_end;
}
-static inline unsigned int nstack_walk_frame_size(const struct sdesc *sdesc)
+static inline unsigned int nstack_walk_frame_size(const struct hipe_sdesc *sdesc)
{
return sdesc_fsize(sdesc) + 1 + sdesc_arity(sdesc);
}
@@ -100,7 +114,7 @@ static inline Eterm *nstack_walk_frame_index(Eterm *nsp, unsigned int i)
}
static inline unsigned long
-nstack_walk_frame_ra(const Eterm *nsp, const struct sdesc *sdesc)
+nstack_walk_frame_ra(const Eterm *nsp, const struct hipe_sdesc *sdesc)
{
return nsp[sdesc_fsize(sdesc)];
}
diff --git a/erts/emulator/hipe/hipe_risc_glue.h b/erts/emulator/hipe/hipe_risc_glue.h
index cc2671c016..1369b392fe 100644
--- a/erts/emulator/hipe/hipe_risc_glue.h
+++ b/erts/emulator/hipe/hipe_risc_glue.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2008-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2008-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -65,13 +66,17 @@ static __inline__ unsigned int max(unsigned int x, unsigned int y)
static __inline__ void hipe_arch_glue_init(void)
{
- static struct sdesc_with_exnra nbif_return_sdesc = {
- .exnra = (unsigned long)&nbif_fail,
- .sdesc = {
- .bucket = { .hvalue = (unsigned long)&nbif_return },
- .summary = (1<<8),
- },
- };
+ static struct hipe_sdesc_with_exnra nbif_return_sdesc;
+
+ nbif_return_sdesc.exnra = (unsigned long)nbif_fail;
+ nbif_return_sdesc.sdesc.bucket.hvalue = (unsigned long)nbif_return;
+ nbif_return_sdesc.sdesc.fsize = 0;
+ nbif_return_sdesc.sdesc.has_exnra = 1;
+ nbif_return_sdesc.sdesc.stk_nargs = 0;
+ nbif_return_sdesc.sdesc.m_aix = atom_val(am_Empty);
+ nbif_return_sdesc.sdesc.f_aix = atom_val(am_return);
+ nbif_return_sdesc.sdesc.a = 0;
+
hipe_init_sdesc_table(&nbif_return_sdesc.sdesc);
}
@@ -214,6 +219,14 @@ hipe_trap_from_native_is_recursive(Process *p)
return 0;
}
+/* Native called BIF. Is it a recursive call?
+ i.e should we return back to native when BIF is done? */
+static __inline__ int
+hipe_bifcall_from_native_is_recursive(Process *p)
+{
+ return (p->hipe.nra != (void(*)(void))&nbif_return);
+}
+
/* Native makes a call which needs to unload the parameters.
This differs from hipe_call_from_native_is_recursive() in
diff --git a/erts/emulator/hipe/hipe_risc_stack.c b/erts/emulator/hipe/hipe_risc_stack.c
index 1183856c7e..4001bedeb6 100644
--- a/erts/emulator/hipe/hipe_risc_stack.c
+++ b/erts/emulator/hipe/hipe_risc_stack.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2008-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2008-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -55,8 +56,8 @@ void hipe_print_nstack(Process *p)
{
Eterm *nsp;
Eterm *nsp_end;
- const struct sdesc *sdesc1;
- const struct sdesc *sdesc;
+ const struct hipe_sdesc *sdesc1;
+ const struct hipe_sdesc *sdesc;
unsigned long ra;
unsigned long exnra;
unsigned int mask;
@@ -174,7 +175,7 @@ void hipe_print_nstack(Process *p)
#define MINSTACK 128
#define NSKIPFRAMES 4
-void hipe_update_stack_trap(Process *p, const struct sdesc *sdesc)
+void hipe_update_stack_trap(Process *p, const struct hipe_sdesc *sdesc)
{
Eterm *nsp;
Eterm *nsp_end;
@@ -215,7 +216,7 @@ void hipe_update_stack_trap(Process *p, const struct sdesc *sdesc)
void (*hipe_handle_stack_trap(Process *p))(void)
{
void (*ngra)(void) = p->hipe.ngra;
- const struct sdesc *sdesc = hipe_find_sdesc((unsigned long)ngra);
+ const struct hipe_sdesc *sdesc = hipe_find_sdesc((unsigned long)ngra);
hipe_update_stack_trap(p, sdesc);
return ngra;
}
@@ -226,7 +227,7 @@ void (*hipe_handle_stack_trap(Process *p))(void)
* The native stack MUST contain a stack frame as it appears on
* entry to a function (actuals, caller's frame, caller's return address).
* p->hipe.narity MUST contain the arity (number of actuals).
- * On exit, p->hipe.ncallee is set to the handler's PC and p->hipe.nsp
+ * On exit, p->hipe.u.ncallee is set to the handler's PC and p->hipe.nsp
* is set to its SP (low address of its stack frame).
*/
void hipe_find_handler(Process *p)
@@ -236,7 +237,7 @@ void hipe_find_handler(Process *p)
unsigned long ra;
unsigned long exnra;
unsigned int arity;
- const struct sdesc *sdesc;
+ const struct hipe_sdesc *sdesc;
nsp = p->hipe.nsp;
nsp_end = p->hipe.nstend;
@@ -254,7 +255,7 @@ void hipe_find_handler(Process *p)
if ((exnra = sdesc_exnra(sdesc)) != 0 &&
(p->catches >= 0 ||
exnra == (unsigned long)&nbif_fail)) {
- p->hipe.ncallee = (void(*)(void)) exnra;
+ p->hipe.u.ncallee = (void(*)(void)) exnra;
p->hipe.nsp = nsp;
p->hipe.narity = 0;
/* update the gray/white boundary if we threw past it */
@@ -276,7 +277,7 @@ int hipe_fill_stacktrace(Process *p, int depth, Eterm **trace)
Eterm *nsp_end;
unsigned long ra, prev_ra;
unsigned int arity;
- const struct sdesc *sdesc;
+ const struct hipe_sdesc *sdesc;
int i;
if (depth < 1)
@@ -291,7 +292,7 @@ int hipe_fill_stacktrace(Process *p, int depth, Eterm **trace)
ra = (unsigned long)p->hipe.nra;
prev_ra = 0;
i = 0;
- for (;;) {
+ while (nsp < nsp_end) {
if (ra == (unsigned long)nbif_stack_trap_ra)
ra = (unsigned long)p->hipe.ngra;
if (ra != prev_ra) {
@@ -301,8 +302,6 @@ int hipe_fill_stacktrace(Process *p, int depth, Eterm **trace)
break;
prev_ra = ra;
}
- if (nsp >= nsp_end)
- break;
sdesc = hipe_find_sdesc(ra);
nsp += arity + sdesc_fsize(sdesc);
arity = sdesc_arity(sdesc);
diff --git a/erts/emulator/hipe/hipe_signal.h b/erts/emulator/hipe/hipe_signal.h
index 4eacf52b5d..5d8621135b 100644
--- a/erts/emulator/hipe/hipe_signal.h
+++ b/erts/emulator/hipe/hipe_signal.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2002-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2002-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/hipe/hipe_sparc.c b/erts/emulator/hipe/hipe_sparc.c
index 49d4da7bab..876b20bb15 100644
--- a/erts/emulator/hipe/hipe_sparc.c
+++ b/erts/emulator/hipe/hipe_sparc.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2003-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2003-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -23,7 +24,6 @@
#include "config.h"
#endif
#include "global.h"
-#include <sys/mman.h>
#include "hipe_arch.h"
#include "hipe_native_bif.h" /* nbif_callemu() */
@@ -87,8 +87,8 @@ int hipe_patch_call(void *callAddress, void *destAddress, void *trampoline)
{
Uint32 relDest, newI;
- if (trampoline)
- return -1;
+ ASSERT(trampoline == NULL);
+
relDest = (Uint32)((Sint32)destAddress - (Sint32)callAddress);
newI = (1 << 30) | (relDest >> 2);
*(Uint32*)callAddress = newI;
@@ -96,104 +96,9 @@ int hipe_patch_call(void *callAddress, void *destAddress, void *trampoline)
return 0;
}
-/*
- * Memory allocator for executable code.
- *
- * This is required on x86 because some combinations
- * of Linux kernels and CPU generations default to
- * non-executable memory mappings, causing ordinary
- * malloc() memory to be non-executable.
- */
-static unsigned int code_bytes;
-static char *code_next;
-
-#if 0 /* change to non-zero to get allocation statistics at exit() */
-static unsigned int total_mapped, nr_joins, nr_splits, total_alloc, nr_allocs, nr_large, total_lost;
-static unsigned int atexit_done;
-
-static void alloc_code_stats(void)
-{
- printf("\r\nalloc_code_stats: %u bytes mapped, %u joins, %u splits, %u bytes allocated, %u average alloc, %u large allocs, %u bytes lost\r\n",
- total_mapped, nr_joins, nr_splits, total_alloc, nr_allocs ? total_alloc/nr_allocs : 0, nr_large, total_lost);
-}
-
-static void atexit_alloc_code_stats(void)
-{
- if (!atexit_done) {
- atexit_done = 1;
- (void)atexit(alloc_code_stats);
- }
-}
-
-#define ALLOC_CODE_STATS(X) do{X;}while(0)
-#else
-#define ALLOC_CODE_STATS(X) do{}while(0)
-#endif
-
-static void morecore(unsigned int alloc_bytes)
-{
- unsigned int map_bytes;
- char *map_hint, *map_start;
-
- /* Page-align the amount to allocate. */
- map_bytes = (alloc_bytes + 4095) & ~4095;
-
- /* Round up small allocations. */
- if (map_bytes < 1024*1024)
- map_bytes = 1024*1024;
- else
- ALLOC_CODE_STATS(++nr_large);
-
- /* Create a new memory mapping, ensuring it is executable
- and in the low 2GB of the address space. Also attempt
- to make it adjacent to the previous mapping. */
- map_hint = code_next + code_bytes;
- if ((unsigned long)map_hint & 4095)
- abort();
- map_start = mmap(map_hint, map_bytes,
- PROT_EXEC|PROT_READ|PROT_WRITE,
- MAP_PRIVATE|MAP_ANONYMOUS
-#ifdef __x86_64__
- |MAP_32BIT
-#endif
- ,
- -1, 0);
- if (map_start == MAP_FAILED) {
- perror("mmap");
- abort();
- }
- ALLOC_CODE_STATS(total_mapped += map_bytes);
-
- /* Merge adjacent mappings, so the trailing portion of the previous
- mapping isn't lost. In practice this is quite successful. */
- if (map_start == map_hint) {
- ALLOC_CODE_STATS(++nr_joins);
- code_bytes += map_bytes;
- } else {
- ALLOC_CODE_STATS(++nr_splits);
- ALLOC_CODE_STATS(total_lost += code_bytes);
- code_next = map_start;
- code_bytes = map_bytes;
- }
-
- ALLOC_CODE_STATS(atexit_alloc_code_stats());
-}
-
static void *alloc_code(unsigned int alloc_bytes)
{
- void *res;
-
- /* Align function entries. */
- alloc_bytes = (alloc_bytes + 3) & ~3;
-
- if (code_bytes < alloc_bytes)
- morecore(alloc_bytes);
- ALLOC_CODE_STATS(++nr_allocs);
- ALLOC_CODE_STATS(total_alloc += alloc_bytes);
- res = code_next;
- code_next += alloc_bytes;
- code_bytes -= alloc_bytes;
- return res;
+ return erts_alloc(ERTS_ALC_T_HIPE_EXEC, alloc_bytes);
}
void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *p)
@@ -204,22 +109,27 @@ void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *
return alloc_code(nrbytes);
}
-/* called from hipe_bif0.c:hipe_bifs_make_native_stub_2()
- and hipe_bif0.c:hipe_make_stub() */
-void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity)
+void hipe_free_code(void* code, unsigned int nrbytes)
+{
+ erts_free(ERTS_ALC_T_HIPE_EXEC, code);
+}
+
+void *hipe_make_native_stub(void *callee_exp, unsigned int beamArity)
{
unsigned int *code;
unsigned int callEmuOffset;
int i;
code = alloc_code(5*sizeof(int));
+ if (!code)
+ return NULL;
/* sethi %hi(Address), %i4 */
- code[0] = 0x39000000 | (((unsigned int)beamAddress >> 10) & 0x3FFFFF);
+ code[0] = 0x39000000 | (((unsigned int)callee_exp >> 10) & 0x3FFFFF);
/* or %g0, %o7, %i3 ! mov %o7, %i3 */
code[1] = 0xB610000F;
/* or %i4, %lo(Address), %i4 */
- code[2] = 0xB8172000 | ((unsigned int)beamAddress & 0x3FF);
+ code[2] = 0xB8172000 | ((unsigned int)callee_exp & 0x3FF);
/* call callemu */
callEmuOffset = (char*)nbif_callemu - (char*)&code[3];
code[3] = (1 << 30) | ((callEmuOffset >> 2) & 0x3FFFFFFF);
@@ -233,6 +143,11 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity)
return code;
}
+void hipe_free_native_stub(void* stub)
+{
+ erts_free(ERTS_ALC_T_HIPE_EXEC, stub);
+}
+
void hipe_arch_print_pcb(struct hipe_process_state *p)
{
#define U(n,x) \
diff --git a/erts/emulator/hipe/hipe_sparc.h b/erts/emulator/hipe/hipe_sparc.h
index 1134b86004..25d513e988 100644
--- a/erts/emulator/hipe/hipe_sparc.h
+++ b/erts/emulator/hipe/hipe_sparc.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2003-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2003-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -47,8 +48,4 @@ static __inline__ int hipe_word32_address_ok(void *address)
extern void hipe_sparc_inc_stack(void);
-/* for hipe_bifs_enter_code_2 */
-extern void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *p);
-#define HIPE_ALLOC_CODE(n,c,t,p) hipe_alloc_code((n),(c),(t),(p))
-
#endif /* HIPE_SPARC_H */
diff --git a/erts/emulator/hipe/hipe_sparc.tab b/erts/emulator/hipe/hipe_sparc.tab
index c620c73c67..bc90d38168 100644
--- a/erts/emulator/hipe/hipe_sparc.tab
+++ b/erts/emulator/hipe/hipe_sparc.tab
@@ -1,18 +1,19 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2004-2011. All Rights Reserved.
+# Copyright Ericsson AB 2004-2016. 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/.
+# 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
#
-# 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.
+# 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%
#
diff --git a/erts/emulator/hipe/hipe_sparc_asm.m4 b/erts/emulator/hipe/hipe_sparc_asm.m4
index 227d10ed80..8a9a516eab 100644
--- a/erts/emulator/hipe/hipe_sparc_asm.m4
+++ b/erts/emulator/hipe/hipe_sparc_asm.m4
@@ -2,18 +2,19 @@ changecom(`/*', `*/')dnl
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2007-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2007-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -29,6 +30,14 @@ define(LEAF_WORDS,16)dnl number of stack words for leaf functions
define(NR_ARG_REGS,4)dnl admissible values are 0 to 6, inclusive
`#define SPARC_LEAF_WORDS 'LEAF_WORDS
+`#define SPARC_NR_ARG_REGS 'NR_ARG_REGS
+`#define NR_ARG_REGS 'NR_ARG_REGS
+
+
+`#ifdef ASM'
+/*
+ * Only assembler stuff from here on (when included from *.S)
+ */
/*
* Reserved registers.
@@ -80,9 +89,6 @@ define(NR_ARG_REGS,4)dnl admissible values are 0 to 6, inclusive
/*
* Argument (parameter) registers.
*/
-`#define SPARC_NR_ARG_REGS 'NR_ARG_REGS
-`#define NR_ARG_REGS 'NR_ARG_REGS
-
define(defarg,`define(ARG$1,`$2')dnl
#`define ARG'$1 $2'
)dnl
@@ -171,6 +177,10 @@ define(NBIF_ARG,`ifelse(eval($3 >= NR_ARG_REGS),0,`NBIF_REG_ARG($1,$3)',`NBIF_ST
`/* #define NBIF_ARG_3_0 'NBIF_ARG(r1,3,0)` */'
`/* #define NBIF_ARG_3_1 'NBIF_ARG(r2,3,1)` */'
`/* #define NBIF_ARG_3_2 'NBIF_ARG(r3,3,2)` */'
+`/* #define NBIF_ARG_4_0 'NBIF_ARG(r1,4,0)` */'
+`/* #define NBIF_ARG_4_1 'NBIF_ARG(r2,4,1)` */'
+`/* #define NBIF_ARG_4_2 'NBIF_ARG(r3,4,2)` */'
+`/* #define NBIF_ARG_4_3 'NBIF_ARG(r3,4,3)` */'
`/* #define NBIF_ARG_5_0 'NBIF_ARG(r1,5,0)` */'
`/* #define NBIF_ARG_5_1 'NBIF_ARG(r2,5,1)` */'
`/* #define NBIF_ARG_5_2 'NBIF_ARG(r3,5,2)` */'
@@ -195,6 +205,7 @@ define(NBIF_RET,`NBIF_RET_N(eval(RET_POP($1)))')dnl
`/* #define NBIF_RET_1 'NBIF_RET(1)` */'
`/* #define NBIF_RET_2 'NBIF_RET(2)` */'
`/* #define NBIF_RET_3 'NBIF_RET(3)` */'
+`/* #define NBIF_RET_4 'NBIF_RET(4)` */'
`/* #define NBIF_RET_5 'NBIF_RET(5)` */'
dnl
@@ -210,4 +221,6 @@ define(QUICK_CALL_RET,`ba $1; NBIF_POP_N(eval(RET_POP($2)))')dnl
`/* #define QUICK_CALL_RET_F_3 'QUICK_CALL_RET(F,3)` */'
`/* #define QUICK_CALL_RET_F_5 'QUICK_CALL_RET(F,5)` */'
+`#endif /* ASM */'
+
`#endif /* HIPE_SPARC_ASM_H */'
diff --git a/erts/emulator/hipe/hipe_sparc_bifs.m4 b/erts/emulator/hipe/hipe_sparc_bifs.m4
index ca5af45d58..14330c2f1c 100644
--- a/erts/emulator/hipe/hipe_sparc_bifs.m4
+++ b/erts/emulator/hipe/hipe_sparc_bifs.m4
@@ -2,23 +2,25 @@ changecom(`/*', `*/')dnl
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
+#`define ASM'
include(`hipe/hipe_sparc_asm.m4')
#`include' "config.h"
#`include' "hipe_literals.h"
@@ -27,9 +29,9 @@ include(`hipe/hipe_sparc_asm.m4')
.align 4
`#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP)
-# define CALL_BIF(F) set F, %o7; st %o7, [%o0+P_BIF_CALLEE]; call hipe_debug_bif_wrapper
+# define CALL_BIF(F) set nbif_impl_##F, %o7; st %o7, [%o0+P_BIF_CALLEE]; call hipe_debug_bif_wrapper
#else
-# define CALL_BIF(F) call F
+# define CALL_BIF(F) call nbif_impl_##F
#endif'
/*
@@ -53,9 +55,10 @@ define(HANDLE_GOT_MBUF,`
* standard_bif_interface_1(nbif_name, cbif_name)
* standard_bif_interface_2(nbif_name, cbif_name)
* standard_bif_interface_3(nbif_name, cbif_name)
+ * standard_bif_interface_4(nbif_name, cbif_name)
* standard_bif_interface_0(nbif_name, cbif_name)
*
- * Generate native interface for a BIF with 0-3 parameters and
+ * Generate native interface for a BIF with 0-4 parameters and
* standard failure mode.
*/
define(standard_bif_interface_1,
@@ -145,6 +148,39 @@ $1:
.type $1, #function
#endif')
+define(standard_bif_interface_4,
+`
+#ifndef HAVE_$1
+#`define' HAVE_$1
+ .global $1
+$1:
+ /* Set up C argument registers. */
+ mov P, %o0
+ NBIF_ARG(%o1,4,0)
+ NBIF_ARG(%o2,4,1)
+ NBIF_ARG(%o3,4,2)
+ NBIF_ARG(%o4,4,3)
+
+ /* Save caller-save registers and call the C function. */
+ SAVE_CONTEXT_BIF
+ st %o1, [%o0+P_ARG0] ! Store BIF__ARGS in def_arg_reg
+ st %o2, [%o0+P_ARG1]
+ st %o3, [%o0+P_ARG2]
+ st %o4, [%o0+P_ARG3]
+ add %o0, P_ARG0, %o1
+ CALL_BIF($2)
+ nop
+ TEST_GOT_MBUF
+
+ /* Restore registers. Check for exception. */
+ TEST_GOT_EXN(4)
+ RESTORE_CONTEXT_BIF
+ NBIF_RET(4)
+ HANDLE_GOT_MBUF(4)
+ .size $1, .-$1
+ .type $1, #function
+#endif')
+
define(standard_bif_interface_0,
`
#ifndef HAVE_$1
@@ -174,8 +210,9 @@ $1:
* gc_bif_interface_0(nbif_name, cbif_name)
* gc_bif_interface_1(nbif_name, cbif_name)
* gc_bif_interface_2(nbif_name, cbif_name)
+ * gc_bif_interface_3(nbif_name, cbif_name)
*
- * Generate native interface for a BIF with 0-2 parameters and
+ * Generate native interface for a BIF with 0-3 parameters and
* standard failure mode.
* The BIF may do a GC.
*/
@@ -259,6 +296,37 @@ $1:
.type $1, #function
#endif')
+define(gc_bif_interface_3,
+`
+#ifndef HAVE_$1
+#`define' HAVE_$1
+ .global $1
+$1:
+ /* Set up C argument registers. */
+ mov P, %o0
+ NBIF_ARG(%o1,3,0)
+ NBIF_ARG(%o2,3,1)
+ NBIF_ARG(%o3,3,2)
+
+ /* Save caller-save registers and call the C function. */
+ SAVE_CONTEXT_GC
+ st %o1, [%o0+P_ARG0] ! Store BIF__ARGS in def_arg_reg
+ st %o2, [%o0+P_ARG1]
+ st %o3, [%o0+P_ARG2]
+ add %o0, P_ARG0, %o1
+ CALL_BIF($2)
+ nop
+ TEST_GOT_MBUF
+
+ /* Restore registers. Check for exception. */
+ TEST_GOT_EXN(3)
+ RESTORE_CONTEXT_GC
+ NBIF_RET(3)
+ HANDLE_GOT_MBUF(3)
+ .size $1, .-$1
+ .type $1, #function
+#endif')
+
/*
* gc_nofail_primop_interface_1(nbif_name, cbif_name)
*
diff --git a/erts/emulator/hipe/hipe_sparc_gc.h b/erts/emulator/hipe/hipe_sparc_gc.h
index b870ddd59e..eea0268ed5 100644
--- a/erts/emulator/hipe/hipe_sparc_gc.h
+++ b/erts/emulator/hipe/hipe_sparc_gc.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2004-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2004-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/hipe/hipe_sparc_glue.S b/erts/emulator/hipe/hipe_sparc_glue.S
index 44bdf1bc7e..077db9b8ad 100644
--- a/erts/emulator/hipe/hipe_sparc_glue.S
+++ b/erts/emulator/hipe/hipe_sparc_glue.S
@@ -2,26 +2,26 @@
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
-
+#define ASM
#include "hipe_sparc_asm.h"
#include "hipe_literals.h"
-#define ASM
#include "hipe_mode_switch.h"
.section ".text"
@@ -155,9 +155,9 @@ hipe_sparc_throw_to_native:
* which should look as follows:
*
* stub for f/N:
- * sethi %hi(f's BEAM code address), TEMP_ARG0
+ * sethi %hi(f's export entry address), TEMP_ARG0
* mov RA, TEMP_RA ! because the call below clobbers RA (%o7)
- * or TEMP_ARG0, %lo(f's BEAM code address), TEMP_ARG0
+ * or TEMP_ARG0, %lo(f's export entry address), TEMP_ARG0
* call nbif_callemu ! clobbers RA!
* mov N, TEMP_ARG1 ! delay slot: TEMP_ARG1 := ARITY
*
@@ -165,12 +165,12 @@ hipe_sparc_throw_to_native:
*/
.global nbif_callemu
nbif_callemu:
- st TEMP_ARG0, [P+P_BEAM_IP]
+ st TEMP_ARG0, [P+P_CALLEE_EXP]
st TEMP_ARG1, [P+P_ARITY]
st TEMP_RA, [P+P_NRA]
STORE_ARG_REGS
ba .flush_exit
- mov HIPE_MODE_SWITCH_RES_CALL, %o0
+ mov HIPE_MODE_SWITCH_RES_CALL_EXPORTED, %o0
/*
* nbif_apply
@@ -317,6 +317,7 @@ nbif_fail:
.global nbif_1_gc_after_bif
.global nbif_2_gc_after_bif
.global nbif_3_gc_after_bif
+ .global nbif_4_gc_after_bif
nbif_0_gc_after_bif:
ba .gc_after_bif
mov 0, %o1 /* delay slot */
@@ -327,7 +328,10 @@ nbif_2_gc_after_bif:
ba .gc_after_bif
mov 2, %o1 /* delay slot */
nbif_3_gc_after_bif:
- mov 3, %o1
+ ba .gc_after_bif
+ mov 3, %o1 /* delay slot */
+nbif_4_gc_after_bif:
+ mov 4, %o1
/*FALLTHROUGH*/
.gc_after_bif:
st %o1, [P+P_NARITY]
@@ -365,7 +369,11 @@ nbif_2_simple_exception:
mov 2, %o1 /* delay slot */
.global nbif_3_simple_exception
nbif_3_simple_exception:
- mov 3, %o1
+ ba .nbif_simple_exception
+ mov 3, %o1 /* delay slot */
+ .global nbif_4_simple_exception
+nbif_4_simple_exception:
+ mov 4, %o1
/*FALLTHROUGH*/
.nbif_simple_exception:
ld [P+P_FREASON], %o0
diff --git a/erts/emulator/hipe/hipe_sparc_glue.h b/erts/emulator/hipe/hipe_sparc_glue.h
index 1404c0d4c0..3a1795f408 100644
--- a/erts/emulator/hipe/hipe_sparc_glue.h
+++ b/erts/emulator/hipe/hipe_sparc_glue.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/hipe/hipe_sparc_primops.h b/erts/emulator/hipe/hipe_sparc_primops.h
index 413371e5f0..2ecfa1293e 100644
--- a/erts/emulator/hipe/hipe_sparc_primops.h
+++ b/erts/emulator/hipe/hipe_sparc_primops.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2005-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2005-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/hipe/hipe_stack.c b/erts/emulator/hipe/hipe_stack.c
index 53c316ba52..4ee06690cf 100644
--- a/erts/emulator/hipe/hipe_stack.c
+++ b/erts/emulator/hipe/hipe_stack.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2003-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2003-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -42,10 +43,10 @@
*/
struct hipe_sdesc_table hipe_sdesc_table;
-static struct sdesc **alloc_bucket(unsigned int size)
+static struct hipe_sdesc **alloc_bucket(unsigned int size)
{
- unsigned long nbytes = size * sizeof(struct sdesc*);
- struct sdesc **bucket = erts_alloc(ERTS_ALC_T_HIPE, nbytes);
+ unsigned long nbytes = size * sizeof(struct hipe_sdesc*);
+ struct hipe_sdesc **bucket = erts_alloc(ERTS_ALC_T_HIPE_LL, nbytes);
sys_memzero(bucket, nbytes);
return bucket;
}
@@ -53,7 +54,7 @@ static struct sdesc **alloc_bucket(unsigned int size)
static void hipe_grow_sdesc_table(void)
{
unsigned int old_size, new_size, new_mask;
- struct sdesc **old_bucket, **new_bucket;
+ struct hipe_sdesc **old_bucket, **new_bucket;
unsigned int i;
old_size = 1 << hipe_sdesc_table.log2size;
@@ -65,23 +66,23 @@ static void hipe_grow_sdesc_table(void)
new_bucket = alloc_bucket(new_size);
hipe_sdesc_table.bucket = new_bucket;
for (i = 0; i < old_size; ++i) {
- struct sdesc *b = old_bucket[i];
+ struct hipe_sdesc *b = old_bucket[i];
while (b != NULL) {
- struct sdesc *next = b->bucket.next;
+ struct hipe_sdesc *next = b->bucket.next;
unsigned int j = (b->bucket.hvalue >> HIPE_RA_LSR_COUNT) & new_mask;
b->bucket.next = new_bucket[j];
new_bucket[j] = b;
b = next;
}
}
- erts_free(ERTS_ALC_T_HIPE, old_bucket);
+ erts_free(ERTS_ALC_T_HIPE_LL, old_bucket);
}
-struct sdesc *hipe_put_sdesc(struct sdesc *sdesc)
+struct hipe_sdesc *hipe_put_sdesc(struct hipe_sdesc *sdesc)
{
unsigned long ra;
unsigned int i;
- struct sdesc *chain;
+ struct hipe_sdesc *chain;
unsigned int size;
ra = sdesc->bucket.hvalue;
@@ -101,7 +102,29 @@ struct sdesc *hipe_put_sdesc(struct sdesc *sdesc)
return sdesc;
}
-void hipe_init_sdesc_table(struct sdesc *sdesc)
+void hipe_destruct_sdesc(struct hipe_sdesc *sdesc)
+{
+ unsigned int i;
+ struct hipe_sdesc** prevp;
+ void* free_me;
+
+ i = (sdesc->bucket.hvalue >> HIPE_RA_LSR_COUNT) & hipe_sdesc_table.mask;
+ prevp = &hipe_sdesc_table.bucket[i];
+
+ for (; *prevp != sdesc; prevp = &(*prevp)->bucket.next)
+ ASSERT(*prevp);
+
+ *prevp = sdesc->bucket.next;
+ hipe_sdesc_table.used -= 1;
+
+ if (sdesc->has_exnra)
+ free_me = ErtsContainerStruct(sdesc, struct hipe_sdesc_with_exnra, sdesc);
+ else
+ free_me = sdesc;
+ erts_free(ERTS_ALC_T_HIPE_LL, free_me);
+}
+
+void hipe_init_sdesc_table(struct hipe_sdesc *sdesc)
{
unsigned int log2size, size;
@@ -120,31 +143,46 @@ void hipe_init_sdesc_table(struct sdesc *sdesc)
* representation. If different representations are needed in
* the future, this code has to be made target dependent.
*/
-struct sdesc *hipe_decode_sdesc(Eterm arg)
+struct hipe_sdesc *hipe_decode_sdesc(Eterm arg)
{
Uint ra, exnra;
Eterm *live;
- Uint fsize, arity, nlive, i, nslots, off;
+ Uint fsize, nargs, stk_nargs, nlive, i, nslots, off;
Uint livebitswords, sdescbytes;
void *p;
- struct sdesc *sdesc;
-
- if (is_not_tuple(arg) ||
- (tuple_val(arg))[0] != make_arityval(6) ||
- term_to_Uint((tuple_val(arg))[1], &ra) == 0 ||
- term_to_Uint((tuple_val(arg))[2], &exnra) == 0 ||
- is_not_small((tuple_val(arg))[3]) ||
- (fsize = unsigned_val((tuple_val(arg))[3])) > 65535 ||
- is_not_small((tuple_val(arg))[4]) ||
- (arity = unsigned_val((tuple_val(arg))[4])) > 255 ||
- is_not_tuple((tuple_val(arg))[5]))
+ struct hipe_sdesc *sdesc;
+ Eterm* mfa_tpl;
+ Eterm* tp;
+
+ if (is_not_tuple(arg))
+ return 0;
+
+ tp = tuple_val(arg);
+ if (tp[0] != make_arityval(6) ||
+ term_to_Uint(tp[1], &ra) == 0 ||
+ term_to_Uint(tp[2], &exnra) == 0 ||
+ is_not_small(tp[3]) ||
+ (fsize = unsigned_val(tp[3])) > 65535 ||
+ is_not_small(tp[4]) ||
+ (stk_nargs = unsigned_val(tp[4])) > 255 ||
+ is_not_tuple(tp[5]) ||
+ is_not_tuple(tp[6]) ||
+ (mfa_tpl = tuple_val(tp[6]))[0] != make_arityval(3) ||
+ is_not_atom(mfa_tpl[1]) ||
+ is_not_atom(mfa_tpl[2]) ||
+ is_not_small(mfa_tpl[3]) ||
+ (nargs = unsigned_val(mfa_tpl[3])) > 255)
return 0;
+
+ if (stk_nargs > nargs)
+ return 0;
+
/* Get tuple with live slots */
- live = tuple_val((tuple_val(arg))[5]) + 1;
+ live = tuple_val(tp[5]) + 1;
/* Get number of live slots */
nlive = arityval(live[-1]);
- /* Calculate size of frame = locals + ra + arguments */
- nslots = fsize + 1 + arity;
+ /* Calculate size of frame = locals + ra + stack arguments */
+ nslots = fsize + 1 + stk_nargs;
/* Check that only valid slots are given. */
for (i = 0; i < nlive; ++i) {
if (is_not_small(live[i]) ||
@@ -154,27 +192,34 @@ struct sdesc *hipe_decode_sdesc(Eterm arg)
}
/* Calculate number of words for the live bitmap. */
- livebitswords = (fsize + arity + 1 + 31) / 32;
+ livebitswords = (fsize + stk_nargs + 1 + 31) / 32;
/* Calculate number of bytes needed for the stack descriptor. */
sdescbytes =
(exnra
- ? offsetof(struct sdesc_with_exnra, sdesc.livebits)
- : offsetof(struct sdesc, livebits))
+ ? offsetof(struct hipe_sdesc_with_exnra, sdesc.livebits)
+ : offsetof(struct hipe_sdesc, livebits))
+ livebitswords * sizeof(int);
- p = erts_alloc(ERTS_ALC_T_HIPE, sdescbytes);
+ p = erts_alloc(ERTS_ALC_T_HIPE_LL, sdescbytes);
/* If we have an exception handler use the
special sdesc_with_exnra structure. */
if (exnra) {
- struct sdesc_with_exnra *sdesc_we = p;
+ struct hipe_sdesc_with_exnra *sdesc_we = p;
sdesc_we->exnra = exnra;
sdesc = &(sdesc_we->sdesc);
} else
sdesc = p;
+ sdesc->m_aix = atom_val(mfa_tpl[1]);
+ sdesc->f_aix = atom_val(mfa_tpl[2]);
+ sdesc->a = nargs;
+
+
/* Initialise head of sdesc. */
sdesc->bucket.next = 0;
sdesc->bucket.hvalue = ra;
- sdesc->summary = (fsize << 9) | (exnra ? (1<<8) : 0) | arity;
+ sdesc->fsize = fsize;
+ sdesc->has_exnra = (exnra ? 1 : 0);
+ sdesc->stk_nargs = stk_nargs;
/* Clear all live-bits */
for (i = 0; i < livebitswords; ++i)
sdesc->livebits[i] = 0;
@@ -183,13 +228,5 @@ struct sdesc *hipe_decode_sdesc(Eterm arg)
off = unsigned_val(live[i]);
sdesc->livebits[off / 32] |= (1 << (off & 31));
}
-#ifdef DEBUG
- {
- Eterm mfa_tpl = tuple_val(arg)[6];
- sdesc->dbg_M = tuple_val(mfa_tpl)[1];
- sdesc->dbg_F = tuple_val(mfa_tpl)[2];
- sdesc->dbg_A = tuple_val(mfa_tpl)[3];
- }
-#endif
return sdesc;
}
diff --git a/erts/emulator/hipe/hipe_stack.h b/erts/emulator/hipe/hipe_stack.h
index 66f9f04c73..7e30358767 100644
--- a/erts/emulator/hipe/hipe_stack.h
+++ b/erts/emulator/hipe/hipe_stack.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2012. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -29,40 +30,43 @@
#include <stddef.h> /* offsetof() */
-struct sdesc {
+struct hipe_sdesc {
struct {
unsigned long hvalue; /* return address */
- struct sdesc *next; /* hash collision chain */
+ struct hipe_sdesc *next; /* hash collision chain */
} bucket;
- unsigned int summary; /* frame size, exn handler presence flag, arity */
-#ifdef DEBUG
- Eterm dbg_M, dbg_F;
- unsigned dbg_A;
-#endif
- unsigned int livebits[1]; /* size depends on arch & data in summary field */
+ unsigned int fsize : 23; /* frame size */
+ unsigned int has_exnra : 1; /* exn handler presence flag */
+ unsigned int stk_nargs : 8; /* arguments on stack */
+ Uint32 m_aix;
+ Uint32 f_aix;
+ Uint32 a;
+ struct hipe_sdesc* next_in_modi;
+ Uint32 livebits[1]; /* size depends on arch & data in summary field */
};
-struct sdesc_with_exnra {
+struct hipe_sdesc_with_exnra {
unsigned long exnra;
- struct sdesc sdesc;
+ struct hipe_sdesc sdesc;
};
-static __inline__ unsigned int sdesc_fsize(const struct sdesc *sdesc)
+static __inline__ unsigned int sdesc_fsize(const struct hipe_sdesc *sdesc)
{
- return sdesc->summary >> 9;
+ return sdesc->fsize;
}
-static __inline__ unsigned int sdesc_arity(const struct sdesc *sdesc)
+/* Nr of arguments pushed on stack */
+static __inline__ unsigned int sdesc_arity(const struct hipe_sdesc *sdesc)
{
- return sdesc->summary & 0xFF;
+ return sdesc->stk_nargs;
}
-static __inline__ unsigned long sdesc_exnra(const struct sdesc *sdesc)
+static __inline__ unsigned long sdesc_exnra(const struct hipe_sdesc *sdesc)
{
- if ((sdesc->summary & (1<<8))) {
+ if (sdesc->has_exnra) {
const char *tmp;
- tmp = (const char*)sdesc - offsetof(struct sdesc_with_exnra, sdesc);
- return ((const struct sdesc_with_exnra*)tmp)->exnra;
+ tmp = (const char*)sdesc - offsetof(struct hipe_sdesc_with_exnra, sdesc);
+ return ((const struct hipe_sdesc_with_exnra*)tmp)->exnra;
}
return 0;
}
@@ -71,13 +75,14 @@ struct hipe_sdesc_table {
unsigned int log2size;
unsigned int mask; /* INV: mask == (1 << log2size)-1 */
unsigned int used;
- struct sdesc **bucket;
+ struct hipe_sdesc **bucket;
};
extern struct hipe_sdesc_table hipe_sdesc_table;
-extern struct sdesc *hipe_put_sdesc(struct sdesc*);
-extern void hipe_init_sdesc_table(struct sdesc*);
-extern struct sdesc *hipe_decode_sdesc(Eterm);
+extern struct hipe_sdesc *hipe_put_sdesc(struct hipe_sdesc*);
+extern void hipe_destruct_sdesc(struct hipe_sdesc*);
+extern void hipe_init_sdesc_table(struct hipe_sdesc*);
+extern struct hipe_sdesc *hipe_decode_sdesc(Eterm);
#if !defined(__GNUC__) || (__GNUC__ < 2) || (__GNUC__ == 2 && __GNUC_MINOR__ < 96)
#define __builtin_expect(x, expected_value) (x)
@@ -85,10 +90,10 @@ extern struct sdesc *hipe_decode_sdesc(Eterm);
#define likely(x) __builtin_expect((x),1)
#define unlikely(x) __builtin_expect((x),0)
-static __inline__ const struct sdesc *hipe_find_sdesc(unsigned long ra)
+static __inline__ const struct hipe_sdesc *hipe_find_sdesc(unsigned long ra)
{
unsigned int i = (ra >> HIPE_RA_LSR_COUNT) & hipe_sdesc_table.mask;
- const struct sdesc *sdesc = hipe_sdesc_table.bucket[i];
+ const struct hipe_sdesc *sdesc = hipe_sdesc_table.bucket[i];
if (likely(sdesc->bucket.hvalue == ra))
return sdesc;
do {
@@ -102,22 +107,38 @@ AEXTERN(void,nbif_stack_trap_ra,(void));
extern void hipe_print_nstack(Process*);
extern void hipe_find_handler(Process*);
extern void (*hipe_handle_stack_trap(Process*))(void);
-extern void hipe_update_stack_trap(Process*, const struct sdesc*);
+extern void hipe_update_stack_trap(Process*, const struct hipe_sdesc*);
extern int hipe_fill_stacktrace(Process*, int, Eterm**);
#if 0 && defined(HIPE_NSTACK_GROWS_UP)
#define hipe_nstack_start(p) ((p)->hipe.nstack)
#define hipe_nstack_used(p) ((p)->hipe.nsp - (p)->hipe.nstack)
+#define hipe_nstack_avail(p) ((p)->hipe.nstend - (p)->hipe.nsp)
#endif
#if defined(HIPE_NSTACK_GROWS_DOWN)
#define hipe_nstack_start(p) ((p)->hipe.nsp)
#define hipe_nstack_used(p) ((p)->hipe.nstend - (p)->hipe.nsp)
+#define hipe_nstack_avail(p) ((unsigned)((p)->hipe.nsp - (p)->hipe.nstack))
#endif
+/* ensure that at least nwords words are available on the native stack */
+static __inline__ void hipe_check_nstack(Process *p, unsigned nwords)
+{
+ extern void hipe_inc_nstack(Process *p);
+
+ while (hipe_nstack_avail(p) < nwords)
+ hipe_inc_nstack(p);
+}
+
/*
* GC support procedures
*/
extern Eterm *fullsweep_nstack(Process *p, Eterm *n_htop);
extern void gensweep_nstack(Process *p, Eterm **ptr_old_htop, Eterm **ptr_n_htop);
+extern Eterm *sweep_literals_nstack(Process *p, Eterm *n_htop, char *area,
+ Uint area_size);
+extern int nstack_any_heap_ref_ptrs(Process *, char* mod_start, Uint mod_size);
+extern int nstack_any_cps_in_segment(Process *, char* seg_start, Uint seg_size);
+
#endif /* HIPE_STACK_H */
diff --git a/erts/emulator/hipe/hipe_x86.c b/erts/emulator/hipe/hipe_x86.c
index 327c74e9aa..c7e24673ac 100644
--- a/erts/emulator/hipe/hipe_x86.c
+++ b/erts/emulator/hipe/hipe_x86.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2003-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2003-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -23,7 +24,6 @@
#include "config.h"
#endif
#include "global.h"
-#include <sys/mman.h>
#include "hipe_arch.h"
#include "hipe_native_bif.h" /* nbif_callemu() */
@@ -36,7 +36,7 @@
void hipe_patch_load_fe(Uint32 *address, Uint32 value)
{
/* address points to a disp32 or imm32 operand */
- *address = value;
+ *address += value;
}
int hipe_patch_insn(void *address, Uint32 value, Eterm type)
@@ -53,7 +53,7 @@ int hipe_patch_insn(void *address, Uint32 value, Eterm type)
default:
return -1;
}
- *(Uint32*)address = value;
+ *(Uint32*)address += value;
return 0;
}
@@ -61,117 +61,17 @@ int hipe_patch_call(void *callAddress, void *destAddress, void *trampoline)
{
Uint rel32;
- if (trampoline)
- return -1;
+ ASSERT(trampoline == NULL);
+
rel32 = (Uint)destAddress - (Uint)callAddress - 4;
*(Uint32*)callAddress = rel32;
hipe_flush_icache_word(callAddress);
return 0;
}
-/*
- * Memory allocator for executable code.
- *
- * This is required on x86 because some combinations
- * of Linux kernels and CPU generations default to
- * non-executable memory mappings, causing ordinary
- * malloc() memory to be non-executable.
- */
-static unsigned int code_bytes;
-static char *code_next;
-
-#if 0 /* change to non-zero to get allocation statistics at exit() */
-static unsigned int total_mapped, nr_joins, nr_splits, total_alloc, nr_allocs, nr_large, total_lost;
-static unsigned int atexit_done;
-
-static void alloc_code_stats(void)
-{
- printf("\r\nalloc_code_stats: %u bytes mapped, %u joins, %u splits, %u bytes allocated, %u average alloc, %u large allocs, %u bytes lost\r\n",
- total_mapped, nr_joins, nr_splits, total_alloc, nr_allocs ? total_alloc/nr_allocs : 0, nr_large, total_lost);
-}
-
-static void atexit_alloc_code_stats(void)
-{
- if (!atexit_done) {
- atexit_done = 1;
- (void)atexit(alloc_code_stats);
- }
-}
-
-#define ALLOC_CODE_STATS(X) do{X;}while(0)
-#else
-#define ALLOC_CODE_STATS(X) do{}while(0)
-#endif
-
-/* FreeBSD 6.1 and Darwin breakage */
-#if !defined(MAP_ANONYMOUS) && defined(MAP_ANON)
-#define MAP_ANONYMOUS MAP_ANON
-#endif
-
-static void morecore(unsigned int alloc_bytes)
-{
- unsigned int map_bytes;
- char *map_hint, *map_start;
-
- /* Page-align the amount to allocate. */
- map_bytes = (alloc_bytes + 4095) & ~4095;
-
- /* Round up small allocations. */
- if (map_bytes < 1024*1024)
- map_bytes = 1024*1024;
- else
- ALLOC_CODE_STATS(++nr_large);
-
- /* Create a new memory mapping, ensuring it is executable
- and in the low 2GB of the address space. Also attempt
- to make it adjacent to the previous mapping. */
- map_hint = code_next + code_bytes;
- if ((unsigned long)map_hint & 4095)
- abort();
- map_start = mmap(map_hint, map_bytes,
- PROT_EXEC|PROT_READ|PROT_WRITE,
- MAP_PRIVATE|MAP_ANONYMOUS
-#ifdef __x86_64__
- |MAP_32BIT
-#endif
- ,
- -1, 0);
- if (map_start == MAP_FAILED) {
- perror("mmap");
- abort();
- }
- ALLOC_CODE_STATS(total_mapped += map_bytes);
-
- /* Merge adjacent mappings, so the trailing portion of the previous
- mapping isn't lost. In practice this is quite successful. */
- if (map_start == map_hint) {
- ALLOC_CODE_STATS(++nr_joins);
- code_bytes += map_bytes;
- } else {
- ALLOC_CODE_STATS(++nr_splits);
- ALLOC_CODE_STATS(total_lost += code_bytes);
- code_next = map_start;
- code_bytes = map_bytes;
- }
-
- ALLOC_CODE_STATS(atexit_alloc_code_stats());
-}
-
static void *alloc_code(unsigned int alloc_bytes)
{
- void *res;
-
- /* Align function entries. */
- alloc_bytes = (alloc_bytes + 3) & ~3;
-
- if (code_bytes < alloc_bytes)
- morecore(alloc_bytes);
- ALLOC_CODE_STATS(++nr_allocs);
- ALLOC_CODE_STATS(total_alloc += alloc_bytes);
- res = code_next;
- code_next += alloc_bytes;
- code_bytes -= alloc_bytes;
- return res;
+ return erts_alloc(ERTS_ALC_T_HIPE_EXEC, alloc_bytes);
}
void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *p)
@@ -182,18 +82,21 @@ void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *
return alloc_code(nrbytes);
}
-/* called from hipe_bif0.c:hipe_bifs_make_native_stub_2()
- and hipe_bif0.c:hipe_make_stub() */
-void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity)
+void hipe_free_code(void* code, unsigned int bytes)
+{
+ erts_free(ERTS_ALC_T_HIPE_EXEC, code);
+}
+
+void *hipe_make_native_stub(void *callee_exp, unsigned int beamArity)
{
/*
* This creates a native code stub with the following contents:
*
- * movl $Address, P_BEAM_IP(%ebp)
+ * movl $Address, P_CALLEE_EXP(%ebp)
* movb $Arity, P_ARITY(%ebp)
* jmp callemu
*
- * The stub has variable size, depending on whether the P_BEAM_IP
+ * The stub has variable size, depending on whether the P_CALLEE_EXP
* and P_ARITY offsets fit in 8-bit signed displacements or not.
* The rel32 offset in the final jmp depends on its actual location,
* which also depends on the size of the previous instructions.
@@ -206,28 +109,30 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity)
codeSize = /* 16, 19, or 22 bytes */
16 + /* 16 when both offsets are 8-bit */
- (P_BEAM_IP >= 128 ? 3 : 0) +
+ (P_CALLEE_EXP >= 128 ? 3 : 0) +
(P_ARITY >= 128 ? 3 : 0);
codep = code = alloc_code(codeSize);
+ if (!code)
+ return NULL;
- /* movl $beamAddress, P_BEAM_IP(%ebp); 3 or 6 bytes, plus 4 */
+ /* movl $beamAddress, P_CALLEE_EXP(%ebp); 3 or 6 bytes, plus 4 */
codep[0] = 0xc7;
-#if P_BEAM_IP >= 128
+#if P_CALLEE_EXP >= 128
codep[1] = 0x85; /* disp32[EBP] */
- codep[2] = P_BEAM_IP & 0xFF;
- codep[3] = (P_BEAM_IP >> 8) & 0xFF;
- codep[4] = (P_BEAM_IP >> 16) & 0xFF;
- codep[5] = (P_BEAM_IP >> 24) & 0xFF;
+ codep[2] = P_CALLEE_EXP & 0xFF;
+ codep[3] = (P_CALLEE_EXP >> 8) & 0xFF;
+ codep[4] = (P_CALLEE_EXP >> 16) & 0xFF;
+ codep[5] = (P_CALLEE_EXP >> 24) & 0xFF;
codep += 6;
#else
codep[1] = 0x45; /* disp8[EBP] */
- codep[2] = P_BEAM_IP;
+ codep[2] = P_CALLEE_EXP;
codep += 3;
#endif
- codep[0] = ((unsigned int)beamAddress) & 0xFF;
- codep[1] = ((unsigned int)beamAddress >> 8) & 0xFF;
- codep[2] = ((unsigned int)beamAddress >> 16) & 0xFF;
- codep[3] = ((unsigned int)beamAddress >> 24) & 0xFF;
+ codep[0] = ((unsigned int)callee_exp) & 0xFF;
+ codep[1] = ((unsigned int)callee_exp >> 8) & 0xFF;
+ codep[2] = ((unsigned int)callee_exp >> 16) & 0xFF;
+ codep[3] = ((unsigned int)callee_exp >> 24) & 0xFF;
codep += 4;
/* movb $beamArity, P_ARITY(%ebp); 3 or 6 bytes */
@@ -262,6 +167,11 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity)
return code;
}
+void hipe_free_native_stub(void* stub)
+{
+ erts_free(ERTS_ALC_T_HIPE_EXEC, stub);
+}
+
void hipe_arch_print_pcb(struct hipe_process_state *p)
{
#define U(n,x) \
diff --git a/erts/emulator/hipe/hipe_x86.h b/erts/emulator/hipe/hipe_x86.h
index 97f09e38cd..8967793171 100644
--- a/erts/emulator/hipe/hipe_x86.h
+++ b/erts/emulator/hipe/hipe_x86.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2003-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2003-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -53,8 +54,4 @@ extern void nbif_inc_stack_0(void);
extern void nbif_handle_fp_exception(void);
#endif
-/* for hipe_bifs_enter_code_2 */
-extern void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *p);
-#define HIPE_ALLOC_CODE(n,c,t,p) hipe_alloc_code((n),(c),(t),(p))
-
#endif /* HIPE_X86_H */
diff --git a/erts/emulator/hipe/hipe_x86.tab b/erts/emulator/hipe/hipe_x86.tab
index fb33d0a6b9..b922f05165 100644
--- a/erts/emulator/hipe/hipe_x86.tab
+++ b/erts/emulator/hipe/hipe_x86.tab
@@ -1,18 +1,19 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2004-2011. All Rights Reserved.
+# Copyright Ericsson AB 2004-2016. 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/.
+# 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
#
-# 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.
+# 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%
#
diff --git a/erts/emulator/hipe/hipe_x86_abi.txt b/erts/emulator/hipe/hipe_x86_abi.txt
index aa04a12611..31a4a0e121 100644
--- a/erts/emulator/hipe/hipe_x86_abi.txt
+++ b/erts/emulator/hipe/hipe_x86_abi.txt
@@ -1,18 +1,19 @@
%CopyrightBegin%
- Copyright Ericsson AB 2001-2011. All Rights Reserved.
+ Copyright Ericsson AB 2001-2016. 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/.
+ 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
- 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.
+ 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%
diff --git a/erts/emulator/hipe/hipe_x86_asm.m4 b/erts/emulator/hipe/hipe_x86_asm.m4
index 020ccf8d4b..91c60382eb 100644
--- a/erts/emulator/hipe/hipe_x86_asm.m4
+++ b/erts/emulator/hipe/hipe_x86_asm.m4
@@ -2,18 +2,19 @@ changecom(`/*', `*/')dnl
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2002-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2002-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -33,6 +34,18 @@ define(SIMULATE_NSP,0)dnl change to 1 to simulate call/ret insns
`#define X86_LEAF_WORDS 'LEAF_WORDS
`#define LEAF_WORDS 'LEAF_WORDS
+`#define X86_NR_ARG_REGS 'NR_ARG_REGS
+`#define NR_ARG_REGS 'NR_ARG_REGS
+
+`#define X86_HP_IN_ESI 'HP_IN_ESI
+`#define X86_SIMULATE_NSP 'SIMULATE_NSP
+
+
+`#ifdef ASM'
+/*
+ * Only assembler stuff from here on (when included from *.S)
+ */
+
/*
* Workarounds for Darwin.
*/
@@ -60,7 +73,6 @@ ifelse(OPSYS,darwin,``
*/
`#define P %ebp'
-`#define X86_HP_IN_ESI 'HP_IN_ESI
`#if X86_HP_IN_ESI
#define SAVE_HP movl %esi, P_HP(P)
#define RESTORE_HP movl P_HP(P), %esi
@@ -73,7 +85,6 @@ ifelse(OPSYS,darwin,``
#define SAVE_CSP movl %esp, P_CSP(P)
#define RESTORE_CSP movl P_CSP(P), %esp'
-`#define X86_SIMULATE_NSP 'SIMULATE_NSP
/*
* Context switching macros.
@@ -100,12 +111,10 @@ ifelse(OPSYS,darwin,``
SAVE_CACHED_STATE; \
SWITCH_ERLANG_TO_C_QUICK'
+
/*
* Argument (parameter) registers.
*/
-`#define X86_NR_ARG_REGS 'NR_ARG_REGS
-`#define NR_ARG_REGS 'NR_ARG_REGS
-
ifelse(eval(NR_ARG_REGS >= 1),0,,
``#define ARG0 %eax
'')dnl
@@ -204,6 +213,7 @@ define(NBIF_COPY_NSP,`ifelse(eval($1 > NR_ARG_REGS),0,,`movl %esp, TEMP_NSP')')d
`/* #define NBIF_COPY_NSP_1 'NBIF_COPY_NSP(1)` */'
`/* #define NBIF_COPY_NSP_2 'NBIF_COPY_NSP(2)` */'
`/* #define NBIF_COPY_NSP_3 'NBIF_COPY_NSP(3)` */'
+`/* #define NBIF_COPY_NSP_4 'NBIF_COPY_NSP(4)` */'
`/* #define NBIF_COPY_NSP_5 'NBIF_COPY_NSP(5)` */'
dnl
@@ -227,6 +237,10 @@ define(NBIF_ARG_OPND,`ifelse(eval($2 >= NR_ARG_REGS),0,`ARG'$2,BASE_OFFSET(eval(
`/* #define NBIF_ARG_OPND_3_0 'NBIF_ARG_OPND(3,0)` */'
`/* #define NBIF_ARG_OPND_3_1 'NBIF_ARG_OPND(3,1)` */'
`/* #define NBIF_ARG_OPND_3_2 'NBIF_ARG_OPND(3,2)` */'
+`/* #define NBIF_ARG_OPND_4_0 'NBIF_ARG_OPND(4,0)` */'
+`/* #define NBIF_ARG_OPND_4_1 'NBIF_ARG_OPND(4,1)` */'
+`/* #define NBIF_ARG_OPND_4_2 'NBIF_ARG_OPND(4,2)` */'
+`/* #define NBIF_ARG_OPND_4_3 'NBIF_ARG_OPND(4,3)` */'
`/* #define NBIF_ARG_OPND_5_0 'NBIF_ARG_OPND(5,0)` */'
`/* #define NBIF_ARG_OPND_5_1 'NBIF_ARG_OPND(5,1)` */'
`/* #define NBIF_ARG_OPND_5_2 'NBIF_ARG_OPND(5,2)` */'
@@ -266,6 +280,7 @@ define(NBIF_RET,`NBIF_RET_N(eval(RET_POP($1)))')dnl
`/* #define NBIF_RET_1 'NBIF_RET(1)` */'
`/* #define NBIF_RET_2 'NBIF_RET(2)` */'
`/* #define NBIF_RET_3 'NBIF_RET(3)` */'
+`/* #define NBIF_RET_4 'NBIF_RET(4)` */'
`/* #define NBIF_RET_5 'NBIF_RET(5)` */'
dnl
@@ -282,4 +297,6 @@ define(LOAD_CALLER_SAVE,`LAR_N(eval(NR_CALLER_SAVE-1))')dnl
`#define STORE_CALLER_SAVE 'STORE_CALLER_SAVE
`#define LOAD_CALLER_SAVE 'LOAD_CALLER_SAVE
+`#endif /* ASM */'
+
`#endif /* HIPE_X86_ASM_H */'
diff --git a/erts/emulator/hipe/hipe_x86_bifs.m4 b/erts/emulator/hipe/hipe_x86_bifs.m4
index dd6980f555..aecf67dc1b 100644
--- a/erts/emulator/hipe/hipe_x86_bifs.m4
+++ b/erts/emulator/hipe/hipe_x86_bifs.m4
@@ -2,23 +2,25 @@ changecom(`/*', `*/')dnl
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2012. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
+#`define ASM'
include(`hipe/hipe_x86_asm.m4')
#`include' "config.h"
#`include' "hipe_literals.h"
@@ -30,9 +32,9 @@ include(`hipe/hipe_x86_asm.m4')
#endif'
`#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP)
-# define CALL_BIF(F) movl $CSYM(F), P_BIF_CALLEE(P); call CSYM(hipe_debug_bif_wrapper)
+# define CALL_BIF(F) movl $CSYM(nbif_impl_##F), P_BIF_CALLEE(P); call CSYM(hipe_debug_bif_wrapper)
#else
-# define CALL_BIF(F) call CSYM(F)
+# define CALL_BIF(F) call CSYM(nbif_impl_##F)
#endif'
define(TEST_GOT_MBUF,`movl P_MBUF(P), %edx /* `TEST_GOT_MBUF' */
@@ -47,9 +49,10 @@ define(HANDLE_GOT_MBUF,`
* standard_bif_interface_1(nbif_name, cbif_name)
* standard_bif_interface_2(nbif_name, cbif_name)
* standard_bif_interface_3(nbif_name, cbif_name)
+ * standard_bif_interface_4(nbif_name, cbif_name)
* standard_bif_interface_0(nbif_name, cbif_name)
*
- * Generate native interface for a BIF with 0-3 parameters and
+ * Generate native interface for a BIF with 0-4 parameters and
* standard failure mode.
*/
define(standard_bif_interface_1,
@@ -157,6 +160,43 @@ ASYM($1):
TYPE_FUNCTION(ASYM($1))
#endif')
+define(standard_bif_interface_4,
+`
+#ifndef HAVE_$1
+#`define' HAVE_$1
+ TEXT
+ .align 4
+ GLOBAL(ASYM($1))
+ASYM($1):
+ /* copy native stack pointer */
+ NBIF_COPY_NSP(4)
+
+ /* switch to C stack */
+ SWITCH_ERLANG_TO_C
+
+ /* make the call on the C stack */
+ NBIF_ARG_REG(0,P)
+ NBIF_ARG(2,4,0)
+ NBIF_ARG(3,4,1)
+ NBIF_ARG(4,4,2)
+ NBIF_ARG(5,4,3)
+ lea 8(%esp), %eax
+ NBIF_ARG_REG(1,%eax) /* BIF__ARGS */
+ CALL_BIF($2)
+ TEST_GOT_MBUF
+
+ /* switch to native stack */
+ SWITCH_C_TO_ERLANG
+
+ /* throw exception if failure, otherwise return */
+ TEST_GOT_EXN
+ jz nbif_4_simple_exception
+ NBIF_RET(4)
+ HANDLE_GOT_MBUF(4)
+ SET_SIZE(ASYM($1))
+ TYPE_FUNCTION(ASYM($1))
+#endif')
+
define(standard_bif_interface_0,
`
#ifndef HAVE_$1
@@ -626,15 +666,12 @@ noproc_primop_interface_0(nbif_handle_fp_exception, erts_restore_fpu)
#endif /* NO_FPE_SIGNALS */
/*
- * Implement gc_bif_interface_0 as nofail_primop_interface_0.
- */
-define(gc_bif_interface_0,`nofail_primop_interface_0($1, $2)')
-
-/*
- * Implement gc_bif_interface_N as standard_bif_interface_N (N=1,2).
+ * Implement gc_bif_interface_N as standard_bif_interface_N.
*/
+define(gc_bif_interface_0,`standard_bif_interface_0($1, $2)')
define(gc_bif_interface_1,`standard_bif_interface_1($1, $2)')
define(gc_bif_interface_2,`standard_bif_interface_2($1, $2)')
+define(gc_bif_interface_3,`standard_bif_interface_3($1, $2)')
/*
* Implement gc_nofail_primop_interface_1 as nofail_primop_interface_1.
diff --git a/erts/emulator/hipe/hipe_x86_gc.h b/erts/emulator/hipe/hipe_x86_gc.h
index ac6b4f70bb..a703e24b8c 100644
--- a/erts/emulator/hipe/hipe_x86_gc.h
+++ b/erts/emulator/hipe/hipe_x86_gc.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2004-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2004-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -29,9 +30,9 @@
struct nstack_walk_state {
#ifdef SKIP_YOUNGEST_FRAME
- const struct sdesc *sdesc0; /* .sdesc0 must be a pointer rvalue */
+ const struct hipe_sdesc *sdesc0; /* .sdesc0 must be a pointer rvalue */
#else
- struct sdesc sdesc0[1]; /* .sdesc0 must be a pointer rvalue */
+ struct hipe_sdesc sdesc0[1]; /* .sdesc0 must be a pointer rvalue */
#endif
};
@@ -56,31 +57,47 @@ static inline Eterm *nstack_walk_nsp_begin(const Process *p)
#endif
}
-static inline const struct sdesc*
+static inline const struct hipe_sdesc*
nstack_walk_init_sdesc(const Process *p, struct nstack_walk_state *state)
{
#ifdef SKIP_YOUNGEST_FRAME
- const struct sdesc *sdesc = hipe_find_sdesc(p->hipe.nsp[0]);
+ const struct hipe_sdesc *sdesc = hipe_find_sdesc(p->hipe.nsp[0]);
state->sdesc0 = sdesc;
return sdesc;
#else
- unsigned int nstkarity = p->hipe.narity - NR_ARG_REGS;
- if ((int)nstkarity < 0)
- nstkarity = 0;
- state->sdesc0[0].summary = (0 << 9) | (0 << 8) | nstkarity;
+ state->sdesc0[0].bucket.hvalue = 0; /* for nstack_any_cps_in_segment */
+ state->sdesc0[0].fsize = 0;
+ state->sdesc0[0].has_exnra = 0;
+ state->sdesc0[0].stk_nargs = (p->hipe.narity < NR_ARG_REGS ? 0 :
+ p->hipe.narity - NR_ARG_REGS);
state->sdesc0[0].livebits[0] = 0;
-# ifdef DEBUG
- state->sdesc0[0].dbg_M = 0;
- state->sdesc0[0].dbg_F = am_undefined;
- state->sdesc0[0].dbg_A = 0;
-# endif
+ state->sdesc0[0].m_aix = 0;
+ state->sdesc0[0].f_aix = atom_val(am_undefined);
+ state->sdesc0[0].a = 0;
/* XXX: this appears to prevent a gcc-4.1.1 bug on x86 */
__asm__ __volatile__("" : : "m"(*state) : "memory");
return &state->sdesc0[0];
#endif
}
-static inline void nstack_walk_update_trap(Process *p, const struct sdesc *sdesc0)
+static inline const struct hipe_sdesc*
+nstack_walk_init_sdesc_ignore_trap(const Process *p,
+ struct nstack_walk_state *state)
+{
+#ifdef SKIP_YOUNGEST_FRAME
+ unsigned long ra = p->hipe.nsp[0];
+ const struct hipe_sdesc *sdesc;
+ if (ra == (unsigned long)nbif_stack_trap_ra)
+ ra = (unsigned long)p->hipe.ngra;
+ sdesc = hipe_find_sdesc(ra);
+ state->sdesc0 = sdesc;
+ return sdesc;
+#else
+ return nstack_walk_init_sdesc(p, state);
+#endif
+}
+
+static inline void nstack_walk_update_trap(Process *p, const struct hipe_sdesc *sdesc0)
{
#ifdef SKIP_YOUNGEST_FRAME
Eterm *nsp = p->hipe.nsp;
@@ -119,7 +136,7 @@ static inline int nstack_walk_nsp_reached_end(const Eterm *nsp, const Eterm *nsp
return nsp >= nsp_end;
}
-static inline unsigned int nstack_walk_frame_size(const struct sdesc *sdesc)
+static inline unsigned int nstack_walk_frame_size(const struct hipe_sdesc *sdesc)
{
return sdesc_fsize(sdesc) + 1 + sdesc_arity(sdesc);
}
@@ -130,7 +147,7 @@ static inline Eterm *nstack_walk_frame_index(Eterm *nsp, unsigned int i)
}
static inline unsigned long
-nstack_walk_frame_ra(const Eterm *nsp, const struct sdesc *sdesc)
+nstack_walk_frame_ra(const Eterm *nsp, const struct hipe_sdesc *sdesc)
{
return nsp[sdesc_fsize(sdesc)];
}
diff --git a/erts/emulator/hipe/hipe_x86_glue.S b/erts/emulator/hipe/hipe_x86_glue.S
index 88b86f4de7..8d6e377730 100644
--- a/erts/emulator/hipe/hipe_x86_glue.S
+++ b/erts/emulator/hipe/hipe_x86_glue.S
@@ -2,26 +2,26 @@
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
-
+#define ASM
#include "hipe_x86_asm.h"
#include "hipe_literals.h"
-#define ASM
#include "hipe_mode_switch.h"
/*
@@ -104,7 +104,7 @@ ASYM(nbif_return):
* stub (hipe_x86_loader.erl) which should look as follows:
*
* stub for f/N:
- * movl $<f's BEAM code address>, P_BEAM_IP(P)
+ * movl $<f's export entry address>, P_CALLEE_EXP(P)
* movb $<N>, P_ARITY(P)
* jmp nbif_callemu
*
@@ -114,7 +114,7 @@ ASYM(nbif_return):
GLOBAL(ASYM(nbif_callemu))
ASYM(nbif_callemu):
STORE_ARG_REGS
- movl $HIPE_MODE_SWITCH_RES_CALL, %eax
+ movl $HIPE_MODE_SWITCH_RES_CALL_EXPORTED, %eax
jmp .suspend_exit
/*
@@ -300,6 +300,7 @@ ASYM(nbif_fail):
GLOBAL(nbif_1_gc_after_bif)
GLOBAL(nbif_2_gc_after_bif)
GLOBAL(nbif_3_gc_after_bif)
+ GLOBAL(nbif_4_gc_after_bif)
.align 4
nbif_0_gc_after_bif:
xorl %edx, %edx
@@ -315,6 +316,10 @@ nbif_2_gc_after_bif:
.align 4
nbif_3_gc_after_bif:
movl $3, %edx
+ jmp .gc_after_bif
+ .align 4
+nbif_4_gc_after_bif:
+ movl $4, %edx
/*FALLTHROUGH*/
.align 4
.gc_after_bif:
@@ -338,6 +343,7 @@ nbif_3_gc_after_bif:
GLOBAL(nbif_1_simple_exception)
GLOBAL(nbif_2_simple_exception)
GLOBAL(nbif_3_simple_exception)
+ GLOBAL(nbif_4_simple_exception)
.align 4
nbif_0_simple_exception:
xorl %eax, %eax
@@ -353,6 +359,10 @@ nbif_2_simple_exception:
.align 4
nbif_3_simple_exception:
movl $3, %eax
+ jmp .nbif_simple_exception
+ .align 4
+nbif_4_simple_exception:
+ movl $4, %eax
/*FALLTHROUGH*/
.align 4
.nbif_simple_exception:
diff --git a/erts/emulator/hipe/hipe_x86_glue.h b/erts/emulator/hipe/hipe_x86_glue.h
index 63ad250d60..de2b061706 100644
--- a/erts/emulator/hipe/hipe_x86_glue.h
+++ b/erts/emulator/hipe/hipe_x86_glue.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -57,16 +58,17 @@ static __inline__ unsigned int max(unsigned int x, unsigned int y)
static __inline__ void hipe_arch_glue_init(void)
{
- static struct sdesc_with_exnra nbif_return_sdesc = {
- .exnra = (unsigned long)nbif_fail,
- .sdesc = {
- .bucket = { .hvalue = (unsigned long)nbif_return },
- .summary = (1<<8),
- #ifdef DEBUG
- .dbg_F = am_return,
- #endif
- },
- };
+ static struct hipe_sdesc_with_exnra nbif_return_sdesc;
+
+ nbif_return_sdesc.exnra = (unsigned long)nbif_fail;
+ nbif_return_sdesc.sdesc.bucket.hvalue = (unsigned long)nbif_return;
+ nbif_return_sdesc.sdesc.fsize = 0;
+ nbif_return_sdesc.sdesc.has_exnra = 1;
+ nbif_return_sdesc.sdesc.stk_nargs = 0;
+ nbif_return_sdesc.sdesc.m_aix = atom_val(am_Empty);
+ nbif_return_sdesc.sdesc.f_aix = atom_val(am_return);
+ nbif_return_sdesc.sdesc.a = 0;
+
hipe_init_sdesc_table(&nbif_return_sdesc.sdesc);
}
@@ -207,6 +209,14 @@ hipe_trap_from_native_is_recursive(Process *p)
return 0;
}
+/* Native called BIF. Is it a recursive call?
+ i.e should we return back to native when BIF is done? */
+static __inline__ int
+hipe_bifcall_from_native_is_recursive(Process *p)
+{
+ return (*p->hipe.nsp != (Eterm)nbif_return);
+}
+
/* Native makes a call which needs to unload the parameters.
This differs from hipe_call_from_native_is_recursive() in
diff --git a/erts/emulator/hipe/hipe_x86_primops.h b/erts/emulator/hipe/hipe_x86_primops.h
index 111b1fa8bd..68a284203e 100644
--- a/erts/emulator/hipe/hipe_x86_primops.h
+++ b/erts/emulator/hipe/hipe_x86_primops.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2005-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2005-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/hipe/hipe_x86_signal.c b/erts/emulator/hipe/hipe_x86_signal.c
index f5668013e2..be68d7d463 100644
--- a/erts/emulator/hipe/hipe_x86_signal.c
+++ b/erts/emulator/hipe/hipe_x86_signal.c
@@ -2,18 +2,19 @@
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2014. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -37,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"
@@ -53,28 +51,7 @@
#endif
#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*/)
+#if defined(__GLIBC__) && __GLIBC__ == 2 && (__GLIBC_MINOR__ >= 3)
/*
* __libc_sigaction() is the core routine.
* Without libpthread, sigaction() and __sigaction() are both aliases
@@ -99,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__)
@@ -180,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:
@@ -217,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)
{
@@ -254,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);
@@ -286,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();
}
}
@@ -306,7 +267,7 @@ void hipe_thread_signal_init(void)
{
/* Stack don't really need to be cache aligned.
We use it to suppress false leak report from valgrind */
- hipe_sigaltstack(erts_alloc_permanent_cache_aligned(ERTS_ALC_T_HIPE, SIGSTKSZ));
+ hipe_sigaltstack(erts_alloc_permanent_cache_aligned(ERTS_ALC_T_HIPE_LL, SIGSTKSZ));
}
#endif
@@ -331,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/hipe/hipe_x86_stack.c b/erts/emulator/hipe/hipe_x86_stack.c
index 9ad3fa9d31..31582b3a2e 100644
--- a/erts/emulator/hipe/hipe_x86_stack.c
+++ b/erts/emulator/hipe/hipe_x86_stack.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -51,15 +52,14 @@ void hipe_print_nstack(Process *p)
{
Eterm *nsp;
Eterm *nsp_end;
- struct sdesc sdesc0;
- const struct sdesc *sdesc1;
- const struct sdesc *sdesc;
+ struct hipe_sdesc sdesc0;
+ const struct hipe_sdesc *sdesc1;
+ const struct hipe_sdesc *sdesc;
unsigned long ra;
unsigned long exnra;
unsigned int mask;
unsigned int sdesc_size;
unsigned int i;
- unsigned int nstkarity;
static const char dashes[2*sizeof(long)+5] = {
[0 ... 2*sizeof(long)+3] = '-'
};
@@ -67,10 +67,10 @@ void hipe_print_nstack(Process *p)
nsp = p->hipe.nsp;
nsp_end = p->hipe.nstend;
- nstkarity = p->hipe.narity - NR_ARG_REGS;
- if ((int)nstkarity < 0)
- nstkarity = 0;
- sdesc0.summary = nstkarity;
+ sdesc0.fsize = 0;
+ sdesc0.has_exnra = 0;
+ sdesc0.stk_nargs = (p->hipe.narity < NR_ARG_REGS ? 0 :
+ p->hipe.narity - NR_ARG_REGS);
sdesc0.livebits[0] = ~1;
sdesc = &sdesc0;
@@ -157,7 +157,7 @@ void hipe_print_nstack(Process *p)
#define MINSTACK 128
#define NSKIPFRAMES 4
-void hipe_update_stack_trap(Process *p, const struct sdesc *sdesc)
+void hipe_update_stack_trap(Process *p, const struct hipe_sdesc *sdesc)
{
Eterm *nsp;
Eterm *nsp_end;
@@ -198,7 +198,7 @@ void hipe_update_stack_trap(Process *p, const struct sdesc *sdesc)
void (*hipe_handle_stack_trap(Process *p))(void)
{
void (*ngra)(void) = p->hipe.ngra;
- const struct sdesc *sdesc = hipe_find_sdesc((unsigned long)ngra);
+ const struct hipe_sdesc *sdesc = hipe_find_sdesc((unsigned long)ngra);
hipe_update_stack_trap(p, sdesc);
return ngra;
}
@@ -209,7 +209,7 @@ void (*hipe_handle_stack_trap(Process *p))(void)
* The native stack MUST contain a stack frame as it appears on
* entry to a function (return address, actuals, caller's frame).
* p->hipe.narity MUST contain the arity (number of actuals).
- * On exit, p->hipe.ncallee is set to the handler's PC and p->hipe.nsp
+ * On exit, p->hipe.u.ncallee is set to the handler's PC and p->hipe.nsp
* is set to its SP (low address of its stack frame).
*/
void hipe_find_handler(Process *p)
@@ -219,7 +219,7 @@ void hipe_find_handler(Process *p)
unsigned long ra;
unsigned long exnra;
unsigned int arity;
- const struct sdesc *sdesc;
+ const struct hipe_sdesc *sdesc;
unsigned int nstkarity;
nsp = p->hipe.nsp;
@@ -240,7 +240,7 @@ void hipe_find_handler(Process *p)
if ((exnra = sdesc_exnra(sdesc)) != 0 &&
(p->catches >= 0 ||
exnra == (unsigned long)nbif_fail)) {
- p->hipe.ncallee = (void(*)(void)) exnra;
+ p->hipe.u.ncallee = (void(*)(void)) exnra;
p->hipe.nsp = nsp;
p->hipe.narity = 0;
/* update the gray/white boundary if we threw past it */
@@ -261,7 +261,7 @@ int hipe_fill_stacktrace(Process *p, int depth, Eterm **trace)
Eterm *nsp_end;
unsigned long ra, prev_ra;
unsigned int arity;
- const struct sdesc *sdesc;
+ const struct hipe_sdesc *sdesc;
unsigned int nstkarity;
int i;
diff --git a/erts/emulator/internal_doc/CarrierMigration.md b/erts/emulator/internal_doc/CarrierMigration.md
index b93c11c6ec..2a9594db25 100644
--- a/erts/emulator/internal_doc/CarrierMigration.md
+++ b/erts/emulator/internal_doc/CarrierMigration.md
@@ -16,12 +16,12 @@ When a carrier is empty, i.e. contains only one large free block, it
is deallocated. Since multiblock carriers can contain both allocated
blocks and free blocks at the same time, an allocator instance might
be stuck with a large amount of poorly utilized carriers if the memory
-load decrease. After a peak in memory usage it is expected that not
-all memory can be returned since the blocks still allocated is likely
+load decreases. After a peak in memory usage it is expected that not
+all memory can be returned since the blocks still allocated are likely
to be dispersed over multiple carriers. Such poorly utilized carriers
-can usually be reused if the memory load increase again. However,
+can usually be reused if the memory load increases again. However,
since each scheduler thread manages its own set of allocator
-instances, and memory load is not necessarily connected to CPU load we
+instances, and memory load is not necessarily correlated to CPU load, we
might get into a situation where there are lots of poorly utilized
multiblock carriers on some allocator instances while we need to
allocate new multiblock carriers on other allocator instances. In
@@ -50,13 +50,13 @@ the allocator instance manages. Free blocks in one specific carrier
can be referred to from potentially every other carrier that is
managed, and the amount of such references can be huge. That is, the
work of removing the free blocks of such a carrier from the search
-tree will be huge. One way of solving this could be to not migrate
+tree will be huge. One way of solving this could be not to migrate
carriers that contain lots of free blocks, but this would prevent us
-from migrating carriers that potentially needs to be migrated in order
+from migrating carriers that potentially need to be migrated in order
to solve the problem we set out to solve.
By using one data structure of free blocks in each carrier and an
-allocator instance wide data structure of carriers managed by the
+allocator instance-wide data structure of carriers managed by the
allocator instance, the work needed in order to remove and add
carriers can be kept to a minimum. When migration of carriers is
enabled on a specific allocator type, we require that an allocation
@@ -76,9 +76,9 @@ through a pool of carriers. In order for a carrier migration to
complete, one scheduler needs to move the carrier into the pool, and
another scheduler needs to take the carrier out of the pool.
-The pool is implemented as a lock free, circular, double linked,
+The pool is implemented as a lock-free, circular, double linked,
list. The list contains a sentinel which is used as the starting point
-when inserting to, or fetching from the pool. Carriers in the pool are
+when inserting to, or fetching from, the pool. Carriers in the pool are
elements in this list.
The list can be modified by all scheduler threads
@@ -108,19 +108,19 @@ all search operations need to read the content of the sentinel. If we
were to modify the sentinel, the cache line containing the sentinel
would unnecessarily be bounced between processors.
-The `prev`, and `next` fields in the elements of the list contains the
+The `prev` and `next` fields in the elements of the list contain the
value of the pointer, a modification marker, and a deleted
marker. Memory operations on these fields are done using atomic memory
operations. When a thread has set the modification marker in a field,
no-one except the thread that set the marker is allowed to modify the
-field. If multiple modification markers needs to be set, we always
+field. If multiple modification markers need to be set, we always
begin with `next` fields followed by `prev` fields in the order
following the actual pointers. This guarantees that no deadlocks will
occur.
When a carrier is being removed from a pool, we mark it with a thread
progress value that needs to be reached before we are allowed to
-modify the `next`, and `prev` fields. That is, until we reach this
+modify the `next` and `prev` fields. That is, until we reach this
thread progress we are not allowed to insert the carrier into the pool
again, and we are not allowed to deallocate the carrier. This ensures
that threads inspecting the pool always will be able to traverse the
@@ -130,12 +130,12 @@ threads may have references to it via the pool.
### Migration ###
-There exist one pool for each allocator type enabling migration of
+There exists one pool for each allocator type enabling migration of
carriers between scheduler specific allocator instances of the same
allocator type.
Each allocator instance keeps track of the current utilization of its
-multiblock carriers. When the utilization falls below the "abandon
+multiblock carriers. When the total utilization falls below the "abandon
carrier utilization limit" it starts to inspect the utilization of the
current carrier when deallocations are made. If also the utilization
of the carrier falls below the "abandon carrier utilization limit" it
@@ -146,28 +146,53 @@ Since the carrier has been unlinked from the data structure of
available free blocks, no more allocations will be made in the
carrier. The allocator instance putting the carrier into the pool,
however, still has the responsibility of performing deallocations in
-it while it remains in the pool.
+it while it remains in the pool. The allocator instance with this
+deallocation responsibility is here called the **employer**.
-Each carrier has a flag field containing information about allocator
-instance owning the carrier, a flag indicating if the carrier is in
+Each carrier has a flag field containing information about the
+employing allocator instance, a flag indicating if the carrier is in
the pool or not, and a flag indicating if it is busy or not. When the
-carrier is in the pool, the owning allocator instance needs to mark it
+carrier is in the pool, the employing allocator instance needs to mark it
as busy while operating on it. If another thread inspects it in order
-to try to fetch it from the pool, it will abort the fetch if it is
-busy. When fetching the carrier from the pool, ownership will changed
-and further deallocations in the carrier will be redirected to the new
-owner using the delayed dealloc functionality.
+to try to fetch it from the pool, it will skip it if it is busy. When
+fetching the carrier from the pool, employment will change and further
+deallocations in the carrier will be redirected to the new
+employer using the delayed dealloc functionality.
If a carrier in the pool becomes empty, it will be withdrawn from the
pool. All carriers that become empty are also always passed to its
-originating allocator instance for deallocation using the delayed
+**owning** allocator instance for deallocation using the delayed
dealloc functionality. Since carriers this way always will be
-deallocated by the allocator instance that allocated the carrier the
+deallocated by the owner that allocated the carrier, the
underlying functionality of allocating and deallocating carriers can
remain simple and doesn't have to bother about multiple threads. In a
NUMA system we will also not mix carriers originating from multiple
NUMA nodes.
+In short:
+
+* The allocator instance that created a carrier **owns** it.
+* An empty carrier is always deallocated by its **owner**.
+* **Ownership** never changes.
+* The allocator instance that uses a carrier **employs** it.
+* An **employer** can abandon a carrier into the pool.
+* Pooled carriers are not allocated from.
+* Deallocation in a pooled carrier is still performed by its **employer**.
+* **Employment** can only change when a carrier is fetched from the pool.
+
+### Searching the pool ###
+
+To harbor real time characteristics, searching the pool is
+limited. We only inspect a limited number of carriers. If none of
+those carriers had a free block large enough to satisfy the allocation
+request, the search will fail. A carrier in the pool can also be busy
+if another thread is currently doing block deallocation work on the
+carrier. A busy carrier will also be skipped by the search as it can
+not satisfy the request. The pool is lock-free and we do not want to
+block, waiting for the other thread to finish.
+
+#### Before OTP 17.4 ####
+
When an allocator instance needs more carrier space, it always begins
by inspecting its own carriers that are waiting for thread progress
before they can be deallocated. If no such carrier could be found, it
@@ -176,10 +201,69 @@ it will allocate a new carrier. Regardless of where the allocator
instance gets the carrier from it the just links in the carrier into
its data structure of free blocks.
+#### After OTP 17.4 ####
+
+The old search algorithm had a problem as the search always started at
+the same position in the pool, the sentinel. This could lead to
+contention from concurrent searching processes. But even worse, it
+could lead to a "bad" state when searches fail with a high rate
+leading to new carriers instead being allocated. These new carriers
+may later be inserted into the pool due to bad utilization. If the
+frequency of insertions into the pool is higher than successful
+fetching from the pool, memory will eventually get exhausted.
+
+This "bad" state consists of a cluster of small and/or highly
+fragmented carriers located at the sentinel in the pool. The largest free
+block in such a "bad" carrier is rather small, making it unable to satisfy
+most allocation requests. As the search always started at the
+sentinel, any such "bad" carriers that had been left in the pool would
+eventually cluster together at the sentinel. All searches first
+have to skip past this cluster of "bad" carriers to reach a "good"
+carrier. When the cluster gets to the same size as the search limit,
+all searches will essentially fail.
+
+To counter the "bad cluster" problem and also ease the contention, the
+search will now always start by first looking at the allocators **own**
+carriers. That is, carriers that were initially created by the
+allocator itself and later had been abandoned to the pool. If none of
+our own abandoned carrier would do, then the search continues into the
+pool, as before, to look for carriers created by other
+allocators. However, if we have at least one abandoned carrier of our
+own that could not satisfy the request, we can use that as entry point
+into the pool.
+
+The result is that we prefer carriers created by the thread itself,
+which is good for NUMA performance. And we get more entry points when
+searching the pool, which will ease contention and clustering.
+
+To do the first search among own carriers, every allocator instance
+has two new lists: `pooled_list` and `traitor_list`. These lists are only
+accessed by the allocator itself and they only contain the allocator's
+own carriers. When an owned carrier is abandoned and put in the
+pool, it is also linked into `pooled_list`. When we search our
+`pooled_list` and find a carrier that is no longer in the pool, we
+move that carrier from `pooled_list` to `traitor_list` as it is now
+employed by another allocator. If searching `pooled_list` fails, we
+also do a limited search of `traitor_list`. When finding an abandoned
+carrier in `traitor_list` it is either employed or moved back to
+`pooled_list` if it could not satisfy the allocation request.
+
+When searching `pooled_list` and `traitor_list` we always start at the
+point where the last search ended. This to avoid clustering
+problems and increase the probability to find a "good" carrier. As
+`pooled_list` and `traitor_list` are only accessed by the owning
+allocator instance, they need no thread synchronization at all.
+
+Furthermore, the search for own carriers that are scheduled
+for deallocation is now done as the last search option. The idea is
+that it is better to reuse a poorly utilized carrier than to
+resurrect an empty carrier that was just about to be released back to
+the OS.
+
### Result ###
The use of this strategy of abandoning carriers with poor utilization
-and reusing these in allocator instances with an increased carrier
+and reusing them in allocator instances with an increased carrier
demand is extremely effective and completely eliminates the problems
that otherwise sometimes occurred when CPU load dropped while memory
load did not.
diff --git a/erts/emulator/internal_doc/DelayedDealloc.md b/erts/emulator/internal_doc/DelayedDealloc.md
index b7d87b839f..4b7c774141 100644
--- a/erts/emulator/internal_doc/DelayedDealloc.md
+++ b/erts/emulator/internal_doc/DelayedDealloc.md
@@ -19,7 +19,7 @@ the Erlang VM where memory allocation/deallocation is frequent and
references to memory also are passed around between threads this
solution will also scale poorly due to lock contention.
-Functionality Used to Adress This problem
+Functionality Used to Address This problem
-----------------------------------------
In order to reduce contention due to locking of allocator instances we
@@ -44,12 +44,12 @@ deallocation.
The "message box" is implemented using a lock free single linked list
through the memory blocks to deallocate. The order of the elements in
this list is not important. Insertion of new free blocks will be made
-somewhere near the end of this list. Requirering that the new blocks
+somewhere near the end of this list. Requiring that the new blocks
need to be inserted at the end would cause unnecessary contention when
large amount of memory blocks are inserted simultaneous by multiple
threads.
-The data structure refering to this single linked list cover two cache
+The data structure referring to this single linked list cover two cache
lines. One cache line containing information about the head of the
list, and one cache line containing information about the tail of the
list. This in order to reduce cache line ping ponging of this data
@@ -65,21 +65,21 @@ list. In the uncontended case it will point to the end of the list,
but when simultaneous insert operations are performed it will point to
something near the end of the list.
-When insterting an element one will try to write a pointer to the new
+When inserting an element one will try to write a pointer to the new
element in the next pointer of the element pointed to by the last
pointer. This is done using an atomic compare and swap that expects
-the next pointer to be `NULL`. If this succeds the thread performing
+the next pointer to be `NULL`. If this succeeds the thread performing
this operation moves the last pointer to point to the newly inserted
element.
If the atomic compare and swap described above failed, the last
pointer didn't point to the last element. In this case we need to
-insert the new element somewhere inbetween the element that the last
+insert the new element somewhere between the element that the last
pointer pointed to and the actual last element. If we do it this way
the last pointer will eventually end up at the last element when
threads stop adding new elements. When trying to insert somewhere near
the end and failing to do so, the inserting thread sometimes moves to
-the next element and somtimes tries with the same element again. This
+the next element and sometimes tries with the same element again. This
in order to spread the inserted elements during heavy contention. That
is, we try to spread the modifications of memory to different
locations instead of letting all threads continue to try to modify the
@@ -87,7 +87,7 @@ same location in memory.
### Head ###
-The head contains pointers to begining of the list (`head.first`), and
+The head contains pointers to beginning of the list (`head.first`), and
to the first block which other threads may refer to
(`head.unref_end`). Blocks between these pointers are only refered to
by the head part of the data structure which is only used by the
@@ -142,7 +142,7 @@ contains this "marker" element.
### Contention ###
-When elements are continously inserted by threads not owning the
+When elements are continuously inserted by threads not owning the
allocator instance, the thread owning the allocator instance will be
able to work more or less undisturbed by other threads at the head end
of the list. At the tail end large amounts of simultaneous inserts may
diff --git a/erts/emulator/internal_doc/PortSignals.md b/erts/emulator/internal_doc/PortSignals.md
index b1afb7c5cb..8782ae4e17 100644
--- a/erts/emulator/internal_doc/PortSignals.md
+++ b/erts/emulator/internal_doc/PortSignals.md
@@ -204,7 +204,7 @@ high limit is 8 KB and the low limit is 4 KB.
Previously all operations sending signals to ports began by acquiring
the port lock, then performed preparations for sending the signal, and
-then finaly sent the signal. The preparations typically included
+then finally sent the signal. The preparations typically included
inspecting the state of the port, and preparing the data to pass along
with the signal. The preparation of data is frequently quite time
consuming, and did not really depend on the port. That is we would
diff --git a/erts/emulator/internal_doc/SuperCarrier.md b/erts/emulator/internal_doc/SuperCarrier.md
new file mode 100644
index 0000000000..acf722ea37
--- /dev/null
+++ b/erts/emulator/internal_doc/SuperCarrier.md
@@ -0,0 +1,191 @@
+Super Carrier
+=============
+
+A super carrier is large memory area, allocated at VM start, which can
+be used during runtime to allocate normal carriers from.
+
+The super carrier feature was introduced in OTP R16B03. It is
+enabled with command line option +MMscs <size in Mb>
+and can be configured with other options.
+
+Problem
+-------
+
+The initial motivation for this feature was customers asking for a way
+to pre-allocate physcial memory at VM start for it to use.
+
+Other problems were different experienced limitations of the OS
+implementation of mmap:
+
+* Increasingly bad performance of mmap/munmap as the number of mmap'ed areas grow.
+* Fragmentation problem between mmap'ed areas.
+
+A third problem was management of low memory in the halfword
+emulator. The implementation used a naive linear search structure to
+hold free segments which would lead to poor performance when
+fragmentation increased.
+
+
+Solution
+--------
+
+Allocate one large continious area of address space at VM start and
+then use that area to satisfy our dynamic memory need during
+runtime. In other words: implement our own mmap.
+
+### Use cases ###
+
+If command line option +MMscrpm (Reserve Physical Memory) is set to
+false, only virtual space is allocated for the super carrier from
+start. The super carrier then acts as an "alternative mmap" implementation
+without changing the consumption of physical memory pages. Physical
+pages will be reserved on demand when an allocation is done from the super
+carrier and be unreserved when the memory is released back to the
+super carrier.
+
+If +MMscrpm is set to true, which is default, the initial allocation
+will reserve physical memory for the entire super carrier. This can be
+used by users that want to ensure a certain *minimum* amount of
+physical memory for the VM.
+
+However, what reservation of physical memory actually means highly
+depends on the operating system, and how it is configured. For
+example, different memory overcommit settings on Linux drastically
+change the behaviour.
+
+A third feature is to have the super carrier limit the *maximum*
+amount of memory used by the VM. If +MMsco (Super Carrier Only) is set
+to true, which is default, allocations will only be done from the
+super carrier. When the super carrier gets full, the VM will fail due
+to out of memory.
+If +MMsco is false, allocations will use mmap directly if the super
+carrier is full.
+
+
+
+### Implementation ###
+
+The entire super carrier implementation is kept in erl_mmap.c. The
+name suggest that it can be viewed as our own mmap implementation.
+
+A super carrier needs to satisfy two slightly different kinds of
+allocation requests; multi block carriers (MBC) and single block
+carriers (SBC). They are both rather large blocks of continious
+memory, but MBCs and SBCs have different demands on alignment and
+size.
+
+SBCs can have arbitrary size and do only need minimum 8-byte
+alignment.
+
+MBCs are more restricted. They can only have a number of fixed
+sizes that are powers of 2. The start address need to have a very
+large aligment (currently 256 kb, called "super alignment"). This is a
+design choice that allows very low overhead per allocated block in the
+MBC.
+
+To reduce fragmentation within the super carrier, it is good to keep SBCs
+and MBCs apart. MBCs with their uniform alignment and sizes can be
+packed very efficiently together. SBCs without demand for aligment can
+also be allocated quite efficiently together. But mixing them can lead
+to a lot of memory wasted when we need to create large holes of
+padding to the next alignment limit.
+
+The super carrier thus contains two areas. One area for MBCs growing from
+the bottom and up. And one area for SBCs growing from the top and
+down. Like a process with a heap and a stack growing towards each
+other.
+
+
+### Data structures ###
+
+The MBC area is called **sa** as in super aligned and the SBC area is
+called **sua** as in super un-aligned.
+
+Note that the "super" in super alignment and the "super" in super
+carrier has nothing to do with each other. We could have choosen
+another naming to avoid confusion, such as "meta" carrier or "giant"
+aligment.
+
+ +-------+ <---- sua.top
+ | sua |
+ | |
+ |-------| <---- sua.bot
+ | |
+ | |
+ | |
+ |-------| <---- sa.top
+ | |
+ | sa |
+ | |
+ +-------+ <---- sa.bot
+
+
+When a carrier is deallocated a free memory segment will be created
+inside the corresponding area, unless the carrier was at the very top
+(in `sa`) or bottom (in `sua`) in which case the area will just shrink
+down or up.
+
+We need to keep track of all the free segments in order to reuse them
+for new carrier allocations. One initial idea was to use the same
+mechanism that is used to keep track of free blocks within MBCs
+(alloc_util and the different strategies). However, that would not be
+as straight forward as one can think and can also waste quite a lot of
+memory as it uses prepended block headers. The granularity of the
+super carrier is one memory page (usually 4kb). We want to allocate
+and free entire pages and we don't want to waste an entire page just
+to hold the block header of the following pages.
+
+Instead we store the meta information about all the free segments in a
+dedicated area apart from the `sa` and `sua` areas. Every free segment is
+represented by a descriptor struct (`ErtsFreeSegDesc`).
+
+ typedef struct {
+ RBTNode snode; /* node in 'stree' */
+ RBTNode anode; /* node in 'atree' */
+ char* start;
+ char* end;
+ }ErtsFreeSegDesc;
+
+To find the smallest free segment that will satisfy a carrier allocation
+(best fit), the free segments are organized in a tree sorted by
+size (`stree`). We search in this tree at allocation. If no free segment of
+sufficient size was found, the area (`sa` or `sua`) is instead expanded.
+If two or more free segments with equal size exist, the one at lowest
+address is chosen for `sa` and highest address for `sua`.
+
+At carrier deallocation, we want to coalesce with any adjacent free
+segments, to form one large free segment. To do that, all free
+segments are also organized in a tree sorted in address order (`atree`).
+
+So, in total we keep four trees of free descriptors for the super
+carrier; two for `sa` and two for `sua`. They all use the same
+red-black-tree implementation that support the different sorting
+orders used.
+
+When allocating a new MBC we first search after a free segment in `sa`,
+then try to raise `sa.top`, and then as a fallback try to search after a
+free segment in `sua`. When an MBC is allocated in `sua`, a larger segment
+is allocated which is then trimmed to obtain the right
+alignment. Allocation search for an SBC is done in reverse order. When
+an SBC is allocated in `sa`, the size is aligned up to super aligned
+size.
+
+### The free descriptor area ###
+
+As mentioned above, the descriptors for the free segments are
+allocated in a separate area. This area has a constant configurable
+size (+MMscrfsd) that defaults to 65536 descriptors. This should be
+more than enough in most cases. If the descriptors area should fill up,
+new descriptor areas will be allocated first directly from the OS, and
+then from `sua` and `sa` in the super carrier, and lastly from the memory
+segment itself which is being deallocated. Allocating free descriptor
+areas from the super carrier is only a last resort, and should be
+avoided, as it creates fragmentation.
+
+### Halfword emulator ###
+
+The halfword emulator uses the super carrier implementation to manage
+its low memory mappings thar are needed for all term storage. The
+super carrier can here not be configured by command line options. One
+could imagine a second configurable instance of the super carrier used
+by high memory allocation, but that has not been implemented.
diff --git a/erts/emulator/internal_doc/ThreadProgress.md b/erts/emulator/internal_doc/ThreadProgress.md
index 6118bcf0f6..03a802f904 100644
--- a/erts/emulator/internal_doc/ThreadProgress.md
+++ b/erts/emulator/internal_doc/ThreadProgress.md
@@ -60,7 +60,7 @@ threads are managed threads.
### Thread Progress Events ###
Any thread in the system may use the thread progress functionality in
-order to determine when the following events have occured at least
+order to determine when the following events have occurred at least
once in all managed threads:
1. The thread has returned from other code to a known state in the
@@ -160,7 +160,7 @@ calling the following functions:
* `int erts_thr_progress_leader_update(ErtsSchedulerData *esdp)` -
Leader update thread progress.
-Unmanaged threads can delay thread progress beeing made:
+Unmanaged threads can delay thread progress being made:
* `ErtsThrPrgrDelayHandle erts_thr_progress_unmanaged_delay(void)` -
Delay thread progress.
@@ -251,7 +251,7 @@ doing so. If not zero, the leader isn't allowed to increment the
global counter, and needs to wait before it can do this. When it is
zero, it swaps the `waiting` and `current` counters before increasing
the global counter. From now on the new `waiting` counter will
-decrease, so that it eventualy will reach zero, making it possible to
+decrease, so that it eventually will reach zero, making it possible to
increment the global counter the next time. If we only used one
reference counter it would potentially be held above zero for ever by
different unmanaged threads.
@@ -261,7 +261,7 @@ prevent the next increment of the global counter, but instead the
increment after that. This is sufficient since the global counter
needs to be incremented two times before thread progress has been
made. It is also desirable not to prevent the first increment, since
-the likelyhood increases that the delay is withdrawn before any
+the likelihood increases that the delay is withdrawn before any
increment of the global counter is delayed. That is, the operation
will cause as little disruption as possible.
diff --git a/erts/emulator/internal_doc/Tracing.md b/erts/emulator/internal_doc/Tracing.md
index 30bc5327a7..7f97f64765 100644
--- a/erts/emulator/internal_doc/Tracing.md
+++ b/erts/emulator/internal_doc/Tracing.md
@@ -51,13 +51,13 @@ the new instrumented code. Normally loaded code can only be reached
through external functions calls. Trace settings must be activated
instantaneously without the need of external function calls.
-The choosen solution is instead for tracing to use the technique of
+The chosen solution is instead for tracing to use the technique of
replication applied on the data structures for breakpoints. Two
generations of breakpoints are kept and indentified by index of 0 and
1. The global atomic variables `erts_active_bp_index` will determine
which generation of breakpoints running code will use.
-### Atomicy Without Atomic Operations
+### Atomicity Without Atomic Operations
Not using the code loading generations (or any other code duplication)
means that `trace_pattern` must at some point write to the active beam
diff --git a/erts/emulator/internal_doc/dec.erl b/erts/emulator/internal_doc/dec.erl
index dc995989fb..8ce83fa402 100644
--- a/erts/emulator/internal_doc/dec.erl
+++ b/erts/emulator/internal_doc/dec.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2016. 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/.
+%% 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
%%
-%% 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.
+%% 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%
%%
@@ -64,18 +65,17 @@ dec() ->
"*~n"
"* Copyright Ericsson AB 1999-2010. All Rights Reserved.~n"
"*~n"
- "* The contents of this file are subject to the Erlang Public License,~n"
- "* Version 1.1, (the \"License\"); you may not use this file except in~n"
- "* compliance with the License. You should have received a copy of the~n"
- "* Erlang Public License along with this software. If not, it can be~n"
- "* retrieved online at http://www.erlang.org/.~n"
+ "* Licensed under the Apache License, Version 2.0 (the \"License\");~n"
+ "* you may not use this file except in compliance with the License.~n"
+ "* You may obtain a copy of the License at~n"
+ "*~n"
+ "* http://www.apache.org/licenses/LICENSE-2.0~n"
"*~n"
- "* Software distributed under the License is distributed on an "
- "\"AS IS\"~n"
- "* basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See~n"
- "* the License for the specific language governing rights and "
- "limitations~n"
- "* under the License.~n"
+ "* Unless required by applicable law or agreed to in writing, software~n"
+ "* distributed under the License is distributed on an \"AS IS\" BASIS,~n"
+ "* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.~n"
+ "* See the License for the specific language governing permissions and~n"
+ "* limitations under the License.~n"
"*~n"
"* %CopyrightEnd%~n"
"*/~n"
diff --git a/erts/emulator/internal_doc/erl_ext_dist.txt b/erts/emulator/internal_doc/erl_ext_dist.txt
index 1cbbbcc7b8..0b9a783069 100644
--- a/erts/emulator/internal_doc/erl_ext_dist.txt
+++ b/erts/emulator/internal_doc/erl_ext_dist.txt
@@ -1,18 +1,19 @@
%CopyrightBegin%
- Copyright Ericsson AB 1997-2009. All Rights Reserved.
+ Copyright Ericsson AB 1997-2016. 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/.
+ 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
- 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.
+ 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%
diff --git a/erts/emulator/nifs/common/erl_tracer_nif.c b/erts/emulator/nifs/common/erl_tracer_nif.c
new file mode 100644
index 0000000000..0bde60d057
--- /dev/null
+++ b/erts/emulator/nifs/common/erl_tracer_nif.c
@@ -0,0 +1,257 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson 2015-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%
+ */
+
+/*
+ * Purpose: NIF library for process/port tracer
+ *
+ */
+
+
+#define STATIC_ERLANG_NIF 1
+
+#include "erl_nif.h"
+#include "config.h"
+#include "sys.h"
+
+#ifdef VALGRIND
+# include <valgrind/memcheck.h>
+#endif
+
+/* NIF interface declarations */
+static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info);
+static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info);
+static void unload(ErlNifEnv* env, void* priv_data);
+
+/* The NIFs: */
+static ERL_NIF_TERM enabled(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM trace(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+
+static ErlNifFunc nif_funcs[] = {
+ {"enabled", 3, enabled},
+ {"trace", 5, trace}
+};
+
+
+ERL_NIF_INIT(erl_tracer, nif_funcs, load, NULL, upgrade, unload)
+
+#define ATOMS \
+ ATOM_DECL(call); \
+ ATOM_DECL(command); \
+ ATOM_DECL(cpu_timestamp); \
+ ATOM_DECL(discard); \
+ ATOM_DECL(exception_from); \
+ ATOM_DECL(extra); \
+ ATOM_DECL(match_spec_result); \
+ ATOM_DECL(monotonic); \
+ ATOM_DECL(ok); \
+ ATOM_DECL(remove); \
+ ATOM_DECL(return_from); \
+ ATOM_DECL(scheduler_id); \
+ ATOM_DECL(send); \
+ ATOM_DECL(send_to_non_existing_process); \
+ ATOM_DECL(seq_trace); \
+ ATOM_DECL(spawn); \
+ ATOM_DECL(strict_monotonic); \
+ ATOM_DECL(timestamp); \
+ ATOM_DECL(trace); \
+ ATOM_DECL(trace_status); \
+ ATOM_DECL(trace_ts); \
+ ATOM_DECL(true); \
+ ATOM_DECL(gc_minor_start); \
+ ATOM_DECL(gc_minor_end); \
+ ATOM_DECL(gc_major_start); \
+ ATOM_DECL(gc_major_end);
+
+#define ATOM_DECL(A) static ERL_NIF_TERM atom_##A
+ATOMS
+#undef ATOM_DECL
+
+static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info)
+{
+
+#define ATOM_DECL(A) atom_##A = enif_make_atom(env, #A)
+ATOMS
+#undef ATOM_DECL
+
+ *priv_data = NULL;
+
+ return 0;
+}
+
+static void unload(ErlNifEnv* env, void* priv_data)
+{
+
+}
+
+static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data,
+ ERL_NIF_TERM load_info)
+{
+ if (*old_priv_data != NULL) {
+ return -1; /* Don't know how to do that */
+ }
+ if (*priv_data != NULL) {
+ return -1; /* Don't know how to do that */
+ }
+ if (load(env, priv_data, load_info)) {
+ return -1;
+ }
+ return 0;
+}
+
+static ERL_NIF_TERM enabled(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ErlNifPid to_pid;
+ ErlNifPort to_port;
+ ERL_NIF_TERM ret = enif_is_identical(argv[0], atom_trace_status) ?
+ atom_remove : atom_discard;
+
+ ASSERT(argc == 3);
+
+ if (enif_get_local_pid(env, argv[1], &to_pid)) {
+ if (!enif_is_process_alive(env, &to_pid))
+ /* tracer is dead so we should remove this trace point */
+ return ret;
+ } else if (enif_get_local_port(env, argv[1], &to_port)) {
+ if (!enif_is_port_alive(env, &to_port))
+ /* tracer is dead so we should remove this trace point */
+ return ret;
+ } else {
+ /* The state was not a pid or a port */
+ return ret;
+ }
+
+ /* Only generate trace for when tracer != tracee */
+ if (enif_is_identical(argv[1], argv[2])) {
+ return atom_discard;
+ }
+
+ return atom_trace;
+}
+
+/*
+ -spec trace(seq_trace, TracerState :: pid() | port(),
+ Label :: non_neg_integer(),
+ Msg :: term(),
+ Opts :: map()) -> ignored();
+ trace(Tag :: atom(), TracerState :: pid() | port(),
+ Tracee :: pid() || port() || undefined,
+ Msg :: term(),
+ Opts :: map()) -> ignored().
+*/
+static ERL_NIF_TERM trace(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ERL_NIF_TERM value, msg, tt[8], opts;
+ ErlNifPid to_pid;
+ ErlNifPort to_port;
+ size_t tt_sz = 0;
+ int is_port = 0;
+ size_t opts_sz = 0;
+ ASSERT(argc == 5);
+
+ if (!enif_get_local_pid(env, argv[1], &to_pid)) {
+ if (!enif_get_local_port(env, argv[1], &to_port)) {
+ /* This only fails if argv[1] is a not a local port/pid
+ which should not happen as it is checked in enabled */
+ ASSERT(0);
+ return atom_ok;
+ }
+ is_port = 1;
+ }
+
+ opts = argv[4];
+
+ if (!enif_get_map_size(env, opts, &opts_sz))
+ opts_sz = 0;
+
+ if (opts_sz && enif_get_map_value(env, opts, atom_extra, &value)) {
+ tt[tt_sz++] = atom_trace;
+ tt[tt_sz++] = argv[2];
+ tt[tt_sz++] = argv[0];
+ tt[tt_sz++] = argv[3];
+ tt[tt_sz++] = value;
+ } else {
+ if (enif_is_identical(argv[0], atom_seq_trace)) {
+ tt[tt_sz++] = atom_seq_trace;
+ tt[tt_sz++] = argv[2];
+ tt[tt_sz++] = argv[3];
+ } else {
+ tt[tt_sz++] = atom_trace;
+ tt[tt_sz++] = argv[2];
+ tt[tt_sz++] = argv[0];
+ tt[tt_sz++] = argv[3];
+ }
+ }
+
+
+ if (opts_sz && enif_get_map_value(env, opts, atom_match_spec_result, &value)) {
+ tt[tt_sz++] = value;
+ }
+
+ if (opts_sz && enif_get_map_value(env, opts, atom_scheduler_id, &value)) {
+ tt[tt_sz++] = value;
+ }
+
+ if (opts_sz && enif_get_map_value(env, opts, atom_timestamp, &value)) {
+ ERL_NIF_TERM ts;
+ if (enif_is_identical(value, atom_monotonic)) {
+ ErlNifTime mon = enif_monotonic_time(ERL_NIF_NSEC);
+ ts = enif_make_int64(env, mon);
+ } else if (enif_is_identical(value, atom_strict_monotonic)) {
+ ErlNifTime mon = enif_monotonic_time(ERL_NIF_NSEC);
+ ERL_NIF_TERM unique = enif_make_unique_integer(
+ env, ERL_NIF_UNIQUE_MONOTONIC);
+ ts = enif_make_tuple2(env, enif_make_int64(env, mon), unique);
+ } else if (enif_is_identical(value, atom_timestamp)) {
+ ts = enif_now_time(env);
+ } else if (enif_is_identical(value, atom_cpu_timestamp)) {
+ ts = enif_cpu_time(env);
+ } else {
+ ASSERT(0);
+ goto error;
+ }
+ tt[tt_sz++] = ts;
+ if (tt[0] == atom_trace)
+ tt[0] = atom_trace_ts;
+ }
+
+ msg = enif_make_tuple_from_array(env, tt, tt_sz);
+
+ if (is_port) {
+ ErlNifBinary bin;
+
+ if (!enif_term_to_binary(env, msg, &bin))
+ goto error;
+
+ msg = enif_make_binary(env, &bin);
+
+ if (!enif_port_command(env, &to_port, NULL, msg))
+ /* port has probably died, enabled will clean up */;
+
+ enif_release_binary(&bin);
+ } else {
+
+ if (!enif_send(env, &to_pid, NULL, msg))
+ /* process has probably died, enabled will clean up */;
+ }
+
+error:
+
+ return atom_ok;
+}
diff --git a/erts/emulator/nifs/common/zlib_nif.c b/erts/emulator/nifs/common/zlib_nif.c
new file mode 100644
index 0000000000..fa29b4fb71
--- /dev/null
+++ b/erts/emulator/nifs/common/zlib_nif.c
@@ -0,0 +1,1028 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson 2017. 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%
+ */
+
+#define STATIC_ERLANG_NIF 1
+
+#include <stdio.h>
+#include <zlib.h>
+
+#include "erl_nif.h"
+#include "config.h"
+#include "sys.h"
+
+#ifdef VALGRIND
+# include <valgrind/memcheck.h>
+#endif
+
+#define INFL_DICT_SZ (32768)
+
+/* NIF interface declarations */
+static int load(ErlNifEnv *env, void** priv_data, ERL_NIF_TERM load_info);
+static int upgrade(ErlNifEnv *env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info);
+static void unload(ErlNifEnv *env, void* priv_data);
+
+static ErlNifResourceType *rtype_zlib;
+
+static ERL_NIF_TERM am_not_on_controlling_process;
+
+static ERL_NIF_TERM am_not_initialized;
+static ERL_NIF_TERM am_already_initialized;
+
+static ERL_NIF_TERM am_ok;
+static ERL_NIF_TERM am_error;
+
+static ERL_NIF_TERM am_continue;
+static ERL_NIF_TERM am_finished;
+
+static ERL_NIF_TERM am_not_supported;
+static ERL_NIF_TERM am_need_dictionary;
+
+static ERL_NIF_TERM am_empty;
+
+static ERL_NIF_TERM am_stream_end;
+static ERL_NIF_TERM am_stream_error;
+static ERL_NIF_TERM am_data_error;
+static ERL_NIF_TERM am_mem_error;
+static ERL_NIF_TERM am_buf_error;
+static ERL_NIF_TERM am_version_error;
+static ERL_NIF_TERM am_unknown_error;
+
+typedef enum {
+ ST_NONE = 0,
+ ST_DEFLATE = 1,
+ ST_INFLATE = 2,
+ ST_CLOSED = 3
+} zlib_state_t;
+
+/* Controls what to do when the user attempts to decompress more data after
+ * Z_STREAM_END has been returned:
+ *
+ * - 'cut' wipes all further input and returns empty results until reset by
+ * the user. This is the default behavior, matching that of the old driver.
+ * - 'reset' resets the state without discarding any input, making it possible
+ * to decompress blindly concatenated streams.
+ * - 'error' crashes with a data error. */
+typedef enum {
+ EOS_BEHAVIOR_ERROR = 0,
+ EOS_BEHAVIOR_RESET = 1,
+ EOS_BEHAVIOR_CUT = 2
+} zlib_eos_behavior_t;
+
+typedef struct {
+ z_stream s;
+ zlib_state_t state;
+
+ zlib_eos_behavior_t eos_behavior;
+
+ /* These refer to the plaintext CRC, and are only needed for zlib:crc32/1
+ * which is deprecated. */
+ uLong input_crc;
+ uLong output_crc;
+ int want_input_crc;
+ int want_output_crc;
+
+ int is_raw_stream;
+
+ int eos_seen;
+
+ /* DEPRECATED */
+ int inflateChunk_buffer_size;
+
+ ErlNifPid controlling_process;
+ ErlNifMutex *controller_lock;
+
+ ErlNifIOQueue *input_queue;
+
+ ErlNifEnv *stash_env;
+ ERL_NIF_TERM stash_term;
+} zlib_data_t;
+
+/* The NIFs: */
+
+static ERL_NIF_TERM zlib_open(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM zlib_close(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM zlib_set_controller(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+
+static ERL_NIF_TERM zlib_deflateInit(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM zlib_deflateSetDictionary(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM zlib_deflateReset(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM zlib_deflateEnd(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM zlib_deflateParams(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM zlib_deflate(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+
+static ERL_NIF_TERM zlib_inflateInit(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM zlib_inflateSetDictionary(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM zlib_inflateGetDictionary(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM zlib_inflateReset(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM zlib_inflateEnd(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM zlib_inflate(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+
+static ERL_NIF_TERM zlib_crc32(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+
+static ERL_NIF_TERM zlib_clearStash(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM zlib_setStash(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM zlib_getStash(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+
+static ERL_NIF_TERM zlib_getBufSize(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM zlib_setBufSize(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+
+static ERL_NIF_TERM zlib_enqueue_input(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+
+static ErlNifFunc nif_funcs[] = {
+ {"close_nif", 1, zlib_close},
+ {"open_nif", 0, zlib_open},
+
+ {"set_controller_nif", 2, zlib_set_controller},
+
+ /* deflate */
+ {"deflateInit_nif", 6, zlib_deflateInit},
+ {"deflateSetDictionary_nif", 2, zlib_deflateSetDictionary},
+ {"deflateReset_nif", 1, zlib_deflateReset},
+ {"deflateEnd_nif", 1, zlib_deflateEnd},
+ {"deflateParams_nif", 3, zlib_deflateParams},
+ {"deflate_nif", 4, zlib_deflate},
+
+ /* inflate */
+ {"inflateInit_nif", 3, zlib_inflateInit},
+ {"inflateSetDictionary_nif", 2, zlib_inflateSetDictionary},
+ {"inflateGetDictionary_nif", 1, zlib_inflateGetDictionary},
+ {"inflateReset_nif", 1, zlib_inflateReset},
+ {"inflateEnd_nif", 1, zlib_inflateEnd},
+ {"inflate_nif", 4, zlib_inflate},
+
+ /* running checksum */
+ {"crc32_nif", 1, zlib_crc32},
+
+ /* The stash keeps a single term alive across calls, and is used in
+ * exception_on_need_dict/1 to retain the old error behavior, and for
+ * saving data flushed through deflateParams/3. */
+ {"getStash_nif", 1, zlib_getStash},
+ {"clearStash_nif", 1, zlib_clearStash},
+ {"setStash_nif", 2, zlib_setStash},
+
+ /* DEPRECATED: buffer size for inflateChunk */
+ {"getBufSize_nif", 1, zlib_getBufSize},
+ {"setBufSize_nif", 2, zlib_setBufSize},
+
+ {"enqueue_nif", 2, zlib_enqueue_input},
+};
+
+ERL_NIF_INIT(zlib, nif_funcs, load, NULL, upgrade, unload)
+
+static void gc_zlib(ErlNifEnv *env, void* data);
+
+static int load(ErlNifEnv *env, void** priv_data, ERL_NIF_TERM load_info)
+{
+ am_not_on_controlling_process =
+ enif_make_atom(env, "not_on_controlling_process");
+
+ am_not_initialized = enif_make_atom(env, "not_initialized");
+ am_already_initialized = enif_make_atom(env, "already_initialized");
+
+ am_ok = enif_make_atom(env, "ok");
+ am_error = enif_make_atom(env, "error");
+
+ am_continue = enif_make_atom(env, "continue");
+ am_finished = enif_make_atom(env, "finished");
+
+ am_not_supported = enif_make_atom(env, "not_supported");
+ am_need_dictionary = enif_make_atom(env, "need_dictionary");
+
+ am_empty = enif_make_atom(env, "empty");
+
+ am_stream_end = enif_make_atom(env, "stream_end");
+ am_stream_error = enif_make_atom(env, "stream_error");
+ am_data_error = enif_make_atom(env, "data_error");
+ am_mem_error = enif_make_atom(env, "mem_error");
+ am_buf_error = enif_make_atom(env, "buf_error");
+ am_version_error = enif_make_atom(env, "version_error");
+ am_unknown_error = enif_make_atom(env, "unknown_error");
+
+ rtype_zlib = enif_open_resource_type(env, NULL,
+ "gc_zlib", gc_zlib, ERL_NIF_RT_CREATE, NULL);
+ *priv_data = NULL;
+
+ return 0;
+}
+
+static void unload(ErlNifEnv *env, void* priv_data)
+{
+
+}
+
+static int upgrade(ErlNifEnv *env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info)
+{
+ if(*old_priv_data != NULL) {
+ return -1; /* Don't know how to do that */
+ }
+ if(*priv_data != NULL) {
+ return -1; /* Don't know how to do that */
+ }
+ if(load(env, priv_data, load_info)) {
+ return -1;
+ }
+ return 0;
+}
+
+static void* zlib_alloc(void* data, unsigned int items, unsigned int size)
+{
+ return (void*) enif_alloc(items * size);
+}
+
+static void zlib_free(void* data, void* addr)
+{
+ enif_free(addr);
+}
+
+static ERL_NIF_TERM zlib_return(ErlNifEnv *env, int code) {
+ ERL_NIF_TERM reason;
+ switch(code) {
+ case Z_OK:
+ reason = am_ok;
+ break;
+ case Z_STREAM_END:
+ reason = am_stream_end;
+ break;
+ case Z_ERRNO:
+ reason = enif_make_int(env, errno);
+ break;
+ case Z_STREAM_ERROR:
+ reason = enif_raise_exception(env, am_stream_error);
+ break;
+ case Z_DATA_ERROR:
+ reason = enif_raise_exception(env, am_data_error);
+ break;
+ case Z_MEM_ERROR:
+ reason = am_mem_error;
+ break;
+ case Z_BUF_ERROR:
+ reason = am_buf_error;
+ break;
+ case Z_VERSION_ERROR:
+ reason = am_version_error;
+ break;
+ default:
+ reason = am_unknown_error;
+ break;
+ }
+ return reason;
+}
+
+static void zlib_internal_close(zlib_data_t *d) {
+ if(d->state == ST_DEFLATE) {
+ deflateEnd(&d->s);
+ } else if(d->state == ST_INFLATE) {
+ inflateEnd(&d->s);
+ }
+
+ if(d->state != ST_CLOSED) {
+ if(d->stash_env != NULL) {
+ enif_free_env(d->stash_env);
+ }
+
+ d->state = ST_CLOSED;
+ }
+}
+
+static void gc_zlib(ErlNifEnv *env, void* data) {
+ zlib_data_t *d = (zlib_data_t*)data;
+
+ enif_mutex_destroy(d->controller_lock);
+ enif_ioq_destroy(d->input_queue);
+
+ zlib_internal_close(d);
+
+ (void)env;
+}
+
+static int get_zlib_data(ErlNifEnv *env, ERL_NIF_TERM opaque, zlib_data_t **d) {
+ return enif_get_resource(env, opaque, rtype_zlib, (void **)d);
+}
+
+static int zlib_process_check(ErlNifEnv *env, zlib_data_t *d) {
+ int is_controlling_process;
+ ErlNifPid current_process;
+
+ enif_self(env, &current_process);
+
+ enif_mutex_lock(d->controller_lock);
+
+ is_controlling_process = enif_is_identical(
+ enif_make_pid(env, &current_process),
+ enif_make_pid(env, &d->controlling_process));
+
+ enif_mutex_unlock(d->controller_lock);
+
+ return is_controlling_process;
+}
+
+static void zlib_reset_input(zlib_data_t *d) {
+ enif_ioq_destroy(d->input_queue);
+ d->input_queue = enif_ioq_create(ERL_NIF_IOQ_NORMAL);
+
+ if(d->stash_env != NULL) {
+ enif_free_env(d->stash_env);
+ d->stash_env = NULL;
+ d->stash_term = NIL;
+ }
+}
+
+static int zlib_flush_queue(int (*codec)(z_stream*, int), ErlNifEnv *env,
+ zlib_data_t *d, size_t input_limit, ErlNifBinary *output_buffer, int flush,
+ size_t *bytes_produced, size_t *bytes_consumed, size_t *bytes_remaining) {
+
+ int vec_len, vec_idx;
+ SysIOVec *input_vec;
+ int res;
+
+ input_vec = enif_ioq_peek(d->input_queue, &vec_len);
+ vec_idx = 0;
+ res = Z_OK;
+
+ *bytes_produced = 0;
+ *bytes_consumed = 0;
+
+ d->s.avail_out = output_buffer->size;
+ d->s.next_out = output_buffer->data;
+
+ while(res == Z_OK && vec_idx < vec_len && *bytes_consumed < input_limit) {
+ size_t timeslice_percent, block_consumed, block_size;
+
+ block_size = MIN(input_vec[vec_idx].iov_len, input_limit);
+
+ d->s.next_in = input_vec[vec_idx].iov_base;
+ d->s.avail_in = block_size;
+
+ res = codec(&d->s, Z_NO_FLUSH);
+
+ ASSERT(d->s.avail_in == 0 || d->s.avail_out == 0 || res != Z_OK);
+
+ block_consumed = block_size - d->s.avail_in;
+ *bytes_consumed += block_consumed;
+
+ if(d->want_input_crc) {
+ d->input_crc =
+ crc32(d->input_crc, input_vec[vec_idx].iov_base, block_consumed);
+ }
+
+ timeslice_percent = (100 * block_consumed) / input_limit;
+ if(enif_consume_timeslice(env, MAX(1, timeslice_percent))) {
+ break;
+ }
+
+ vec_idx++;
+ }
+
+ if(!enif_ioq_deq(d->input_queue, *bytes_consumed, bytes_remaining)) {
+ *bytes_remaining = 0;
+ res = Z_BUF_ERROR;
+ }
+
+ if(res == Z_OK && flush != Z_NO_FLUSH && (*bytes_remaining == 0)) {
+ d->s.next_in = NULL;
+ d->s.avail_in = 0;
+
+ res = codec(&d->s, flush);
+ }
+
+ *bytes_produced = output_buffer->size - d->s.avail_out;
+
+ return res;
+}
+
+static ERL_NIF_TERM zlib_codec(int (*codec)(z_stream*, int),
+ ErlNifEnv *env, zlib_data_t *d,
+ int input_chunk_size,
+ int output_chunk_size,
+ int flush) {
+
+ size_t bytes_produced, bytes_consumed, bytes_remaining;
+ ErlNifBinary output_buffer;
+ int res;
+
+ if(!enif_alloc_binary(output_chunk_size, &output_buffer)) {
+ return zlib_return(env, Z_MEM_ERROR);
+ }
+
+ res = zlib_flush_queue(codec, env, d, input_chunk_size, &output_buffer,
+ flush, &bytes_produced, &bytes_consumed, &bytes_remaining);
+
+ if(res < 0 && res != Z_BUF_ERROR) {
+ enif_release_binary(&output_buffer);
+ return zlib_return(env, res);
+ }
+
+ if(res == Z_STREAM_END) {
+ d->eos_seen = 1;
+ }
+
+ if(d->want_output_crc) {
+ d->output_crc =
+ crc32(d->output_crc, output_buffer.data, bytes_produced);
+ }
+
+ if(bytes_consumed == 0 && bytes_produced == 0 && bytes_remaining != 0) {
+ /* Die if we've made zero progress; this should not happen on
+ * well-formed input. */
+
+ enif_release_binary(&output_buffer);
+ return zlib_return(env, Z_DATA_ERROR);
+ } else {
+ ERL_NIF_TERM flushed_output;
+
+ if(bytes_produced > 0) {
+ if(bytes_produced < output_buffer.size) {
+ enif_realloc_binary(&output_buffer, bytes_produced);
+ }
+
+ flushed_output =
+ enif_make_list1(env, enif_make_binary(env, &output_buffer));
+ } else {
+ enif_release_binary(&output_buffer);
+ flushed_output = enif_make_list(env, 0);
+ }
+
+ if(bytes_remaining == 0 && bytes_produced < output_chunk_size) {
+ return enif_make_tuple2(env, am_finished, flushed_output);
+ } else if(res != Z_NEED_DICT) {
+ return enif_make_tuple2(env, am_continue, flushed_output);
+ }
+
+ return enif_make_tuple3(env, am_need_dictionary,
+ enif_make_int(env, d->s.adler), flushed_output);
+ }
+}
+
+/* zlib nifs */
+
+static ERL_NIF_TERM zlib_getStash(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ zlib_data_t *d;
+
+ if(argc != 1 || !get_zlib_data(env, argv[0], &d)) {
+ return enif_make_badarg(env);
+ } else if(!zlib_process_check(env, d)) {
+ return enif_raise_exception(env, am_not_on_controlling_process);
+ }
+
+ if(d->stash_env == NULL) {
+ return am_empty;
+ }
+
+ return enif_make_tuple2(env, am_ok, enif_make_copy(env, d->stash_term));
+}
+
+static ERL_NIF_TERM zlib_clearStash(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ zlib_data_t *d;
+
+ if(argc != 1 || !get_zlib_data(env, argv[0], &d)) {
+ return enif_make_badarg(env);
+ } else if(!zlib_process_check(env, d)) {
+ return enif_raise_exception(env, am_not_on_controlling_process);
+ } else if(d->stash_env == NULL) {
+ return enif_raise_exception(env, am_error);
+ }
+
+ enif_free_env(d->stash_env);
+ d->stash_env = NULL;
+ d->stash_term = NIL;
+
+ return am_ok;
+}
+
+static ERL_NIF_TERM zlib_setStash(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ zlib_data_t *d;
+
+ if(argc != 2 || !get_zlib_data(env, argv[0], &d)) {
+ return enif_make_badarg(env);
+ } else if(!zlib_process_check(env, d)) {
+ return enif_raise_exception(env, am_not_on_controlling_process);
+ } else if(d->stash_env != NULL) {
+ return enif_raise_exception(env, am_error);
+ }
+
+ d->stash_env = enif_alloc_env();
+ d->stash_term = enif_make_copy(d->stash_env, argv[1]);
+
+ return am_ok;
+}
+
+static ERL_NIF_TERM zlib_open(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ zlib_data_t *d;
+ ERL_NIF_TERM result;
+
+ d = (zlib_data_t *) enif_alloc_resource(rtype_zlib, sizeof(zlib_data_t));
+
+ memset(&d->s, 0, sizeof(z_stream));
+
+ enif_self(env, &d->controlling_process);
+
+ d->input_queue = enif_ioq_create(ERL_NIF_IOQ_NORMAL);
+
+ d->controller_lock = enif_mutex_create("zlib_controller_lock");
+
+ d->s.zalloc = zlib_alloc;
+ d->s.zfree = zlib_free;
+ d->s.opaque = d;
+ d->s.data_type = Z_BINARY;
+
+ d->eos_behavior = EOS_BEHAVIOR_CUT;
+ d->eos_seen = 0;
+
+ d->state = ST_NONE;
+
+ d->want_output_crc = 0;
+ d->want_input_crc = 0;
+ d->is_raw_stream = 0;
+
+ d->output_crc = crc32(0L, Z_NULL, 0);
+ d->input_crc = crc32(0L, Z_NULL, 0);
+
+ d->stash_env = NULL;
+ d->stash_term = NIL;
+
+ d->inflateChunk_buffer_size = 4000;
+
+ result = enif_make_resource(env, d);
+ enif_release_resource(d);
+
+ return result;
+}
+
+static ERL_NIF_TERM zlib_close(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ zlib_data_t *d;
+
+ /* strictly speaking not needed since the gc will handle this */
+ if(argc != 1 || !get_zlib_data(env, argv[0], &d)) {
+ return enif_make_badarg(env);
+ } else if(!zlib_process_check(env, d)) {
+ return enif_raise_exception(env, am_not_on_controlling_process);
+ } else if(d->state == ST_CLOSED) {
+ return enif_raise_exception(env, am_not_initialized);
+ }
+
+ zlib_internal_close(d);
+
+ return am_ok;
+}
+
+static ERL_NIF_TERM zlib_set_controller(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ zlib_data_t *d;
+
+ ErlNifPid new_owner;
+
+ if(argc != 2 || !get_zlib_data(env, argv[0], &d)
+ || !enif_get_local_pid(env, argv[1], &new_owner)) {
+ return enif_make_badarg(env);
+ } else if(!zlib_process_check(env, d)) {
+ return enif_raise_exception(env, am_not_on_controlling_process);
+ }
+
+ enif_mutex_lock(d->controller_lock);
+
+ d->controlling_process = new_owner;
+
+ enif_mutex_unlock(d->controller_lock);
+
+ return am_ok;
+}
+
+/* deflate */
+
+static ERL_NIF_TERM zlib_deflateInit(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ zlib_data_t *d;
+ int level, method, windowBits, memLevel, strategy, res;
+
+ if(argc != 6 || !get_zlib_data(env, argv[0], &d)
+ || !enif_get_int(env, argv[1], &level)
+ || !enif_get_int(env, argv[2], &method)
+ || !enif_get_int(env, argv[3], &windowBits)
+ || !enif_get_int(env, argv[4], &memLevel)
+ || !enif_get_int(env, argv[5], &strategy)) {
+ return enif_make_badarg(env);
+ } else if(!zlib_process_check(env, d)) {
+ return enif_raise_exception(env, am_not_on_controlling_process);
+ } else if(d->state != ST_NONE) {
+ return enif_raise_exception(env, am_already_initialized);
+ }
+
+ res = deflateInit2(&d->s, level, method, windowBits, memLevel, strategy);
+
+ if(res == Z_OK) {
+ d->state = ST_DEFLATE;
+ d->eos_seen = 0;
+
+ d->is_raw_stream = (windowBits < 0);
+
+ d->want_output_crc = 0;
+ d->want_input_crc = d->is_raw_stream;
+
+ d->output_crc = crc32(0L, Z_NULL, 0);
+ d->input_crc = crc32(0L, Z_NULL, 0);
+ }
+
+ return zlib_return(env, res);
+}
+
+static ERL_NIF_TERM zlib_deflateSetDictionary(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ zlib_data_t *d;
+ ErlNifBinary bin;
+ int res;
+
+ if(argc != 2 || !get_zlib_data(env, argv[0], &d)
+ || !enif_inspect_iolist_as_binary(env, argv[1], &bin)) {
+ return enif_make_badarg(env);
+ } else if(!zlib_process_check(env, d)) {
+ return enif_raise_exception(env, am_not_on_controlling_process);
+ } else if(d->state != ST_DEFLATE) {
+ return enif_raise_exception(env, am_not_initialized);
+ }
+
+ if((res = deflateSetDictionary(&d->s, bin.data, bin.size)) == Z_OK) {
+ uLong checksum = d->s.adler;
+
+ /* d->s.adler is not updated in raw deflate mode, so we'll calculate it
+ * ourselves in case the user wants to rely on that behavior. */
+ if(d->is_raw_stream) {
+ checksum = adler32(0, bin.data, bin.size);
+ }
+
+ return enif_make_int(env, checksum);
+ }
+
+ return zlib_return(env, res);
+}
+
+static ERL_NIF_TERM zlib_deflateReset(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ zlib_data_t *d;
+ int res;
+
+ if(argc != 1 || !get_zlib_data(env, argv[0], &d)) {
+ return enif_make_badarg(env);
+ } else if(!zlib_process_check(env, d)) {
+ return enif_raise_exception(env, am_not_on_controlling_process);
+ } else if(d->state != ST_DEFLATE) {
+ return enif_raise_exception(env, am_not_initialized);
+ }
+
+ res = deflateReset(&d->s);
+
+ d->input_crc = crc32(0L, Z_NULL, 0);
+ d->eos_seen = 0;
+
+ zlib_reset_input(d);
+
+ return zlib_return(env, res);
+}
+
+static ERL_NIF_TERM zlib_deflateEnd(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ zlib_data_t *d;
+ int res;
+
+ if(argc != 1 || !get_zlib_data(env, argv[0], &d)) {
+ return enif_make_badarg(env);
+ } else if(!zlib_process_check(env, d)) {
+ return enif_raise_exception(env, am_not_on_controlling_process);
+ } else if(d->state != ST_DEFLATE) {
+ return enif_raise_exception(env, am_not_initialized);
+ }
+
+ res = deflateEnd(&d->s);
+
+ if(res == Z_OK && enif_ioq_size(d->input_queue) > 0) {
+ res = Z_DATA_ERROR;
+ }
+
+ zlib_reset_input(d);
+ d->state = ST_NONE;
+
+ return zlib_return(env, res);
+}
+
+static ERL_NIF_TERM zlib_deflateParams(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ zlib_data_t *d;
+ int res, level, strategy;
+
+ if(argc != 3 || !get_zlib_data(env, argv[0], &d)
+ || !enif_get_int(env, argv[1], &level)
+ || !enif_get_int(env, argv[2], &strategy)) {
+ return enif_make_badarg(env);
+ } else if(!zlib_process_check(env, d)) {
+ return enif_raise_exception(env, am_not_on_controlling_process);
+ } else if(d->state != ST_DEFLATE) {
+ return enif_raise_exception(env, am_not_initialized);
+ }
+
+ /* deflateParams will flush everything currently in the stream, corrupting
+ * the heap unless it's empty. We therefore pretend to have a full output
+ * buffer, forcing a Z_BUF_ERROR if there's anything left to be flushed. */
+ d->s.avail_out = 0;
+ res = deflateParams(&d->s, level, strategy);
+
+ return zlib_return(env, res);
+}
+
+static ERL_NIF_TERM zlib_deflate(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ zlib_data_t *d;
+
+ int input_chunk_size, output_chunk_size, flush;
+
+ if(argc != 4 || !get_zlib_data(env, argv[0], &d)
+ || !enif_get_int(env, argv[1], &input_chunk_size)
+ || !enif_get_int(env, argv[2], &output_chunk_size)
+ || !enif_get_int(env, argv[3], &flush)) {
+ return enif_make_badarg(env);
+ } else if(!zlib_process_check(env, d)) {
+ return enif_raise_exception(env, am_not_on_controlling_process);
+ } else if(d->state != ST_DEFLATE) {
+ return enif_raise_exception(env, am_not_initialized);
+ }
+
+ return zlib_codec(&deflate, env, d, input_chunk_size, output_chunk_size, flush);
+}
+
+/* inflate */
+
+static ERL_NIF_TERM zlib_inflateInit(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ zlib_data_t *d;
+
+ int windowBits, eosBehavior, res;
+
+ if(argc != 3 || !get_zlib_data(env, argv[0], &d)
+ || !enif_get_int(env, argv[1], &windowBits)
+ || !enif_get_int(env, argv[2], &eosBehavior)) {
+ return enif_make_badarg(env);
+ } else if(!zlib_process_check(env, d)) {
+ return enif_raise_exception(env, am_not_on_controlling_process);
+ } else if(d->state != ST_NONE) {
+ return enif_raise_exception(env, am_already_initialized);
+ }
+
+ res = inflateInit2(&d->s, windowBits);
+
+ if(res == Z_OK) {
+ d->state = ST_INFLATE;
+
+ d->eos_behavior = eosBehavior;
+ d->eos_seen = 0;
+
+ d->is_raw_stream = (windowBits < 0);
+
+ d->want_output_crc = d->is_raw_stream;
+ d->want_input_crc = 0;
+
+ d->output_crc = crc32(0L, Z_NULL, 0);
+ d->input_crc = crc32(0L, Z_NULL, 0);
+ }
+
+ return zlib_return(env, res);
+}
+
+static ERL_NIF_TERM zlib_inflateSetDictionary(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ zlib_data_t *d;
+ ErlNifBinary bin;
+ int res;
+
+ if(argc != 2 || !get_zlib_data(env, argv[0], &d)
+ || !enif_inspect_iolist_as_binary(env, argv[1], &bin)) {
+ return enif_make_badarg(env);
+ } else if(!zlib_process_check(env, d)) {
+ return enif_raise_exception(env, am_not_on_controlling_process);
+ } else if(d->state != ST_INFLATE) {
+ return enif_raise_exception(env, am_not_initialized);
+ }
+
+ res = inflateSetDictionary(&d->s, bin.data, bin.size);
+
+ return zlib_return(env, res);
+}
+
+#ifdef HAVE_ZLIB_INFLATEGETDICTIONARY
+/* Work around broken build system with runtime version test */
+static int zlib_supports_inflateGetDictionary(void) {
+ static int supportsGetDictionary = -1;
+
+#if defined(__APPLE__) && defined(__MACH__)
+ if(supportsGetDictionary < 0) {
+ unsigned int v[4] = {0, 0, 0, 0};
+ unsigned hexver;
+
+ sscanf(zlibVersion(), "%u.%u.%u.%u", &v[0], &v[1], &v[2], &v[3]);
+
+ hexver = (v[0] << (8*3)) | (v[1] << (8*2)) | (v[2] << (8)) | v[3];
+ supportsGetDictionary = (hexver >= 0x1020701); /* 1.2.7.1 */
+ }
+#endif
+
+ return supportsGetDictionary;
+}
+#endif
+
+static ERL_NIF_TERM zlib_inflateGetDictionary(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ zlib_data_t *d;
+
+ if(argc != 1 || !get_zlib_data(env, argv[0], &d)) {
+ return enif_make_badarg(env);
+ } else if(!zlib_process_check(env, d)) {
+ return enif_raise_exception(env, am_not_on_controlling_process);
+ } else if(d->state != ST_INFLATE) {
+ return enif_raise_exception(env, am_not_initialized);
+ }
+
+#ifdef HAVE_ZLIB_INFLATEGETDICTIONARY
+ if(zlib_supports_inflateGetDictionary()) {
+ ErlNifBinary obin;
+ uInt len;
+ int res;
+
+ enif_alloc_binary(INFL_DICT_SZ, &obin);
+ len = 0;
+
+ if((res = inflateGetDictionary(&d->s, obin.data, &len)) < 0) {
+ enif_release_binary(&obin);
+ return zlib_return(env, res);
+ }
+
+ enif_realloc_binary(&obin, (size_t)len);
+ return enif_make_binary(env, &obin);
+ }
+#endif
+
+ return enif_raise_exception(env, am_not_supported);
+}
+
+static ERL_NIF_TERM zlib_inflateReset(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ zlib_data_t *d;
+ int res;
+
+ if(argc != 1 || !get_zlib_data(env, argv[0], &d)) {
+ return enif_make_badarg(env);
+ } else if(!zlib_process_check(env, d)) {
+ return enif_raise_exception(env, am_not_on_controlling_process);
+ } else if(d->state != ST_INFLATE) {
+ return enif_raise_exception(env, am_not_initialized);
+ }
+
+ res = inflateReset(&d->s);
+
+ d->output_crc = crc32(0L, Z_NULL, 0);
+ d->eos_seen = 0;
+
+ zlib_reset_input(d);
+
+ return zlib_return(env, res);
+}
+
+static ERL_NIF_TERM zlib_inflateEnd(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ zlib_data_t *d;
+ int res;
+
+ if(argc != 1 || !get_zlib_data(env, argv[0], &d)) {
+ return enif_make_badarg(env);
+ } else if(!zlib_process_check(env, d)) {
+ return enif_raise_exception(env, am_not_on_controlling_process);
+ } else if(d->state != ST_INFLATE) {
+ return enif_raise_exception(env, am_not_initialized);
+ }
+
+ res = inflateEnd(&d->s);
+
+ if(res == Z_OK && (!d->eos_seen || enif_ioq_size(d->input_queue) > 0)) {
+ res = Z_DATA_ERROR;
+ }
+
+ zlib_reset_input(d);
+ d->state = ST_NONE;
+
+ return zlib_return(env, res);
+}
+
+static ERL_NIF_TERM zlib_inflate(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ zlib_data_t *d;
+
+ int input_chunk_size, output_chunk_size, flush;
+
+ if(argc != 4 || !get_zlib_data(env, argv[0], &d)
+ || !enif_get_int(env, argv[1], &input_chunk_size)
+ || !enif_get_int(env, argv[2], &output_chunk_size)
+ || !enif_get_int(env, argv[3], &flush)) {
+ return enif_make_badarg(env);
+ } else if(!zlib_process_check(env, d)) {
+ return enif_raise_exception(env, am_not_on_controlling_process);
+ } else if(d->state != ST_INFLATE) {
+ return enif_raise_exception(env, am_not_initialized);
+ }
+
+ if(d->eos_seen) {
+ int res;
+
+ switch(d->eos_behavior) {
+ case EOS_BEHAVIOR_ERROR:
+ return zlib_return(env, Z_DATA_ERROR);
+ case EOS_BEHAVIOR_RESET:
+ res = inflateReset(&d->s);
+
+ if(res != Z_OK) {
+ return zlib_return(env, res);
+ }
+
+ d->eos_seen = 0;
+ break;
+ case EOS_BEHAVIOR_CUT:
+ zlib_reset_input(d);
+
+ return enif_make_tuple2(env, am_finished, enif_make_list(env, 0));
+ }
+ }
+
+ return zlib_codec(&inflate, env, d, input_chunk_size, output_chunk_size, flush);
+}
+
+static ERL_NIF_TERM zlib_crc32(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ zlib_data_t *d;
+
+ if(argc != 1 || !get_zlib_data(env, argv[0], &d)) {
+ return enif_make_badarg(env);
+ } else if(!zlib_process_check(env, d)) {
+ return enif_raise_exception(env, am_not_on_controlling_process);
+ }
+
+ if(d->state == ST_DEFLATE) {
+ return enif_make_ulong(env, d->input_crc);
+ } else if(d->state == ST_INFLATE) {
+ return enif_make_ulong(env, d->output_crc);
+ }
+
+ return enif_raise_exception(env, am_not_initialized);
+}
+
+static ERL_NIF_TERM zlib_getBufSize(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ zlib_data_t *d;
+
+ if(argc != 1 || !get_zlib_data(env, argv[0], &d)) {
+ return enif_make_badarg(env);
+ } else if(!zlib_process_check(env, d)) {
+ return enif_raise_exception(env, am_not_on_controlling_process);
+ }
+
+ return enif_make_int(env, d->inflateChunk_buffer_size);
+}
+
+static ERL_NIF_TERM zlib_setBufSize(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ zlib_data_t *d;
+
+ if(argc != 2 || !get_zlib_data(env, argv[0], &d)) {
+ return enif_make_badarg(env);
+ } else if(!zlib_process_check(env, d)) {
+ return enif_raise_exception(env, am_not_on_controlling_process);
+ }
+
+ if(!enif_get_int(env, argv[1], &d->inflateChunk_buffer_size)) {
+ return enif_make_badarg(env);
+ }
+
+ return am_ok;
+}
+
+static ERL_NIF_TERM zlib_enqueue_input(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ zlib_data_t *d;
+
+ ErlNifIOVec prealloc, *iovec = &prealloc;
+ ERL_NIF_TERM tail;
+
+ if(argc != 2 || !get_zlib_data(env, argv[0], &d)) {
+ return enif_make_badarg(env);
+ } else if(!zlib_process_check(env, d)) {
+ return enif_raise_exception(env, am_not_on_controlling_process);
+ } else if(d->state != ST_DEFLATE && d->state != ST_INFLATE) {
+ return enif_raise_exception(env, am_not_initialized);
+ }
+
+ if(!enif_inspect_iovec(env, 256, argv[1], &tail, &iovec)) {
+ return enif_make_badarg(env);
+ } else if(!enif_ioq_enqv(d->input_queue, iovec, 0)) {
+ return enif_make_badarg(env);
+ }
+
+ if(!enif_is_empty_list(env, tail)) {
+ return enif_make_tuple2(env, am_continue, tail);
+ }
+
+ return am_ok;
+}
diff --git a/erts/emulator/pcre/README.pcre_update.md b/erts/emulator/pcre/README.pcre_update.md
index 5f2414f0d9..8caf575d31 100644
--- a/erts/emulator/pcre/README.pcre_update.md
+++ b/erts/emulator/pcre/README.pcre_update.md
@@ -243,7 +243,8 @@ To begin with you will need a default table for Latin-1 characters, so:
~/tmp/pcre/pcre-8.33> LANG=sv_SE ./dftables -L ../epcre-8.33/pcre_latin_1_table.c
Compare it to the pcre\_latin\_1\_table.c in the old version, they
-should not differ in any significant way.
+should not differ in any significant way. If they do, it might be
+that you do not have the sv_SE locale installed on your machine.
A good starting point is then to try to find all files in the new
version of the library that have (probably) the same names as the
@@ -685,10 +686,23 @@ generation that you do not get to many of the "Fishy character"
messages, if they are more than, say 20, you will probably need to
address the UTF8 issues in the Perl execution. As it is now, we skip
non latin1 characters in this test. You will need to run iconv on the
-generated module to make it UTF-8 before running tests.
+generated module to make it UTF-8 before running tests. Try to use a
+perl version that is as new as possible.
The exact same procedure goes for the re\_testoutput1\_split\_test.erl.
+Make a note about perl version used in the commit updating the replace
+and split test files.
+
+Note that the perl version you are using may not be completely
+compatible with the PCRE version you are upgrading to. If this is the
+case you might get failures when running the replace and split tests.
+If you get failures, you need to inspect the failures and decide what
+to do. If there are only a small amount of failures you will probably
+end up preferring the behavior of PCRE, and manually changing these
+tests. Do these changes in a separate commit so it is easy to see
+what differed.
+
Also add copyright headers to the files after converting them to UTF-8.
After ironing out the rest of the bugs, you should be done with the
diff --git a/erts/emulator/pcre/local_config.h b/erts/emulator/pcre/local_config.h
index 791d7f5a6b..c6af423d72 100644
--- a/erts/emulator/pcre/local_config.h
+++ b/erts/emulator/pcre/local_config.h
@@ -55,6 +55,11 @@
--disable-stack-for-recursion). */
#define NO_RECURSE
+/* The value of PARENS_NEST_LIMIT specifies the maximum depth of nested
+ parentheses (of any kind) in a pattern. This limits the amount of system
+ stack that is used while compiling a pattern. */
+#define PARENS_NEST_LIMIT 10000
+
/* Define if linking statically (TODO: make nice with Libtool) */
#define PCRE_STATIC 1
@@ -74,8 +79,11 @@
/* Define to enable support for Unicode properties */
#define SUPPORT_UCP
-/* Define to enable support for the UTF-8 Unicode encoding. */
+/* Define to any value to enable support for the UTF-8/16/32 Unicode encoding.
+ This will work even in an EBCDIC environment, but it is incompatible with
+ the EBCDIC macro. That is, PCRE can support *either* EBCDIC code *or*
+ ASCII/UTF-8/16/32, but not both at once. */
#define SUPPORT_UTF
/* Version number of package */
-#define VERSION "8.33"
+#define VERSION "8.41"
diff --git a/erts/emulator/pcre/pcre-8.33.tar.bz2 b/erts/emulator/pcre/pcre-8.33.tar.bz2
deleted file mode 100644
index 0cea71c8b6..0000000000
--- a/erts/emulator/pcre/pcre-8.33.tar.bz2
+++ /dev/null
Binary files differ
diff --git a/erts/emulator/pcre/pcre-8.33_1370.diff b/erts/emulator/pcre/pcre-8.33_1370.diff
deleted file mode 100644
index d62398985d..0000000000
--- a/erts/emulator/pcre/pcre-8.33_1370.diff
+++ /dev/null
@@ -1,60 +0,0 @@
---- code/trunk/pcre_exec.c 2013/07/02 18:37:36 1346
-+++ code/trunk/pcre_exec.c 2013/07/26 10:03:38 1350
-@@ -5637,7 +5637,7 @@
- }
- }
-
-- /* Match extended Unicode sequences. We will get here only if the
-+ /* Match extended Unicode grapheme clusters. We will get here only if the
- support is in the binary; otherwise a compile-time error occurs. */
-
- else if (ctype == OP_EXTUNI)
-@@ -5670,21 +5670,41 @@
- /* eptr is now past the end of the maximum run */
-
- if (possessive) continue; /* No backtracking */
-+
- for(;;)
- {
-- if (eptr == pp) goto TAIL_RECURSE;
-+ int lgb, rgb;
-+ PCRE_PUCHAR fptr;
-+
-+ if (eptr == pp) goto TAIL_RECURSE; /* At start of char run */
- RMATCH(eptr, ecode, offset_top, md, eptrb, RM45);
- if (rrc != MATCH_NOMATCH) RRETURN(rrc);
-+
-+ /* Backtracking over an extended grapheme cluster involves inspecting
-+ the previous two characters (if present) to see if a break is
-+ permitted between them. */
-+
- eptr--;
-- for (;;) /* Move back over one extended */
-+ if (!utf) c = *eptr; else
-+ {
-+ BACKCHAR(eptr);
-+ GETCHAR(c, eptr);
-+ }
-+ rgb = UCD_GRAPHBREAK(c);
-+
-+ for (;;)
- {
-- if (!utf) c = *eptr; else
-+ if (eptr == pp) goto TAIL_RECURSE; /* At start of char run */
-+ fptr = eptr - 1;
-+ if (!utf) c = *fptr; else
- {
-- BACKCHAR(eptr);
-- GETCHAR(c, eptr);
-+ BACKCHAR(fptr);
-+ GETCHAR(c, fptr);
- }
-- if (UCD_CATEGORY(c) != ucp_M) break;
-- eptr--;
-+ lgb = UCD_GRAPHBREAK(c);
-+ if ((PRIV(ucp_gbtable)[lgb] & (1 << rgb)) == 0) break;
-+ eptr = fptr;
-+ rgb = lgb;
- }
- }
- }
diff --git a/erts/emulator/pcre/pcre-8.41.tar.bz2 b/erts/emulator/pcre/pcre-8.41.tar.bz2
new file mode 100644
index 0000000000..1798432dc9
--- /dev/null
+++ b/erts/emulator/pcre/pcre-8.41.tar.bz2
Binary files differ
diff --git a/erts/emulator/pcre/pcre.h b/erts/emulator/pcre/pcre.h
index 57efdd01f5..ab8f40cfc1 100644
--- a/erts/emulator/pcre/pcre.h
+++ b/erts/emulator/pcre/pcre.h
@@ -5,7 +5,7 @@
/* This is the public header file for the PCRE library, to be #included by
applications that call the PCRE functions.
- Copyright (c) 1997-2013 University of Cambridge
+ Copyright (c) 1997-2014 University of Cambridge
-----------------------------------------------------------------------------
Redistribution and use in source and binary forms, with or without
@@ -43,9 +43,9 @@ POSSIBILITY OF SUCH DAMAGE.
/* The current PCRE version information. */
#define PCRE_MAJOR 8
-#define PCRE_MINOR 33
+#define PCRE_MINOR 41
#define PCRE_PRERELEASE
-#define PCRE_DATE 2013-05-28
+#define PCRE_DATE 2017-07-05
/* When an application links to a PCRE DLL in Windows, the symbols that are
imported have to be identified as such. When building PCRE, the appropriate
@@ -151,7 +151,10 @@ with J. */
#define PCRE_NEVER_UTF 0x00010000 /* C1 ) Overlaid */
#define PCRE_DFA_SHORTEST 0x00010000 /* D ) Overlaid */
-#define PCRE_DFA_RESTART 0x00020000 /* D */
+/* This pair use the same bit. */
+#define PCRE_NO_AUTO_POSSESS 0x00020000 /* C1 ) Overlaid */
+#define PCRE_DFA_RESTART 0x00020000 /* D ) Overlaid */
+
#define PCRE_FIRSTLINE 0x00040000 /* C3 */
#define PCRE_DUPNAMES 0x00080000 /* C1 */
#define PCRE_NEWLINE_CR 0x00100000 /* C3 E D */
@@ -281,6 +284,7 @@ with J. */
#define PCRE_INFO_REQUIREDCHARFLAGS 22
#define PCRE_INFO_MATCHLIMIT 23
#define PCRE_INFO_RECURSIONLIMIT 24
+#define PCRE_INFO_MATCH_EMPTY 25
/* Request types for pcre_config(). Do not re-arrange, in order to remain
compatible. */
@@ -298,6 +302,7 @@ compatible. */
#define PCRE_CONFIG_UTF16 10
#define PCRE_CONFIG_JITTARGET 11
#define PCRE_CONFIG_UTF32 12
+#define PCRE_CONFIG_PARENS_LIMIT 13
/* Request types for pcre_study(). Do not re-arrange, in order to remain
compatible. */
@@ -513,24 +518,28 @@ PCRE_EXP_DECL void (*erts_pcre_free)(void *);
PCRE_EXP_DECL void *(*erts_pcre_stack_malloc)(size_t);
PCRE_EXP_DECL void (*erts_pcre_stack_free)(void *);
PCRE_EXP_DECL int (*erts_pcre_callout)(erts_pcre_callout_block *);
+PCRE_EXP_DECL int (*erts_pcre_stack_guard)(void);
#else
PCRE_EXP_DECL void *(*pcre_malloc)(size_t);
PCRE_EXP_DECL void (*pcre_free)(void *);
PCRE_EXP_DECL void *(*pcre_stack_malloc)(size_t);
PCRE_EXP_DECL void (*pcre_stack_free)(void *);
PCRE_EXP_DECL int (*pcre_callout)(pcre_callout_block *);
+PCRE_EXP_DECL int (*pcre_stack_guard)(void);
#endif
PCRE_EXP_DECL void *(*pcre16_malloc)(size_t);
PCRE_EXP_DECL void (*pcre16_free)(void *);
PCRE_EXP_DECL void *(*pcre16_stack_malloc)(size_t);
PCRE_EXP_DECL void (*pcre16_stack_free)(void *);
PCRE_EXP_DECL int (*pcre16_callout)(pcre16_callout_block *);
+PCRE_EXP_DECL int (*pcre16_stack_guard)(void);
PCRE_EXP_DECL void *(*pcre32_malloc)(size_t);
PCRE_EXP_DECL void (*pcre32_free)(void *);
PCRE_EXP_DECL void *(*pcre32_stack_malloc)(size_t);
PCRE_EXP_DECL void (*pcre32_stack_free)(void *);
PCRE_EXP_DECL int (*pcre32_callout)(pcre32_callout_block *);
+PCRE_EXP_DECL int (*pcre32_stack_guard)(void);
#else /* VPCOMPAT */
#if defined(ERLANG_INTEGRATION)
PCRE_EXP_DECL void *erts_pcre_malloc(size_t);
@@ -538,12 +547,14 @@ PCRE_EXP_DECL void erts_pcre_free(void *);
PCRE_EXP_DECL void *erts_pcre_stack_malloc(size_t);
PCRE_EXP_DECL void erts_pcre_stack_free(void *);
PCRE_EXP_DECL int erts_pcre_callout(erts_pcre_callout_block *);
+PCRE_EXP_DECL int erts_pcre_stack_guard(void);
#else
PCRE_EXP_DECL void *pcre_malloc(size_t);
PCRE_EXP_DECL void pcre_free(void *);
PCRE_EXP_DECL void *pcre_stack_malloc(size_t);
PCRE_EXP_DECL void pcre_stack_free(void *);
PCRE_EXP_DECL int pcre_callout(pcre_callout_block *);
+PCRE_EXP_DECL int pcre_stack_guard(void);
#endif
PCRE_EXP_DECL void *pcre16_malloc(size_t);
@@ -551,12 +562,14 @@ PCRE_EXP_DECL void pcre16_free(void *);
PCRE_EXP_DECL void *pcre16_stack_malloc(size_t);
PCRE_EXP_DECL void pcre16_stack_free(void *);
PCRE_EXP_DECL int pcre16_callout(pcre16_callout_block *);
+PCRE_EXP_DECL int pcre16_stack_guard(void);
PCRE_EXP_DECL void *pcre32_malloc(size_t);
PCRE_EXP_DECL void pcre32_free(void *);
PCRE_EXP_DECL void *pcre32_stack_malloc(size_t);
PCRE_EXP_DECL void pcre32_stack_free(void *);
PCRE_EXP_DECL int pcre32_callout(pcre32_callout_block *);
+PCRE_EXP_DECL int pcre32_stack_guard(void);
#endif /* VPCOMPAT */
/* User defined callback which provides a stack just before the match starts. */
@@ -811,6 +824,9 @@ PCRE_EXP_DECL void pcre16_assign_jit_stack(pcre16_extra *,
pcre16_jit_callback, void *);
PCRE_EXP_DECL void pcre32_assign_jit_stack(pcre32_extra *,
pcre32_jit_callback, void *);
+PCRE_EXP_DECL void pcre_jit_free_unused_memory(void);
+PCRE_EXP_DECL void pcre16_jit_free_unused_memory(void);
+PCRE_EXP_DECL void pcre32_jit_free_unused_memory(void);
#ifdef ERLANG_INTEGRATION
PCRE_EXP_DECL void erts_pcre_free_restart_data(void *restart_data);
diff --git a/erts/emulator/pcre/pcre.mk b/erts/emulator/pcre/pcre.mk
index 54412f6b1d..38b91237a2 100644
--- a/erts/emulator/pcre/pcre.mk
+++ b/erts/emulator/pcre/pcre.mk
@@ -1,18 +1,19 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2012. All Rights Reserved.
+# Copyright Ericsson AB 2012-2016. 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/.
+# 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
#
-# 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.
+# 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%
#
diff --git a/erts/emulator/pcre/pcre_byte_order.c b/erts/emulator/pcre/pcre_byte_order.c
index 710676988f..f99317c44e 100644
--- a/erts/emulator/pcre/pcre_byte_order.c
+++ b/erts/emulator/pcre/pcre_byte_order.c
@@ -6,7 +6,7 @@
and semantics are as close as possible to those of the Perl 5 language.
Written by Philip Hazel
- Copyright (c) 1997-2013 University of Cambridge
+ Copyright (c) 1997-2014 University of Cambridge
-----------------------------------------------------------------------------
Redistribution and use in source and binary forms, with or without
@@ -316,9 +316,9 @@ while(TRUE)
ptr++;
}
/* Control should never reach here in 16/32 bit mode. */
-#endif /* !COMPILE_PCRE8 */
-
+#else /* In 8-bit mode, the pattern does not need to be processed. */
return 0;
+#endif /* !COMPILE_PCRE8 */
}
/* End of pcre_byte_order.c */
diff --git a/erts/emulator/pcre/pcre_chartables.c b/erts/emulator/pcre/pcre_chartables.c
index 0d7ecd5261..b3d9020f25 100644
--- a/erts/emulator/pcre/pcre_chartables.c
+++ b/erts/emulator/pcre/pcre_chartables.c
@@ -163,7 +163,7 @@ graph, print, punct, and cntrl. Other classes are built from combinations. */
*/
0x80,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 0- 7 */
- 0x00,0x01,0x01,0x00,0x01,0x01,0x00,0x00, /* 8- 15 */
+ 0x00,0x01,0x01,0x01,0x01,0x01,0x00,0x00, /* 8- 15 */
0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 16- 23 */
0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 24- 31 */
0x01,0x00,0x00,0x00,0x80,0x00,0x00,0x00, /* - ' */
diff --git a/erts/emulator/pcre/pcre_compile.c b/erts/emulator/pcre/pcre_compile.c
index d48126a55d..e79284ab79 100644
--- a/erts/emulator/pcre/pcre_compile.c
+++ b/erts/emulator/pcre/pcre_compile.c
@@ -6,7 +6,7 @@
and semantics are as close as possible to those of the Perl 5 language.
Written by Philip Hazel
- Copyright (c) 1997-2013 University of Cambridge
+ Copyright (c) 1997-2016 University of Cambridge
-----------------------------------------------------------------------------
Redistribution and use in source and binary forms, with or without
@@ -48,8 +48,8 @@ supporting internal functions that are not used by other modules. */
#endif
#define NLBLOCK cd /* Block containing newline information */
-#define PSSTART start_pattern /* Field containing processed string start */
-#define PSEND end_pattern /* Field containing processed string end */
+#define PSSTART start_pattern /* Field containing pattern start */
+#define PSEND end_pattern /* Field containing pattern end */
#include "pcre_internal.h"
@@ -116,6 +116,13 @@ kicks in at the same number of forward references in all cases. */
#define COMPILE_WORK_SIZE (2048*LINK_SIZE)
#define COMPILE_WORK_SIZE_MAX (100*COMPILE_WORK_SIZE)
+/* This value determines the size of the initial vector that is used for
+remembering named groups during the pre-compile. It is allocated on the stack,
+but if it is too small, it is expanded using malloc(), in a similar way to the
+workspace. The value is the number of slots in the list. */
+
+#define NAMED_GROUP_LIST_SIZE 20
+
/* The overrun tests check for a slightly smaller size so that they detect the
overrun before it actually does run off the end of the data block. */
@@ -168,7 +175,7 @@ static const short int escapes[] = {
-ESC_Z, CHAR_LEFT_SQUARE_BRACKET,
CHAR_BACKSLASH, CHAR_RIGHT_SQUARE_BRACKET,
CHAR_CIRCUMFLEX_ACCENT, CHAR_UNDERSCORE,
- CHAR_GRAVE_ACCENT, 7,
+ CHAR_GRAVE_ACCENT, ESC_a,
-ESC_b, 0,
-ESC_d, ESC_e,
ESC_f, 0,
@@ -196,9 +203,9 @@ static const short int escapes[] = {
/* 68 */ 0, 0, '|', ',', '%', '_', '>', '?',
/* 70 */ 0, 0, 0, 0, 0, 0, 0, 0,
/* 78 */ 0, '`', ':', '#', '@', '\'', '=', '"',
-/* 80 */ 0, 7, -ESC_b, 0, -ESC_d, ESC_e, ESC_f, 0,
+/* 80 */ 0, ESC_a, -ESC_b, 0, -ESC_d, ESC_e, ESC_f, 0,
/* 88 */-ESC_h, 0, 0, '{', 0, 0, 0, 0,
-/* 90 */ 0, 0, -ESC_k, 'l', 0, ESC_n, 0, -ESC_p,
+/* 90 */ 0, 0, -ESC_k, 0, 0, ESC_n, 0, -ESC_p,
/* 98 */ 0, ESC_r, 0, '}', 0, 0, 0, 0,
/* A0 */ 0, '~', -ESC_s, ESC_tee, 0,-ESC_v, -ESC_w, 0,
/* A8 */ 0,-ESC_z, 0, 0, 0, '[', 0, 0,
@@ -213,6 +220,12 @@ static const short int escapes[] = {
/* F0 */ 0, 0, 0, 0, 0, 0, 0, 0,
/* F8 */ 0, 0, 0, 0, 0, 0, 0, 0
};
+
+/* We also need a table of characters that may follow \c in an EBCDIC
+environment for characters 0-31. */
+
+static unsigned char ebcdic_escape_c[] = "@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_";
+
#endif
@@ -254,11 +267,25 @@ static const verbitem verbs[] = {
static const int verbcount = sizeof(verbs)/sizeof(verbitem);
+/* Substitutes for [[:<:]] and [[:>:]], which mean start and end of word in
+another regex library. */
+
+static const pcre_uchar sub_start_of_word[] = {
+ CHAR_BACKSLASH, CHAR_b, CHAR_LEFT_PARENTHESIS, CHAR_QUESTION_MARK,
+ CHAR_EQUALS_SIGN, CHAR_BACKSLASH, CHAR_w, CHAR_RIGHT_PARENTHESIS, '\0' };
+
+static const pcre_uchar sub_end_of_word[] = {
+ CHAR_BACKSLASH, CHAR_b, CHAR_LEFT_PARENTHESIS, CHAR_QUESTION_MARK,
+ CHAR_LESS_THAN_SIGN, CHAR_EQUALS_SIGN, CHAR_BACKSLASH, CHAR_w,
+ CHAR_RIGHT_PARENTHESIS, '\0' };
+
+
/* Tables of names of POSIX character classes and their lengths. The names are
now all in a single string, to reduce the number of relocations when a shared
library is dynamically loaded. The list of lengths is terminated by a zero
length entry. The first three must be alpha, lower, upper, as this is assumed
-for handling case independence. */
+for handling case independence. The indices for graph, print, and punct are
+needed, so identify them. */
static const char posix_names[] =
STRING_alpha0 STRING_lower0 STRING_upper0 STRING_alnum0
@@ -269,6 +296,11 @@ static const char posix_names[] =
static const pcre_uint8 posix_name_lengths[] = {
5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 4, 6, 0 };
+#define PC_GRAPH 8
+#define PC_PRINT 9
+#define PC_PUNCT 10
+
+
/* Table of class bit maps for each POSIX class. Each class is formed from a
base map, with an optional addition or removal of another map. Then, for some
classes, there is some additional tweaking: for [:blank:] the vertical space
@@ -296,9 +328,8 @@ static const int posix_class_maps[] = {
cbit_xdigit,-1, 0 /* xdigit */
};
-/* Table of substitutes for \d etc when PCRE_UCP is set. The POSIX class
-substitutes must be in the order of the names, defined above, and there are
-both positive and negative cases. NULL means no substitute. */
+/* Table of substitutes for \d etc when PCRE_UCP is set. They are replaced by
+Unicode property escapes. */
#ifdef SUPPORT_UCP
static const pcre_uchar string_PNd[] = {
@@ -323,12 +354,18 @@ static const pcre_uchar string_pXwd[] = {
static const pcre_uchar *substitutes[] = {
string_PNd, /* \D */
string_pNd, /* \d */
- string_PXsp, /* \S */ /* NOTE: Xsp is Perl space */
- string_pXsp, /* \s */
+ string_PXsp, /* \S */ /* Xsp is Perl space, but from 8.34, Perl */
+ string_pXsp, /* \s */ /* space and POSIX space are the same. */
string_PXwd, /* \W */
string_pXwd /* \w */
};
+/* The POSIX class substitutes must be in the order of the POSIX class names,
+defined above, and there are both positive and negative cases. NULL means no
+general substitute of a Unicode property escape (\p or \P). However, for some
+POSIX classes (e.g. graph, print, punct) a special property code is compiled
+directly. */
+
static const pcre_uchar string_pL[] = {
CHAR_BACKSLASH, CHAR_p, CHAR_LEFT_CURLY_BRACKET,
CHAR_L, CHAR_RIGHT_CURLY_BRACKET, '\0' };
@@ -376,8 +413,8 @@ static const pcre_uchar *posix_substitutes[] = {
NULL, /* graph */
NULL, /* print */
NULL, /* punct */
- string_pXps, /* space */ /* NOTE: Xps is POSIX space */
- string_pXwd, /* word */
+ string_pXps, /* space */ /* Xps is POSIX space, but from 8.34 */
+ string_pXwd, /* word */ /* Perl and POSIX space are the same */
NULL, /* xdigit */
/* Negated cases */
string_PL, /* ^alpha */
@@ -391,8 +428,8 @@ static const pcre_uchar *posix_substitutes[] = {
NULL, /* ^graph */
NULL, /* ^print */
NULL, /* ^punct */
- string_PXps, /* ^space */ /* NOTE: Xps is POSIX space */
- string_PXwd, /* ^word */
+ string_PXps, /* ^space */ /* Xps is POSIX space, but from 8.34 */
+ string_PXwd, /* ^word */ /* Perl and POSIX space are the same */
NULL /* ^xdigit */
};
#define POSIX_SUBSIZE (sizeof(posix_substitutes) / sizeof(pcre_uchar *))
@@ -428,7 +465,7 @@ static const char error_texts[] =
"range out of order in character class\0"
"nothing to repeat\0"
/* 10 */
- "operand of unlimited repeat could match the empty string\0" /** DEAD **/
+ "internal error: invalid forward reference offset\0"
"internal error: unexpected repeat\0"
"unrecognized character after (? or (?-\0"
"POSIX named classes are supported only within a class\0"
@@ -449,14 +486,14 @@ static const char error_texts[] =
"lookbehind assertion is not fixed length\0"
"malformed number or name after (?(\0"
"conditional group contains more than two branches\0"
- "assertion expected after (?(\0"
+ "assertion expected after (?( or (?(?C)\0"
"(?R or (?[+-]digits must be followed by )\0"
/* 30 */
"unknown POSIX class name\0"
"POSIX collating elements are not supported\0"
"this version of PCRE is compiled without UTF support\0"
"spare error\0" /** DEAD **/
- "character value in \\x{...} sequence is too large\0"
+ "character value in \\x{} or \\o{} is too large\0"
/* 35 */
"invalid condition (?(0)\0"
"\\C not allowed in lookbehind assertion\0"
@@ -497,7 +534,11 @@ static const char error_texts[] =
"different names for subpatterns of the same number are not allowed\0"
"(*MARK) must have an argument\0"
"this version of PCRE is not compiled with Unicode property support\0"
+#ifndef EBCDIC
"\\c must be followed by an ASCII character\0"
+#else
+ "\\c must be followed by a letter or one of [\\]^_?\0"
+#endif
"\\k is not followed by a braced, angle-bracketed, or quoted name\0"
/* 70 */
"internal error: unknown opcode in find_fixedlength()\0"
@@ -510,6 +551,17 @@ static const char error_texts[] =
"character value in \\u.... sequence is too large\0"
"invalid UTF-32 string\0"
"setting UTF is disabled by the application\0"
+ "non-hex character in \\x{} (closing brace missing?)\0"
+ /* 80 */
+ "non-octal character in \\o{} (closing brace missing?)\0"
+ "missing opening brace after \\o\0"
+ "parentheses are too deeply nested\0"
+ "invalid range in character class\0"
+ "group name must start with a non-digit\0"
+ /* 85 */
+ "parentheses are too deeply nested (stack check)\0"
+ "digits missing in \\x{} or \\o{}\0"
+ "regular expression is too complicated\0"
;
/* Table to identify digits and hex digits. This is used when compiling
@@ -649,6 +701,183 @@ static const pcre_uint8 ebcdic_chartab[] = { /* chartable partial dup */
#endif
+/* This table is used to check whether auto-possessification is possible
+between adjacent character-type opcodes. The left-hand (repeated) opcode is
+used to select the row, and the right-hand opcode is use to select the column.
+A value of 1 means that auto-possessification is OK. For example, the second
+value in the first row means that \D+\d can be turned into \D++\d.
+
+The Unicode property types (\P and \p) have to be present to fill out the table
+because of what their opcode values are, but the table values should always be
+zero because property types are handled separately in the code. The last four
+columns apply to items that cannot be repeated, so there is no need to have
+rows for them. Note that OP_DIGIT etc. are generated only when PCRE_UCP is
+*not* set. When it is set, \d etc. are converted into OP_(NOT_)PROP codes. */
+
+#define APTROWS (LAST_AUTOTAB_LEFT_OP - FIRST_AUTOTAB_OP + 1)
+#define APTCOLS (LAST_AUTOTAB_RIGHT_OP - FIRST_AUTOTAB_OP + 1)
+
+static const pcre_uint8 autoposstab[APTROWS][APTCOLS] = {
+/* \D \d \S \s \W \w . .+ \C \P \p \R \H \h \V \v \X \Z \z $ $M */
+ { 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0 }, /* \D */
+ { 1, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1, 0, 1, 1, 1, 1 }, /* \d */
+ { 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1, 0, 1, 1, 1, 1 }, /* \S */
+ { 0, 1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0 }, /* \s */
+ { 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0 }, /* \W */
+ { 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1, 0, 1, 1, 1, 1 }, /* \w */
+ { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0 }, /* . */
+ { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0 }, /* .+ */
+ { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0 }, /* \C */
+ { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }, /* \P */
+ { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }, /* \p */
+ { 0, 1, 0, 1, 0, 1, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0 }, /* \R */
+ { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0 }, /* \H */
+ { 0, 1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 1, 1, 0, 0, 1, 0, 0, 1, 0, 0 }, /* \h */
+ { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 1, 0, 0 }, /* \V */
+ { 0, 1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 1, 0, 0 }, /* \v */
+ { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0 } /* \X */
+};
+
+
+/* This table is used to check whether auto-possessification is possible
+between adjacent Unicode property opcodes (OP_PROP and OP_NOTPROP). The
+left-hand (repeated) opcode is used to select the row, and the right-hand
+opcode is used to select the column. The values are as follows:
+
+ 0 Always return FALSE (never auto-possessify)
+ 1 Character groups are distinct (possessify if both are OP_PROP)
+ 2 Check character categories in the same group (general or particular)
+ 3 TRUE if the two opcodes are not the same (PROP vs NOTPROP)
+
+ 4 Check left general category vs right particular category
+ 5 Check right general category vs left particular category
+
+ 6 Left alphanum vs right general category
+ 7 Left space vs right general category
+ 8 Left word vs right general category
+
+ 9 Right alphanum vs left general category
+ 10 Right space vs left general category
+ 11 Right word vs left general category
+
+ 12 Left alphanum vs right particular category
+ 13 Left space vs right particular category
+ 14 Left word vs right particular category
+
+ 15 Right alphanum vs left particular category
+ 16 Right space vs left particular category
+ 17 Right word vs left particular category
+*/
+
+static const pcre_uint8 propposstab[PT_TABSIZE][PT_TABSIZE] = {
+/* ANY LAMP GC PC SC ALNUM SPACE PXSPACE WORD CLIST UCNC */
+ { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }, /* PT_ANY */
+ { 0, 3, 0, 0, 0, 3, 1, 1, 0, 0, 0 }, /* PT_LAMP */
+ { 0, 0, 2, 4, 0, 9, 10, 10, 11, 0, 0 }, /* PT_GC */
+ { 0, 0, 5, 2, 0, 15, 16, 16, 17, 0, 0 }, /* PT_PC */
+ { 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0 }, /* PT_SC */
+ { 0, 3, 6, 12, 0, 3, 1, 1, 0, 0, 0 }, /* PT_ALNUM */
+ { 0, 1, 7, 13, 0, 1, 3, 3, 1, 0, 0 }, /* PT_SPACE */
+ { 0, 1, 7, 13, 0, 1, 3, 3, 1, 0, 0 }, /* PT_PXSPACE */
+ { 0, 0, 8, 14, 0, 0, 1, 1, 3, 0, 0 }, /* PT_WORD */
+ { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }, /* PT_CLIST */
+ { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3 } /* PT_UCNC */
+};
+
+/* This table is used to check whether auto-possessification is possible
+between adjacent Unicode property opcodes (OP_PROP and OP_NOTPROP) when one
+specifies a general category and the other specifies a particular category. The
+row is selected by the general category and the column by the particular
+category. The value is 1 if the particular category is not part of the general
+category. */
+
+static const pcre_uint8 catposstab[7][30] = {
+/* Cc Cf Cn Co Cs Ll Lm Lo Lt Lu Mc Me Mn Nd Nl No Pc Pd Pe Pf Pi Po Ps Sc Sk Sm So Zl Zp Zs */
+ { 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 }, /* C */
+ { 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 }, /* L */
+ { 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 }, /* M */
+ { 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 }, /* N */
+ { 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1 }, /* P */
+ { 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1, 1, 1 }, /* S */
+ { 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0 } /* Z */
+};
+
+/* This table is used when checking ALNUM, (PX)SPACE, SPACE, and WORD against
+a general or particular category. The properties in each row are those
+that apply to the character set in question. Duplication means that a little
+unnecessary work is done when checking, but this keeps things much simpler
+because they can all use the same code. For more details see the comment where
+this table is used.
+
+Note: SPACE and PXSPACE used to be different because Perl excluded VT from
+"space", but from Perl 5.18 it's included, so both categories are treated the
+same here. */
+
+static const pcre_uint8 posspropstab[3][4] = {
+ { ucp_L, ucp_N, ucp_N, ucp_Nl }, /* ALNUM, 3rd and 4th values redundant */
+ { ucp_Z, ucp_Z, ucp_C, ucp_Cc }, /* SPACE and PXSPACE, 2nd value redundant */
+ { ucp_L, ucp_N, ucp_P, ucp_Po } /* WORD */
+};
+
+/* This table is used when converting repeating opcodes into possessified
+versions as a result of an explicit possessive quantifier such as ++. A zero
+value means there is no possessified version - in those cases the item in
+question must be wrapped in ONCE brackets. The table is truncated at OP_CALLOUT
+because all relevant opcodes are less than that. */
+
+static const pcre_uint8 opcode_possessify[] = {
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0 - 15 */
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 16 - 31 */
+
+ 0, /* NOTI */
+ OP_POSSTAR, 0, /* STAR, MINSTAR */
+ OP_POSPLUS, 0, /* PLUS, MINPLUS */
+ OP_POSQUERY, 0, /* QUERY, MINQUERY */
+ OP_POSUPTO, 0, /* UPTO, MINUPTO */
+ 0, /* EXACT */
+ 0, 0, 0, 0, /* POS{STAR,PLUS,QUERY,UPTO} */
+
+ OP_POSSTARI, 0, /* STARI, MINSTARI */
+ OP_POSPLUSI, 0, /* PLUSI, MINPLUSI */
+ OP_POSQUERYI, 0, /* QUERYI, MINQUERYI */
+ OP_POSUPTOI, 0, /* UPTOI, MINUPTOI */
+ 0, /* EXACTI */
+ 0, 0, 0, 0, /* POS{STARI,PLUSI,QUERYI,UPTOI} */
+
+ OP_NOTPOSSTAR, 0, /* NOTSTAR, NOTMINSTAR */
+ OP_NOTPOSPLUS, 0, /* NOTPLUS, NOTMINPLUS */
+ OP_NOTPOSQUERY, 0, /* NOTQUERY, NOTMINQUERY */
+ OP_NOTPOSUPTO, 0, /* NOTUPTO, NOTMINUPTO */
+ 0, /* NOTEXACT */
+ 0, 0, 0, 0, /* NOTPOS{STAR,PLUS,QUERY,UPTO} */
+
+ OP_NOTPOSSTARI, 0, /* NOTSTARI, NOTMINSTARI */
+ OP_NOTPOSPLUSI, 0, /* NOTPLUSI, NOTMINPLUSI */
+ OP_NOTPOSQUERYI, 0, /* NOTQUERYI, NOTMINQUERYI */
+ OP_NOTPOSUPTOI, 0, /* NOTUPTOI, NOTMINUPTOI */
+ 0, /* NOTEXACTI */
+ 0, 0, 0, 0, /* NOTPOS{STARI,PLUSI,QUERYI,UPTOI} */
+
+ OP_TYPEPOSSTAR, 0, /* TYPESTAR, TYPEMINSTAR */
+ OP_TYPEPOSPLUS, 0, /* TYPEPLUS, TYPEMINPLUS */
+ OP_TYPEPOSQUERY, 0, /* TYPEQUERY, TYPEMINQUERY */
+ OP_TYPEPOSUPTO, 0, /* TYPEUPTO, TYPEMINUPTO */
+ 0, /* TYPEEXACT */
+ 0, 0, 0, 0, /* TYPEPOS{STAR,PLUS,QUERY,UPTO} */
+
+ OP_CRPOSSTAR, 0, /* CRSTAR, CRMINSTAR */
+ OP_CRPOSPLUS, 0, /* CRPLUS, CRMINPLUS */
+ OP_CRPOSQUERY, 0, /* CRQUERY, CRMINQUERY */
+ OP_CRPOSRANGE, 0, /* CRRANGE, CRMINRANGE */
+ 0, 0, 0, 0, /* CRPOS{STAR,PLUS,QUERY,RANGE} */
+
+ 0, 0, 0, /* CLASS, NCLASS, XCLASS */
+ 0, 0, /* REF, REFI */
+ 0, 0, /* DNREF, DNREFI */
+ 0, 0 /* RECURSE, CALLOUT */
+};
+
+
/*************************************************
* Find an error text *
@@ -676,6 +905,7 @@ return s;
}
+
/*************************************************
* Expand the workspace *
*************************************************/
@@ -753,16 +983,15 @@ return (*p == CHAR_RIGHT_CURLY_BRACKET);
*************************************************/
/* This function is called when a \ has been encountered. It either returns a
-positive value for a simple escape such as \n, or 0 for a data character
-which will be placed in chptr. A backreference to group n is returned as
-negative n. When UTF-8 is enabled, a positive value greater than 255 may
-be returned in chptr.
-On entry,ptr is pointing at the \. On exit, it is on the final character of the
-escape sequence.
+positive value for a simple escape such as \n, or 0 for a data character which
+will be placed in chptr. A backreference to group n is returned as negative n.
+When UTF-8 is enabled, a positive value greater than 255 may be returned in
+chptr. On entry, ptr is pointing at the \. On exit, it is on the final
+character of the escape sequence.
Arguments:
ptrptr points to the pattern position pointer
- chptr points to the data character
+ chptr points to a returned data character
errorcodeptr points to the errorcode variable
bracount number of previous extracting brackets
options the options bits
@@ -966,16 +1195,20 @@ else
break;
/* The handling of escape sequences consisting of a string of digits
- starting with one that is not zero is not straightforward. By experiment,
- the way Perl works seems to be as follows:
+ starting with one that is not zero is not straightforward. Perl has changed
+ over the years. Nowadays \g{} for backreferences and \o{} for octal are
+ recommended to avoid the ambiguities in the old syntax.
Outside a character class, the digits are read as a decimal number. If the
- number is less than 10, or if there are that many previous extracting
- left brackets, then it is a back reference. Otherwise, up to three octal
- digits are read to form an escaped byte. Thus \123 is likely to be octal
- 123 (cf \0123, which is octal 012 followed by the literal 3). If the octal
- value is greater than 377, the least significant 8 bits are taken. Inside a
- character class, \ followed by a digit is always an octal number. */
+ number is less than 8 (used to be 10), or if there are that many previous
+ extracting left brackets, then it is a back reference. Otherwise, up to
+ three octal digits are read to form an escaped byte. Thus \123 is likely to
+ be octal 123 (cf \0123, which is octal 012 followed by the literal 3). If
+ the octal value is greater than 377, the least significant 8 bits are
+ taken. \8 and \9 are treated as the literal characters 8 and 9.
+
+ Inside a character class, \ followed by a digit is always either a literal
+ 8 or 9 or an octal number. */
case CHAR_1: case CHAR_2: case CHAR_3: case CHAR_4: case CHAR_5:
case CHAR_6: case CHAR_7: case CHAR_8: case CHAR_9:
@@ -1002,7 +1235,7 @@ else
*errorcodeptr = ERR61;
break;
}
- if (s < 10 || s <= bracount)
+ if (s < 8 || s <= bracount) /* Check for back reference */
{
escape = -s;
break;
@@ -1010,16 +1243,14 @@ else
ptr = oldptr; /* Put the pointer back and fall through */
}
- /* Handle an octal number following \. If the first digit is 8 or 9, Perl
- generates a binary zero byte and treats the digit as a following literal.
- Thus we have to pull back the pointer by one. */
+ /* Handle a digit following \ when the number is not a back reference. If
+ the first digit is 8 or 9, Perl used to generate a binary zero byte and
+ then treat the digit as a following literal. At least by Perl 5.18 this
+ changed so as not to insert the binary zero. */
- if ((c = *ptr) >= CHAR_8)
- {
- ptr--;
- c = 0;
- break;
- }
+ if ((c = *ptr) >= CHAR_8) break;
+
+ /* Fall through with a digit less than 8 */
/* \0 always starts an octal number, but we may drop through to here with a
larger first octal digit. The original code used just to take the least
@@ -1036,15 +1267,51 @@ else
#endif
break;
- /* \x is complicated. \x{ddd} is a character number which can be greater
- than 0xff in utf or non-8bit mode, but only if the ddd are hex digits.
- If not, { is treated as a data character. */
+ /* \o is a relatively new Perl feature, supporting a more general way of
+ specifying character codes in octal. The only supported form is \o{ddd}. */
+
+ case CHAR_o:
+ if (ptr[1] != CHAR_LEFT_CURLY_BRACKET) *errorcodeptr = ERR81; else
+ if (ptr[2] == CHAR_RIGHT_CURLY_BRACKET) *errorcodeptr = ERR86; else
+ {
+ ptr += 2;
+ c = 0;
+ overflow = FALSE;
+ while (*ptr >= CHAR_0 && *ptr <= CHAR_7)
+ {
+ register pcre_uint32 cc = *ptr++;
+ if (c == 0 && cc == CHAR_0) continue; /* Leading zeroes */
+#ifdef COMPILE_PCRE32
+ if (c >= 0x20000000l) { overflow = TRUE; break; }
+#endif
+ c = (c << 3) + cc - CHAR_0 ;
+#if defined COMPILE_PCRE8
+ if (c > (utf ? 0x10ffffU : 0xffU)) { overflow = TRUE; break; }
+#elif defined COMPILE_PCRE16
+ if (c > (utf ? 0x10ffffU : 0xffffU)) { overflow = TRUE; break; }
+#elif defined COMPILE_PCRE32
+ if (utf && c > 0x10ffffU) { overflow = TRUE; break; }
+#endif
+ }
+ if (overflow)
+ {
+ while (*ptr >= CHAR_0 && *ptr <= CHAR_7) ptr++;
+ *errorcodeptr = ERR34;
+ }
+ else if (*ptr == CHAR_RIGHT_CURLY_BRACKET)
+ {
+ if (utf && c >= 0xd800 && c <= 0xdfff) *errorcodeptr = ERR73;
+ }
+ else *errorcodeptr = ERR80;
+ }
+ break;
+
+ /* \x is complicated. In JavaScript, \x must be followed by two hexadecimal
+ numbers. Otherwise it is a lowercase x letter. */
case CHAR_x:
if ((options & PCRE_JAVASCRIPT_COMPAT) != 0)
{
- /* In JavaScript, \x must be followed by two hexadecimal numbers.
- Otherwise it is a lowercase x letter. */
if (MAX_255(ptr[1]) && (digitab[ptr[1]] & ctype_xdigit) != 0
&& MAX_255(ptr[2]) && (digitab[ptr[2]] & ctype_xdigit) != 0)
{
@@ -1061,73 +1328,91 @@ else
#endif
}
}
- break;
- }
+ } /* End JavaScript handling */
- if (ptr[1] == CHAR_LEFT_CURLY_BRACKET)
- {
- const pcre_uchar *pt = ptr + 2;
+ /* Handle \x in Perl's style. \x{ddd} is a character number which can be
+ greater than 0xff in utf or non-8bit mode, but only if the ddd are hex
+ digits. If not, { used to be treated as a data character. However, Perl
+ seems to read hex digits up to the first non-such, and ignore the rest, so
+ that, for example \x{zz} matches a binary zero. This seems crazy, so PCRE
+ now gives an error. */
- c = 0;
- overflow = FALSE;
- while (MAX_255(*pt) && (digitab[*pt] & ctype_xdigit) != 0)
+ else
+ {
+ if (ptr[1] == CHAR_LEFT_CURLY_BRACKET)
{
- register pcre_uint32 cc = *pt++;
- if (c == 0 && cc == CHAR_0) continue; /* Leading zeroes */
+ ptr += 2;
+ if (*ptr == CHAR_RIGHT_CURLY_BRACKET)
+ {
+ *errorcodeptr = ERR86;
+ break;
+ }
+ c = 0;
+ overflow = FALSE;
+ while (MAX_255(*ptr) && (digitab[*ptr] & ctype_xdigit) != 0)
+ {
+ register pcre_uint32 cc = *ptr++;
+ if (c == 0 && cc == CHAR_0) continue; /* Leading zeroes */
#ifdef COMPILE_PCRE32
- if (c >= 0x10000000l) { overflow = TRUE; break; }
+ if (c >= 0x10000000l) { overflow = TRUE; break; }
#endif
#ifndef EBCDIC /* ASCII/UTF-8 coding */
- if (cc >= CHAR_a) cc -= 32; /* Convert to upper case */
- c = (c << 4) + cc - ((cc < CHAR_A)? CHAR_0 : (CHAR_A - 10));
+ if (cc >= CHAR_a) cc -= 32; /* Convert to upper case */
+ c = (c << 4) + cc - ((cc < CHAR_A)? CHAR_0 : (CHAR_A - 10));
#else /* EBCDIC coding */
- if (cc >= CHAR_a && cc <= CHAR_z) cc += 64; /* Convert to upper case */
- c = (c << 4) + cc - ((cc >= CHAR_0)? CHAR_0 : (CHAR_A - 10));
+ if (cc >= CHAR_a && cc <= CHAR_z) cc += 64; /* Convert to upper case */
+ c = (c << 4) + cc - ((cc >= CHAR_0)? CHAR_0 : (CHAR_A - 10));
#endif
#if defined COMPILE_PCRE8
- if (c > (utf ? 0x10ffffU : 0xffU)) { overflow = TRUE; break; }
+ if (c > (utf ? 0x10ffffU : 0xffU)) { overflow = TRUE; break; }
#elif defined COMPILE_PCRE16
- if (c > (utf ? 0x10ffffU : 0xffffU)) { overflow = TRUE; break; }
+ if (c > (utf ? 0x10ffffU : 0xffffU)) { overflow = TRUE; break; }
#elif defined COMPILE_PCRE32
- if (utf && c > 0x10ffffU) { overflow = TRUE; break; }
+ if (utf && c > 0x10ffffU) { overflow = TRUE; break; }
#endif
- }
+ }
- if (overflow)
- {
- while (MAX_255(*pt) && (digitab[*pt] & ctype_xdigit) != 0) pt++;
- *errorcodeptr = ERR34;
- }
+ if (overflow)
+ {
+ while (MAX_255(*ptr) && (digitab[*ptr] & ctype_xdigit) != 0) ptr++;
+ *errorcodeptr = ERR34;
+ }
- if (*pt == CHAR_RIGHT_CURLY_BRACKET)
- {
- if (utf && c >= 0xd800 && c <= 0xdfff) *errorcodeptr = ERR73;
- ptr = pt;
- break;
- }
+ else if (*ptr == CHAR_RIGHT_CURLY_BRACKET)
+ {
+ if (utf && c >= 0xd800 && c <= 0xdfff) *errorcodeptr = ERR73;
+ }
- /* If the sequence of hex digits does not end with '}', then we don't
- recognize this construct; fall through to the normal \x handling. */
- }
+ /* If the sequence of hex digits does not end with '}', give an error.
+ We used just to recognize this construct and fall through to the normal
+ \x handling, but nowadays Perl gives an error, which seems much more
+ sensible, so we do too. */
- /* Read just a single-byte hex-defined char */
+ else *errorcodeptr = ERR79;
+ } /* End of \x{} processing */
- c = 0;
- while (i++ < 2 && MAX_255(ptr[1]) && (digitab[ptr[1]] & ctype_xdigit) != 0)
- {
- pcre_uint32 cc; /* Some compilers don't like */
- cc = *(++ptr); /* ++ in initializers */
+ /* Read a single-byte hex-defined char (up to two hex digits after \x) */
+
+ else
+ {
+ c = 0;
+ while (i++ < 2 && MAX_255(ptr[1]) && (digitab[ptr[1]] & ctype_xdigit) != 0)
+ {
+ pcre_uint32 cc; /* Some compilers don't like */
+ cc = *(++ptr); /* ++ in initializers */
#ifndef EBCDIC /* ASCII/UTF-8 coding */
- if (cc >= CHAR_a) cc -= 32; /* Convert to upper case */
- c = c * 16 + cc - ((cc < CHAR_A)? CHAR_0 : (CHAR_A - 10));
+ if (cc >= CHAR_a) cc -= 32; /* Convert to upper case */
+ c = c * 16 + cc - ((cc < CHAR_A)? CHAR_0 : (CHAR_A - 10));
#else /* EBCDIC coding */
- if (cc <= CHAR_z) cc += 64; /* Convert to upper case */
- c = c * 16 + cc - ((cc >= CHAR_0)? CHAR_0 : (CHAR_A - 10));
+ if (cc <= CHAR_z) cc += 64; /* Convert to upper case */
+ c = c * 16 + cc - ((cc >= CHAR_0)? CHAR_0 : (CHAR_A - 10));
#endif
- }
+ }
+ } /* End of \xdd handling */
+ } /* End of Perl-style \x handling */
break;
/* For \c, a following letter is upper-cased; then the 0x40 bit is flipped.
@@ -1152,7 +1437,16 @@ else
c ^= 0x40;
#else /* EBCDIC coding */
if (c >= CHAR_a && c <= CHAR_z) c += 64;
- c ^= 0xC0;
+ if (c == CHAR_QUESTION_MARK)
+ c = ('\\' == 188 && '`' == 74)? 0x5f : 0xff;
+ else
+ {
+ for (i = 0; i < 32; i++)
+ {
+ if (c == ebcdic_escape_c[i]) break;
+ }
+ if (i < 32) c = i; else *errorcodeptr = ERR68;
+ }
#endif
break;
@@ -1193,6 +1487,8 @@ if ((options & PCRE_UCP) != 0 && escape >= ESC_D && escape <= ESC_w)
return escape;
}
+
+
#ifdef SUPPORT_UCP
/*************************************************
* Handle \P and \p *
@@ -1290,7 +1586,6 @@ return FALSE;
-
/*************************************************
* Read repeat counts *
*************************************************/
@@ -1316,29 +1611,29 @@ read_repeat_counts(const pcre_uchar *p, int *minp, int *maxp, int *errorcodeptr)
int min = 0;
int max = -1;
-/* Read the minimum value and do a paranoid check: a negative value indicates
-an integer overflow. */
-
-while (IS_DIGIT(*p)) min = min * 10 + (int)(*p++ - CHAR_0);
-if (min < 0 || min > 65535)
+while (IS_DIGIT(*p))
{
- *errorcodeptr = ERR5;
- return p;
+ min = min * 10 + (int)(*p++ - CHAR_0);
+ if (min > 65535)
+ {
+ *errorcodeptr = ERR5;
+ return p;
+ }
}
-/* Read the maximum value if there is one, and again do a paranoid on its size.
-Also, max must not be less than min. */
-
if (*p == CHAR_RIGHT_CURLY_BRACKET) max = min; else
{
if (*(++p) != CHAR_RIGHT_CURLY_BRACKET)
{
max = 0;
- while(IS_DIGIT(*p)) max = max * 10 + (int)(*p++ - CHAR_0);
- if (max < 0 || max > 65535)
+ while(IS_DIGIT(*p))
{
- *errorcodeptr = ERR5;
- return p;
+ max = max * 10 + (int)(*p++ - CHAR_0);
+ if (max > 65535)
+ {
+ *errorcodeptr = ERR5;
+ return p;
+ }
}
if (max < min)
{
@@ -1348,9 +1643,6 @@ if (*p == CHAR_RIGHT_CURLY_BRACKET) max = min; else
}
}
-/* Fill in the required variables, and pass back the pointer to the terminating
-'}'. */
-
*minp = min;
*maxp = max;
return p;
@@ -1359,306 +1651,6 @@ return p;
/*************************************************
-* Subroutine for finding forward reference *
-*************************************************/
-
-/* This recursive function is called only from find_parens() below. The
-top-level call starts at the beginning of the pattern. All other calls must
-start at a parenthesis. It scans along a pattern's text looking for capturing
-subpatterns, and counting them. If it finds a named pattern that matches the
-name it is given, it returns its number. Alternatively, if the name is NULL, it
-returns when it reaches a given numbered subpattern. Recursion is used to keep
-track of subpatterns that reset the capturing group numbers - the (?| feature.
-
-This function was originally called only from the second pass, in which we know
-that if (?< or (?' or (?P< is encountered, the name will be correctly
-terminated because that is checked in the first pass. There is now one call to
-this function in the first pass, to check for a recursive back reference by
-name (so that we can make the whole group atomic). In this case, we need check
-only up to the current position in the pattern, and that is still OK because
-and previous occurrences will have been checked. To make this work, the test
-for "end of pattern" is a check against cd->end_pattern in the main loop,
-instead of looking for a binary zero. This means that the special first-pass
-call can adjust cd->end_pattern temporarily. (Checks for binary zero while
-processing items within the loop are OK, because afterwards the main loop will
-terminate.)
-
-Arguments:
- ptrptr address of the current character pointer (updated)
- cd compile background data
- name name to seek, or NULL if seeking a numbered subpattern
- lorn name length, or subpattern number if name is NULL
- xmode TRUE if we are in /x mode
- utf TRUE if we are in UTF-8 / UTF-16 / UTF-32 mode
- count pointer to the current capturing subpattern number (updated)
-
-Returns: the number of the named subpattern, or -1 if not found
-*/
-
-static int
-find_parens_sub(pcre_uchar **ptrptr, compile_data *cd, const pcre_uchar *name, int lorn,
- BOOL xmode, BOOL utf, int *count)
-{
-pcre_uchar *ptr = *ptrptr;
-int start_count = *count;
-int hwm_count = start_count;
-BOOL dup_parens = FALSE;
-
-/* If the first character is a parenthesis, check on the type of group we are
-dealing with. The very first call may not start with a parenthesis. */
-
-if (ptr[0] == CHAR_LEFT_PARENTHESIS)
- {
- /* Handle specials such as (*SKIP) or (*UTF8) etc. */
-
- if (ptr[1] == CHAR_ASTERISK)
- {
- ptr += 2;
- while (ptr < cd->end_pattern && *ptr != CHAR_RIGHT_PARENTHESIS) ptr++;
- }
-
- /* Handle a normal, unnamed capturing parenthesis. */
-
- else if (ptr[1] != CHAR_QUESTION_MARK)
- {
- *count += 1;
- if (name == NULL && *count == lorn) return *count;
- ptr++;
- }
-
- /* All cases now have (? at the start. Remember when we are in a group
- where the parenthesis numbers are duplicated. */
-
- else if (ptr[2] == CHAR_VERTICAL_LINE)
- {
- ptr += 3;
- dup_parens = TRUE;
- }
-
- /* Handle comments; all characters are allowed until a ket is reached. */
-
- else if (ptr[2] == CHAR_NUMBER_SIGN)
- {
- for (ptr += 3; *ptr != CHAR_NULL; ptr++)
- if (*ptr == CHAR_RIGHT_PARENTHESIS) break;
- goto FAIL_EXIT;
- }
-
- /* Handle a condition. If it is an assertion, just carry on so that it
- is processed as normal. If not, skip to the closing parenthesis of the
- condition (there can't be any nested parens). */
-
- else if (ptr[2] == CHAR_LEFT_PARENTHESIS)
- {
- ptr += 2;
- if (ptr[1] != CHAR_QUESTION_MARK)
- {
- while (*ptr != CHAR_NULL && *ptr != CHAR_RIGHT_PARENTHESIS) ptr++;
- if (*ptr != CHAR_NULL) ptr++;
- }
- }
-
- /* Start with (? but not a condition. */
-
- else
- {
- ptr += 2;
- if (*ptr == CHAR_P) ptr++; /* Allow optional P */
-
- /* We have to disambiguate (?<! and (?<= from (?<name> for named groups */
-
- if ((*ptr == CHAR_LESS_THAN_SIGN && ptr[1] != CHAR_EXCLAMATION_MARK &&
- ptr[1] != CHAR_EQUALS_SIGN) || *ptr == CHAR_APOSTROPHE)
- {
- pcre_uchar term;
- const pcre_uchar *thisname;
- *count += 1;
- if (name == NULL && *count == lorn) return *count;
- term = *ptr++;
- if (term == CHAR_LESS_THAN_SIGN) term = CHAR_GREATER_THAN_SIGN;
- thisname = ptr;
- while (*ptr != term) ptr++;
- if (name != NULL && lorn == (int)(ptr - thisname) &&
- STRNCMP_UC_UC(name, thisname, (unsigned int)lorn) == 0)
- return *count;
- term++;
- }
- }
- }
-
-/* Past any initial parenthesis handling, scan for parentheses or vertical
-bars. Stop if we get to cd->end_pattern. Note that this is important for the
-first-pass call when this value is temporarily adjusted to stop at the current
-position. So DO NOT change this to a test for binary zero. */
-
-for (; ptr < cd->end_pattern; ptr++)
- {
- /* Skip over backslashed characters and also entire \Q...\E */
-
- if (*ptr == CHAR_BACKSLASH)
- {
- if (*(++ptr) == CHAR_NULL) goto FAIL_EXIT;
- if (*ptr == CHAR_Q) for (;;)
- {
- while (*(++ptr) != CHAR_NULL && *ptr != CHAR_BACKSLASH) {};
- if (*ptr == CHAR_NULL) goto FAIL_EXIT;
- if (*(++ptr) == CHAR_E) break;
- }
- continue;
- }
-
- /* Skip over character classes; this logic must be similar to the way they
- are handled for real. If the first character is '^', skip it. Also, if the
- first few characters (either before or after ^) are \Q\E or \E we skip them
- too. This makes for compatibility with Perl. Note the use of STR macros to
- encode "Q\\E" so that it works in UTF-8 on EBCDIC platforms. */
-
- if (*ptr == CHAR_LEFT_SQUARE_BRACKET)
- {
- BOOL negate_class = FALSE;
- for (;;)
- {
- if (ptr[1] == CHAR_BACKSLASH)
- {
- if (ptr[2] == CHAR_E)
- ptr+= 2;
- else if (STRNCMP_UC_C8(ptr + 2,
- STR_Q STR_BACKSLASH STR_E, 3) == 0)
- ptr += 4;
- else
- break;
- }
- else if (!negate_class && ptr[1] == CHAR_CIRCUMFLEX_ACCENT)
- {
- negate_class = TRUE;
- ptr++;
- }
- else break;
- }
-
- /* If the next character is ']', it is a data character that must be
- skipped, except in JavaScript compatibility mode. */
-
- if (ptr[1] == CHAR_RIGHT_SQUARE_BRACKET &&
- (cd->external_options & PCRE_JAVASCRIPT_COMPAT) == 0)
- ptr++;
-
- while (*(++ptr) != CHAR_RIGHT_SQUARE_BRACKET)
- {
- if (*ptr == CHAR_NULL) return -1;
- if (*ptr == CHAR_BACKSLASH)
- {
- if (*(++ptr) == CHAR_NULL) goto FAIL_EXIT;
- if (*ptr == CHAR_Q) for (;;)
- {
- while (*(++ptr) != CHAR_NULL && *ptr != CHAR_BACKSLASH) {};
- if (*ptr == CHAR_NULL) goto FAIL_EXIT;
- if (*(++ptr) == CHAR_E) break;
- }
- continue;
- }
- }
- continue;
- }
-
- /* Skip comments in /x mode */
-
- if (xmode && *ptr == CHAR_NUMBER_SIGN)
- {
- ptr++;
- while (*ptr != CHAR_NULL)
- {
- if (IS_NEWLINE(ptr)) { ptr += cd->nllen - 1; break; }
- ptr++;
-#ifdef SUPPORT_UTF
- if (utf) FORWARDCHAR(ptr);
-#endif
- }
- if (*ptr == CHAR_NULL) goto FAIL_EXIT;
- continue;
- }
-
- /* Check for the special metacharacters */
-
- if (*ptr == CHAR_LEFT_PARENTHESIS)
- {
- int rc = find_parens_sub(&ptr, cd, name, lorn, xmode, utf, count);
- if (rc > 0) return rc;
- if (*ptr == CHAR_NULL) goto FAIL_EXIT;
- }
-
- else if (*ptr == CHAR_RIGHT_PARENTHESIS)
- {
- if (dup_parens && *count < hwm_count) *count = hwm_count;
- goto FAIL_EXIT;
- }
-
- else if (*ptr == CHAR_VERTICAL_LINE && dup_parens)
- {
- if (*count > hwm_count) hwm_count = *count;
- *count = start_count;
- }
- }
-
-FAIL_EXIT:
-*ptrptr = ptr;
-return -1;
-}
-
-
-
-
-/*************************************************
-* Find forward referenced subpattern *
-*************************************************/
-
-/* This function scans along a pattern's text looking for capturing
-subpatterns, and counting them. If it finds a named pattern that matches the
-name it is given, it returns its number. Alternatively, if the name is NULL, it
-returns when it reaches a given numbered subpattern. This is used for forward
-references to subpatterns. We used to be able to start this scan from the
-current compiling point, using the current count value from cd->bracount, and
-do it all in a single loop, but the addition of the possibility of duplicate
-subpattern numbers means that we have to scan from the very start, in order to
-take account of such duplicates, and to use a recursive function to keep track
-of the different types of group.
-
-Arguments:
- cd compile background data
- name name to seek, or NULL if seeking a numbered subpattern
- lorn name length, or subpattern number if name is NULL
- xmode TRUE if we are in /x mode
- utf TRUE if we are in UTF-8 / UTF-16 / UTF-32 mode
-
-Returns: the number of the found subpattern, or -1 if not found
-*/
-
-static int
-find_parens(compile_data *cd, const pcre_uchar *name, int lorn, BOOL xmode,
- BOOL utf)
-{
-pcre_uchar *ptr = (pcre_uchar *)cd->start_pattern;
-int count = 0;
-int rc;
-
-/* If the pattern does not start with an opening parenthesis, the first call
-to find_parens_sub() will scan right to the end (if necessary). However, if it
-does start with a parenthesis, find_parens_sub() will return when it hits the
-matching closing parens. That is why we have to have a loop. */
-
-for (;;)
- {
- rc = find_parens_sub(&ptr, cd, name, lorn, xmode, utf, &count);
- if (rc > 0 || *ptr++ == CHAR_NULL) break;
- }
-
-return rc;
-}
-
-
-
-
-/*************************************************
* Find first significant op code *
*************************************************/
@@ -1697,9 +1689,9 @@ for (;;)
case OP_CALLOUT:
case OP_CREF:
- case OP_NCREF:
+ case OP_DNCREF:
case OP_RREF:
- case OP_NRREF:
+ case OP_DNRREF:
case OP_DEF:
code += PRIV(OP_lengths)[*code];
break;
@@ -1713,7 +1705,6 @@ for (;;)
-
/*************************************************
* Find the fixed length of a branch *
*************************************************/
@@ -1734,6 +1725,7 @@ Arguments:
utf TRUE in UTF-8 / UTF-16 / UTF-32 mode
atend TRUE if called when the pattern is complete
cd the "compile data" structure
+ recurses chain of recurse_check to catch mutual recursion
Returns: the fixed length,
or -1 if there is no fixed length,
@@ -1743,10 +1735,11 @@ Returns: the fixed length,
*/
static int
-find_fixedlength(pcre_uchar *code, BOOL utf, BOOL atend, compile_data *cd)
+find_fixedlength(pcre_uchar *code, BOOL utf, BOOL atend, compile_data *cd,
+ recurse_check *recurses)
{
int length = -1;
-
+recurse_check this_recurse;
register int branchlength = 0;
register pcre_uchar *cc = code + 1 + LINK_SIZE;
@@ -1771,7 +1764,8 @@ for (;;)
case OP_ONCE:
case OP_ONCE_NC:
case OP_COND:
- d = find_fixedlength(cc + ((op == OP_CBRA)? IMM2_SIZE : 0), utf, atend, cd);
+ d = find_fixedlength(cc + ((op == OP_CBRA)? IMM2_SIZE : 0), utf, atend, cd,
+ recurses);
if (d < 0) return d;
branchlength += d;
do cc += GET(cc, 1); while (*cc == OP_ALT);
@@ -1805,7 +1799,15 @@ for (;;)
cs = ce = (pcre_uchar *)cd->start_code + GET(cc, 1); /* Start subpattern */
do ce += GET(ce, 1); while (*ce == OP_ALT); /* End subpattern */
if (cc > cs && cc < ce) return -1; /* Recursion */
- d = find_fixedlength(cs + IMM2_SIZE, utf, atend, cd);
+ else /* Check for mutual recursion */
+ {
+ recurse_check *r = recurses;
+ for (r = recurses; r != NULL; r = r->prev) if (r->group == cs) break;
+ if (r != NULL) return -1; /* Mutual recursion */
+ }
+ this_recurse.prev = recurses;
+ this_recurse.group = cs;
+ d = find_fixedlength(cs + IMM2_SIZE, utf, atend, cd, &this_recurse);
if (d < 0) return d;
branchlength += d;
cc += 1 + LINK_SIZE;
@@ -1818,7 +1820,7 @@ for (;;)
case OP_ASSERTBACK:
case OP_ASSERTBACK_NOT:
do cc += GET(cc, 1); while (*cc == OP_ALT);
- cc += PRIV(OP_lengths)[*cc];
+ cc += 1 + LINK_SIZE;
break;
/* Skip over things that don't match chars */
@@ -1837,13 +1839,13 @@ for (;;)
case OP_COMMIT:
case OP_CREF:
case OP_DEF:
+ case OP_DNCREF:
+ case OP_DNRREF:
case OP_DOLL:
case OP_DOLLM:
case OP_EOD:
case OP_EODN:
case OP_FAIL:
- case OP_NCREF:
- case OP_NRREF:
case OP_NOT_WORD_BOUNDARY:
case OP_PRUNE:
case OP_REVERSE:
@@ -1938,16 +1940,20 @@ for (;;)
switch (*cc)
{
- case OP_CRPLUS:
- case OP_CRMINPLUS:
case OP_CRSTAR:
case OP_CRMINSTAR:
+ case OP_CRPLUS:
+ case OP_CRMINPLUS:
case OP_CRQUERY:
case OP_CRMINQUERY:
+ case OP_CRPOSSTAR:
+ case OP_CRPOSPLUS:
+ case OP_CRPOSQUERY:
return -1;
case OP_CRRANGE:
case OP_CRMINRANGE:
+ case OP_CRPOSRANGE:
if (GET2(cc,1) != GET2(cc,1+IMM2_SIZE)) return -1;
branchlength += (int)GET2(cc,1);
cc += 1 + 2 * IMM2_SIZE;
@@ -2016,6 +2022,8 @@ for (;;)
case OP_QUERYI:
case OP_REF:
case OP_REFI:
+ case OP_DNREF:
+ case OP_DNREFI:
case OP_SBRA:
case OP_SBRAPOS:
case OP_SCBRA:
@@ -2052,7 +2060,6 @@ for (;;)
-
/*************************************************
* Scan compiled regex for specific bracket *
*************************************************/
@@ -2154,32 +2161,60 @@ for (;;)
{
case OP_CHAR:
case OP_CHARI:
+ case OP_NOT:
+ case OP_NOTI:
case OP_EXACT:
case OP_EXACTI:
+ case OP_NOTEXACT:
+ case OP_NOTEXACTI:
case OP_UPTO:
case OP_UPTOI:
+ case OP_NOTUPTO:
+ case OP_NOTUPTOI:
case OP_MINUPTO:
case OP_MINUPTOI:
+ case OP_NOTMINUPTO:
+ case OP_NOTMINUPTOI:
case OP_POSUPTO:
case OP_POSUPTOI:
+ case OP_NOTPOSUPTO:
+ case OP_NOTPOSUPTOI:
case OP_STAR:
case OP_STARI:
+ case OP_NOTSTAR:
+ case OP_NOTSTARI:
case OP_MINSTAR:
case OP_MINSTARI:
+ case OP_NOTMINSTAR:
+ case OP_NOTMINSTARI:
case OP_POSSTAR:
case OP_POSSTARI:
+ case OP_NOTPOSSTAR:
+ case OP_NOTPOSSTARI:
case OP_PLUS:
case OP_PLUSI:
+ case OP_NOTPLUS:
+ case OP_NOTPLUSI:
case OP_MINPLUS:
case OP_MINPLUSI:
+ case OP_NOTMINPLUS:
+ case OP_NOTMINPLUSI:
case OP_POSPLUS:
case OP_POSPLUSI:
+ case OP_NOTPOSPLUS:
+ case OP_NOTPOSPLUSI:
case OP_QUERY:
case OP_QUERYI:
+ case OP_NOTQUERY:
+ case OP_NOTQUERYI:
case OP_MINQUERY:
case OP_MINQUERYI:
+ case OP_NOTMINQUERY:
+ case OP_NOTMINQUERYI:
case OP_POSQUERY:
case OP_POSQUERYI:
+ case OP_NOTPOSQUERY:
+ case OP_NOTPOSQUERYI:
if (HAS_EXTRALEN(code[-1])) code += GET_EXTRALEN(code[-1]);
break;
}
@@ -2354,15 +2389,18 @@ Arguments:
endcode points to where to stop
utf TRUE if in UTF-8 / UTF-16 / UTF-32 mode
cd contains pointers to tables etc.
+ recurses chain of recurse_check to catch mutual recursion
Returns: TRUE if what is matched could be empty
*/
static BOOL
could_be_empty_branch(const pcre_uchar *code, const pcre_uchar *endcode,
- BOOL utf, compile_data *cd)
+ BOOL utf, compile_data *cd, recurse_check *recurses)
{
register pcre_uchar c;
+recurse_check this_recurse;
+
for (code = first_significant_code(code + PRIV(OP_lengths)[*code], TRUE);
code < endcode;
code = first_significant_code(code + PRIV(OP_lengths)[c], TRUE))
@@ -2390,25 +2428,47 @@ for (code = first_significant_code(code + PRIV(OP_lengths)[*code], TRUE);
if (c == OP_RECURSE)
{
- const pcre_uchar *scode;
+ const pcre_uchar *scode = cd->start_code + GET(code, 1);
+ const pcre_uchar *endgroup = scode;
BOOL empty_branch;
- /* Test for forward reference */
+ /* Test for forward reference or uncompleted reference. This is disabled
+ when called to scan a completed pattern by setting cd->start_workspace to
+ NULL. */
- for (scode = cd->start_workspace; scode < cd->hwm; scode += LINK_SIZE)
- if ((int)GET(scode, 0) == (int)(code + 1 - cd->start_code)) return TRUE;
+ if (cd->start_workspace != NULL)
+ {
+ const pcre_uchar *tcode;
+ for (tcode = cd->start_workspace; tcode < cd->hwm; tcode += LINK_SIZE)
+ if ((int)GET(tcode, 0) == (int)(code + 1 - cd->start_code)) return TRUE;
+ if (GET(scode, 1) == 0) return TRUE; /* Unclosed */
+ }
- /* Not a forward reference, test for completed backward reference */
+ /* If the reference is to a completed group, we need to detect whether this
+ is a recursive call, as otherwise there will be an infinite loop. If it is
+ a recursion, just skip over it. Simple recursions are easily detected. For
+ mutual recursions we keep a chain on the stack. */
- empty_branch = FALSE;
- scode = cd->start_code + GET(code, 1);
- if (GET(scode, 1) == 0) return TRUE; /* Unclosed */
+ do endgroup += GET(endgroup, 1); while (*endgroup == OP_ALT);
+ if (code >= scode && code <= endgroup) continue; /* Simple recursion */
+ else
+ {
+ recurse_check *r = recurses;
+ for (r = recurses; r != NULL; r = r->prev)
+ if (r->group == scode) break;
+ if (r != NULL) continue; /* Mutual recursion */
+ }
+
+ /* Completed reference; scan the referenced group, remembering it on the
+ stack chain to detect mutual recursions. */
- /* Completed backwards reference */
+ empty_branch = FALSE;
+ this_recurse.prev = recurses;
+ this_recurse.group = scode;
do
{
- if (could_be_empty_branch(scode, endcode, utf, cd))
+ if (could_be_empty_branch(scode, endcode, utf, cd, &this_recurse))
{
empty_branch = TRUE;
break;
@@ -2448,7 +2508,7 @@ for (code = first_significant_code(code + PRIV(OP_lengths)[*code], TRUE);
if (c == OP_BRA || c == OP_BRAPOS ||
c == OP_CBRA || c == OP_CBRAPOS ||
c == OP_ONCE || c == OP_ONCE_NC ||
- c == OP_COND)
+ c == OP_COND || c == OP_SCOND)
{
BOOL empty_branch;
if (GET(code, 1) == 0) return TRUE; /* Hit unclosed bracket */
@@ -2464,8 +2524,8 @@ for (code = first_significant_code(code + PRIV(OP_lengths)[*code], TRUE);
empty_branch = FALSE;
do
{
- if (!empty_branch && could_be_empty_branch(code, endcode, utf, cd))
- empty_branch = TRUE;
+ if (!empty_branch && could_be_empty_branch(code, endcode, utf, cd,
+ recurses)) empty_branch = TRUE;
code += GET(code, 1);
}
while (*code == OP_ALT);
@@ -2506,15 +2566,19 @@ for (code = first_significant_code(code + PRIV(OP_lengths)[*code], TRUE);
case OP_CRMINSTAR:
case OP_CRQUERY:
case OP_CRMINQUERY:
+ case OP_CRPOSSTAR:
+ case OP_CRPOSQUERY:
break;
default: /* Non-repeat => class must match */
case OP_CRPLUS: /* These repeats aren't empty */
case OP_CRMINPLUS:
+ case OP_CRPOSPLUS:
return FALSE;
case OP_CRRANGE:
case OP_CRMINRANGE:
+ case OP_CRPOSRANGE:
if (GET2(ccode, 1) > 0) return FALSE; /* Minimum > 0 */
break;
}
@@ -2522,34 +2586,57 @@ for (code = first_significant_code(code + PRIV(OP_lengths)[*code], TRUE);
/* Opcodes that must match a character */
+ case OP_ANY:
+ case OP_ALLANY:
+ case OP_ANYBYTE:
+
case OP_PROP:
case OP_NOTPROP:
+ case OP_ANYNL:
+
+ case OP_NOT_HSPACE:
+ case OP_HSPACE:
+ case OP_NOT_VSPACE:
+ case OP_VSPACE:
case OP_EXTUNI:
+
case OP_NOT_DIGIT:
case OP_DIGIT:
case OP_NOT_WHITESPACE:
case OP_WHITESPACE:
case OP_NOT_WORDCHAR:
case OP_WORDCHAR:
- case OP_ANY:
- case OP_ALLANY:
- case OP_ANYBYTE:
+
case OP_CHAR:
case OP_CHARI:
case OP_NOT:
case OP_NOTI:
+
case OP_PLUS:
+ case OP_PLUSI:
case OP_MINPLUS:
- case OP_POSPLUS:
- case OP_EXACT:
+ case OP_MINPLUSI:
+
case OP_NOTPLUS:
+ case OP_NOTPLUSI:
case OP_NOTMINPLUS:
+ case OP_NOTMINPLUSI:
+
+ case OP_POSPLUS:
+ case OP_POSPLUSI:
case OP_NOTPOSPLUS:
+ case OP_NOTPOSPLUSI:
+
+ case OP_EXACT:
+ case OP_EXACTI:
case OP_NOTEXACT:
+ case OP_NOTEXACTI:
+
case OP_TYPEPLUS:
case OP_TYPEMINPLUS:
case OP_TYPEPOSPLUS:
case OP_TYPEEXACT:
+
return FALSE;
/* These are going to continue, as they may be empty, but we have to
@@ -2583,30 +2670,58 @@ for (code = first_significant_code(code + PRIV(OP_lengths)[*code], TRUE);
return TRUE;
/* In UTF-8 mode, STAR, MINSTAR, POSSTAR, QUERY, MINQUERY, POSQUERY, UPTO,
- MINUPTO, and POSUPTO may be followed by a multibyte character */
+ MINUPTO, and POSUPTO and their caseless and negative versions may be
+ followed by a multibyte character. */
#if defined SUPPORT_UTF && !defined COMPILE_PCRE32
case OP_STAR:
case OP_STARI:
+ case OP_NOTSTAR:
+ case OP_NOTSTARI:
+
case OP_MINSTAR:
case OP_MINSTARI:
+ case OP_NOTMINSTAR:
+ case OP_NOTMINSTARI:
+
case OP_POSSTAR:
case OP_POSSTARI:
+ case OP_NOTPOSSTAR:
+ case OP_NOTPOSSTARI:
+
case OP_QUERY:
case OP_QUERYI:
+ case OP_NOTQUERY:
+ case OP_NOTQUERYI:
+
case OP_MINQUERY:
case OP_MINQUERYI:
+ case OP_NOTMINQUERY:
+ case OP_NOTMINQUERYI:
+
case OP_POSQUERY:
case OP_POSQUERYI:
+ case OP_NOTPOSQUERY:
+ case OP_NOTPOSQUERYI:
+
if (utf && HAS_EXTRALEN(code[1])) code += GET_EXTRALEN(code[1]);
break;
case OP_UPTO:
case OP_UPTOI:
+ case OP_NOTUPTO:
+ case OP_NOTUPTOI:
+
case OP_MINUPTO:
case OP_MINUPTOI:
+ case OP_NOTMINUPTO:
+ case OP_NOTMINUPTOI:
+
case OP_POSUPTO:
case OP_POSUPTOI:
+ case OP_NOTPOSUPTO:
+ case OP_NOTPOSUPTOI:
+
if (utf && HAS_EXTRALEN(code[1 + IMM2_SIZE])) code += GET_EXTRALEN(code[1 + IMM2_SIZE]);
break;
#endif
@@ -2660,7 +2775,7 @@ could_be_empty(const pcre_uchar *code, const pcre_uchar *endcode,
{
while (bcptr != NULL && bcptr->current_branch >= code)
{
- if (!could_be_empty_branch(bcptr->current_branch, endcode, utf, cd))
+ if (!could_be_empty_branch(bcptr->current_branch, endcode, utf, cd, NULL))
return FALSE;
bcptr = bcptr->outer;
}
@@ -2670,6 +2785,1111 @@ return TRUE;
/*************************************************
+* Base opcode of repeated opcodes *
+*************************************************/
+
+/* Returns the base opcode for repeated single character type opcodes. If the
+opcode is not a repeated character type, it returns with the original value.
+
+Arguments: c opcode
+Returns: base opcode for the type
+*/
+
+static pcre_uchar
+get_repeat_base(pcre_uchar c)
+{
+return (c > OP_TYPEPOSUPTO)? c :
+ (c >= OP_TYPESTAR)? OP_TYPESTAR :
+ (c >= OP_NOTSTARI)? OP_NOTSTARI :
+ (c >= OP_NOTSTAR)? OP_NOTSTAR :
+ (c >= OP_STARI)? OP_STARI :
+ OP_STAR;
+}
+
+
+
+#ifdef SUPPORT_UCP
+/*************************************************
+* Check a character and a property *
+*************************************************/
+
+/* This function is called by check_auto_possessive() when a property item
+is adjacent to a fixed character.
+
+Arguments:
+ c the character
+ ptype the property type
+ pdata the data for the type
+ negated TRUE if it's a negated property (\P or \p{^)
+
+Returns: TRUE if auto-possessifying is OK
+*/
+
+static BOOL
+check_char_prop(pcre_uint32 c, unsigned int ptype, unsigned int pdata,
+ BOOL negated)
+{
+const pcre_uint32 *p;
+const ucd_record *prop = GET_UCD(c);
+
+switch(ptype)
+ {
+ case PT_LAMP:
+ return (prop->chartype == ucp_Lu ||
+ prop->chartype == ucp_Ll ||
+ prop->chartype == ucp_Lt) == negated;
+
+ case PT_GC:
+ return (pdata == PRIV(ucp_gentype)[prop->chartype]) == negated;
+
+ case PT_PC:
+ return (pdata == prop->chartype) == negated;
+
+ case PT_SC:
+ return (pdata == prop->script) == negated;
+
+ /* These are specials */
+
+ case PT_ALNUM:
+ return (PRIV(ucp_gentype)[prop->chartype] == ucp_L ||
+ PRIV(ucp_gentype)[prop->chartype] == ucp_N) == negated;
+
+ /* Perl space used to exclude VT, but from Perl 5.18 it is included, which
+ means that Perl space and POSIX space are now identical. PCRE was changed
+ at release 8.34. */
+
+ case PT_SPACE: /* Perl space */
+ case PT_PXSPACE: /* POSIX space */
+ switch(c)
+ {
+ HSPACE_CASES:
+ VSPACE_CASES:
+ return negated;
+
+ default:
+ return (PRIV(ucp_gentype)[prop->chartype] == ucp_Z) == negated;
+ }
+ break; /* Control never reaches here */
+
+ case PT_WORD:
+ return (PRIV(ucp_gentype)[prop->chartype] == ucp_L ||
+ PRIV(ucp_gentype)[prop->chartype] == ucp_N ||
+ c == CHAR_UNDERSCORE) == negated;
+
+ case PT_CLIST:
+ p = PRIV(ucd_caseless_sets) + prop->caseset;
+ for (;;)
+ {
+ if (c < *p) return !negated;
+ if (c == *p++) return negated;
+ }
+ break; /* Control never reaches here */
+ }
+
+return FALSE;
+}
+#endif /* SUPPORT_UCP */
+
+
+
+/*************************************************
+* Fill the character property list *
+*************************************************/
+
+/* Checks whether the code points to an opcode that can take part in auto-
+possessification, and if so, fills a list with its properties.
+
+Arguments:
+ code points to start of expression
+ utf TRUE if in UTF-8 / UTF-16 / UTF-32 mode
+ fcc points to case-flipping table
+ list points to output list
+ list[0] will be filled with the opcode
+ list[1] will be non-zero if this opcode
+ can match an empty character string
+ list[2..7] depends on the opcode
+
+Returns: points to the start of the next opcode if *code is accepted
+ NULL if *code is not accepted
+*/
+
+static const pcre_uchar *
+get_chr_property_list(const pcre_uchar *code, BOOL utf,
+ const pcre_uint8 *fcc, pcre_uint32 *list)
+{
+pcre_uchar c = *code;
+pcre_uchar base;
+const pcre_uchar *end;
+pcre_uint32 chr;
+
+#ifdef SUPPORT_UCP
+pcre_uint32 *clist_dest;
+const pcre_uint32 *clist_src;
+#else
+utf = utf; /* Suppress "unused parameter" compiler warning */
+#endif
+
+list[0] = c;
+list[1] = FALSE;
+code++;
+
+if (c >= OP_STAR && c <= OP_TYPEPOSUPTO)
+ {
+ base = get_repeat_base(c);
+ c -= (base - OP_STAR);
+
+ if (c == OP_UPTO || c == OP_MINUPTO || c == OP_EXACT || c == OP_POSUPTO)
+ code += IMM2_SIZE;
+
+ list[1] = (c != OP_PLUS && c != OP_MINPLUS && c != OP_EXACT && c != OP_POSPLUS);
+
+ switch(base)
+ {
+ case OP_STAR:
+ list[0] = OP_CHAR;
+ break;
+
+ case OP_STARI:
+ list[0] = OP_CHARI;
+ break;
+
+ case OP_NOTSTAR:
+ list[0] = OP_NOT;
+ break;
+
+ case OP_NOTSTARI:
+ list[0] = OP_NOTI;
+ break;
+
+ case OP_TYPESTAR:
+ list[0] = *code;
+ code++;
+ break;
+ }
+ c = list[0];
+ }
+
+switch(c)
+ {
+ case OP_NOT_DIGIT:
+ case OP_DIGIT:
+ case OP_NOT_WHITESPACE:
+ case OP_WHITESPACE:
+ case OP_NOT_WORDCHAR:
+ case OP_WORDCHAR:
+ case OP_ANY:
+ case OP_ALLANY:
+ case OP_ANYNL:
+ case OP_NOT_HSPACE:
+ case OP_HSPACE:
+ case OP_NOT_VSPACE:
+ case OP_VSPACE:
+ case OP_EXTUNI:
+ case OP_EODN:
+ case OP_EOD:
+ case OP_DOLL:
+ case OP_DOLLM:
+ return code;
+
+ case OP_CHAR:
+ case OP_NOT:
+ GETCHARINCTEST(chr, code);
+ list[2] = chr;
+ list[3] = NOTACHAR;
+ return code;
+
+ case OP_CHARI:
+ case OP_NOTI:
+ list[0] = (c == OP_CHARI) ? OP_CHAR : OP_NOT;
+ GETCHARINCTEST(chr, code);
+ list[2] = chr;
+
+#ifdef SUPPORT_UCP
+ if (chr < 128 || (chr < 256 && !utf))
+ list[3] = fcc[chr];
+ else
+ list[3] = UCD_OTHERCASE(chr);
+#elif defined SUPPORT_UTF || !defined COMPILE_PCRE8
+ list[3] = (chr < 256) ? fcc[chr] : chr;
+#else
+ list[3] = fcc[chr];
+#endif
+
+ /* The othercase might be the same value. */
+
+ if (chr == list[3])
+ list[3] = NOTACHAR;
+ else
+ list[4] = NOTACHAR;
+ return code;
+
+#ifdef SUPPORT_UCP
+ case OP_PROP:
+ case OP_NOTPROP:
+ if (code[0] != PT_CLIST)
+ {
+ list[2] = code[0];
+ list[3] = code[1];
+ return code + 2;
+ }
+
+ /* Convert only if we have enough space. */
+
+ clist_src = PRIV(ucd_caseless_sets) + code[1];
+ clist_dest = list + 2;
+ code += 2;
+
+ do {
+ if (clist_dest >= list + 8)
+ {
+ /* Early return if there is not enough space. This should never
+ happen, since all clists are shorter than 5 character now. */
+ list[2] = code[0];
+ list[3] = code[1];
+ return code;
+ }
+ *clist_dest++ = *clist_src;
+ }
+ while(*clist_src++ != NOTACHAR);
+
+ /* All characters are stored. The terminating NOTACHAR
+ is copied form the clist itself. */
+
+ list[0] = (c == OP_PROP) ? OP_CHAR : OP_NOT;
+ return code;
+#endif
+
+ case OP_NCLASS:
+ case OP_CLASS:
+#if defined SUPPORT_UTF || !defined COMPILE_PCRE8
+ case OP_XCLASS:
+ if (c == OP_XCLASS)
+ end = code + GET(code, 0) - 1;
+ else
+#endif
+ end = code + 32 / sizeof(pcre_uchar);
+
+ switch(*end)
+ {
+ case OP_CRSTAR:
+ case OP_CRMINSTAR:
+ case OP_CRQUERY:
+ case OP_CRMINQUERY:
+ case OP_CRPOSSTAR:
+ case OP_CRPOSQUERY:
+ list[1] = TRUE;
+ end++;
+ break;
+
+ case OP_CRPLUS:
+ case OP_CRMINPLUS:
+ case OP_CRPOSPLUS:
+ end++;
+ break;
+
+ case OP_CRRANGE:
+ case OP_CRMINRANGE:
+ case OP_CRPOSRANGE:
+ list[1] = (GET2(end, 1) == 0);
+ end += 1 + 2 * IMM2_SIZE;
+ break;
+ }
+ list[2] = (pcre_uint32)(end - code);
+ return end;
+ }
+return NULL; /* Opcode not accepted */
+}
+
+
+
+/*************************************************
+* Scan further character sets for match *
+*************************************************/
+
+/* Checks whether the base and the current opcode have a common character, in
+which case the base cannot be possessified.
+
+Arguments:
+ code points to the byte code
+ utf TRUE in UTF-8 / UTF-16 / UTF-32 mode
+ cd static compile data
+ base_list the data list of the base opcode
+
+Returns: TRUE if the auto-possessification is possible
+*/
+
+static BOOL
+compare_opcodes(const pcre_uchar *code, BOOL utf, const compile_data *cd,
+ const pcre_uint32 *base_list, const pcre_uchar *base_end, int *rec_limit)
+{
+pcre_uchar c;
+pcre_uint32 list[8];
+const pcre_uint32 *chr_ptr;
+const pcre_uint32 *ochr_ptr;
+const pcre_uint32 *list_ptr;
+const pcre_uchar *next_code;
+#if defined SUPPORT_UTF || !defined COMPILE_PCRE8
+const pcre_uchar *xclass_flags;
+#endif
+const pcre_uint8 *class_bitset;
+const pcre_uint8 *set1, *set2, *set_end;
+pcre_uint32 chr;
+BOOL accepted, invert_bits;
+BOOL entered_a_group = FALSE;
+
+if (*rec_limit == 0) return FALSE;
+--(*rec_limit);
+
+/* Note: the base_list[1] contains whether the current opcode has greedy
+(represented by a non-zero value) quantifier. This is a different from
+other character type lists, which stores here that the character iterator
+matches to an empty string (also represented by a non-zero value). */
+
+for(;;)
+ {
+ /* All operations move the code pointer forward.
+ Therefore infinite recursions are not possible. */
+
+ c = *code;
+
+ /* Skip over callouts */
+
+ if (c == OP_CALLOUT)
+ {
+ code += PRIV(OP_lengths)[c];
+ continue;
+ }
+
+ if (c == OP_ALT)
+ {
+ do code += GET(code, 1); while (*code == OP_ALT);
+ c = *code;
+ }
+
+ switch(c)
+ {
+ case OP_END:
+ case OP_KETRPOS:
+ /* TRUE only in greedy case. The non-greedy case could be replaced by
+ an OP_EXACT, but it is probably not worth it. (And note that OP_EXACT
+ uses more memory, which we cannot get at this stage.) */
+
+ return base_list[1] != 0;
+
+ case OP_KET:
+ /* If the bracket is capturing, and referenced by an OP_RECURSE, or
+ it is an atomic sub-pattern (assert, once, etc.) the non-greedy case
+ cannot be converted to a possessive form. */
+
+ if (base_list[1] == 0) return FALSE;
+
+ switch(*(code - GET(code, 1)))
+ {
+ case OP_ASSERT:
+ case OP_ASSERT_NOT:
+ case OP_ASSERTBACK:
+ case OP_ASSERTBACK_NOT:
+ case OP_ONCE:
+ case OP_ONCE_NC:
+ /* Atomic sub-patterns and assertions can always auto-possessify their
+ last iterator. However, if the group was entered as a result of checking
+ a previous iterator, this is not possible. */
+
+ return !entered_a_group;
+ }
+
+ code += PRIV(OP_lengths)[c];
+ continue;
+
+ case OP_ONCE:
+ case OP_ONCE_NC:
+ case OP_BRA:
+ case OP_CBRA:
+ next_code = code + GET(code, 1);
+ code += PRIV(OP_lengths)[c];
+
+ while (*next_code == OP_ALT)
+ {
+ if (!compare_opcodes(code, utf, cd, base_list, base_end, rec_limit))
+ return FALSE;
+ code = next_code + 1 + LINK_SIZE;
+ next_code += GET(next_code, 1);
+ }
+
+ entered_a_group = TRUE;
+ continue;
+
+ case OP_BRAZERO:
+ case OP_BRAMINZERO:
+
+ next_code = code + 1;
+ if (*next_code != OP_BRA && *next_code != OP_CBRA
+ && *next_code != OP_ONCE && *next_code != OP_ONCE_NC) return FALSE;
+
+ do next_code += GET(next_code, 1); while (*next_code == OP_ALT);
+
+ /* The bracket content will be checked by the
+ OP_BRA/OP_CBRA case above. */
+ next_code += 1 + LINK_SIZE;
+ if (!compare_opcodes(next_code, utf, cd, base_list, base_end, rec_limit))
+ return FALSE;
+
+ code += PRIV(OP_lengths)[c];
+ continue;
+
+ default:
+ break;
+ }
+
+ /* Check for a supported opcode, and load its properties. */
+
+ code = get_chr_property_list(code, utf, cd->fcc, list);
+ if (code == NULL) return FALSE; /* Unsupported */
+
+ /* If either opcode is a small character list, set pointers for comparing
+ characters from that list with another list, or with a property. */
+
+ if (base_list[0] == OP_CHAR)
+ {
+ chr_ptr = base_list + 2;
+ list_ptr = list;
+ }
+ else if (list[0] == OP_CHAR)
+ {
+ chr_ptr = list + 2;
+ list_ptr = base_list;
+ }
+
+ /* Character bitsets can also be compared to certain opcodes. */
+
+ else if (base_list[0] == OP_CLASS || list[0] == OP_CLASS
+#ifdef COMPILE_PCRE8
+ /* In 8 bit, non-UTF mode, OP_CLASS and OP_NCLASS are the same. */
+ || (!utf && (base_list[0] == OP_NCLASS || list[0] == OP_NCLASS))
+#endif
+ )
+ {
+#ifdef COMPILE_PCRE8
+ if (base_list[0] == OP_CLASS || (!utf && base_list[0] == OP_NCLASS))
+#else
+ if (base_list[0] == OP_CLASS)
+#endif
+ {
+ set1 = (pcre_uint8 *)(base_end - base_list[2]);
+ list_ptr = list;
+ }
+ else
+ {
+ set1 = (pcre_uint8 *)(code - list[2]);
+ list_ptr = base_list;
+ }
+
+ invert_bits = FALSE;
+ switch(list_ptr[0])
+ {
+ case OP_CLASS:
+ case OP_NCLASS:
+ set2 = (pcre_uint8 *)
+ ((list_ptr == list ? code : base_end) - list_ptr[2]);
+ break;
+
+#if defined SUPPORT_UTF || !defined COMPILE_PCRE8
+ case OP_XCLASS:
+ xclass_flags = (list_ptr == list ? code : base_end) - list_ptr[2] + LINK_SIZE;
+ if ((*xclass_flags & XCL_HASPROP) != 0) return FALSE;
+ if ((*xclass_flags & XCL_MAP) == 0)
+ {
+ /* No bits are set for characters < 256. */
+ if (list[1] == 0) return TRUE;
+ /* Might be an empty repeat. */
+ continue;
+ }
+ set2 = (pcre_uint8 *)(xclass_flags + 1);
+ break;
+#endif
+
+ case OP_NOT_DIGIT:
+ invert_bits = TRUE;
+ /* Fall through */
+ case OP_DIGIT:
+ set2 = (pcre_uint8 *)(cd->cbits + cbit_digit);
+ break;
+
+ case OP_NOT_WHITESPACE:
+ invert_bits = TRUE;
+ /* Fall through */
+ case OP_WHITESPACE:
+ set2 = (pcre_uint8 *)(cd->cbits + cbit_space);
+ break;
+
+ case OP_NOT_WORDCHAR:
+ invert_bits = TRUE;
+ /* Fall through */
+ case OP_WORDCHAR:
+ set2 = (pcre_uint8 *)(cd->cbits + cbit_word);
+ break;
+
+ default:
+ return FALSE;
+ }
+
+ /* Because the sets are unaligned, we need
+ to perform byte comparison here. */
+ set_end = set1 + 32;
+ if (invert_bits)
+ {
+ do
+ {
+ if ((*set1++ & ~(*set2++)) != 0) return FALSE;
+ }
+ while (set1 < set_end);
+ }
+ else
+ {
+ do
+ {
+ if ((*set1++ & *set2++) != 0) return FALSE;
+ }
+ while (set1 < set_end);
+ }
+
+ if (list[1] == 0) return TRUE;
+ /* Might be an empty repeat. */
+ continue;
+ }
+
+ /* Some property combinations also acceptable. Unicode property opcodes are
+ processed specially; the rest can be handled with a lookup table. */
+
+ else
+ {
+ pcre_uint32 leftop, rightop;
+
+ leftop = base_list[0];
+ rightop = list[0];
+
+#ifdef SUPPORT_UCP
+ accepted = FALSE; /* Always set in non-unicode case. */
+ if (leftop == OP_PROP || leftop == OP_NOTPROP)
+ {
+ if (rightop == OP_EOD)
+ accepted = TRUE;
+ else if (rightop == OP_PROP || rightop == OP_NOTPROP)
+ {
+ int n;
+ const pcre_uint8 *p;
+ BOOL same = leftop == rightop;
+ BOOL lisprop = leftop == OP_PROP;
+ BOOL risprop = rightop == OP_PROP;
+ BOOL bothprop = lisprop && risprop;
+
+ /* There's a table that specifies how each combination is to be
+ processed:
+ 0 Always return FALSE (never auto-possessify)
+ 1 Character groups are distinct (possessify if both are OP_PROP)
+ 2 Check character categories in the same group (general or particular)
+ 3 Return TRUE if the two opcodes are not the same
+ ... see comments below
+ */
+
+ n = propposstab[base_list[2]][list[2]];
+ switch(n)
+ {
+ case 0: break;
+ case 1: accepted = bothprop; break;
+ case 2: accepted = (base_list[3] == list[3]) != same; break;
+ case 3: accepted = !same; break;
+
+ case 4: /* Left general category, right particular category */
+ accepted = risprop && catposstab[base_list[3]][list[3]] == same;
+ break;
+
+ case 5: /* Right general category, left particular category */
+ accepted = lisprop && catposstab[list[3]][base_list[3]] == same;
+ break;
+
+ /* This code is logically tricky. Think hard before fiddling with it.
+ The posspropstab table has four entries per row. Each row relates to
+ one of PCRE's special properties such as ALNUM or SPACE or WORD.
+ Only WORD actually needs all four entries, but using repeats for the
+ others means they can all use the same code below.
+
+ The first two entries in each row are Unicode general categories, and
+ apply always, because all the characters they include are part of the
+ PCRE character set. The third and fourth entries are a general and a
+ particular category, respectively, that include one or more relevant
+ characters. One or the other is used, depending on whether the check
+ is for a general or a particular category. However, in both cases the
+ category contains more characters than the specials that are defined
+ for the property being tested against. Therefore, it cannot be used
+ in a NOTPROP case.
+
+ Example: the row for WORD contains ucp_L, ucp_N, ucp_P, ucp_Po.
+ Underscore is covered by ucp_P or ucp_Po. */
+
+ case 6: /* Left alphanum vs right general category */
+ case 7: /* Left space vs right general category */
+ case 8: /* Left word vs right general category */
+ p = posspropstab[n-6];
+ accepted = risprop && lisprop ==
+ (list[3] != p[0] &&
+ list[3] != p[1] &&
+ (list[3] != p[2] || !lisprop));
+ break;
+
+ case 9: /* Right alphanum vs left general category */
+ case 10: /* Right space vs left general category */
+ case 11: /* Right word vs left general category */
+ p = posspropstab[n-9];
+ accepted = lisprop && risprop ==
+ (base_list[3] != p[0] &&
+ base_list[3] != p[1] &&
+ (base_list[3] != p[2] || !risprop));
+ break;
+
+ case 12: /* Left alphanum vs right particular category */
+ case 13: /* Left space vs right particular category */
+ case 14: /* Left word vs right particular category */
+ p = posspropstab[n-12];
+ accepted = risprop && lisprop ==
+ (catposstab[p[0]][list[3]] &&
+ catposstab[p[1]][list[3]] &&
+ (list[3] != p[3] || !lisprop));
+ break;
+
+ case 15: /* Right alphanum vs left particular category */
+ case 16: /* Right space vs left particular category */
+ case 17: /* Right word vs left particular category */
+ p = posspropstab[n-15];
+ accepted = lisprop && risprop ==
+ (catposstab[p[0]][base_list[3]] &&
+ catposstab[p[1]][base_list[3]] &&
+ (base_list[3] != p[3] || !risprop));
+ break;
+ }
+ }
+ }
+
+ else
+#endif /* SUPPORT_UCP */
+
+ accepted = leftop >= FIRST_AUTOTAB_OP && leftop <= LAST_AUTOTAB_LEFT_OP &&
+ rightop >= FIRST_AUTOTAB_OP && rightop <= LAST_AUTOTAB_RIGHT_OP &&
+ autoposstab[leftop - FIRST_AUTOTAB_OP][rightop - FIRST_AUTOTAB_OP];
+
+ if (!accepted) return FALSE;
+
+ if (list[1] == 0) return TRUE;
+ /* Might be an empty repeat. */
+ continue;
+ }
+
+ /* Control reaches here only if one of the items is a small character list.
+ All characters are checked against the other side. */
+
+ do
+ {
+ chr = *chr_ptr;
+
+ switch(list_ptr[0])
+ {
+ case OP_CHAR:
+ ochr_ptr = list_ptr + 2;
+ do
+ {
+ if (chr == *ochr_ptr) return FALSE;
+ ochr_ptr++;
+ }
+ while(*ochr_ptr != NOTACHAR);
+ break;
+
+ case OP_NOT:
+ ochr_ptr = list_ptr + 2;
+ do
+ {
+ if (chr == *ochr_ptr)
+ break;
+ ochr_ptr++;
+ }
+ while(*ochr_ptr != NOTACHAR);
+ if (*ochr_ptr == NOTACHAR) return FALSE; /* Not found */
+ break;
+
+ /* Note that OP_DIGIT etc. are generated only when PCRE_UCP is *not*
+ set. When it is set, \d etc. are converted into OP_(NOT_)PROP codes. */
+
+ case OP_DIGIT:
+ if (chr < 256 && (cd->ctypes[chr] & ctype_digit) != 0) return FALSE;
+ break;
+
+ case OP_NOT_DIGIT:
+ if (chr > 255 || (cd->ctypes[chr] & ctype_digit) == 0) return FALSE;
+ break;
+
+ case OP_WHITESPACE:
+ if (chr < 256 && (cd->ctypes[chr] & ctype_space) != 0) return FALSE;
+ break;
+
+ case OP_NOT_WHITESPACE:
+ if (chr > 255 || (cd->ctypes[chr] & ctype_space) == 0) return FALSE;
+ break;
+
+ case OP_WORDCHAR:
+ if (chr < 255 && (cd->ctypes[chr] & ctype_word) != 0) return FALSE;
+ break;
+
+ case OP_NOT_WORDCHAR:
+ if (chr > 255 || (cd->ctypes[chr] & ctype_word) == 0) return FALSE;
+ break;
+
+ case OP_HSPACE:
+ switch(chr)
+ {
+ HSPACE_CASES: return FALSE;
+ default: break;
+ }
+ break;
+
+ case OP_NOT_HSPACE:
+ switch(chr)
+ {
+ HSPACE_CASES: break;
+ default: return FALSE;
+ }
+ break;
+
+ case OP_ANYNL:
+ case OP_VSPACE:
+ switch(chr)
+ {
+ VSPACE_CASES: return FALSE;
+ default: break;
+ }
+ break;
+
+ case OP_NOT_VSPACE:
+ switch(chr)
+ {
+ VSPACE_CASES: break;
+ default: return FALSE;
+ }
+ break;
+
+ case OP_DOLL:
+ case OP_EODN:
+ switch (chr)
+ {
+ case CHAR_CR:
+ case CHAR_LF:
+ case CHAR_VT:
+ case CHAR_FF:
+ case CHAR_NEL:
+#ifndef EBCDIC
+ case 0x2028:
+ case 0x2029:
+#endif /* Not EBCDIC */
+ return FALSE;
+ }
+ break;
+
+ case OP_EOD: /* Can always possessify before \z */
+ break;
+
+#ifdef SUPPORT_UCP
+ case OP_PROP:
+ case OP_NOTPROP:
+ if (!check_char_prop(chr, list_ptr[2], list_ptr[3],
+ list_ptr[0] == OP_NOTPROP))
+ return FALSE;
+ break;
+#endif
+
+ case OP_NCLASS:
+ if (chr > 255) return FALSE;
+ /* Fall through */
+
+ case OP_CLASS:
+ if (chr > 255) break;
+ class_bitset = (pcre_uint8 *)
+ ((list_ptr == list ? code : base_end) - list_ptr[2]);
+ if ((class_bitset[chr >> 3] & (1 << (chr & 7))) != 0) return FALSE;
+ break;
+
+#if defined SUPPORT_UTF || !defined COMPILE_PCRE8
+ case OP_XCLASS:
+ if (PRIV(xclass)(chr, (list_ptr == list ? code : base_end) -
+ list_ptr[2] + LINK_SIZE, utf)) return FALSE;
+ break;
+#endif
+
+ default:
+ return FALSE;
+ }
+
+ chr_ptr++;
+ }
+ while(*chr_ptr != NOTACHAR);
+
+ /* At least one character must be matched from this opcode. */
+
+ if (list[1] == 0) return TRUE;
+ }
+
+/* Control never reaches here. There used to be a fail-save return FALSE; here,
+but some compilers complain about an unreachable statement. */
+
+}
+
+
+
+/*************************************************
+* Scan compiled regex for auto-possession *
+*************************************************/
+
+/* Replaces single character iterations with their possessive alternatives
+if appropriate. This function modifies the compiled opcode!
+
+Arguments:
+ code points to start of the byte code
+ utf TRUE in UTF-8 / UTF-16 / UTF-32 mode
+ cd static compile data
+
+Returns: nothing
+*/
+
+static void
+auto_possessify(pcre_uchar *code, BOOL utf, const compile_data *cd)
+{
+register pcre_uchar c;
+const pcre_uchar *end;
+pcre_uchar *repeat_opcode;
+pcre_uint32 list[8];
+int rec_limit;
+
+for (;;)
+ {
+ c = *code;
+
+ /* When a pattern with bad UTF-8 encoding is compiled with NO_UTF_CHECK,
+ it may compile without complaining, but may get into a loop here if the code
+ pointer points to a bad value. This is, of course a documentated possibility,
+ when NO_UTF_CHECK is set, so it isn't a bug, but we can detect this case and
+ just give up on this optimization. */
+
+ if (c >= OP_TABLE_LENGTH) return;
+
+ if (c >= OP_STAR && c <= OP_TYPEPOSUPTO)
+ {
+ c -= get_repeat_base(c) - OP_STAR;
+ end = (c <= OP_MINUPTO) ?
+ get_chr_property_list(code, utf, cd->fcc, list) : NULL;
+ list[1] = c == OP_STAR || c == OP_PLUS || c == OP_QUERY || c == OP_UPTO;
+
+ rec_limit = 1000;
+ if (end != NULL && compare_opcodes(end, utf, cd, list, end, &rec_limit))
+ {
+ switch(c)
+ {
+ case OP_STAR:
+ *code += OP_POSSTAR - OP_STAR;
+ break;
+
+ case OP_MINSTAR:
+ *code += OP_POSSTAR - OP_MINSTAR;
+ break;
+
+ case OP_PLUS:
+ *code += OP_POSPLUS - OP_PLUS;
+ break;
+
+ case OP_MINPLUS:
+ *code += OP_POSPLUS - OP_MINPLUS;
+ break;
+
+ case OP_QUERY:
+ *code += OP_POSQUERY - OP_QUERY;
+ break;
+
+ case OP_MINQUERY:
+ *code += OP_POSQUERY - OP_MINQUERY;
+ break;
+
+ case OP_UPTO:
+ *code += OP_POSUPTO - OP_UPTO;
+ break;
+
+ case OP_MINUPTO:
+ *code += OP_POSUPTO - OP_MINUPTO;
+ break;
+ }
+ }
+ c = *code;
+ }
+ else if (c == OP_CLASS || c == OP_NCLASS || c == OP_XCLASS)
+ {
+#if defined SUPPORT_UTF || !defined COMPILE_PCRE8
+ if (c == OP_XCLASS)
+ repeat_opcode = code + GET(code, 1);
+ else
+#endif
+ repeat_opcode = code + 1 + (32 / sizeof(pcre_uchar));
+
+ c = *repeat_opcode;
+ if (c >= OP_CRSTAR && c <= OP_CRMINRANGE)
+ {
+ /* end must not be NULL. */
+ end = get_chr_property_list(code, utf, cd->fcc, list);
+
+ list[1] = (c & 1) == 0;
+
+ rec_limit = 1000;
+ if (compare_opcodes(end, utf, cd, list, end, &rec_limit))
+ {
+ switch (c)
+ {
+ case OP_CRSTAR:
+ case OP_CRMINSTAR:
+ *repeat_opcode = OP_CRPOSSTAR;
+ break;
+
+ case OP_CRPLUS:
+ case OP_CRMINPLUS:
+ *repeat_opcode = OP_CRPOSPLUS;
+ break;
+
+ case OP_CRQUERY:
+ case OP_CRMINQUERY:
+ *repeat_opcode = OP_CRPOSQUERY;
+ break;
+
+ case OP_CRRANGE:
+ case OP_CRMINRANGE:
+ *repeat_opcode = OP_CRPOSRANGE;
+ break;
+ }
+ }
+ }
+ c = *code;
+ }
+
+ switch(c)
+ {
+ case OP_END:
+ return;
+
+ case OP_TYPESTAR:
+ case OP_TYPEMINSTAR:
+ case OP_TYPEPLUS:
+ case OP_TYPEMINPLUS:
+ case OP_TYPEQUERY:
+ case OP_TYPEMINQUERY:
+ case OP_TYPEPOSSTAR:
+ case OP_TYPEPOSPLUS:
+ case OP_TYPEPOSQUERY:
+ if (code[1] == OP_PROP || code[1] == OP_NOTPROP) code += 2;
+ break;
+
+ case OP_TYPEUPTO:
+ case OP_TYPEMINUPTO:
+ case OP_TYPEEXACT:
+ case OP_TYPEPOSUPTO:
+ if (code[1 + IMM2_SIZE] == OP_PROP || code[1 + IMM2_SIZE] == OP_NOTPROP)
+ code += 2;
+ break;
+
+#if defined SUPPORT_UTF || !defined COMPILE_PCRE8
+ case OP_XCLASS:
+ code += GET(code, 1);
+ break;
+#endif
+
+ case OP_MARK:
+ case OP_PRUNE_ARG:
+ case OP_SKIP_ARG:
+ case OP_THEN_ARG:
+ code += code[1];
+ break;
+ }
+
+ /* Add in the fixed length from the table */
+
+ code += PRIV(OP_lengths)[c];
+
+ /* In UTF-8 mode, opcodes that are followed by a character may be followed by
+ a multi-byte character. The length in the table is a minimum, so we have to
+ arrange to skip the extra bytes. */
+
+#if defined SUPPORT_UTF && !defined COMPILE_PCRE32
+ if (utf) switch(c)
+ {
+ case OP_CHAR:
+ case OP_CHARI:
+ case OP_NOT:
+ case OP_NOTI:
+ case OP_STAR:
+ case OP_MINSTAR:
+ case OP_PLUS:
+ case OP_MINPLUS:
+ case OP_QUERY:
+ case OP_MINQUERY:
+ case OP_UPTO:
+ case OP_MINUPTO:
+ case OP_EXACT:
+ case OP_POSSTAR:
+ case OP_POSPLUS:
+ case OP_POSQUERY:
+ case OP_POSUPTO:
+ case OP_STARI:
+ case OP_MINSTARI:
+ case OP_PLUSI:
+ case OP_MINPLUSI:
+ case OP_QUERYI:
+ case OP_MINQUERYI:
+ case OP_UPTOI:
+ case OP_MINUPTOI:
+ case OP_EXACTI:
+ case OP_POSSTARI:
+ case OP_POSPLUSI:
+ case OP_POSQUERYI:
+ case OP_POSUPTOI:
+ case OP_NOTSTAR:
+ case OP_NOTMINSTAR:
+ case OP_NOTPLUS:
+ case OP_NOTMINPLUS:
+ case OP_NOTQUERY:
+ case OP_NOTMINQUERY:
+ case OP_NOTUPTO:
+ case OP_NOTMINUPTO:
+ case OP_NOTEXACT:
+ case OP_NOTPOSSTAR:
+ case OP_NOTPOSPLUS:
+ case OP_NOTPOSQUERY:
+ case OP_NOTPOSUPTO:
+ case OP_NOTSTARI:
+ case OP_NOTMINSTARI:
+ case OP_NOTPLUSI:
+ case OP_NOTMINPLUSI:
+ case OP_NOTQUERYI:
+ case OP_NOTMINQUERYI:
+ case OP_NOTUPTOI:
+ case OP_NOTMINUPTOI:
+ case OP_NOTEXACTI:
+ case OP_NOTPOSSTARI:
+ case OP_NOTPOSPLUSI:
+ case OP_NOTPOSQUERYI:
+ case OP_NOTPOSUPTOI:
+ if (HAS_EXTRALEN(code[-1])) code += GET_EXTRALEN(code[-1]);
+ break;
+ }
+#else
+ (void)(utf); /* Keep compiler happy by referencing function argument */
+#endif
+ }
+}
+
+
+
+/*************************************************
* Check for POSIX class syntax *
*************************************************/
@@ -2687,11 +3907,11 @@ didn't consider this to be a POSIX class. Likewise for [:1234:].
The problem in trying to be exactly like Perl is in the handling of escapes. We
have to be sure that [abc[:x\]pqr] is *not* treated as containing a POSIX
class, but [abc[:x\]pqr:]] is (so that an error can be generated). The code
-below handles the special case of \], but does not try to do any other escape
-processing. This makes it different from Perl for cases such as [:l\ower:]
-where Perl recognizes it as the POSIX class "lower" but PCRE does not recognize
-"l\ower". This is a lesser evil that not diagnosing bad classes when Perl does,
-I think.
+below handles the special cases \\ and \], but does not try to do any other
+escape processing. This makes it different from Perl for cases such as
+[:l\ower:] where Perl recognizes it as the POSIX class "lower" but PCRE does
+not recognize "l\ower". This is a lesser evil than not diagnosing bad classes
+when Perl does, I think.
A user pointed out that PCRE was rejecting [:a[:digit:]] whereas Perl was not.
It seems that the appearance of a nested POSIX class supersedes an apparent
@@ -2718,21 +3938,16 @@ pcre_uchar terminator; /* Don't combine these lines; the Solaris cc */
terminator = *(++ptr); /* compiler warns about "non-constant" initializer. */
for (++ptr; *ptr != CHAR_NULL; ptr++)
{
- if (*ptr == CHAR_BACKSLASH && ptr[1] == CHAR_RIGHT_SQUARE_BRACKET)
+ if (*ptr == CHAR_BACKSLASH &&
+ (ptr[1] == CHAR_RIGHT_SQUARE_BRACKET ||
+ ptr[1] == CHAR_BACKSLASH))
ptr++;
- else if (*ptr == CHAR_RIGHT_SQUARE_BRACKET) return FALSE;
- else
+ else if ((*ptr == CHAR_LEFT_SQUARE_BRACKET && ptr[1] == terminator) ||
+ *ptr == CHAR_RIGHT_SQUARE_BRACKET) return FALSE;
+ else if (*ptr == terminator && ptr[1] == CHAR_RIGHT_SQUARE_BRACKET)
{
- if (*ptr == terminator && ptr[1] == CHAR_RIGHT_SQUARE_BRACKET)
- {
- *endptr = ptr;
- return TRUE;
- }
- if (*ptr == CHAR_LEFT_SQUARE_BRACKET &&
- (ptr[1] == CHAR_COLON || ptr[1] == CHAR_DOT ||
- ptr[1] == CHAR_EQUALS_SIGN) &&
- check_posix_syntax(ptr, endptr))
- return FALSE;
+ *endptr = ptr;
+ return TRUE;
}
}
return FALSE;
@@ -2786,48 +4001,42 @@ have their offsets adjusted. That one of the jobs of this function. Before it
is called, the partially compiled regex must be temporarily terminated with
OP_END.
-This function has been extended with the possibility of forward references for
-recursions and subroutine calls. It must also check the list of such references
-for the group we are dealing with. If it finds that one of the recursions in
-the current group is on this list, it adjusts the offset in the list, not the
-value in the reference (which is a group number).
+This function has been extended to cope with forward references for recursions
+and subroutine calls. It must check the list of such references for the
+group we are dealing with. If it finds that one of the recursions in the
+current group is on this list, it does not adjust the value in the reference
+(which is a group number). After the group has been scanned, all the offsets in
+the forward reference list for the group are adjusted.
Arguments:
group points to the start of the group
adjust the amount by which the group is to be moved
utf TRUE in UTF-8 / UTF-16 / UTF-32 mode
cd contains pointers to tables etc.
- save_hwm the hwm forward reference pointer at the start of the group
+ save_hwm_offset the hwm forward reference offset at the start of the group
Returns: nothing
*/
static void
adjust_recurse(pcre_uchar *group, int adjust, BOOL utf, compile_data *cd,
- pcre_uchar *save_hwm)
+ size_t save_hwm_offset)
{
+int offset;
+pcre_uchar *hc;
pcre_uchar *ptr = group;
while ((ptr = (pcre_uchar *)find_recurse(ptr, utf)) != NULL)
{
- int offset;
- pcre_uchar *hc;
-
- /* See if this recursion is on the forward reference list. If so, adjust the
- reference. */
-
- for (hc = save_hwm; hc < cd->hwm; hc += LINK_SIZE)
+ for (hc = (pcre_uchar *)cd->start_workspace + save_hwm_offset; hc < cd->hwm;
+ hc += LINK_SIZE)
{
offset = (int)GET(hc, 0);
- if (cd->start_code + offset == ptr + 1)
- {
- PUT(hc, 0, offset + adjust);
- break;
- }
+ if (cd->start_code + offset == ptr + 1) break;
}
- /* Otherwise, adjust the recursion offset if it's after the start of this
- group. */
+ /* If we have not found this recursion on the forward reference list, adjust
+ the recursion's offset if it's after the start of this group. */
if (hc >= cd->hwm)
{
@@ -2837,6 +4046,15 @@ while ((ptr = (pcre_uchar *)find_recurse(ptr, utf)) != NULL)
ptr += 1 + LINK_SIZE;
}
+
+/* Now adjust all forward reference offsets for the group. */
+
+for (hc = (pcre_uchar *)cd->start_workspace + save_hwm_offset; hc < cd->hwm;
+ hc += LINK_SIZE)
+ {
+ offset = (int)GET(hc, 0);
+ PUT(hc, 0, offset + adjust);
+ }
}
@@ -2939,12 +4157,16 @@ for (c = *cptr; c <= d; c++)
if (c > d) return -1; /* Reached end of range */
+/* Found a character that has a single other case. Search for the end of the
+range, which is either the end of the input range, or a character that has zero
+or more than one other cases. */
+
*ocptr = othercase;
next = othercase + 1;
for (++c; c <= d; c++)
{
- if (UCD_OTHERCASE(c) != next) break;
+ if ((co = UCD_CASESET(c)) != 0 || UCD_OTHERCASE(c) != next) break;
next++;
}
@@ -2952,477 +4174,11 @@ for (++c; c <= d; c++)
*cptr = c; /* Rest of input range */
return 0;
}
-
-
-
-/*************************************************
-* Check a character and a property *
-*************************************************/
-
-/* This function is called by check_auto_possessive() when a property item
-is adjacent to a fixed character.
-
-Arguments:
- c the character
- ptype the property type
- pdata the data for the type
- negated TRUE if it's a negated property (\P or \p{^)
-
-Returns: TRUE if auto-possessifying is OK
-*/
-
-static BOOL
-check_char_prop(pcre_uint32 c, unsigned int ptype, unsigned int pdata, BOOL negated)
-{
-#ifdef SUPPORT_UCP
-const pcre_uint32 *p;
-#endif
-
-const ucd_record *prop = GET_UCD(c);
-
-switch(ptype)
- {
- case PT_LAMP:
- return (prop->chartype == ucp_Lu ||
- prop->chartype == ucp_Ll ||
- prop->chartype == ucp_Lt) == negated;
-
- case PT_GC:
- return (pdata == PRIV(ucp_gentype)[prop->chartype]) == negated;
-
- case PT_PC:
- return (pdata == prop->chartype) == negated;
-
- case PT_SC:
- return (pdata == prop->script) == negated;
-
- /* These are specials */
-
- case PT_ALNUM:
- return (PRIV(ucp_gentype)[prop->chartype] == ucp_L ||
- PRIV(ucp_gentype)[prop->chartype] == ucp_N) == negated;
-
- case PT_SPACE: /* Perl space */
- return (PRIV(ucp_gentype)[prop->chartype] == ucp_Z ||
- c == CHAR_HT || c == CHAR_NL || c == CHAR_FF || c == CHAR_CR)
- == negated;
-
- case PT_PXSPACE: /* POSIX space */
- return (PRIV(ucp_gentype)[prop->chartype] == ucp_Z ||
- c == CHAR_HT || c == CHAR_NL || c == CHAR_VT ||
- c == CHAR_FF || c == CHAR_CR)
- == negated;
-
- case PT_WORD:
- return (PRIV(ucp_gentype)[prop->chartype] == ucp_L ||
- PRIV(ucp_gentype)[prop->chartype] == ucp_N ||
- c == CHAR_UNDERSCORE) == negated;
-
-#ifdef SUPPORT_UCP
- case PT_CLIST:
- p = PRIV(ucd_caseless_sets) + prop->caseset;
- for (;;)
- {
- if (c < *p) return !negated;
- if (c == *p++) return negated;
- }
- break; /* Control never reaches here */
-#endif
- }
-
-return FALSE;
-}
#endif /* SUPPORT_UCP */
/*************************************************
-* Check if auto-possessifying is possible *
-*************************************************/
-
-/* This function is called for unlimited repeats of certain items, to see
-whether the next thing could possibly match the repeated item. If not, it makes
-sense to automatically possessify the repeated item.
-
-Arguments:
- previous pointer to the repeated opcode
- utf TRUE in UTF-8 / UTF-16 / UTF-32 mode
- ptr next character in pattern
- options options bits
- cd contains pointers to tables etc.
-
-Returns: TRUE if possessifying is wanted
-*/
-
-static BOOL
-check_auto_possessive(const pcre_uchar *previous, BOOL utf,
- const pcre_uchar *ptr, int options, compile_data *cd)
-{
-pcre_uint32 c = NOTACHAR;
-pcre_uint32 next;
-int escape;
-pcre_uchar op_code = *previous++;
-
-/* Skip whitespace and comments in extended mode */
-
-if ((options & PCRE_EXTENDED) != 0)
- {
- for (;;)
- {
- while (MAX_255(*ptr) && (cd->ctypes[*ptr] & ctype_space) != 0) ptr++;
- if (*ptr == CHAR_NUMBER_SIGN)
- {
- ptr++;
- while (*ptr != CHAR_NULL)
- {
- if (IS_NEWLINE(ptr)) { ptr += cd->nllen; break; }
- ptr++;
-#ifdef SUPPORT_UTF
- if (utf) FORWARDCHAR(ptr);
-#endif
- }
- }
- else break;
- }
- }
-
-/* If the next item is one that we can handle, get its value. A non-negative
-value is a character, a negative value is an escape value. */
-
-if (*ptr == CHAR_BACKSLASH)
- {
- int temperrorcode = 0;
- escape = check_escape(&ptr, &next, &temperrorcode, cd->bracount, options,
- FALSE);
- if (temperrorcode != 0) return FALSE;
- ptr++; /* Point after the escape sequence */
- }
-else if (!MAX_255(*ptr) || (cd->ctypes[*ptr] & ctype_meta) == 0)
- {
- escape = 0;
-#ifdef SUPPORT_UTF
- if (utf) { GETCHARINC(next, ptr); } else
-#endif
- next = *ptr++;
- }
-else return FALSE;
-
-/* Skip whitespace and comments in extended mode */
-
-if ((options & PCRE_EXTENDED) != 0)
- {
- for (;;)
- {
- while (MAX_255(*ptr) && (cd->ctypes[*ptr] & ctype_space) != 0) ptr++;
- if (*ptr == CHAR_NUMBER_SIGN)
- {
- ptr++;
- while (*ptr != CHAR_NULL)
- {
- if (IS_NEWLINE(ptr)) { ptr += cd->nllen; break; }
- ptr++;
-#ifdef SUPPORT_UTF
- if (utf) FORWARDCHAR(ptr);
-#endif
- }
- }
- else break;
- }
- }
-
-/* If the next thing is itself optional, we have to give up. */
-
-if (*ptr == CHAR_ASTERISK || *ptr == CHAR_QUESTION_MARK ||
- STRNCMP_UC_C8(ptr, STR_LEFT_CURLY_BRACKET STR_0 STR_COMMA, 3) == 0)
- return FALSE;
-
-/* If the previous item is a character, get its value. */
-
-if (op_code == OP_CHAR || op_code == OP_CHARI ||
- op_code == OP_NOT || op_code == OP_NOTI)
- {
-#ifdef SUPPORT_UTF
- GETCHARTEST(c, previous);
-#else
- c = *previous;
-#endif
- }
-
-/* Now compare the next item with the previous opcode. First, handle cases when
-the next item is a character. */
-
-if (escape == 0)
- {
- /* For a caseless UTF match, the next character may have more than one other
- case, which maps to the special PT_CLIST property. Check this first. */
-
-#ifdef SUPPORT_UCP
- if (utf && c != NOTACHAR && (options & PCRE_CASELESS) != 0)
- {
- unsigned int ocs = UCD_CASESET(next);
- if (ocs > 0) return check_char_prop(c, PT_CLIST, ocs, op_code >= OP_NOT);
- }
-#endif
-
- switch(op_code)
- {
- case OP_CHAR:
- return c != next;
-
- /* For CHARI (caseless character) we must check the other case. If we have
- Unicode property support, we can use it to test the other case of
- high-valued characters. We know that next can have only one other case,
- because multi-other-case characters are dealt with above. */
-
- case OP_CHARI:
- if (c == next) return FALSE;
-#ifdef SUPPORT_UTF
- if (utf)
- {
- pcre_uint32 othercase;
- if (next < 128) othercase = cd->fcc[next]; else
-#ifdef SUPPORT_UCP
- othercase = UCD_OTHERCASE(next);
-#else
- othercase = NOTACHAR;
-#endif
- return c != othercase;
- }
- else
-#endif /* SUPPORT_UTF */
- return (c != TABLE_GET(next, cd->fcc, next)); /* Not UTF */
-
- case OP_NOT:
- return c == next;
-
- case OP_NOTI:
- if (c == next) return TRUE;
-#ifdef SUPPORT_UTF
- if (utf)
- {
- pcre_uint32 othercase;
- if (next < 128) othercase = cd->fcc[next]; else
-#ifdef SUPPORT_UCP
- othercase = UCD_OTHERCASE(next);
-#else
- othercase = NOTACHAR;
-#endif
- return c == othercase;
- }
- else
-#endif /* SUPPORT_UTF */
- return (c == TABLE_GET(next, cd->fcc, next)); /* Not UTF */
-
- /* Note that OP_DIGIT etc. are generated only when PCRE_UCP is *not* set.
- When it is set, \d etc. are converted into OP_(NOT_)PROP codes. */
-
- case OP_DIGIT:
- return next > 255 || (cd->ctypes[next] & ctype_digit) == 0;
-
- case OP_NOT_DIGIT:
- return next <= 255 && (cd->ctypes[next] & ctype_digit) != 0;
-
- case OP_WHITESPACE:
- return next > 255 || (cd->ctypes[next] & ctype_space) == 0;
-
- case OP_NOT_WHITESPACE:
- return next <= 255 && (cd->ctypes[next] & ctype_space) != 0;
-
- case OP_WORDCHAR:
- return next > 255 || (cd->ctypes[next] & ctype_word) == 0;
-
- case OP_NOT_WORDCHAR:
- return next <= 255 && (cd->ctypes[next] & ctype_word) != 0;
-
- case OP_HSPACE:
- case OP_NOT_HSPACE:
- switch(next)
- {
- HSPACE_CASES:
- return op_code == OP_NOT_HSPACE;
-
- default:
- return op_code != OP_NOT_HSPACE;
- }
-
- case OP_ANYNL:
- case OP_VSPACE:
- case OP_NOT_VSPACE:
- switch(next)
- {
- VSPACE_CASES:
- return op_code == OP_NOT_VSPACE;
-
- default:
- return op_code != OP_NOT_VSPACE;
- }
-
-#ifdef SUPPORT_UCP
- case OP_PROP:
- return check_char_prop(next, previous[0], previous[1], FALSE);
-
- case OP_NOTPROP:
- return check_char_prop(next, previous[0], previous[1], TRUE);
-#endif
-
- default:
- return FALSE;
- }
- }
-
-/* Handle the case when the next item is \d, \s, etc. Note that when PCRE_UCP
-is set, \d turns into ESC_du rather than ESC_d, etc., so ESC_d etc. are
-generated only when PCRE_UCP is *not* set, that is, when only ASCII
-characteristics are recognized. Similarly, the opcodes OP_DIGIT etc. are
-replaced by OP_PROP codes when PCRE_UCP is set. */
-
-switch(op_code)
- {
- case OP_CHAR:
- case OP_CHARI:
- switch(escape)
- {
- case ESC_d:
- return c > 255 || (cd->ctypes[c] & ctype_digit) == 0;
-
- case ESC_D:
- return c <= 255 && (cd->ctypes[c] & ctype_digit) != 0;
-
- case ESC_s:
- return c > 255 || (cd->ctypes[c] & ctype_space) == 0;
-
- case ESC_S:
- return c <= 255 && (cd->ctypes[c] & ctype_space) != 0;
-
- case ESC_w:
- return c > 255 || (cd->ctypes[c] & ctype_word) == 0;
-
- case ESC_W:
- return c <= 255 && (cd->ctypes[c] & ctype_word) != 0;
-
- case ESC_h:
- case ESC_H:
- switch(c)
- {
- HSPACE_CASES:
- return escape != ESC_h;
-
- default:
- return escape == ESC_h;
- }
-
- case ESC_v:
- case ESC_V:
- switch(c)
- {
- VSPACE_CASES:
- return escape != ESC_v;
-
- default:
- return escape == ESC_v;
- }
-
- /* When PCRE_UCP is set, these values get generated for \d etc. Find
- their substitutions and process them. The result will always be either
- ESC_p or ESC_P. Then fall through to process those values. */
-
-#ifdef SUPPORT_UCP
- case ESC_du:
- case ESC_DU:
- case ESC_wu:
- case ESC_WU:
- case ESC_su:
- case ESC_SU:
- {
- int temperrorcode = 0;
- ptr = substitutes[escape - ESC_DU];
- escape = check_escape(&ptr, &next, &temperrorcode, 0, options, FALSE);
- if (temperrorcode != 0) return FALSE;
- ptr++; /* For compatibility */
- }
- /* Fall through */
-
- case ESC_p:
- case ESC_P:
- {
- unsigned int ptype = 0, pdata = 0;
- int errorcodeptr;
- BOOL negated;
-
- ptr--; /* Make ptr point at the p or P */
- if (!get_ucp(&ptr, &negated, &ptype, &pdata, &errorcodeptr))
- return FALSE;
- ptr++; /* Point past the final curly ket */
-
- /* If the property item is optional, we have to give up. (When generated
- from \d etc by PCRE_UCP, this test will have been applied much earlier,
- to the original \d etc. At this point, ptr will point to a zero byte. */
-
- if (*ptr == CHAR_ASTERISK || *ptr == CHAR_QUESTION_MARK ||
- STRNCMP_UC_C8(ptr, STR_LEFT_CURLY_BRACKET STR_0 STR_COMMA, 3) == 0)
- return FALSE;
-
- /* Do the property check. */
-
- return check_char_prop(c, ptype, pdata, (escape == ESC_P) != negated);
- }
-#endif
-
- default:
- return FALSE;
- }
-
- /* In principle, support for Unicode properties should be integrated here as
- well. It means re-organizing the above code so as to get hold of the property
- values before switching on the op-code. However, I wonder how many patterns
- combine ASCII \d etc with Unicode properties? (Note that if PCRE_UCP is set,
- these op-codes are never generated.) */
-
- case OP_DIGIT:
- return escape == ESC_D || escape == ESC_s || escape == ESC_W ||
- escape == ESC_h || escape == ESC_v || escape == ESC_R;
-
- case OP_NOT_DIGIT:
- return escape == ESC_d;
-
- case OP_WHITESPACE:
- return escape == ESC_S || escape == ESC_d || escape == ESC_w;
-
- case OP_NOT_WHITESPACE:
- return escape == ESC_s || escape == ESC_h || escape == ESC_v || escape == ESC_R;
-
- case OP_HSPACE:
- return escape == ESC_S || escape == ESC_H || escape == ESC_d ||
- escape == ESC_w || escape == ESC_v || escape == ESC_R;
-
- case OP_NOT_HSPACE:
- return escape == ESC_h;
-
- /* Can't have \S in here because VT matches \S (Perl anomaly) */
- case OP_ANYNL:
- case OP_VSPACE:
- return escape == ESC_V || escape == ESC_d || escape == ESC_w;
-
- case OP_NOT_VSPACE:
- return escape == ESC_v || escape == ESC_R;
-
- case OP_WORDCHAR:
- return escape == ESC_W || escape == ESC_s || escape == ESC_h ||
- escape == ESC_v || escape == ESC_R;
-
- case OP_NOT_WORDCHAR:
- return escape == ESC_w || escape == ESC_d;
-
- default:
- return FALSE;
- }
-
-/* Control does not reach here */
-}
-
-
-
-/*************************************************
* Add a character or range to a class *
*************************************************/
@@ -3448,6 +4204,7 @@ add_to_class(pcre_uint8 *classbits, pcre_uchar **uchardptr, int options,
compile_data *cd, pcre_uint32 start, pcre_uint32 end)
{
pcre_uint32 c;
+pcre_uint32 classbits_end = (end <= 0xff ? end : 0xff);
int n8 = 0;
/* If caseless matching is required, scan the range and process alternate
@@ -3482,7 +4239,11 @@ if ((options & PCRE_CASELESS) != 0)
range. Otherwise, use a recursive call to add the additional range. */
else if (oc < start && od >= start - 1) start = oc; /* Extend downwards */
- else if (od > end && oc <= end + 1) end = od; /* Extend upwards */
+ else if (od > end && oc <= end + 1)
+ {
+ end = od; /* Extend upwards */
+ if (end > classbits_end) classbits_end = (end <= 0xff ? end : 0xff);
+ }
else n8 += add_to_class(classbits, uchardptr, options, cd, oc, od);
}
}
@@ -3491,7 +4252,7 @@ if ((options & PCRE_CASELESS) != 0)
/* Not UTF-mode, or no UCP */
- for (c = start; c <= end && c < 256; c++)
+ for (c = start; c <= classbits_end; c++)
{
SETBIT(classbits, cd->fcc[c]);
n8++;
@@ -3516,22 +4277,21 @@ in all cases. */
#endif /* COMPILE_PCRE[8|16] */
-/* If all characters are less than 256, use the bit map. Otherwise use extra
-data. */
+/* Use the bitmap for characters < 256. Otherwise use extra data.*/
-if (end < 0x100)
+for (c = start; c <= classbits_end; c++)
{
- for (c = start; c <= end; c++)
- {
- n8++;
- SETBIT(classbits, c);
- }
+ /* Regardless of start, c will always be <= 255. */
+ SETBIT(classbits, c);
+ n8++;
}
-else
+#if defined SUPPORT_UTF || !defined COMPILE_PCRE8
+if (start <= 0xff) start = 0xff + 1;
+
+if (end >= start)
{
pcre_uchar *uchardata = *uchardptr;
-
#ifdef SUPPORT_UTF
if ((options & PCRE_UTF8) != 0) /* All UTFs use the same flag bit */
{
@@ -3571,6 +4331,7 @@ else
*uchardptr = uchardata; /* Updata extra data pointer */
}
+#endif /* SUPPORT_UTF || !COMPILE_PCRE8 */
return n8; /* Number of 8-bit characters */
}
@@ -3671,22 +4432,22 @@ to find out the amount of memory needed, as well as during the real compile
phase. The value of lengthptr distinguishes the two phases.
Arguments:
- optionsptr pointer to the option bits
- codeptr points to the pointer to the current code point
- ptrptr points to the current pattern pointer
- errorcodeptr points to error code variable
- firstcharptr place to put the first required character
+ optionsptr pointer to the option bits
+ codeptr points to the pointer to the current code point
+ ptrptr points to the current pattern pointer
+ errorcodeptr points to error code variable
+ firstcharptr place to put the first required character
firstcharflagsptr place to put the first character flags, or a negative number
- reqcharptr place to put the last required character
- reqcharflagsptr place to put the last required character flags, or a negative number
- bcptr points to current branch chain
- cond_depth conditional nesting depth
- cd contains pointers to tables etc.
- lengthptr NULL during the real compile phase
- points to length accumulator during pre-compile phase
-
-Returns: TRUE on success
- FALSE, with *errorcodeptr set non-zero on error
+ reqcharptr place to put the last required character
+ reqcharflagsptr place to put the last required character flags, or a negative number
+ bcptr points to current branch chain
+ cond_depth conditional nesting depth
+ cd contains pointers to tables etc.
+ lengthptr NULL during the real compile phase
+ points to length accumulator during pre-compile phase
+
+Returns: TRUE on success
+ FALSE, with *errorcodeptr set non-zero on error
*/
static BOOL
@@ -3722,7 +4483,7 @@ const pcre_uchar *tempptr;
const pcre_uchar *nestptr = NULL;
pcre_uchar *previous = NULL;
pcre_uchar *previous_callout = NULL;
-pcre_uchar *save_hwm = NULL;
+size_t item_hwm_offset = 0;
pcre_uint8 classbits[32];
/* We can fish out the UTF-8 setting once and for all into a BOOL, but we
@@ -3792,6 +4553,9 @@ for (;; ptr++)
BOOL reset_bracount;
int class_has_8bitchar;
int class_one_char;
+#if defined SUPPORT_UTF || !defined COMPILE_PCRE8
+ BOOL xclass_has_prop;
+#endif
int newoptions;
int recno;
int refsign;
@@ -3804,6 +4568,10 @@ for (;; ptr++)
pcre_uint32 ec;
pcre_uchar mcbuffer[8];
+ /* Come here to restart the loop without advancing the pointer. */
+
+ REDO_LOOP:
+
/* Get next character in the pattern */
c = *ptr;
@@ -3829,7 +4597,8 @@ for (;; ptr++)
if (code > cd->start_workspace + cd->workspace_size -
WORK_SIZE_SAFETY_MARGIN) /* Check for overrun */
{
- *errorcodeptr = ERR52;
+ *errorcodeptr = (code >= cd->start_workspace + cd->workspace_size)?
+ ERR52 : ERR87;
goto FAILED;
}
@@ -3877,16 +4646,16 @@ for (;; ptr++)
/* In the real compile phase, just check the workspace used by the forward
reference list. */
- else if (cd->hwm > cd->start_workspace + cd->workspace_size -
- WORK_SIZE_SAFETY_MARGIN)
+ else if (cd->hwm > cd->start_workspace + cd->workspace_size)
{
*errorcodeptr = ERR52;
goto FAILED;
}
- /* If in \Q...\E, check for the end; if not, we have a literal */
+ /* If in \Q...\E, check for the end; if not, we have a literal. Otherwise an
+ isolated \E is ignored. */
- if (inescq && c != CHAR_NULL)
+ if (c != CHAR_NULL)
{
if (c == CHAR_BACKSLASH && ptr[1] == CHAR_E)
{
@@ -3894,7 +4663,7 @@ for (;; ptr++)
ptr++;
continue;
}
- else
+ else if (inescq)
{
if (previous_callout != NULL)
{
@@ -3909,58 +4678,97 @@ for (;; ptr++)
}
goto NORMAL_CHAR;
}
- }
-
- /* Fill in length of a previous callout, except when the next thing is
- a quantifier. */
- is_quantifier =
- c == CHAR_ASTERISK || c == CHAR_PLUS || c == CHAR_QUESTION_MARK ||
- (c == CHAR_LEFT_CURLY_BRACKET && is_counted_repeat(ptr+1));
+ /* Check for the start of a \Q...\E sequence. We must do this here rather
+ than later in case it is immediately followed by \E, which turns it into a
+ "do nothing" sequence. */
- if (!is_quantifier && previous_callout != NULL &&
- after_manual_callout-- <= 0)
- {
- if (lengthptr == NULL) /* Don't attempt in pre-compile phase */
- complete_callout(previous_callout, ptr, cd);
- previous_callout = NULL;
+ if (c == CHAR_BACKSLASH && ptr[1] == CHAR_Q)
+ {
+ inescq = TRUE;
+ ptr++;
+ continue;
+ }
}
/* In extended mode, skip white space and comments. */
if ((options & PCRE_EXTENDED) != 0)
{
- if (MAX_255(*ptr) && (cd->ctypes[c] & ctype_space) != 0) continue;
+ const pcre_uchar *wscptr = ptr;
+ while (MAX_255(c) && (cd->ctypes[c] & ctype_space) != 0) c = *(++ptr);
if (c == CHAR_NUMBER_SIGN)
{
ptr++;
while (*ptr != CHAR_NULL)
{
- if (IS_NEWLINE(ptr)) { ptr += cd->nllen - 1; break; }
+ if (IS_NEWLINE(ptr)) /* For non-fixed-length newline cases, */
+ { /* IS_NEWLINE sets cd->nllen. */
+ ptr += cd->nllen;
+ break;
+ }
ptr++;
#ifdef SUPPORT_UTF
if (utf) FORWARDCHAR(ptr);
#endif
}
- if (*ptr != CHAR_NULL) continue;
+ }
- /* Else fall through to handle end of string */
- c = 0;
+ /* If we skipped any characters, restart the loop. Otherwise, we didn't see
+ a comment. */
+
+ if (ptr > wscptr) goto REDO_LOOP;
+ }
+
+ /* Skip over (?# comments. We need to do this here because we want to know if
+ the next thing is a quantifier, and these comments may come between an item
+ and its quantifier. */
+
+ if (c == CHAR_LEFT_PARENTHESIS && ptr[1] == CHAR_QUESTION_MARK &&
+ ptr[2] == CHAR_NUMBER_SIGN)
+ {
+ ptr += 3;
+ while (*ptr != CHAR_NULL && *ptr != CHAR_RIGHT_PARENTHESIS) ptr++;
+ if (*ptr == CHAR_NULL)
+ {
+ *errorcodeptr = ERR18;
+ goto FAILED;
}
+ continue;
+ }
+
+ /* See if the next thing is a quantifier. */
+
+ is_quantifier =
+ c == CHAR_ASTERISK || c == CHAR_PLUS || c == CHAR_QUESTION_MARK ||
+ (c == CHAR_LEFT_CURLY_BRACKET && is_counted_repeat(ptr+1));
+
+ /* Fill in length of a previous callout, except when the next thing is a
+ quantifier or when processing a property substitution string in UCP mode. */
+
+ if (!is_quantifier && previous_callout != NULL && nestptr == NULL &&
+ after_manual_callout-- <= 0)
+ {
+ if (lengthptr == NULL) /* Don't attempt in pre-compile phase */
+ complete_callout(previous_callout, ptr, cd);
+ previous_callout = NULL;
}
- /* No auto callout for quantifiers. */
+ /* Create auto callout, except for quantifiers, or while processing property
+ strings that are substituted for \w etc in UCP mode. */
- if ((options & PCRE_AUTO_CALLOUT) != 0 && !is_quantifier)
+ if ((options & PCRE_AUTO_CALLOUT) != 0 && !is_quantifier && nestptr == NULL)
{
previous_callout = code;
code = auto_callout(code, ptr, cd);
}
+ /* Process the next pattern item. */
+
switch(c)
{
/* ===================================================================*/
- case 0: /* The branch terminates at string end */
+ case CHAR_NULL: /* The branch terminates at string end */
case CHAR_VERTICAL_LINE: /* or | or ) */
case CHAR_RIGHT_PARENTHESIS:
*firstcharptr = firstchar;
@@ -3990,7 +4798,8 @@ for (;; ptr++)
previous = NULL;
if ((options & PCRE_MULTILINE) != 0)
{
- if (firstcharflags == REQ_UNSET) firstcharflags = REQ_NONE;
+ if (firstcharflags == REQ_UNSET)
+ zerofirstcharflags = firstcharflags = REQ_NONE;
*code++ = OP_CIRCM;
}
else *code++ = OP_CIRC;
@@ -4011,6 +4820,7 @@ for (;; ptr++)
zeroreqchar = reqchar;
zeroreqcharflags = reqcharflags;
previous = code;
+ item_hwm_offset = cd->hwm - cd->start_workspace;
*code++ = ((options & PCRE_DOTALL) != 0)? OP_ALLANY: OP_ANY;
break;
@@ -4038,8 +4848,31 @@ for (;; ptr++)
}
goto NORMAL_CHAR;
+ /* In another (POSIX) regex library, the ugly syntax [[:<:]] and [[:>:]] is
+ used for "start of word" and "end of word". As these are otherwise illegal
+ sequences, we don't break anything by recognizing them. They are replaced
+ by \b(?=\w) and \b(?<=\w) respectively. Sequences like [a[:<:]] are
+ erroneous and are handled by the normal code below. */
+
case CHAR_LEFT_SQUARE_BRACKET:
+ if (STRNCMP_UC_C8(ptr+1, STRING_WEIRD_STARTWORD, 6) == 0)
+ {
+ nestptr = ptr + 7;
+ ptr = sub_start_of_word;
+ goto REDO_LOOP;
+ }
+
+ if (STRNCMP_UC_C8(ptr+1, STRING_WEIRD_ENDWORD, 6) == 0)
+ {
+ nestptr = ptr + 7;
+ ptr = sub_end_of_word;
+ goto REDO_LOOP;
+ }
+
+ /* Handle a real character class. */
+
previous = code;
+ item_hwm_offset = cd->hwm - cd->start_workspace;
/* PCRE supports POSIX class stuff inside a class. Perl gives an error if
they are encountered at the top level, so we'll do that too. */
@@ -4095,13 +4928,26 @@ for (;; ptr++)
should_flip_negation = FALSE;
+ /* Extended class (xclass) will be used when characters > 255
+ might match. */
+
+#if defined SUPPORT_UTF || !defined COMPILE_PCRE8
+ xclass = FALSE;
+ class_uchardata = code + LINK_SIZE + 2; /* For XCLASS items */
+ class_uchardata_base = class_uchardata; /* Save the start */
+#endif
+
/* For optimization purposes, we track some properties of the class:
class_has_8bitchar will be non-zero if the class contains at least one <
256 character; class_one_char will be 1 if the class contains just one
- character. */
+ character; xclass_has_prop will be TRUE if unicode property checks
+ are present in the class. */
class_has_8bitchar = 0;
class_one_char = 0;
+#if defined SUPPORT_UTF || !defined COMPILE_PCRE8
+ xclass_has_prop = FALSE;
+#endif
/* Initialize the 32-char bit map to all zeros. We build the map in a
temporary bit of memory, in case the class contains fewer than two
@@ -4110,12 +4956,6 @@ for (;; ptr++)
memset(classbits, 0, 32 * sizeof(pcre_uint8));
-#if defined SUPPORT_UTF || !defined COMPILE_PCRE8
- xclass = FALSE;
- class_uchardata = code + LINK_SIZE + 2; /* For XCLASS items */
- class_uchardata_base = class_uchardata; /* Save the start */
-#endif
-
/* Process characters until ] is reached. By writing this as a "do" it
means that an initial ] is taken as a data character. At the start of the
loop, c contains the first byte of the character. */
@@ -4138,10 +4978,11 @@ for (;; ptr++)
(which is on the stack). We have to remember that there was XCLASS data,
however. */
+ if (class_uchardata > class_uchardata_base) xclass = TRUE;
+
if (lengthptr != NULL && class_uchardata > class_uchardata_base)
{
- xclass = TRUE;
- *lengthptr += class_uchardata - class_uchardata_base;
+ *lengthptr += (int)(class_uchardata - class_uchardata_base);
class_uchardata = class_uchardata_base;
}
#endif
@@ -4203,24 +5044,77 @@ for (;; ptr++)
posix_class = 0;
/* When PCRE_UCP is set, some of the POSIX classes are converted to
- different escape sequences that use Unicode properties. */
+ different escape sequences that use Unicode properties \p or \P. Others
+ that are not available via \p or \P generate XCL_PROP/XCL_NOTPROP
+ directly. */
#ifdef SUPPORT_UCP
if ((options & PCRE_UCP) != 0)
{
+ unsigned int ptype = 0;
int pc = posix_class + ((local_negate)? POSIX_SUBSIZE/2 : 0);
+
+ /* The posix_substitutes table specifies which POSIX classes can be
+ converted to \p or \P items. */
+
if (posix_substitutes[pc] != NULL)
{
nestptr = tempptr + 1;
ptr = posix_substitutes[pc] - 1;
continue;
}
+
+ /* There are three other classes that generate special property calls
+ that are recognized only in an XCLASS. */
+
+ else switch(posix_class)
+ {
+ case PC_GRAPH:
+ ptype = PT_PXGRAPH;
+ /* Fall through */
+ case PC_PRINT:
+ if (ptype == 0) ptype = PT_PXPRINT;
+ /* Fall through */
+ case PC_PUNCT:
+ if (ptype == 0) ptype = PT_PXPUNCT;
+ *class_uchardata++ = local_negate? XCL_NOTPROP : XCL_PROP;
+ *class_uchardata++ = ptype;
+ *class_uchardata++ = 0;
+ xclass_has_prop = TRUE;
+ ptr = tempptr + 1;
+ continue;
+
+ /* For the other POSIX classes (ascii, cntrl, xdigit) we are going
+ to fall through to the non-UCP case and build a bit map for
+ characters with code points less than 256. If we are in a negated
+ POSIX class, characters with code points greater than 255 must
+ either all match or all not match. In the special case where we
+ have not yet generated any xclass data, and this is the final item
+ in the overall class, we need do nothing: later on, the opcode
+ OP_NCLASS will be used to indicate that characters greater than 255
+ are acceptable. If we have already seen an xclass item or one may
+ follow (we have to assume that it might if this is not the end of
+ the class), explicitly list all wide codepoints, which will then
+ either not match or match, depending on whether the class is or is
+ not negated. */
+
+ default:
+ if (local_negate &&
+ (xclass || tempptr[2] != CHAR_RIGHT_SQUARE_BRACKET))
+ {
+ *class_uchardata++ = XCL_RANGE;
+ class_uchardata += PRIV(ord2utf)(0x100, class_uchardata);
+ class_uchardata += PRIV(ord2utf)(0x10ffff, class_uchardata);
+ }
+ break;
+ }
}
#endif
- /* In the non-UCP case, we build the bit map for the POSIX class in a
- chunk of local store because we may be adding and subtracting from it,
- and we don't want to subtract bits that may be in the main map already.
- At the end we or the result into the bit map that is being built. */
+ /* In the non-UCP case, or when UCP makes no difference, we build the
+ bit map for the POSIX class in a chunk of local store because we may be
+ adding and subtracting from it, and we don't want to subtract bits that
+ may be in the main map already. At the end we or the result into the
+ bit map that is being built. */
posix_class *= 3;
@@ -4337,21 +5231,20 @@ for (;; ptr++)
for (c = 0; c < 32; c++) classbits[c] |= ~cbits[c+cbit_word];
continue;
- /* Perl 5.004 onwards omits VT from \s, but we must preserve it
- if it was previously set by something earlier in the character
- class. Luckily, the value of CHAR_VT is 0x0b in both ASCII and
- EBCDIC, so we lazily just adjust the appropriate bit. */
+ /* Perl 5.004 onwards omitted VT from \s, but restored it at Perl
+ 5.18. Before PCRE 8.34, we had to preserve the VT bit if it was
+ previously set by something earlier in the character class.
+ Luckily, the value of CHAR_VT is 0x0b in both ASCII and EBCDIC, so
+ we could just adjust the appropriate bit. From PCRE 8.34 we no
+ longer treat \s and \S specially. */
case ESC_s:
- classbits[0] |= cbits[cbit_space];
- classbits[1] |= cbits[cbit_space+1] & ~0x08;
- for (c = 2; c < 32; c++) classbits[c] |= cbits[c+cbit_space];
+ for (c = 0; c < 32; c++) classbits[c] |= cbits[c+cbit_space];
continue;
case ESC_S:
should_flip_negation = TRUE;
for (c = 0; c < 32; c++) classbits[c] |= ~cbits[c+cbit_space];
- classbits[1] |= 0x08; /* Perl 5.004 onwards omits VT from \s */
continue;
/* The rest apply in both UCP and non-UCP cases. */
@@ -4376,9 +5269,9 @@ for (;; ptr++)
cd, PRIV(vspace_list));
continue;
-#ifdef SUPPORT_UCP
case ESC_p:
case ESC_P:
+#ifdef SUPPORT_UCP
{
BOOL negated;
unsigned int ptype = 0, pdata = 0;
@@ -4388,9 +5281,13 @@ for (;; ptr++)
XCL_PROP : XCL_NOTPROP;
*class_uchardata++ = ptype;
*class_uchardata++ = pdata;
+ xclass_has_prop = TRUE;
class_has_8bitchar--; /* Undo! */
continue;
}
+#else
+ *errorcodeptr = ERR45;
+ goto FAILED;
#endif
/* Unrecognized escapes are faulted if PCRE is running in its
strict mode. By default, for compatibility with Perl, they are
@@ -4473,26 +5370,43 @@ for (;; ptr++)
#endif
d = *ptr; /* Not UTF-8 mode */
- /* The second part of a range can be a single-character escape, but
- not any of the other escapes. Perl 5.6 treats a hyphen as a literal
- in such circumstances. */
+ /* The second part of a range can be a single-character escape
+ sequence, but not any of the other escapes. Perl treats a hyphen as a
+ literal in such circumstances. However, in Perl's warning mode, a
+ warning is given, so PCRE now faults it as it is almost certainly a
+ mistake on the user's part. */
- if (!inescq && d == CHAR_BACKSLASH)
+ if (!inescq)
{
- int descape;
- descape = check_escape(&ptr, &d, errorcodeptr, cd->bracount, options, TRUE);
- if (*errorcodeptr != 0) goto FAILED;
+ if (d == CHAR_BACKSLASH)
+ {
+ int descape;
+ descape = check_escape(&ptr, &d, errorcodeptr, cd->bracount, options, TRUE);
+ if (*errorcodeptr != 0) goto FAILED;
- /* \b is backspace; any other special means the '-' was literal. */
+ /* 0 means a character was put into d; \b is backspace; any other
+ special causes an error. */
- if (descape != 0)
- {
- if (descape == ESC_b) d = CHAR_BS; else
+ if (descape != 0)
{
- ptr = oldptr;
- goto CLASS_SINGLE_CHARACTER; /* A few lines below */
+ if (descape == ESC_b) d = CHAR_BS; else
+ {
+ *errorcodeptr = ERR83;
+ goto FAILED;
+ }
}
}
+
+ /* A hyphen followed by a POSIX class is treated in the same way. */
+
+ else if (d == CHAR_LEFT_SQUARE_BRACKET &&
+ (ptr[1] == CHAR_COLON || ptr[1] == CHAR_DOT ||
+ ptr[1] == CHAR_EQUALS_SIGN) &&
+ check_posix_syntax(ptr, &tempptr))
+ {
+ *errorcodeptr = ERR83;
+ goto FAILED;
+ }
}
/* Check that the two values are in the correct order. Optimize
@@ -4530,16 +5444,20 @@ for (;; ptr++)
CLASS_SINGLE_CHARACTER:
if (class_one_char < 2) class_one_char++;
- /* If class_one_char is 1, we have the first single character in the
- class, and there have been no prior ranges, or XCLASS items generated by
- escapes. If this is the final character in the class, we can optimize by
- turning the item into a 1-character OP_CHAR[I] if it's positive, or
- OP_NOT[I] if it's negative. In the positive case, it can cause firstchar
- to be set. Otherwise, there can be no first char if this item is first,
- whatever repeat count may follow. In the case of reqchar, save the
- previous value for reinstating. */
+ /* If xclass_has_prop is false and class_one_char is 1, we have the first
+ single character in the class, and there have been no prior ranges, or
+ XCLASS items generated by escapes. If this is the final character in the
+ class, we can optimize by turning the item into a 1-character OP_CHAR[I]
+ if it's positive, or OP_NOT[I] if it's negative. In the positive case, it
+ can cause firstchar to be set. Otherwise, there can be no first char if
+ this item is first, whatever repeat count may follow. In the case of
+ reqchar, save the previous value for reinstating. */
- if (class_one_char == 1 && ptr[1] == CHAR_RIGHT_SQUARE_BRACKET)
+ if (!inescq &&
+#ifdef SUPPORT_UCP
+ !xclass_has_prop &&
+#endif
+ class_one_char == 1 && ptr[1] == CHAR_RIGHT_SQUARE_BRACKET)
{
ptr++;
zeroreqchar = reqchar;
@@ -4655,16 +5573,46 @@ for (;; ptr++)
actual compiled code. */
#ifdef SUPPORT_UTF
- if (xclass && (!should_flip_negation || (options & PCRE_UCP) != 0))
+ if (xclass && (xclass_has_prop || !should_flip_negation ||
+ (options & PCRE_UCP) != 0))
#elif !defined COMPILE_PCRE8
- if (xclass && !should_flip_negation)
+ if (xclass && (xclass_has_prop || !should_flip_negation))
#endif
#if defined SUPPORT_UTF || !defined COMPILE_PCRE8
{
+ /* For non-UCP wide characters, in a non-negative class containing \S or
+ similar (should_flip_negation is set), all characters greater than 255
+ must be in the class. */
+
+ if (
+#if defined COMPILE_PCRE8
+ utf &&
+#endif
+ should_flip_negation && !negate_class && (options & PCRE_UCP) == 0)
+ {
+ *class_uchardata++ = XCL_RANGE;
+ if (utf) /* Will always be utf in the 8-bit library */
+ {
+ class_uchardata += PRIV(ord2utf)(0x100, class_uchardata);
+ class_uchardata += PRIV(ord2utf)(0x10ffff, class_uchardata);
+ }
+ else /* Can only happen for the 16-bit & 32-bit libraries */
+ {
+#if defined COMPILE_PCRE16
+ *class_uchardata++ = 0x100;
+ *class_uchardata++ = 0xffffu;
+#elif defined COMPILE_PCRE32
+ *class_uchardata++ = 0x100;
+ *class_uchardata++ = 0xffffffffu;
+#endif
+ }
+ }
+
*class_uchardata++ = XCL_END; /* Marks the end of extra data */
*code++ = OP_XCLASS;
code += LINK_SIZE;
*code = negate_class? XCL_NOT:0;
+ if (xclass_has_prop) *code |= XCL_HASPROP;
/* If the map is required, move up the extra data to make room for it;
otherwise just move the code pointer to the end of the extra data. */
@@ -4674,6 +5622,8 @@ for (;; ptr++)
*code++ |= XCL_MAP;
memmove(code + (32 / sizeof(pcre_uchar)), code,
IN_UCHARS(class_uchardata - code));
+ if (negate_class && !xclass_has_prop)
+ for (c = 0; c < 32; c++) classbits[c] = ~classbits[c];
memcpy(code, classbits, 32);
code = class_uchardata + (32 / sizeof(pcre_uchar));
}
@@ -4684,6 +5634,12 @@ for (;; ptr++)
PUT(previous, 1, (int)(code - previous));
break; /* End of class handling */
}
+
+ /* Even though any XCLASS list is now discarded, we must allow for
+ its memory. */
+
+ if (lengthptr != NULL)
+ *lengthptr += (int)(class_uchardata - class_uchardata_base);
#endif
/* If there are no characters > 255, or they are all to be included or
@@ -4756,6 +5712,49 @@ for (;; ptr++)
tempcode = previous;
+ /* Before checking for a possessive quantifier, we must skip over
+ whitespace and comments in extended mode because Perl allows white space at
+ this point. */
+
+ if ((options & PCRE_EXTENDED) != 0)
+ {
+ const pcre_uchar *p = ptr + 1;
+ for (;;)
+ {
+ while (MAX_255(*p) && (cd->ctypes[*p] & ctype_space) != 0) p++;
+ if (*p != CHAR_NUMBER_SIGN) break;
+ p++;
+ while (*p != CHAR_NULL)
+ {
+ if (IS_NEWLINE(p)) /* For non-fixed-length newline cases, */
+ { /* IS_NEWLINE sets cd->nllen. */
+ p += cd->nllen;
+ break;
+ }
+ p++;
+#ifdef SUPPORT_UTF
+ if (utf) FORWARDCHAR(p);
+#endif
+ } /* Loop for comment characters */
+ } /* Loop for multiple comments */
+ ptr = p - 1; /* Character before the next significant one. */
+ }
+
+ /* We also need to skip over (?# comments, which are not dependent on
+ extended mode. */
+
+ if (ptr[1] == CHAR_LEFT_PARENTHESIS && ptr[2] == CHAR_QUESTION_MARK &&
+ ptr[3] == CHAR_NUMBER_SIGN)
+ {
+ ptr += 4;
+ while (*ptr != CHAR_NULL && *ptr != CHAR_RIGHT_PARENTHESIS) ptr++;
+ if (*ptr == CHAR_NULL)
+ {
+ *errorcodeptr = ERR18;
+ goto FAILED;
+ }
+ }
+
/* If the next character is '+', we have a possessive quantifier. This
implies greediness, whatever the setting of the PCRE_UNGREEDY option.
If the next character is '?' this is a minimizing repeat, by default,
@@ -4850,19 +5849,6 @@ for (;; ptr++)
}
}
- /* If the repetition is unlimited, it pays to see if the next thing on
- the line is something that cannot possibly match this character. If so,
- automatically possessifying this item gains some performance in the case
- where the match fails. */
-
- if (!possessive_quantifier &&
- repeat_max < 0 &&
- check_auto_possessive(previous, utf, ptr + 1, options, cd))
- {
- repeat_type = 0; /* Force greedy */
- possessive_quantifier = TRUE;
- }
-
goto OUTPUT_SINGLE_REPEAT; /* Code shared with single character types */
}
@@ -4880,14 +5866,6 @@ for (;; ptr++)
op_type = OP_TYPESTAR - OP_STAR; /* Use type opcodes */
c = *previous;
- if (!possessive_quantifier &&
- repeat_max < 0 &&
- check_auto_possessive(previous, utf, ptr + 1, options, cd))
- {
- repeat_type = 0; /* Force greedy */
- possessive_quantifier = TRUE;
- }
-
OUTPUT_SINGLE_REPEAT:
if (*previous == OP_PROP || *previous == OP_NOTPROP)
{
@@ -5036,13 +6014,12 @@ for (;; ptr++)
/* If previous was a character class or a back reference, we put the repeat
stuff after it, but just skip the item if the repeat was {0,0}. */
- else if (*previous == OP_CLASS ||
- *previous == OP_NCLASS ||
+ else if (*previous == OP_CLASS || *previous == OP_NCLASS ||
#if defined SUPPORT_UTF || !defined COMPILE_PCRE8
*previous == OP_XCLASS ||
#endif
- *previous == OP_REF ||
- *previous == OP_REFI)
+ *previous == OP_REF || *previous == OP_REFI ||
+ *previous == OP_DNREF || *previous == OP_DNREFI)
{
if (repeat_max == 0)
{
@@ -5070,13 +6047,15 @@ for (;; ptr++)
opcodes such as BRA and CBRA, as this is the place where they get converted
into the more special varieties such as BRAPOS and SBRA. A test for >=
OP_ASSERT and <= OP_COND includes ASSERT, ASSERT_NOT, ASSERTBACK,
- ASSERTBACK_NOT, ONCE, BRA, CBRA, and COND. Originally, PCRE did not allow
- repetition of assertions, but now it does, for Perl compatibility. */
+ ASSERTBACK_NOT, ONCE, ONCE_NC, BRA, BRAPOS, CBRA, CBRAPOS, and COND.
+ Originally, PCRE did not allow repetition of assertions, but now it does,
+ for Perl compatibility. */
else if (*previous >= OP_ASSERT && *previous <= OP_COND)
{
register int i;
int len = (int)(code - previous);
+ size_t base_hwm_offset = item_hwm_offset;
pcre_uchar *bralink = NULL;
pcre_uchar *brazeroptr = NULL;
@@ -5089,7 +6068,7 @@ for (;; ptr++)
/* There is no sense in actually repeating assertions. The only potential
use of repetition is in cases when the assertion is optional. Therefore,
if the minimum is greater than zero, just ignore the repeat. If the
- maximum is not not zero or one, set it to 1. */
+ maximum is not zero or one, set it to 1. */
if (*previous < OP_ONCE) /* Assertion */
{
@@ -5131,7 +6110,7 @@ for (;; ptr++)
if (repeat_max <= 1) /* Covers 0, 1, and unlimited */
{
*code = OP_END;
- adjust_recurse(previous, 1, utf, cd, save_hwm);
+ adjust_recurse(previous, 1, utf, cd, item_hwm_offset);
memmove(previous + 1, previous, IN_UCHARS(len));
code++;
if (repeat_max == 0)
@@ -5155,7 +6134,7 @@ for (;; ptr++)
{
int offset;
*code = OP_END;
- adjust_recurse(previous, 2 + LINK_SIZE, utf, cd, save_hwm);
+ adjust_recurse(previous, 2 + LINK_SIZE, utf, cd, item_hwm_offset);
memmove(previous + 2 + LINK_SIZE, previous, IN_UCHARS(len));
code += 2 + LINK_SIZE;
*previous++ = OP_BRAZERO + repeat_type;
@@ -5218,26 +6197,25 @@ for (;; ptr++)
for (i = 1; i < repeat_min; i++)
{
pcre_uchar *hc;
- pcre_uchar *this_hwm = cd->hwm;
+ size_t this_hwm_offset = cd->hwm - cd->start_workspace;
memcpy(code, previous, IN_UCHARS(len));
while (cd->hwm > cd->start_workspace + cd->workspace_size -
- WORK_SIZE_SAFETY_MARGIN - (this_hwm - save_hwm))
+ WORK_SIZE_SAFETY_MARGIN -
+ (this_hwm_offset - base_hwm_offset))
{
- int save_offset = save_hwm - cd->start_workspace;
- int this_offset = this_hwm - cd->start_workspace;
*errorcodeptr = expand_workspace(cd);
if (*errorcodeptr != 0) goto FAILED;
- save_hwm = (pcre_uchar *)cd->start_workspace + save_offset;
- this_hwm = (pcre_uchar *)cd->start_workspace + this_offset;
}
- for (hc = save_hwm; hc < this_hwm; hc += LINK_SIZE)
+ for (hc = (pcre_uchar *)cd->start_workspace + base_hwm_offset;
+ hc < (pcre_uchar *)cd->start_workspace + this_hwm_offset;
+ hc += LINK_SIZE)
{
PUT(cd->hwm, 0, GET(hc, 0) + len);
cd->hwm += LINK_SIZE;
}
- save_hwm = this_hwm;
+ base_hwm_offset = this_hwm_offset;
code += len;
}
}
@@ -5282,7 +6260,7 @@ for (;; ptr++)
else for (i = repeat_max - 1; i >= 0; i--)
{
pcre_uchar *hc;
- pcre_uchar *this_hwm = cd->hwm;
+ size_t this_hwm_offset = cd->hwm - cd->start_workspace;
*code++ = OP_BRAZERO + repeat_type;
@@ -5304,22 +6282,21 @@ for (;; ptr++)
copying them. */
while (cd->hwm > cd->start_workspace + cd->workspace_size -
- WORK_SIZE_SAFETY_MARGIN - (this_hwm - save_hwm))
+ WORK_SIZE_SAFETY_MARGIN -
+ (this_hwm_offset - base_hwm_offset))
{
- int save_offset = save_hwm - cd->start_workspace;
- int this_offset = this_hwm - cd->start_workspace;
*errorcodeptr = expand_workspace(cd);
if (*errorcodeptr != 0) goto FAILED;
- save_hwm = (pcre_uchar *)cd->start_workspace + save_offset;
- this_hwm = (pcre_uchar *)cd->start_workspace + this_offset;
}
- for (hc = save_hwm; hc < this_hwm; hc += LINK_SIZE)
+ for (hc = (pcre_uchar *)cd->start_workspace + base_hwm_offset;
+ hc < (pcre_uchar *)cd->start_workspace + this_hwm_offset;
+ hc += LINK_SIZE)
{
PUT(cd->hwm, 0, GET(hc, 0) + len + ((i != 0)? 2+LINK_SIZE : 1));
cd->hwm += LINK_SIZE;
}
- save_hwm = this_hwm;
+ base_hwm_offset = this_hwm_offset;
code += len;
}
@@ -5392,7 +6369,7 @@ for (;; ptr++)
pcre_uchar *scode = bracode;
do
{
- if (could_be_empty_branch(scode, ketcode, utf, cd))
+ if (could_be_empty_branch(scode, ketcode, utf, cd, NULL))
{
*bracode += OP_SBRA - OP_BRA;
break;
@@ -5402,6 +6379,12 @@ for (;; ptr++)
while (*scode == OP_ALT);
}
+ /* A conditional group with only one branch has an implicit empty
+ alternative branch. */
+
+ if (*bracode == OP_COND && bracode[GET(bracode,1)] != OP_ALT)
+ *bracode = OP_SCOND;
+
/* Handle possessive quantifiers. */
if (possessive_quantifier)
@@ -5415,11 +6398,11 @@ for (;; ptr++)
{
int nlen = (int)(code - bracode);
*code = OP_END;
- adjust_recurse(bracode, 1 + LINK_SIZE, utf, cd, save_hwm);
+ adjust_recurse(bracode, 1 + LINK_SIZE, utf, cd, item_hwm_offset);
memmove(bracode + 1 + LINK_SIZE, bracode, IN_UCHARS(nlen));
code += 1 + LINK_SIZE;
nlen += 1 + LINK_SIZE;
- *bracode = OP_BRAPOS;
+ *bracode = (*bracode == OP_COND)? OP_BRAPOS : OP_SBRAPOS;
*code++ = OP_KETRPOS;
PUTINC(code, 0, nlen);
PUT(bracode, 1, nlen);
@@ -5462,43 +6445,105 @@ for (;; ptr++)
goto FAILED;
}
- /* If the character following a repeat is '+', or if certain optimization
- tests above succeeded, possessive_quantifier is TRUE. For some opcodes,
- there are special alternative opcodes for this case. For anything else, we
- wrap the entire repeated item inside OP_ONCE brackets. Logically, the '+'
- notation is just syntactic sugar, taken from Sun's Java package, but the
- special opcodes can optimize it.
+ /* If the character following a repeat is '+', possessive_quantifier is
+ TRUE. For some opcodes, there are special alternative opcodes for this
+ case. For anything else, we wrap the entire repeated item inside OP_ONCE
+ brackets. Logically, the '+' notation is just syntactic sugar, taken from
+ Sun's Java package, but the special opcodes can optimize it.
Some (but not all) possessively repeated subpatterns have already been
completely handled in the code just above. For them, possessive_quantifier
- is always FALSE at this stage.
-
- Note that the repeated item starts at tempcode, not at previous, which
- might be the first part of a string whose (former) last char we repeated.
-
- Possessifying an 'exact' quantifier has no effect, so we can ignore it. But
- an 'upto' may follow. We skip over an 'exact' item, and then test the
- length of what remains before proceeding. */
+ is always FALSE at this stage. Note that the repeated item starts at
+ tempcode, not at previous, which might be the first part of a string whose
+ (former) last char we repeated. */
if (possessive_quantifier)
{
int len;
- if (*tempcode == OP_TYPEEXACT)
+ /* Possessifying an EXACT quantifier has no effect, so we can ignore it.
+ However, QUERY, STAR, or UPTO may follow (for quantifiers such as {5,6},
+ {5,}, or {5,10}). We skip over an EXACT item; if the length of what
+ remains is greater than zero, there's a further opcode that can be
+ handled. If not, do nothing, leaving the EXACT alone. */
+
+ switch(*tempcode)
+ {
+ case OP_TYPEEXACT:
tempcode += PRIV(OP_lengths)[*tempcode] +
((tempcode[1 + IMM2_SIZE] == OP_PROP
|| tempcode[1 + IMM2_SIZE] == OP_NOTPROP)? 2 : 0);
+ break;
- else if (*tempcode == OP_EXACT || *tempcode == OP_NOTEXACT)
- {
+ /* CHAR opcodes are used for exacts whose count is 1. */
+
+ case OP_CHAR:
+ case OP_CHARI:
+ case OP_NOT:
+ case OP_NOTI:
+ case OP_EXACT:
+ case OP_EXACTI:
+ case OP_NOTEXACT:
+ case OP_NOTEXACTI:
tempcode += PRIV(OP_lengths)[*tempcode];
#ifdef SUPPORT_UTF
if (utf && HAS_EXTRALEN(tempcode[-1]))
tempcode += GET_EXTRALEN(tempcode[-1]);
#endif
+ break;
+
+ /* For the class opcodes, the repeat operator appears at the end;
+ adjust tempcode to point to it. */
+
+ case OP_CLASS:
+ case OP_NCLASS:
+ tempcode += 1 + 32/sizeof(pcre_uchar);
+ break;
+
+#if defined SUPPORT_UTF || !defined COMPILE_PCRE8
+ case OP_XCLASS:
+ tempcode += GET(tempcode, 1);
+ break;
+#endif
}
+ /* If tempcode is equal to code (which points to the end of the repeated
+ item), it means we have skipped an EXACT item but there is no following
+ QUERY, STAR, or UPTO; the value of len will be 0, and we do nothing. In
+ all other cases, tempcode will be pointing to the repeat opcode, and will
+ be less than code, so the value of len will be greater than 0. */
+
len = (int)(code - tempcode);
+ if (len > 0)
+ {
+ unsigned int repcode = *tempcode;
+
+ /* There is a table for possessifying opcodes, all of which are less
+ than OP_CALLOUT. A zero entry means there is no possessified version.
+ */
+
+ if (repcode < OP_CALLOUT && opcode_possessify[repcode] > 0)
+ *tempcode = opcode_possessify[repcode];
+
+ /* For opcode without a special possessified version, wrap the item in
+ ONCE brackets. Because we are moving code along, we must ensure that any
+ pending recursive references are updated. */
+
+ else
+ {
+ *code = OP_END;
+ adjust_recurse(tempcode, 1 + LINK_SIZE, utf, cd, item_hwm_offset);
+ memmove(tempcode + 1 + LINK_SIZE, tempcode, IN_UCHARS(len));
+ code += 1 + LINK_SIZE;
+ len += 1 + LINK_SIZE;
+ tempcode[0] = OP_ONCE;
+ *code++ = OP_KET;
+ PUTINC(code, 0, len);
+ PUT(tempcode, 1, len);
+ }
+ }
+
+#ifdef NEVER
if (len > 0) switch (*tempcode)
{
case OP_STAR: *tempcode = OP_POSSTAR; break;
@@ -5526,12 +6571,17 @@ for (;; ptr++)
case OP_TYPEQUERY: *tempcode = OP_TYPEPOSQUERY; break;
case OP_TYPEUPTO: *tempcode = OP_TYPEPOSUPTO; break;
+ case OP_CRSTAR: *tempcode = OP_CRPOSSTAR; break;
+ case OP_CRPLUS: *tempcode = OP_CRPOSPLUS; break;
+ case OP_CRQUERY: *tempcode = OP_CRPOSQUERY; break;
+ case OP_CRRANGE: *tempcode = OP_CRPOSRANGE; break;
+
/* Because we are moving code along, we must ensure that any
pending recursive references are updated. */
default:
*code = OP_END;
- adjust_recurse(tempcode, 1 + LINK_SIZE, utf, cd, save_hwm);
+ adjust_recurse(tempcode, 1 + LINK_SIZE, utf, cd, item_hwm_offset);
memmove(tempcode + 1 + LINK_SIZE, tempcode, IN_UCHARS(len));
code += 1 + LINK_SIZE;
len += 1 + LINK_SIZE;
@@ -5541,6 +6591,7 @@ for (;; ptr++)
PUT(tempcode, 1, len);
break;
}
+#endif
}
/* In all case we no longer have a previous item. We also set the
@@ -5559,15 +6610,10 @@ for (;; ptr++)
parenthesis forms. */
case CHAR_LEFT_PARENTHESIS:
- newoptions = options;
- skipbytes = 0;
- bravalue = OP_CBRA;
- save_hwm = cd->hwm;
- reset_bracount = FALSE;
+ ptr++;
- /* First deal with various "verbs" that can be introduced by '*'. */
+ /* Now deal with various "verbs" that can be introduced by '*'. */
- ptr++;
if (ptr[0] == CHAR_ASTERISK && (ptr[1] == ':'
|| (MAX_255(ptr[1]) && ((cd->ctypes[ptr[1]] & ctype_letter) != 0))))
{
@@ -5626,8 +6672,21 @@ for (;; ptr++)
cd->had_accept = TRUE;
for (oc = cd->open_caps; oc != NULL; oc = oc->next)
{
- *code++ = OP_CLOSE;
- PUT2INC(code, 0, oc->number);
+ if (lengthptr != NULL)
+ {
+#ifdef COMPILE_PCRE8
+ *lengthptr += 1 + IMM2_SIZE;
+#elif defined COMPILE_PCRE16
+ *lengthptr += 2 + IMM2_SIZE;
+#elif defined COMPILE_PCRE32
+ *lengthptr += 4 + IMM2_SIZE;
+#endif
+ }
+ else
+ {
+ *code++ = OP_CLOSE;
+ PUT2INC(code, 0, oc->number);
+ }
}
setverb = *code++ =
(cd->assert_depth > 0)? OP_ASSERT_ACCEPT : OP_ACCEPT;
@@ -5656,9 +6715,17 @@ for (;; ptr++)
goto FAILED;
}
setverb = *code++ = verbs[i].op_arg;
- *code++ = arglen;
- memcpy(code, arg, IN_UCHARS(arglen));
- code += arglen;
+ if (lengthptr != NULL) /* In pass 1 just add in the length */
+ { /* to avoid potential workspace */
+ *lengthptr += arglen; /* overflow. */
+ *code++ = 0;
+ }
+ else
+ {
+ *code++ = arglen;
+ memcpy(code, arg, IN_UCHARS(arglen));
+ code += arglen;
+ }
*code++ = 0;
}
@@ -5688,10 +6755,18 @@ for (;; ptr++)
goto FAILED;
}
+ /* Initialize for "real" parentheses */
+
+ newoptions = options;
+ skipbytes = 0;
+ bravalue = OP_CBRA;
+ item_hwm_offset = cd->hwm - cd->start_workspace;
+ reset_bracount = FALSE;
+
/* Deal with the extended parentheses; all are introduced by '?', and the
appearance of any of them means that this is not a capturing group. */
- else if (*ptr == CHAR_QUESTION_MARK)
+ if (*ptr == CHAR_QUESTION_MARK)
{
int i, set, unset, namelen;
int *optset;
@@ -5700,20 +6775,10 @@ for (;; ptr++)
switch (*(++ptr))
{
- case CHAR_NUMBER_SIGN: /* Comment; skip to ket */
- ptr++;
- while (*ptr != CHAR_NULL && *ptr != CHAR_RIGHT_PARENTHESIS) ptr++;
- if (*ptr == CHAR_NULL)
- {
- *errorcodeptr = ERR18;
- goto FAILED;
- }
- continue;
-
-
/* ------------------------------------------------------------ */
case CHAR_VERTICAL_LINE: /* Reset capture count for each branch */
reset_bracount = TRUE;
+ cd->dupgroups = TRUE; /* Record (?| encountered */
/* Fall through */
/* ------------------------------------------------------------ */
@@ -5729,17 +6794,16 @@ for (;; ptr++)
tempptr = ptr;
/* A condition can be an assertion, a number (referring to a numbered
- group), a name (referring to a named group), or 'R', referring to
- recursion. R<digits> and R&name are also permitted for recursion tests.
+ group's having been set), a name (referring to a named group), or 'R',
+ referring to recursion. R<digits> and R&name are also permitted for
+ recursion tests.
- There are several syntaxes for testing a named group: (?(name)) is used
- by Python; Perl 5.10 onwards uses (?(<name>) or (?('name')).
+ There are ways of testing a named group: (?(name)) is used by Python;
+ Perl 5.10 onwards uses (?(<name>) or (?('name')).
- There are two unfortunate ambiguities, caused by history. (a) 'R' can
- be the recursive thing or the name 'R' (and similarly for 'R' followed
- by digits), and (b) a number could be a name that consists of digits.
- In both cases, we look for a name first; if not found, we try the other
- cases.
+ There is one unfortunate ambiguity, caused by history. 'R' can be the
+ recursive thing or the name 'R' (and similarly for 'R' followed by
+ digits). We look for a name first; if not found, we try the other case.
For compatibility with auto-callouts, we allow a callout to be
specified before a condition that is an assertion. First, check for the
@@ -5751,6 +6815,15 @@ for (;; ptr++)
for (i = 3;; i++) if (!IS_DIGIT(ptr[i])) break;
if (ptr[i] == CHAR_RIGHT_PARENTHESIS)
tempptr += i + 1;
+
+ /* tempptr should now be pointing to the opening parenthesis of the
+ assertion condition. */
+
+ if (*tempptr != CHAR_LEFT_PARENTHESIS)
+ {
+ *errorcodeptr = ERR28;
+ goto FAILED;
+ }
}
/* For conditions that are assertions, check the syntax, and then exit
@@ -5760,19 +6833,28 @@ for (;; ptr++)
if (tempptr[1] == CHAR_QUESTION_MARK &&
(tempptr[2] == CHAR_EQUALS_SIGN ||
tempptr[2] == CHAR_EXCLAMATION_MARK ||
- tempptr[2] == CHAR_LESS_THAN_SIGN))
+ (tempptr[2] == CHAR_LESS_THAN_SIGN &&
+ (tempptr[3] == CHAR_EQUALS_SIGN ||
+ tempptr[3] == CHAR_EXCLAMATION_MARK))))
+ {
+ cd->iscondassert = TRUE;
break;
+ }
- /* Most other conditions use OP_CREF (a couple change to OP_RREF
- below), and all need to skip 1+IMM2_SIZE bytes at the start of the group. */
+ /* Other conditions use OP_CREF/OP_DNCREF/OP_RREF/OP_DNRREF, and all
+ need to skip at least 1+IMM2_SIZE bytes at the start of the group. */
code[1+LINK_SIZE] = OP_CREF;
skipbytes = 1+IMM2_SIZE;
- refsign = -1;
+ refsign = -1; /* => not a number */
+ namelen = -1; /* => not a name; must set to avoid warning */
+ name = NULL; /* Always set to avoid warning */
+ recno = 0; /* Always set to avoid warning */
/* Check for a test for recursion in a named group. */
- if (ptr[1] == CHAR_R && ptr[2] == CHAR_AMPERSAND)
+ ptr++;
+ if (*ptr == CHAR_R && ptr[1] == CHAR_AMPERSAND)
{
terminator = -1;
ptr += 2;
@@ -5780,14 +6862,15 @@ for (;; ptr++)
}
/* Check for a test for a named group's having been set, using the Perl
- syntax (?(<name>) or (?('name') */
+ syntax (?(<name>) or (?('name'), and also allow for the original PCRE
+ syntax of (?(name) or for (?(+n), (?(-n), and just (?(n). */
- else if (ptr[1] == CHAR_LESS_THAN_SIGN)
+ else if (*ptr == CHAR_LESS_THAN_SIGN)
{
terminator = CHAR_GREATER_THAN_SIGN;
ptr++;
}
- else if (ptr[1] == CHAR_APOSTROPHE)
+ else if (*ptr == CHAR_APOSTROPHE)
{
terminator = CHAR_APOSTROPHE;
ptr++;
@@ -5795,35 +6878,60 @@ for (;; ptr++)
else
{
terminator = CHAR_NULL;
- if (ptr[1] == CHAR_MINUS || ptr[1] == CHAR_PLUS) refsign = *(++ptr);
+ if (*ptr == CHAR_MINUS || *ptr == CHAR_PLUS) refsign = *ptr++;
+ else if (IS_DIGIT(*ptr)) refsign = 0;
}
- /* We now expect to read a name; any thing else is an error */
+ /* Handle a number */
- if (!MAX_255(ptr[1]) || (cd->ctypes[ptr[1]] & ctype_word) == 0)
+ if (refsign >= 0)
{
- ptr += 1; /* To get the right offset */
- *errorcodeptr = ERR28;
- goto FAILED;
+ while (IS_DIGIT(*ptr))
+ {
+ if (recno > INT_MAX / 10 - 1) /* Integer overflow */
+ {
+ while (IS_DIGIT(*ptr)) ptr++;
+ *errorcodeptr = ERR61;
+ goto FAILED;
+ }
+ recno = recno * 10 + (int)(*ptr - CHAR_0);
+ ptr++;
+ }
}
- /* Read the name, but also get it as a number if it's all digits */
+ /* Otherwise we expect to read a name; anything else is an error. When
+ a name is one of a number of duplicates, a different opcode is used and
+ it needs more memory. Unfortunately we cannot tell whether a name is a
+ duplicate in the first pass, so we have to allow for more memory. */
- recno = 0;
- name = ++ptr;
- while (MAX_255(*ptr) && (cd->ctypes[*ptr] & ctype_word) != 0)
+ else
{
- if (recno >= 0)
- recno = (IS_DIGIT(*ptr))? recno * 10 + (int)(*ptr - CHAR_0) : -1;
- ptr++;
+ if (IS_DIGIT(*ptr))
+ {
+ *errorcodeptr = ERR84;
+ goto FAILED;
+ }
+ if (!MAX_255(*ptr) || (cd->ctypes[*ptr] & ctype_word) == 0)
+ {
+ *errorcodeptr = ERR28; /* Assertion expected */
+ goto FAILED;
+ }
+ name = ptr++;
+ while (MAX_255(*ptr) && (cd->ctypes[*ptr] & ctype_word) != 0)
+ {
+ ptr++;
+ }
+ namelen = (int)(ptr - name);
+ if (lengthptr != NULL) skipbytes += IMM2_SIZE;
}
- namelen = (int)(ptr - name);
+
+ /* Check the terminator */
if ((terminator > 0 && *ptr++ != (pcre_uchar)terminator) ||
*ptr++ != CHAR_RIGHT_PARENTHESIS)
{
- ptr--; /* Error offset */
- *errorcodeptr = ERR26;
+ ptr--; /* Error offset */
+ *errorcodeptr = ERR26; /* Malformed number or name */
goto FAILED;
}
@@ -5832,63 +6940,75 @@ for (;; ptr++)
if (lengthptr != NULL) break;
/* In the real compile we do the work of looking for the actual
- reference. If the string started with "+" or "-" we require the rest to
- be digits, in which case recno will be set. */
+ reference. If refsign is not negative, it means we have a number in
+ recno. */
- if (refsign > 0)
+ if (refsign >= 0)
{
if (recno <= 0)
{
- *errorcodeptr = ERR58;
+ *errorcodeptr = ERR35;
goto FAILED;
}
- recno = (refsign == CHAR_MINUS)?
- cd->bracount - recno + 1 : recno +cd->bracount;
+ if (refsign != 0) recno = (refsign == CHAR_MINUS)?
+ cd->bracount - recno + 1 : recno + cd->bracount;
if (recno <= 0 || recno > cd->final_bracount)
{
*errorcodeptr = ERR15;
goto FAILED;
}
PUT2(code, 2+LINK_SIZE, recno);
+ if (recno > cd->top_backref) cd->top_backref = recno;
break;
}
- /* Otherwise (did not start with "+" or "-"), start by looking for the
- name. If we find a name, add one to the opcode to change OP_CREF or
- OP_RREF into OP_NCREF or OP_NRREF. These behave exactly the same,
- except they record that the reference was originally to a name. The
- information is used to check duplicate names. */
+ /* Otherwise look for the name. */
slot = cd->name_table;
for (i = 0; i < cd->names_found; i++)
{
- if (STRNCMP_UC_UC(name, slot+IMM2_SIZE, namelen) == 0) break;
+ if (STRNCMP_UC_UC(name, slot+IMM2_SIZE, namelen) == 0 &&
+ slot[IMM2_SIZE+namelen] == 0) break;
slot += cd->name_entry_size;
}
- /* Found a previous named subpattern */
+ /* Found the named subpattern. If the name is duplicated, add one to
+ the opcode to change CREF/RREF into DNCREF/DNRREF and insert
+ appropriate data values. Otherwise, just insert the unique subpattern
+ number. */
if (i < cd->names_found)
{
- recno = GET2(slot, 0);
- PUT2(code, 2+LINK_SIZE, recno);
- code[1+LINK_SIZE]++;
- }
-
- /* Search the pattern for a forward reference */
+ int offset = i++;
+ int count = 1;
+ recno = GET2(slot, 0); /* Number from first found */
+ if (recno > cd->top_backref) cd->top_backref = recno;
+ for (; i < cd->names_found; i++)
+ {
+ slot += cd->name_entry_size;
+ if (STRNCMP_UC_UC(name, slot+IMM2_SIZE, namelen) != 0 ||
+ (slot+IMM2_SIZE)[namelen] != 0) break;
+ count++;
+ }
- else if ((i = find_parens(cd, name, namelen,
- (options & PCRE_EXTENDED) != 0, utf)) > 0)
- {
- PUT2(code, 2+LINK_SIZE, i);
- code[1+LINK_SIZE]++;
+ if (count > 1)
+ {
+ PUT2(code, 2+LINK_SIZE, offset);
+ PUT2(code, 2+LINK_SIZE+IMM2_SIZE, count);
+ skipbytes += IMM2_SIZE;
+ code[1+LINK_SIZE]++;
+ }
+ else /* Not a duplicated name */
+ {
+ PUT2(code, 2+LINK_SIZE, recno);
+ }
}
/* If terminator == CHAR_NULL it means that the name followed directly
after the opening parenthesis [e.g. (?(abc)...] and in this case there
are some further alternatives to try. For the cases where terminator !=
- 0 [things like (?(<name>... or (?('name')... or (?(R&name)... ] we have
- now checked all the possibilities, so give an error. */
+ CHAR_NULL [things like (?(<name>... or (?('name')... or (?(R&name)... ]
+ we have now checked all the possibilities, so give an error. */
else if (terminator != CHAR_NULL)
{
@@ -5909,6 +7029,11 @@ for (;; ptr++)
*errorcodeptr = ERR15;
goto FAILED;
}
+ if (recno > INT_MAX / 10 - 1) /* Integer overflow */
+ {
+ *errorcodeptr = ERR61;
+ goto FAILED;
+ }
recno = recno * 10 + name[i] - CHAR_0;
}
if (recno == 0) recno = RREF_ANY;
@@ -5925,19 +7050,11 @@ for (;; ptr++)
skipbytes = 1;
}
- /* Check for the "name" actually being a subpattern number. We are
- in the second pass here, so final_bracount is set. */
-
- else if (recno > 0 && recno <= cd->final_bracount)
- {
- PUT2(code, 2+LINK_SIZE, recno);
- }
-
- /* Either an unidentified subpattern, or a reference to (?(0) */
+ /* Reference to an unidentified subpattern. */
else
{
- *errorcodeptr = (recno == 0)? ERR35: ERR15;
+ *errorcodeptr = ERR15;
goto FAILED;
}
break;
@@ -5950,11 +7067,18 @@ for (;; ptr++)
ptr++;
break;
+ /* Optimize (?!) to (*FAIL) unless it is quantified - which is a weird
+ thing to do, but Perl allows all assertions to be quantified, and when
+ they contain capturing parentheses there may be a potential use for
+ this feature. Not that that applies to a quantified (?!) but we allow
+ it for uniformity. */
/* ------------------------------------------------------------ */
case CHAR_EXCLAMATION_MARK: /* Negative lookahead */
ptr++;
- if (*ptr == CHAR_RIGHT_PARENTHESIS) /* Optimize (?!) */
+ if (*ptr == CHAR_RIGHT_PARENTHESIS && ptr[1] != CHAR_ASTERISK &&
+ ptr[1] != CHAR_PLUS && ptr[1] != CHAR_QUESTION_MARK &&
+ (ptr[1] != CHAR_LEFT_CURLY_BRACKET || !is_counted_repeat(ptr+2)))
{
*code++ = OP_FAIL;
previous = NULL;
@@ -6047,124 +7171,110 @@ for (;; ptr++)
/* ------------------------------------------------------------ */
DEFINE_NAME: /* Come here from (?< handling */
case CHAR_APOSTROPHE:
+ terminator = (*ptr == CHAR_LESS_THAN_SIGN)?
+ CHAR_GREATER_THAN_SIGN : CHAR_APOSTROPHE;
+ name = ++ptr;
+ if (IS_DIGIT(*ptr))
{
- terminator = (*ptr == CHAR_LESS_THAN_SIGN)?
- CHAR_GREATER_THAN_SIGN : CHAR_APOSTROPHE;
- name = ++ptr;
+ *errorcodeptr = ERR84; /* Group name must start with non-digit */
+ goto FAILED;
+ }
+ while (MAX_255(*ptr) && (cd->ctypes[*ptr] & ctype_word) != 0) ptr++;
+ namelen = (int)(ptr - name);
- while (MAX_255(*ptr) && (cd->ctypes[*ptr] & ctype_word) != 0) ptr++;
- namelen = (int)(ptr - name);
+ /* In the pre-compile phase, do a syntax check, remember the longest
+ name, and then remember the group in a vector, expanding it if
+ necessary. Duplicates for the same number are skipped; other duplicates
+ are checked for validity. In the actual compile, there is nothing to
+ do. */
- /* In the pre-compile phase, just do a syntax check. */
+ if (lengthptr != NULL)
+ {
+ named_group *ng;
+ pcre_uint32 number = cd->bracount + 1;
- if (lengthptr != NULL)
+ if (*ptr != (pcre_uchar)terminator)
{
- if (*ptr != (pcre_uchar)terminator)
- {
- *errorcodeptr = ERR42;
- goto FAILED;
- }
- if (cd->names_found >= MAX_NAME_COUNT)
+ *errorcodeptr = ERR42;
+ goto FAILED;
+ }
+
+ if (cd->names_found >= MAX_NAME_COUNT)
+ {
+ *errorcodeptr = ERR49;
+ goto FAILED;
+ }
+
+ if (namelen + IMM2_SIZE + 1 > cd->name_entry_size)
+ {
+ cd->name_entry_size = namelen + IMM2_SIZE + 1;
+ if (namelen > MAX_NAME_SIZE)
{
- *errorcodeptr = ERR49;
+ *errorcodeptr = ERR48;
goto FAILED;
}
- if (namelen + IMM2_SIZE + 1 > cd->name_entry_size)
+ }
+
+ /* Scan the list to check for duplicates. For duplicate names, if the
+ number is the same, break the loop, which causes the name to be
+ discarded; otherwise, if DUPNAMES is not set, give an error.
+ If it is set, allow the name with a different number, but continue
+ scanning in case this is a duplicate with the same number. For
+ non-duplicate names, give an error if the number is duplicated. */
+
+ ng = cd->named_groups;
+ for (i = 0; i < cd->names_found; i++, ng++)
+ {
+ if (namelen == ng->length &&
+ STRNCMP_UC_UC(name, ng->name, namelen) == 0)
{
- cd->name_entry_size = namelen + IMM2_SIZE + 1;
- if (namelen > MAX_NAME_SIZE)
+ if (ng->number == number) break;
+ if ((options & PCRE_DUPNAMES) == 0)
{
- *errorcodeptr = ERR48;
+ *errorcodeptr = ERR43;
goto FAILED;
}
+ cd->dupnames = TRUE; /* Duplicate names exist */
+ }
+ else if (ng->number == number)
+ {
+ *errorcodeptr = ERR65;
+ goto FAILED;
}
}
- /* In the real compile, create the entry in the table, maintaining
- alphabetical order. Duplicate names for different numbers are
- permitted only if PCRE_DUPNAMES is set. Duplicate names for the same
- number are always OK. (An existing number can be re-used if (?|
- appears in the pattern.) In either event, a duplicate name results in
- a duplicate entry in the table, even if the number is the same. This
- is because the number of names, and hence the table size, is computed
- in the pre-compile, and it affects various numbers and pointers which
- would all have to be modified, and the compiled code moved down, if
- duplicates with the same number were omitted from the table. This
- doesn't seem worth the hassle. However, *different* names for the
- same number are not permitted. */
-
- else
+ if (i >= cd->names_found) /* Not a duplicate with same number */
{
- BOOL dupname = FALSE;
- slot = cd->name_table;
+ /* Increase the list size if necessary */
- for (i = 0; i < cd->names_found; i++)
+ if (cd->names_found >= cd->named_group_list_size)
{
- int crc = memcmp(name, slot+IMM2_SIZE, IN_UCHARS(namelen));
- if (crc == 0)
- {
- if (slot[IMM2_SIZE+namelen] == 0)
- {
- if (GET2(slot, 0) != cd->bracount + 1 &&
- (options & PCRE_DUPNAMES) == 0)
- {
- *errorcodeptr = ERR43;
- goto FAILED;
- }
- else dupname = TRUE;
- }
- else crc = -1; /* Current name is a substring */
- }
-
- /* Make space in the table and break the loop for an earlier
- name. For a duplicate or later name, carry on. We do this for
- duplicates so that in the simple case (when ?(| is not used) they
- are in order of their numbers. */
+ int newsize = cd->named_group_list_size * 2;
+ named_group *newspace = (PUBL(malloc))
+ (newsize * sizeof(named_group));
- if (crc < 0)
+ if (newspace == NULL)
{
- memmove(slot + cd->name_entry_size, slot,
- IN_UCHARS((cd->names_found - i) * cd->name_entry_size));
- break;
+ *errorcodeptr = ERR21;
+ goto FAILED;
}
- /* Continue the loop for a later or duplicate name */
-
- slot += cd->name_entry_size;
- }
-
- /* For non-duplicate names, check for a duplicate number before
- adding the new name. */
-
- if (!dupname)
- {
- pcre_uchar *cslot = cd->name_table;
- for (i = 0; i < cd->names_found; i++)
- {
- if (cslot != slot)
- {
- if (GET2(cslot, 0) == cd->bracount + 1)
- {
- *errorcodeptr = ERR65;
- goto FAILED;
- }
- }
- else i--;
- cslot += cd->name_entry_size;
- }
+ memcpy(newspace, cd->named_groups,
+ cd->named_group_list_size * sizeof(named_group));
+ if (cd->named_group_list_size > NAMED_GROUP_LIST_SIZE)
+ (PUBL(free))((void *)cd->named_groups);
+ cd->named_groups = newspace;
+ cd->named_group_list_size = newsize;
}
- PUT2(slot, 0, cd->bracount + 1);
- memcpy(slot + IMM2_SIZE, name, IN_UCHARS(namelen));
- slot[IMM2_SIZE + namelen] = 0;
+ cd->named_groups[cd->names_found].name = name;
+ cd->named_groups[cd->names_found].length = namelen;
+ cd->named_groups[cd->names_found].number = number;
+ cd->names_found++;
}
}
- /* In both pre-compile and compile, count the number of names we've
- encountered. */
-
- cd->names_found++;
- ptr++; /* Move past > or ' */
+ ptr++; /* Move past > or ' in both passes. */
goto NUMBERED_GROUP;
@@ -6182,6 +7292,11 @@ for (;; ptr++)
NAMED_REF_OR_RECURSE:
name = ++ptr;
+ if (IS_DIGIT(*ptr))
+ {
+ *errorcodeptr = ERR84; /* Group name must start with non-digit */
+ goto FAILED;
+ }
while (MAX_255(*ptr) && (cd->ctypes[*ptr] & ctype_word) != 0) ptr++;
namelen = (int)(ptr - name);
@@ -6194,7 +7309,8 @@ for (;; ptr++)
if (lengthptr != NULL)
{
- const pcre_uchar *temp;
+ named_group *ng;
+ recno = 0;
if (namelen == 0)
{
@@ -6212,27 +7328,76 @@ for (;; ptr++)
goto FAILED;
}
- /* The name table does not exist in the first pass, so we cannot
- do a simple search as in the code below. Instead, we have to scan the
- pattern to find the number. It is important that we scan it only as
- far as we have got because the syntax of named subpatterns has not
- been checked for the rest of the pattern, and find_parens() assumes
- correct syntax. In any case, it's a waste of resources to scan
- further. We stop the scan at the current point by temporarily
- adjusting the value of cd->endpattern. */
-
- temp = cd->end_pattern;
- cd->end_pattern = ptr;
- recno = find_parens(cd, name, namelen,
- (options & PCRE_EXTENDED) != 0, utf);
- cd->end_pattern = temp;
- if (recno < 0) recno = 0; /* Forward ref; set dummy number */
+ /* Count named back references. */
+
+ if (!is_recurse) cd->namedrefcount++;
+
+ /* We have to allow for a named reference to a duplicated name (this
+ cannot be determined until the second pass). This needs an extra
+ 16-bit data item. */
+
+ *lengthptr += IMM2_SIZE;
+
+ /* If this is a forward reference and we are within a (?|...) group,
+ the reference may end up as the number of a group which we are
+ currently inside, that is, it could be a recursive reference. In the
+ real compile this will be picked up and the reference wrapped with
+ OP_ONCE to make it atomic, so we must space in case this occurs. */
+
+ /* In fact, this can happen for a non-forward reference because
+ another group with the same number might be created later. This
+ issue is fixed "properly" in PCRE2. As PCRE1 is now in maintenance
+ only mode, we finesse the bug by allowing more memory always. */
+
+ *lengthptr += 4 + 4*LINK_SIZE;
+
+ /* It is even worse than that. The current reference may be to an
+ existing named group with a different number (so apparently not
+ recursive) but which later on is also attached to a group with the
+ current number. This can only happen if $(| has been previous
+ encountered. In that case, we allow yet more memory, just in case.
+ (Again, this is fixed "properly" in PCRE2. */
+
+ if (cd->dupgroups) *lengthptr += 4 + 4*LINK_SIZE;
+
+ /* Otherwise, check for recursion here. The name table does not exist
+ in the first pass; instead we must scan the list of names encountered
+ so far in order to get the number. If the name is not found, leave
+ the value of recno as 0 for a forward reference. */
+
+ /* This patch (removing "else") fixes a problem when a reference is
+ to multiple identically named nested groups from within the nest.
+ Once again, it is not the "proper" fix, and it results in an
+ over-allocation of memory. */
+
+ /* else */
+ {
+ ng = cd->named_groups;
+ for (i = 0; i < cd->names_found; i++, ng++)
+ {
+ if (namelen == ng->length &&
+ STRNCMP_UC_UC(name, ng->name, namelen) == 0)
+ {
+ open_capitem *oc;
+ recno = ng->number;
+ if (is_recurse) break;
+ for (oc = cd->open_caps; oc != NULL; oc = oc->next)
+ {
+ if (oc->number == recno)
+ {
+ oc->flag = TRUE;
+ break;
+ }
+ }
+ }
+ }
+ }
}
- /* In the real compile, seek the name in the table. We check the name
+ /* In the real compile, search the name table. We check the name
first, and then check that we have reached the end of the name in the
- table. That way, if the name that is longer than any in the table,
- the comparison will fail without reading beyond the table entry. */
+ table. That way, if the name is longer than any in the table, the
+ comparison will fail without reading beyond the table entry. */
else
{
@@ -6245,30 +7410,88 @@ for (;; ptr++)
slot += cd->name_entry_size;
}
- if (i < cd->names_found) /* Back reference */
+ if (i < cd->names_found)
{
recno = GET2(slot, 0);
}
- else if ((recno = /* Forward back reference */
- find_parens(cd, name, namelen,
- (options & PCRE_EXTENDED) != 0, utf)) <= 0)
+ else
{
*errorcodeptr = ERR15;
goto FAILED;
}
}
- /* In both phases, we can now go to the code than handles numerical
- recursion or backreferences. */
+ /* In both phases, for recursions, we can now go to the code than
+ handles numerical recursion. */
if (is_recurse) goto HANDLE_RECURSION;
- else goto HANDLE_REFERENCE;
+
+ /* In the second pass we must see if the name is duplicated. If so, we
+ generate a different opcode. */
+
+ if (lengthptr == NULL && cd->dupnames)
+ {
+ int count = 1;
+ unsigned int index = i;
+ pcre_uchar *cslot = slot + cd->name_entry_size;
+
+ for (i++; i < cd->names_found; i++)
+ {
+ if (STRCMP_UC_UC(slot + IMM2_SIZE, cslot + IMM2_SIZE) != 0) break;
+ count++;
+ cslot += cd->name_entry_size;
+ }
+
+ if (count > 1)
+ {
+ if (firstcharflags == REQ_UNSET) firstcharflags = REQ_NONE;
+ previous = code;
+ item_hwm_offset = cd->hwm - cd->start_workspace;
+ *code++ = ((options & PCRE_CASELESS) != 0)? OP_DNREFI : OP_DNREF;
+ PUT2INC(code, 0, index);
+ PUT2INC(code, 0, count);
+
+ /* Process each potentially referenced group. */
+
+ for (; slot < cslot; slot += cd->name_entry_size)
+ {
+ open_capitem *oc;
+ recno = GET2(slot, 0);
+ cd->backref_map |= (recno < 32)? (1 << recno) : 1;
+ if (recno > cd->top_backref) cd->top_backref = recno;
+
+ /* Check to see if this back reference is recursive, that it, it
+ is inside the group that it references. A flag is set so that the
+ group can be made atomic. */
+
+ for (oc = cd->open_caps; oc != NULL; oc = oc->next)
+ {
+ if (oc->number == recno)
+ {
+ oc->flag = TRUE;
+ break;
+ }
+ }
+ }
+
+ continue; /* End of back ref handling */
+ }
+ }
+
+ /* First pass, or a non-duplicated name. */
+
+ goto HANDLE_REFERENCE;
/* ------------------------------------------------------------ */
- case CHAR_R: /* Recursion */
- ptr++; /* Same as (?0) */
- /* Fall through */
+ case CHAR_R: /* Recursion, same as (?0) */
+ recno = 0;
+ if (*(++ptr) != CHAR_RIGHT_PARENTHESIS)
+ {
+ *errorcodeptr = ERR29;
+ goto FAILED;
+ }
+ goto HANDLE_RECURSION;
/* ------------------------------------------------------------ */
@@ -6305,7 +7528,15 @@ for (;; ptr++)
recno = 0;
while(IS_DIGIT(*ptr))
+ {
+ if (recno > INT_MAX / 10 - 1) /* Integer overflow */
+ {
+ while (IS_DIGIT(*ptr)) ptr++;
+ *errorcodeptr = ERR61;
+ goto FAILED;
+ }
recno = recno * 10 + *ptr++ - CHAR_0;
+ }
if (*ptr != (pcre_uchar)terminator)
{
@@ -6342,6 +7573,7 @@ for (;; ptr++)
HANDLE_RECURSION:
previous = code;
+ item_hwm_offset = cd->hwm - cd->start_workspace;
called = cd->start_code;
/* When we are actually compiling, find the bracket that is being
@@ -6361,8 +7593,7 @@ for (;; ptr++)
if (called == NULL)
{
- if (find_parens(cd, NULL, recno,
- (options & PCRE_EXTENDED) != 0, utf) < 0)
+ if (recno > cd->final_bracount)
{
*errorcodeptr = ERR15;
goto FAILED;
@@ -6450,39 +7681,15 @@ for (;; ptr++)
newoptions = (options | set) & (~unset);
/* If the options ended with ')' this is not the start of a nested
- group with option changes, so the options change at this level. If this
- item is right at the start of the pattern, the options can be
- abstracted and made external in the pre-compile phase, and ignored in
- the compile phase. This can be helpful when matching -- for instance in
- caseless checking of required bytes.
-
- If the code pointer is not (cd->start_code + 1 + LINK_SIZE), we are
- definitely *not* at the start of the pattern because something has been
- compiled. In the pre-compile phase, however, the code pointer can have
- that value after the start, because it gets reset as code is discarded
- during the pre-compile. However, this can happen only at top level - if
- we are within parentheses, the starting BRA will still be present. At
- any parenthesis level, the length value can be used to test if anything
- has been compiled at that level. Thus, a test for both these conditions
- is necessary to ensure we correctly detect the start of the pattern in
- both phases.
-
+ group with option changes, so the options change at this level.
If we are not at the pattern start, reset the greedy defaults and the
case value for firstchar and reqchar. */
if (*ptr == CHAR_RIGHT_PARENTHESIS)
{
- if (code == cd->start_code + 1 + LINK_SIZE &&
- (lengthptr == NULL || *lengthptr == 2 + 2*LINK_SIZE))
- {
- cd->external_options = newoptions;
- }
- else
- {
- greedy_default = ((newoptions & PCRE_UNGREEDY) != 0);
- greedy_non_default = greedy_default ^ 1;
- req_caseopt = ((newoptions & PCRE_CASELESS) != 0)? REQ_CASELESS:0;
- }
+ greedy_default = ((newoptions & PCRE_UNGREEDY) != 0);
+ greedy_non_default = greedy_default ^ 1;
+ req_caseopt = ((newoptions & PCRE_CASELESS) != 0)? REQ_CASELESS:0;
/* Change options at this level, and pass them back for use
in subsequent branches. */
@@ -6521,12 +7728,35 @@ for (;; ptr++)
skipbytes = IMM2_SIZE;
}
- /* Process nested bracketed regex. Assertions used not to be repeatable,
- but this was changed for Perl compatibility, so all kinds can now be
- repeated. We copy code into a non-register variable (tempcode) in order to
- be able to pass its address because some compilers complain otherwise. */
+ /* Process nested bracketed regex. First check for parentheses nested too
+ deeply. */
+
+ if ((cd->parens_depth += 1) > PARENS_NEST_LIMIT)
+ {
+ *errorcodeptr = ERR82;
+ goto FAILED;
+ }
+
+ /* All assertions used not to be repeatable, but this was changed for Perl
+ compatibility. All kinds can now be repeated except for assertions that are
+ conditions (Perl also forbids these to be repeated). We copy code into a
+ non-register variable (tempcode) in order to be able to pass its address
+ because some compilers complain otherwise. At the start of a conditional
+ group whose condition is an assertion, cd->iscondassert is set. We unset it
+ here so as to allow assertions later in the group to be quantified. */
+
+ if (bravalue >= OP_ASSERT && bravalue <= OP_ASSERTBACK_NOT &&
+ cd->iscondassert)
+ {
+ previous = NULL;
+ cd->iscondassert = FALSE;
+ }
+ else
+ {
+ previous = code;
+ item_hwm_offset = cd->hwm - cd->start_workspace;
+ }
- previous = code; /* For handling repetition */
*code = bravalue;
tempcode = code;
tempreqvary = cd->req_varyopt; /* Save value before bracket */
@@ -6555,6 +7785,8 @@ for (;; ptr++)
))
goto FAILED;
+ cd->parens_depth -= 1;
+
/* If this was an atomic group and there are no capturing groups within it,
generate OP_ONCE_NC instead of OP_ONCE. */
@@ -6702,15 +7934,17 @@ for (;; ptr++)
}
}
- /* For a forward assertion, we take the reqchar, if set. This can be
- helpful if the pattern that follows the assertion doesn't set a different
- char. For example, it's useful for /(?=abcde).+/. We can't set firstchar
- for an assertion, however because it leads to incorrect effect for patterns
- such as /(?=a)a.+/ when the "real" "a" would then become a reqchar instead
- of a firstchar. This is overcome by a scan at the end if there's no
- firstchar, looking for an asserted first char. */
-
- else if (bravalue == OP_ASSERT && subreqcharflags >= 0)
+ /* For a forward assertion, we take the reqchar, if set, provided that the
+ group has also set a first char. This can be helpful if the pattern that
+ follows the assertion doesn't set a different char. For example, it's
+ useful for /(?=abcde).+/. We can't set firstchar for an assertion, however
+ because it leads to incorrect effect for patterns such as /(?=a)a.+/ when
+ the "real" "a" would then become a reqchar instead of a firstchar. This is
+ overcome by a scan at the end if there's no firstchar, looking for an
+ asserted first char. */
+
+ else if (bravalue == OP_ASSERT && subreqcharflags >= 0 &&
+ subfirstcharflags >= 0)
{
reqchar = subreqchar;
reqcharflags = subreqcharflags;
@@ -6736,16 +7970,6 @@ for (;; ptr++)
c = ec;
else
{
- if (escape == ESC_Q) /* Handle start of quoted string */
- {
- if (ptr[1] == CHAR_BACKSLASH && ptr[2] == CHAR_E)
- ptr += 2; /* avoid empty string */
- else inescq = TRUE;
- continue;
- }
-
- if (escape == ESC_E) continue; /* Perl ignores an orphan \E */
-
/* For metasequences that actually match a character, we disable the
setting of a first character if it hasn't already been set. */
@@ -6769,51 +7993,38 @@ for (;; ptr++)
if (escape == ESC_g)
{
const pcre_uchar *p;
- save_hwm = cd->hwm; /* Normally this is set when '(' is read */
+ pcre_uint32 cf;
+
+ item_hwm_offset = cd->hwm - cd->start_workspace; /* Normally this is set when '(' is read */
terminator = (*(++ptr) == CHAR_LESS_THAN_SIGN)?
CHAR_GREATER_THAN_SIGN : CHAR_APOSTROPHE;
/* These two statements stop the compiler for warning about possibly
unset variables caused by the jump to HANDLE_NUMERICAL_RECURSION. In
- fact, because we actually check for a number below, the paths that
+ fact, because we do the check for a number below, the paths that
would actually be in error are never taken. */
skipbytes = 0;
reset_bracount = FALSE;
- /* Test for a name */
+ /* If it's not a signed or unsigned number, treat it as a name. */
- if (ptr[1] != CHAR_PLUS && ptr[1] != CHAR_MINUS)
+ cf = ptr[1];
+ if (cf != CHAR_PLUS && cf != CHAR_MINUS && !IS_DIGIT(cf))
{
- BOOL is_a_number = TRUE;
- for (p = ptr + 1; *p != CHAR_NULL && *p != (pcre_uchar)terminator; p++)
- {
- if (!MAX_255(*p)) { is_a_number = FALSE; break; }
- if ((cd->ctypes[*p] & ctype_digit) == 0) is_a_number = FALSE;
- if ((cd->ctypes[*p] & ctype_word) == 0) break;
- }
- if (*p != (pcre_uchar)terminator)
- {
- *errorcodeptr = ERR57;
- break;
- }
- if (is_a_number)
- {
- ptr++;
- goto HANDLE_NUMERICAL_RECURSION;
- }
is_recurse = TRUE;
goto NAMED_REF_OR_RECURSE;
}
- /* Test a signed number in angle brackets or quotes. */
+ /* Signed or unsigned number (cf = ptr[1]) is known to be plus or minus
+ or a digit. */
p = ptr + 2;
while (IS_DIGIT(*p)) p++;
if (*p != (pcre_uchar)terminator)
{
*errorcodeptr = ERR57;
- break;
+ goto FAILED;
}
ptr++;
goto HANDLE_NUMERICAL_RECURSION;
@@ -6828,7 +8039,7 @@ for (;; ptr++)
ptr[1] != CHAR_APOSTROPHE && ptr[1] != CHAR_LEFT_CURLY_BRACKET))
{
*errorcodeptr = ERR69;
- break;
+ goto FAILED;
}
is_recurse = FALSE;
terminator = (*(++ptr) == CHAR_LESS_THAN_SIGN)?
@@ -6846,9 +8057,13 @@ for (;; ptr++)
open_capitem *oc;
recno = -escape;
- HANDLE_REFERENCE: /* Come here from named backref handling */
+ /* Come here from named backref handling when the reference is to a
+ single group (i.e. not to a duplicated name. */
+
+ HANDLE_REFERENCE:
if (firstcharflags == REQ_UNSET) firstcharflags = REQ_NONE;
previous = code;
+ item_hwm_offset = cd->hwm - cd->start_workspace;
*code++ = ((options & PCRE_CASELESS) != 0)? OP_REFI : OP_REF;
PUT2INC(code, 0, recno);
cd->backref_map |= (recno < 32)? (1 << recno) : 1;
@@ -6878,6 +8093,7 @@ for (;; ptr++)
if (!get_ucp(&ptr, &negated, &ptype, &pdata, errorcodeptr))
goto FAILED;
previous = code;
+ item_hwm_offset = cd->hwm - cd->start_workspace;
*code++ = ((escape == ESC_p) != negated)? OP_PROP : OP_NOTPROP;
*code++ = ptype;
*code++ = pdata;
@@ -6918,6 +8134,7 @@ for (;; ptr++)
{
previous = (escape > ESC_b && escape < ESC_Z)? code : NULL;
+ item_hwm_offset = cd->hwm - cd->start_workspace;
*code++ = (!utf && escape == ESC_C)? OP_ALLANY : escape;
}
}
@@ -6943,8 +8160,8 @@ for (;; ptr++)
/* ===================================================================*/
/* Handle a literal character. It is guaranteed not to be whitespace or #
- when the extended flag is set. If we are in UTF-8 mode, it may be a
- multi-byte literal character. */
+ when the extended flag is set. If we are in a UTF mode, it may be a
+ multi-unit literal character. */
default:
NORMAL_CHAR:
@@ -6961,6 +8178,7 @@ for (;; ptr++)
ONE_CHAR:
previous = code;
+ item_hwm_offset = cd->hwm - cd->start_workspace;
/* For caseless UTF-8 mode when UCP support is available, check whether
this character has more than one other case. If so, generate a special
@@ -6975,7 +8193,8 @@ for (;; ptr++)
*code++ = OP_PROP;
*code++ = PT_CLIST;
*code++ = c;
- if (firstcharflags == REQ_UNSET) firstcharflags = zerofirstcharflags = REQ_NONE;
+ if (firstcharflags == REQ_UNSET)
+ firstcharflags = zerofirstcharflags = REQ_NONE;
break;
}
}
@@ -7007,7 +8226,6 @@ for (;; ptr++)
if (mclength == 1 || req_caseopt == 0)
{
- firstchar = mcbuffer[0] | req_caseopt;
firstchar = mcbuffer[0];
firstcharflags = req_caseopt;
@@ -7064,24 +8282,24 @@ out the amount of memory needed, as well as during the real compile phase. The
value of lengthptr distinguishes the two phases.
Arguments:
- options option bits, including any changes for this subpattern
- codeptr -> the address of the current code pointer
- ptrptr -> the address of the current pattern pointer
- errorcodeptr -> pointer to error code variable
- lookbehind TRUE if this is a lookbehind assertion
- reset_bracount TRUE to reset the count for each branch
- skipbytes skip this many bytes at start (for brackets and OP_COND)
- cond_depth depth of nesting for conditional subpatterns
- firstcharptr place to put the first required character
+ options option bits, including any changes for this subpattern
+ codeptr -> the address of the current code pointer
+ ptrptr -> the address of the current pattern pointer
+ errorcodeptr -> pointer to error code variable
+ lookbehind TRUE if this is a lookbehind assertion
+ reset_bracount TRUE to reset the count for each branch
+ skipbytes skip this many bytes at start (for brackets and OP_COND)
+ cond_depth depth of nesting for conditional subpatterns
+ firstcharptr place to put the first required character
firstcharflagsptr place to put the first character flags, or a negative number
- reqcharptr place to put the last required character
- reqcharflagsptr place to put the last required character flags, or a negative number
- bcptr pointer to the chain of currently open branches
- cd points to the data block with tables pointers etc.
- lengthptr NULL during the real compile phase
- points to length accumulator during pre-compile phase
-
-Returns: TRUE on success
+ reqcharptr place to put the last required character
+ reqcharflagsptr place to put the last required character flags, or a negative number
+ bcptr pointer to the chain of currently open branches
+ cd points to the data block with tables pointers etc.
+ lengthptr NULL during the real compile phase
+ points to length accumulator during pre-compile phase
+
+Returns: TRUE on success
*/
static BOOL
@@ -7107,6 +8325,17 @@ int length;
unsigned int orig_bracount;
unsigned int max_bracount;
branch_chain bc;
+size_t save_hwm_offset;
+
+/* If set, call the external function that checks for stack availability. */
+
+if (PUBL(stack_guard) != NULL && PUBL(stack_guard)())
+ {
+ *errorcodeptr= ERR85;
+ return FALSE;
+ }
+
+/* Miscellaneous initialization */
bc.outer = bcptr;
bc.current_branch = code;
@@ -7114,6 +8343,8 @@ bc.current_branch = code;
firstchar = reqchar = 0;
firstcharflags = reqcharflags = REQ_UNSET;
+save_hwm_offset = cd->hwm - cd->start_workspace;
+
/* Accumulate the length for use in the pre-compile phase. Start with the
length of the BRA and KET and any extra bytes that are required at the
beginning. We accumulate in a local variable to save frequent testing of
@@ -7255,7 +8486,7 @@ for (;;)
int fixed_length;
*code = OP_END;
fixed_length = find_fixedlength(last_branch, (options & PCRE_UTF8) != 0,
- FALSE, cd);
+ FALSE, cd, NULL);
DPRINTF(("fixed length = %d\n", fixed_length));
if (fixed_length == -3)
{
@@ -7307,12 +8538,16 @@ for (;;)
/* If it was a capturing subpattern, check to see if it contained any
recursive back references. If so, we must wrap it in atomic brackets.
- In any event, remove the block from the chain. */
+ Because we are moving code along, we must ensure that any pending recursive
+ references are updated. In any event, remove the block from the chain. */
if (capnumber > 0)
{
if (cd->open_caps->flag)
{
+ *code = OP_END;
+ adjust_recurse(start_bracket, 1 + LINK_SIZE,
+ (options & PCRE_UTF8) != 0, cd, save_hwm_offset);
memmove(start_bracket + 1 + LINK_SIZE, start_bracket,
IN_UCHARS(code - start_bracket));
*start_bracket = OP_ONCE;
@@ -7497,8 +8732,8 @@ matching and for non-DOTALL patterns that start with .* (which must start at
the beginning or after \n). As in the case of is_anchored() (see above), we
have to take account of back references to capturing brackets that contain .*
because in that case we can't make the assumption. Also, the appearance of .*
-inside atomic brackets or in a pattern that contains *PRUNE or *SKIP does not
-count, because once again the assumption no longer holds.
+inside atomic brackets or in an assertion, or in a pattern that contains *PRUNE
+or *SKIP does not count, because once again the assumption no longer holds.
Arguments:
code points to start of expression (the bracket)
@@ -7507,13 +8742,14 @@ Arguments:
the less precise approach
cd points to the compile data
atomcount atomic group level
+ inassert TRUE if in an assertion
Returns: TRUE or FALSE
*/
static BOOL
is_startline(const pcre_uchar *code, unsigned int bracket_map,
- compile_data *cd, int atomcount)
+ compile_data *cd, int atomcount, BOOL inassert)
{
do {
const pcre_uchar *scode = first_significant_code(
@@ -7532,14 +8768,15 @@ do {
switch (*scode)
{
case OP_CREF:
- case OP_NCREF:
+ case OP_DNCREF:
case OP_RREF:
- case OP_NRREF:
+ case OP_DNRREF:
case OP_DEF:
+ case OP_FAIL:
return FALSE;
default: /* Assertion */
- if (!is_startline(scode, bracket_map, cd, atomcount)) return FALSE;
+ if (!is_startline(scode, bracket_map, cd, atomcount, TRUE)) return FALSE;
do scode += GET(scode, 1); while (*scode == OP_ALT);
scode += 1 + LINK_SIZE;
break;
@@ -7553,7 +8790,7 @@ do {
if (op == OP_BRA || op == OP_BRAPOS ||
op == OP_SBRA || op == OP_SBRAPOS)
{
- if (!is_startline(scode, bracket_map, cd, atomcount)) return FALSE;
+ if (!is_startline(scode, bracket_map, cd, atomcount, inassert)) return FALSE;
}
/* Capturing brackets */
@@ -7563,33 +8800,33 @@ do {
{
int n = GET2(scode, 1+LINK_SIZE);
int new_map = bracket_map | ((n < 32)? (1 << n) : 1);
- if (!is_startline(scode, new_map, cd, atomcount)) return FALSE;
+ if (!is_startline(scode, new_map, cd, atomcount, inassert)) return FALSE;
}
/* Positive forward assertions */
else if (op == OP_ASSERT)
{
- if (!is_startline(scode, bracket_map, cd, atomcount)) return FALSE;
+ if (!is_startline(scode, bracket_map, cd, atomcount, TRUE)) return FALSE;
}
/* Atomic brackets */
else if (op == OP_ONCE || op == OP_ONCE_NC)
{
- if (!is_startline(scode, bracket_map, cd, atomcount + 1)) return FALSE;
+ if (!is_startline(scode, bracket_map, cd, atomcount + 1, inassert)) return FALSE;
}
/* .* means "start at start or after \n" if it isn't in atomic brackets or
- brackets that may be referenced, as long as the pattern does not contain
- *PRUNE or *SKIP, because these break the feature. Consider, for example,
- /.*?a(*PRUNE)b/ with the subject "aab", which matches "ab", i.e. not at the
- start of a line. */
+ brackets that may be referenced or an assertion, as long as the pattern does
+ not contain *PRUNE or *SKIP, because these break the feature. Consider, for
+ example, /.*?a(*PRUNE)b/ with the subject "aab", which matches "ab", i.e.
+ not at the start of a line. */
else if (op == OP_TYPESTAR || op == OP_TYPEMINSTAR || op == OP_TYPEPOSSTAR)
{
if (scode[1] != OP_ANY || (bracket_map & cd->backref_map) != 0 ||
- atomcount > 0 || cd->had_pruneorskip)
+ atomcount > 0 || cd->had_pruneorskip || inassert)
return FALSE;
}
@@ -7618,13 +8855,14 @@ return TRUE;
discarded, because they can cause conflicts with actual literals that follow.
However, if we end up without a first char setting for an unanchored pattern,
it is worth scanning the regex to see if there is an initial asserted first
-char. If all branches start with the same asserted char, or with a bracket all
-of whose alternatives start with the same asserted char (recurse ad lib), then
-we return that char, otherwise -1.
+char. If all branches start with the same asserted char, or with a
+non-conditional bracket all of whose alternatives start with the same asserted
+char (recurse ad lib), then we return that char, with the flags set to zero or
+REQ_CASELESS; otherwise return zero with REQ_NONE in the flags.
Arguments:
code points to start of expression (the bracket)
- flags points to the first char flags, or to REQ_NONE
+ flags points to the first char flags, or to REQ_NONE
inassert TRUE if in an assertion
Returns: the fixed first char, or 0 with REQ_NONE in flags
@@ -7661,7 +8899,6 @@ do {
case OP_ASSERT:
case OP_ONCE:
case OP_ONCE_NC:
- case OP_COND:
d = find_firstassertedchar(scode, &dflags, op == OP_ASSERT);
if (dflags < 0)
return 0;
@@ -7706,6 +8943,61 @@ return c;
/*************************************************
+* Add an entry to the name/number table *
+*************************************************/
+
+/* This function is called between compiling passes to add an entry to the
+name/number table, maintaining alphabetical order. Checking for permitted
+and forbidden duplicates has already been done.
+
+Arguments:
+ cd the compile data block
+ name the name to add
+ length the length of the name
+ groupno the group number
+
+Returns: nothing
+*/
+
+static void
+add_name(compile_data *cd, const pcre_uchar *name, int length,
+ unsigned int groupno)
+{
+int i;
+pcre_uchar *slot = cd->name_table;
+
+for (i = 0; i < cd->names_found; i++)
+ {
+ int crc = memcmp(name, slot+IMM2_SIZE, IN_UCHARS(length));
+ if (crc == 0 && slot[IMM2_SIZE+length] != 0)
+ crc = -1; /* Current name is a substring */
+
+ /* Make space in the table and break the loop for an earlier name. For a
+ duplicate or later name, carry on. We do this for duplicates so that in the
+ simple case (when ?(| is not used) they are in order of their numbers. In all
+ cases they are in the order in which they appear in the pattern. */
+
+ if (crc < 0)
+ {
+ memmove(slot + cd->name_entry_size, slot,
+ IN_UCHARS((cd->names_found - i) * cd->name_entry_size));
+ break;
+ }
+
+ /* Continue the loop for a later or duplicate name */
+
+ slot += cd->name_entry_size;
+ }
+
+PUT2(slot, 0, groupno);
+memcpy(slot + IMM2_SIZE, name, IN_UCHARS(length));
+slot[IMM2_SIZE + length] = 0;
+cd->names_found++;
+}
+
+
+
+/*************************************************
* Compile a Regular Expression *
*************************************************/
@@ -7809,6 +9101,11 @@ new memory is obtained from malloc(). */
pcre_uchar cworkspace[COMPILE_WORK_SIZE];
+/* This vector is used for remembering name groups during the pre-compile. In a
+similar way to cworkspace, it can be expanded using malloc() if necessary. */
+
+named_group named_groups[NAMED_GROUP_LIST_SIZE];
+
/* Set this early so that early errors get offset 0. */
ptr = (const pcre_uchar *)pattern;
@@ -7888,6 +9185,8 @@ PCRE_UTF8 == PCRE_UTF16 == PCRE_UTF32. */
{ skipatstart += 6; options |= PCRE_UTF8; continue; }
else if (STRNCMP_UC_C8(ptr+skipatstart+2, STRING_UCP_RIGHTPAR, 4) == 0)
{ skipatstart += 6; options |= PCRE_UCP; continue; }
+ else if (STRNCMP_UC_C8(ptr+skipatstart+2, STRING_NO_AUTO_POSSESS_RIGHTPAR, 16) == 0)
+ { skipatstart += 18; options |= PCRE_NO_AUTO_POSSESS; continue; }
else if (STRNCMP_UC_C8(ptr+skipatstart+2, STRING_NO_START_OPT_RIGHTPAR, 13) == 0)
{ skipatstart += 15; options |= PCRE_NO_START_OPTIMIZE; continue; }
@@ -8071,13 +9370,20 @@ cd->bracount = cd->final_bracount = 0;
cd->names_found = 0;
cd->name_entry_size = 0;
cd->name_table = NULL;
+cd->dupnames = FALSE;
+cd->dupgroups = FALSE;
+cd->namedrefcount = 0;
cd->start_code = cworkspace;
cd->hwm = cworkspace;
+cd->iscondassert = FALSE;
cd->start_workspace = cworkspace;
cd->workspace_size = COMPILE_WORK_SIZE;
+cd->named_groups = named_groups;
+cd->named_group_list_size = NAMED_GROUP_LIST_SIZE;
cd->start_pattern = (const pcre_uchar *)pattern;
cd->end_pattern = (const pcre_uchar *)(pattern + STRLEN_UC((const pcre_uchar *)pattern));
cd->req_varyopt = 0;
+cd->parens_depth = 0;
cd->assert_depth = 0;
cd->max_lookbehind = 0;
cd->external_options = options;
@@ -8092,6 +9398,7 @@ outside can help speed up starting point checks. */
ptr += skipatstart;
code = cworkspace;
*code = OP_BRA;
+
(void)compile_regex(cd->external_options, &code, &ptr, &errorcode, FALSE,
FALSE, 0, 0, &firstchar, &firstcharflags, &reqchar, &reqcharflags, NULL,
cd, &length);
@@ -8106,14 +9413,16 @@ if (length > MAX_PATTERN_SIZE)
goto PCRE_EARLY_ERROR_RETURN;
}
-/* Compute the size of data block needed and get it, either from malloc or
-externally provided function. Integer overflow should no longer be possible
-because nowadays we limit the maximum value of cd->names_found and
-cd->name_entry_size. */
+/* Compute the size of the data block for storing the compiled pattern. Integer
+overflow should no longer be possible because nowadays we limit the maximum
+value of cd->names_found and cd->name_entry_size. */
-size = sizeof(REAL_PCRE) + (length + cd->names_found * cd->name_entry_size) * sizeof(pcre_uchar);
-re = (REAL_PCRE *)(PUBL(malloc))(size);
+size = sizeof(REAL_PCRE) +
+ (length + cd->names_found * cd->name_entry_size) * sizeof(pcre_uchar);
+
+/* Get the memory. */
+re = (REAL_PCRE *)(PUBL(malloc))(size);
if (re == NULL)
{
errorcode = ERR21;
@@ -8154,20 +9463,35 @@ field; this time it's used for remembering forward references to subpatterns.
*/
cd->final_bracount = cd->bracount; /* Save for checking forward references */
+cd->parens_depth = 0;
cd->assert_depth = 0;
cd->bracount = 0;
cd->max_lookbehind = 0;
-cd->names_found = 0;
cd->name_table = (pcre_uchar *)re + re->name_table_offset;
codestart = cd->name_table + re->name_entry_size * re->name_count;
cd->start_code = codestart;
cd->hwm = (pcre_uchar *)(cd->start_workspace);
+cd->iscondassert = FALSE;
cd->req_varyopt = 0;
cd->had_accept = FALSE;
cd->had_pruneorskip = FALSE;
cd->check_lookbehind = FALSE;
cd->open_caps = NULL;
+/* If any named groups were found, create the name/number table from the list
+created in the first pass. */
+
+if (cd->names_found > 0)
+ {
+ int i = cd->names_found;
+ named_group *ng = cd->named_groups;
+ cd->names_found = 0;
+ for (; i > 0; i--, ng++)
+ add_name(cd, ng->name, ng->length, ng->number);
+ if (cd->named_group_list_size > NAMED_GROUP_LIST_SIZE)
+ (PUBL(free))((void *)cd->named_groups);
+ }
+
/* Set up a starting, non-extracting bracket, then compile the expression. On
error, errorcode will be set non-zero, so we don't need to look at the result
of the function here. */
@@ -8220,6 +9544,16 @@ if (cd->hwm > cd->start_workspace)
int offset, recno;
cd->hwm -= LINK_SIZE;
offset = GET(cd->hwm, 0);
+
+ /* Check that the hwm handling hasn't gone wrong. This whole area is
+ rewritten in PCRE2 because there are some obscure cases. */
+
+ if (offset == 0 || codestart[offset-1] != OP_RECURSE)
+ {
+ errorcode = ERR10;
+ break;
+ }
+
recno = GET(codestart, offset);
if (recno != prev_recno)
{
@@ -8231,16 +9565,31 @@ if (cd->hwm > cd->start_workspace)
}
}
-/* If the workspace had to be expanded, free the new memory. */
+/* If the workspace had to be expanded, free the new memory. Set the pointer to
+NULL to indicate that forward references have been filled in. */
if (cd->workspace_size > COMPILE_WORK_SIZE)
(PUBL(free))((void *)cd->start_workspace);
+cd->start_workspace = NULL;
/* Give an error if there's back reference to a non-existent capturing
subpattern. */
if (errorcode == 0 && re->top_backref > re->top_bracket) errorcode = ERR15;
+/* Unless disabled, check whether any single character iterators can be
+auto-possessified. The function overwrites the appropriate opcode values, so
+the type of the pointer must be cast. NOTE: the intermediate variable "temp" is
+used in this code because at least one compiler gives a warning about loss of
+"const" attribute if the cast (pcre_uchar *)codestart is used directly in the
+function call. */
+
+if (errorcode == 0 && (options & PCRE_NO_AUTO_POSSESS) == 0)
+ {
+ pcre_uchar *temp = (pcre_uchar *)codestart;
+ auto_possessify(temp, utf, cd);
+ }
+
/* If there were any lookbehind assertions that contained OP_RECURSE
(recursions or subroutine calls), a flag is set for them to be checked here,
because they may contain forward references. Actual recursions cannot be fixed
@@ -8249,7 +9598,7 @@ OP_RECURSE that are not fixed length get a diagnosic with a useful offset. The
exceptional ones forgo this. We scan the pattern to check that they are fixed
length, and set their lengths. */
-if (cd->check_lookbehind)
+if (errorcode == 0 && cd->check_lookbehind)
{
pcre_uchar *cc = (pcre_uchar *)codestart;
@@ -8269,7 +9618,7 @@ if (cd->check_lookbehind)
int end_op = *be;
*be = OP_END;
fixed_length = find_fixedlength(cc, (re->options & PCRE_UTF8) != 0, TRUE,
- cd);
+ cd, NULL);
*be = end_op;
DPRINTF(("fixed length = %d\n", fixed_length));
if (fixed_length < 0)
@@ -8349,7 +9698,7 @@ if ((re->options & PCRE_ANCHORED) == 0)
re->flags |= PCRE_FIRSTSET;
}
- else if (is_startline(codestart, 0, cd, 0)) re->flags |= PCRE_STARTLINE;
+ else if (is_startline(codestart, 0, cd, 0, FALSE)) re->flags |= PCRE_STARTLINE;
}
}
@@ -8438,6 +9787,20 @@ if (code - codestart > length)
}
#endif /* PCRE_DEBUG */
+/* Check for a pattern than can match an empty string, so that this information
+can be provided to applications. */
+
+do
+ {
+ if (could_be_empty_branch(codestart, code, utf, cd, NULL))
+ {
+ re->flags |= PCRE_MATCH_EMPTY;
+ break;
+ }
+ codestart += GET(codestart, 1);
+ }
+while (*codestart == OP_ALT);
+
#if defined COMPILE_PCRE8
return (pcre *)re;
#elif defined COMPILE_PCRE16
diff --git a/erts/emulator/pcre/pcre_config.c b/erts/emulator/pcre/pcre_config.c
index 06fa3d324f..297f0e14bc 100644
--- a/erts/emulator/pcre/pcre_config.c
+++ b/erts/emulator/pcre/pcre_config.c
@@ -171,6 +171,10 @@ switch (what)
*((int *)where) = POSIX_MALLOC_THRESHOLD;
break;
+ case PCRE_CONFIG_PARENS_LIMIT:
+ *((unsigned long int *)where) = PARENS_NEST_LIMIT;
+ break;
+
case PCRE_CONFIG_MATCH_LIMIT:
*((unsigned long int *)where) = MATCH_LIMIT;
break;
diff --git a/erts/emulator/pcre/pcre_dfa_exec.c b/erts/emulator/pcre/pcre_dfa_exec.c
index f5718a3b33..c859d67fc7 100644
--- a/erts/emulator/pcre/pcre_dfa_exec.c
+++ b/erts/emulator/pcre/pcre_dfa_exec.c
@@ -7,7 +7,7 @@ and semantics are as close as possible to those of the Perl 5 language (but see
below for why this module is different).
Written by Philip Hazel
- Copyright (c) 1997-2013 University of Cambridge
+ Copyright (c) 1997-2017 University of Cambridge
-----------------------------------------------------------------------------
Redistribution and use in source and binary forms, with or without
@@ -121,7 +121,7 @@ static const pcre_uint8 coptable[] = {
0, 0, /* \P, \p */
0, 0, 0, 0, 0, /* \R, \H, \h, \V, \v */
0, /* \X */
- 0, 0, 0, 0, 0, 0, /* \Z, \z, ^, ^M, $, $M */
+ 0, 0, 0, 0, 0, 0, /* \Z, \z, $, $M, ^, ^M */
1, /* Char */
1, /* Chari */
1, /* not */
@@ -152,11 +152,14 @@ static const pcre_uint8 coptable[] = {
/* Character class & ref repeats */
0, 0, 0, 0, 0, 0, /* *, *?, +, +?, ?, ?? */
0, 0, /* CRRANGE, CRMINRANGE */
+ 0, 0, 0, 0, /* Possessive *+, ++, ?+, CRPOSRANGE */
0, /* CLASS */
0, /* NCLASS */
0, /* XCLASS - variable length */
0, /* REF */
0, /* REFI */
+ 0, /* DNREF */
+ 0, /* DNREFI */
0, /* RECURSE */
0, /* CALLOUT */
0, /* Alt */
@@ -172,8 +175,8 @@ static const pcre_uint8 coptable[] = {
0, 0, /* ONCE, ONCE_NC */
0, 0, 0, 0, 0, /* BRA, BRAPOS, CBRA, CBRAPOS, COND */
0, 0, 0, 0, 0, /* SBRA, SBRAPOS, SCBRA, SCBRAPOS, SCOND */
- 0, 0, /* CREF, NCREF */
- 0, 0, /* RREF, NRREF */
+ 0, 0, /* CREF, DNCREF */
+ 0, 0, /* RREF, DNRREF */
0, /* DEF */
0, 0, 0, /* BRAZERO, BRAMINZERO, BRAPOSZERO */
0, 0, 0, /* MARK, PRUNE, PRUNE_ARG */
@@ -195,7 +198,7 @@ static const pcre_uint8 poptable[] = {
1, 1, /* \P, \p */
1, 1, 1, 1, 1, /* \R, \H, \h, \V, \v */
1, /* \X */
- 0, 0, 0, 0, 0, 0, /* \Z, \z, ^, ^M, $, $M */
+ 0, 0, 0, 0, 0, 0, /* \Z, \z, $, $M, ^, ^M */
1, /* Char */
1, /* Chari */
1, /* not */
@@ -221,11 +224,14 @@ static const pcre_uint8 poptable[] = {
/* Character class & ref repeats */
1, 1, 1, 1, 1, 1, /* *, *?, +, +?, ?, ?? */
1, 1, /* CRRANGE, CRMINRANGE */
+ 1, 1, 1, 1, /* Possessive *+, ++, ?+, CRPOSRANGE */
1, /* CLASS */
1, /* NCLASS */
1, /* XCLASS - variable length */
0, /* REF */
0, /* REFI */
+ 0, /* DNREF */
+ 0, /* DNREFI */
0, /* RECURSE */
0, /* CALLOUT */
0, /* Alt */
@@ -241,8 +247,8 @@ static const pcre_uint8 poptable[] = {
0, 0, /* ONCE, ONCE_NC */
0, 0, 0, 0, 0, /* BRA, BRAPOS, CBRA, CBRAPOS, COND */
0, 0, 0, 0, 0, /* SBRA, SBRAPOS, SCBRA, SCBRAPOS, SCOND */
- 0, 0, /* CREF, NCREF */
- 0, 0, /* RREF, NRREF */
+ 0, 0, /* CREF, DNCREF */
+ 0, 0, /* RREF, DNRREF */
0, /* DEF */
0, 0, 0, /* BRAZERO, BRAMINZERO, BRAPOSZERO */
0, 0, 0, /* MARK, PRUNE, PRUNE_ARG */
@@ -1095,15 +1101,23 @@ for (;;)
PRIV(ucp_gentype)[prop->chartype] == ucp_N;
break;
- case PT_SPACE: /* Perl space */
- OK = PRIV(ucp_gentype)[prop->chartype] == ucp_Z ||
- c == CHAR_HT || c == CHAR_NL || c == CHAR_FF || c == CHAR_CR;
- break;
+ /* Perl space used to exclude VT, but from Perl 5.18 it is included,
+ which means that Perl space and POSIX space are now identical. PCRE
+ was changed at release 8.34. */
+ case PT_SPACE: /* Perl space */
case PT_PXSPACE: /* POSIX space */
- OK = PRIV(ucp_gentype)[prop->chartype] == ucp_Z ||
- c == CHAR_HT || c == CHAR_NL || c == CHAR_VT ||
- c == CHAR_FF || c == CHAR_CR;
+ switch(c)
+ {
+ HSPACE_CASES:
+ VSPACE_CASES:
+ OK = TRUE;
+ break;
+
+ default:
+ OK = PRIV(ucp_gentype)[prop->chartype] == ucp_Z;
+ break;
+ }
break;
case PT_WORD:
@@ -1345,15 +1359,23 @@ for (;;)
PRIV(ucp_gentype)[prop->chartype] == ucp_N;
break;
- case PT_SPACE: /* Perl space */
- OK = PRIV(ucp_gentype)[prop->chartype] == ucp_Z ||
- c == CHAR_HT || c == CHAR_NL || c == CHAR_FF || c == CHAR_CR;
- break;
+ /* Perl space used to exclude VT, but from Perl 5.18 it is included,
+ which means that Perl space and POSIX space are now identical. PCRE
+ was changed at release 8.34. */
+ case PT_SPACE: /* Perl space */
case PT_PXSPACE: /* POSIX space */
- OK = PRIV(ucp_gentype)[prop->chartype] == ucp_Z ||
- c == CHAR_HT || c == CHAR_NL || c == CHAR_VT ||
- c == CHAR_FF || c == CHAR_CR;
+ switch(c)
+ {
+ HSPACE_CASES:
+ VSPACE_CASES:
+ OK = TRUE;
+ break;
+
+ default:
+ OK = PRIV(ucp_gentype)[prop->chartype] == ucp_Z;
+ break;
+ }
break;
case PT_WORD:
@@ -1452,7 +1474,7 @@ for (;;)
goto ANYNL01;
case CHAR_CR:
- if (ptr + 1 < end_subject && RAWUCHARTEST(ptr + 1) == CHAR_LF) ncount = 1;
+ if (ptr + 1 < end_subject && UCHAR21TEST(ptr + 1) == CHAR_LF) ncount = 1;
/* Fall through */
ANYNL01:
@@ -1589,15 +1611,23 @@ for (;;)
PRIV(ucp_gentype)[prop->chartype] == ucp_N;
break;
- case PT_SPACE: /* Perl space */
- OK = PRIV(ucp_gentype)[prop->chartype] == ucp_Z ||
- c == CHAR_HT || c == CHAR_NL || c == CHAR_FF || c == CHAR_CR;
- break;
+ /* Perl space used to exclude VT, but from Perl 5.18 it is included,
+ which means that Perl space and POSIX space are now identical. PCRE
+ was changed at release 8.34. */
+ case PT_SPACE: /* Perl space */
case PT_PXSPACE: /* POSIX space */
- OK = PRIV(ucp_gentype)[prop->chartype] == ucp_Z ||
- c == CHAR_HT || c == CHAR_NL || c == CHAR_VT ||
- c == CHAR_FF || c == CHAR_CR;
+ switch(c)
+ {
+ HSPACE_CASES:
+ VSPACE_CASES:
+ OK = TRUE;
+ break;
+
+ default:
+ OK = PRIV(ucp_gentype)[prop->chartype] == ucp_Z;
+ break;
+ }
break;
case PT_WORD:
@@ -1713,7 +1743,7 @@ for (;;)
goto ANYNL02;
case CHAR_CR:
- if (ptr + 1 < end_subject && RAWUCHARTEST(ptr + 1) == CHAR_LF) ncount = 1;
+ if (ptr + 1 < end_subject && UCHAR21TEST(ptr + 1) == CHAR_LF) ncount = 1;
/* Fall through */
ANYNL02:
@@ -1858,15 +1888,23 @@ for (;;)
PRIV(ucp_gentype)[prop->chartype] == ucp_N;
break;
- case PT_SPACE: /* Perl space */
- OK = PRIV(ucp_gentype)[prop->chartype] == ucp_Z ||
- c == CHAR_HT || c == CHAR_NL || c == CHAR_FF || c == CHAR_CR;
- break;
+ /* Perl space used to exclude VT, but from Perl 5.18 it is included,
+ which means that Perl space and POSIX space are now identical. PCRE
+ was changed at release 8.34. */
+ case PT_SPACE: /* Perl space */
case PT_PXSPACE: /* POSIX space */
- OK = PRIV(ucp_gentype)[prop->chartype] == ucp_Z ||
- c == CHAR_HT || c == CHAR_NL || c == CHAR_VT ||
- c == CHAR_FF || c == CHAR_CR;
+ switch(c)
+ {
+ HSPACE_CASES:
+ VSPACE_CASES:
+ OK = TRUE;
+ break;
+
+ default:
+ OK = PRIV(ucp_gentype)[prop->chartype] == ucp_Z;
+ break;
+ }
break;
case PT_WORD:
@@ -1975,7 +2013,7 @@ for (;;)
goto ANYNL03;
case CHAR_CR:
- if (ptr + 1 < end_subject && RAWUCHARTEST(ptr + 1) == CHAR_LF) ncount = 1;
+ if (ptr + 1 < end_subject && UCHAR21TEST(ptr + 1) == CHAR_LF) ncount = 1;
/* Fall through */
ANYNL03:
@@ -2173,7 +2211,7 @@ for (;;)
if ((md->moptions & PCRE_PARTIAL_HARD) != 0)
reset_could_continue = TRUE;
}
- else if (RAWUCHARTEST(ptr + 1) == CHAR_LF)
+ else if (UCHAR21TEST(ptr + 1) == CHAR_LF)
{
ADD_NEW_DATA(-(state_offset + 1), 0, 1);
}
@@ -2534,31 +2572,65 @@ for (;;)
{
case OP_CRSTAR:
case OP_CRMINSTAR:
+ case OP_CRPOSSTAR:
ADD_ACTIVE(next_state_offset + 1, 0);
- if (isinclass) { ADD_NEW(state_offset, 0); }
+ if (isinclass)
+ {
+ if (*ecode == OP_CRPOSSTAR)
+ {
+ active_count--; /* Remove non-match possibility */
+ next_active_state--;
+ }
+ ADD_NEW(state_offset, 0);
+ }
break;
case OP_CRPLUS:
case OP_CRMINPLUS:
+ case OP_CRPOSPLUS:
count = current_state->count; /* Already matched */
if (count > 0) { ADD_ACTIVE(next_state_offset + 1, 0); }
- if (isinclass) { count++; ADD_NEW(state_offset, count); }
+ if (isinclass)
+ {
+ if (count > 0 && *ecode == OP_CRPOSPLUS)
+ {
+ active_count--; /* Remove non-match possibility */
+ next_active_state--;
+ }
+ count++;
+ ADD_NEW(state_offset, count);
+ }
break;
case OP_CRQUERY:
case OP_CRMINQUERY:
+ case OP_CRPOSQUERY:
ADD_ACTIVE(next_state_offset + 1, 0);
- if (isinclass) { ADD_NEW(next_state_offset + 1, 0); }
+ if (isinclass)
+ {
+ if (*ecode == OP_CRPOSQUERY)
+ {
+ active_count--; /* Remove non-match possibility */
+ next_active_state--;
+ }
+ ADD_NEW(next_state_offset + 1, 0);
+ }
break;
case OP_CRRANGE:
case OP_CRMINRANGE:
+ case OP_CRPOSRANGE:
count = current_state->count; /* Already matched */
if (count >= (int)GET2(ecode, 1))
{ ADD_ACTIVE(next_state_offset + 1 + 2 * IMM2_SIZE, 0); }
if (isinclass)
{
int max = (int)GET2(ecode, 1 + IMM2_SIZE);
+ if (*ecode == OP_CRPOSRANGE && count >= (int)GET2(ecode, 1))
+ {
+ active_count--; /* Remove non-match possibility */
+ next_active_state--;
+ }
if (++count >= max && max != 0) /* Max 0 => no limit */
{ ADD_NEW(next_state_offset + 1 + 2 * IMM2_SIZE, 0); }
else
@@ -2658,21 +2730,24 @@ for (;;)
condcode = code[LINK_SIZE+1];
- /* Back reference conditions are not supported */
+ /* Back reference conditions and duplicate named recursion conditions
+ are not supported */
- if (condcode == OP_CREF || condcode == OP_NCREF)
+ if (condcode == OP_CREF || condcode == OP_DNCREF ||
+ condcode == OP_DNRREF)
return PCRE_ERROR_DFA_UCOND;
- /* The DEFINE condition is always false */
+ /* The DEFINE condition is always false, and the assertion (?!) is
+ converted to OP_FAIL. */
- if (condcode == OP_DEF)
+ if (condcode == OP_DEF || condcode == OP_FAIL)
{ ADD_ACTIVE(state_offset + codelink + LINK_SIZE + 1, 0); }
/* The only supported version of OP_RREF is for the value RREF_ANY,
which means "test if in any recursion". We can't test for specifically
recursed groups. */
- else if (condcode == OP_RREF || condcode == OP_NRREF)
+ else if (condcode == OP_RREF)
{
int value = GET2(code, LINK_SIZE + 2);
if (value != RREF_ANY) return PCRE_ERROR_DFA_UCOND;
@@ -3176,7 +3251,7 @@ md->callout_data = NULL;
if (extra_data != NULL)
{
- unsigned int flags = extra_data->flags;
+ unsigned long int flags = extra_data->flags;
if ((flags & PCRE_EXTRA_STUDY_DATA) != 0)
study = (const pcre_study_data *)extra_data->study_data;
if ((flags & PCRE_EXTRA_MATCH_LIMIT) != 0) return PCRE_ERROR_DFA_UMLIMIT;
@@ -3400,7 +3475,7 @@ for (;;)
if (((options | re->options) & PCRE_NO_START_OPTIMIZE) == 0)
{
- /* Advance to a known first char. */
+ /* Advance to a known first pcre_uchar (i.e. data item) */
if (has_first_char)
{
@@ -3408,12 +3483,12 @@ for (;;)
{
pcre_uchar csc;
while (current_subject < end_subject &&
- (csc = RAWUCHARTEST(current_subject)) != first_char && csc != first_char2)
+ (csc = UCHAR21TEST(current_subject)) != first_char && csc != first_char2)
current_subject++;
}
else
while (current_subject < end_subject &&
- RAWUCHARTEST(current_subject) != first_char)
+ UCHAR21TEST(current_subject) != first_char)
current_subject++;
}
@@ -3443,36 +3518,26 @@ for (;;)
ANYCRLF, and we are now at a LF, advance the match position by one
more character. */
- if (RAWUCHARTEST(current_subject - 1) == CHAR_CR &&
+ if (UCHAR21TEST(current_subject - 1) == CHAR_CR &&
(md->nltype == NLTYPE_ANY || md->nltype == NLTYPE_ANYCRLF) &&
current_subject < end_subject &&
- RAWUCHARTEST(current_subject) == CHAR_NL)
+ UCHAR21TEST(current_subject) == CHAR_NL)
current_subject++;
}
}
- /* Or to a non-unique first char after study */
+ /* Advance to a non-unique first pcre_uchar after study */
else if (start_bits != NULL)
{
while (current_subject < end_subject)
{
- register pcre_uint32 c = RAWUCHARTEST(current_subject);
+ register pcre_uint32 c = UCHAR21TEST(current_subject);
#ifndef COMPILE_PCRE8
if (c > 255) c = 255;
#endif
- if ((start_bits[c/8] & (1 << (c&7))) == 0)
- {
- current_subject++;
-#if defined SUPPORT_UTF && defined COMPILE_PCRE8
- /* In non 8-bit mode, the iteration will stop for
- characters > 255 at the beginning or not stop at all. */
- if (utf)
- ACROSSCHAR(current_subject < end_subject, *current_subject,
- current_subject++);
-#endif
- }
- else break;
+ if ((start_bits[c/8] & (1 << (c&7))) != 0) break;
+ current_subject++;
}
}
}
@@ -3491,19 +3556,20 @@ for (;;)
/* If the pattern was studied, a minimum subject length may be set. This
is a lower bound; no actual string of that length may actually match the
pattern. Although the value is, strictly, in characters, we treat it as
- bytes to avoid spending too much time in this optimization. */
+ in pcre_uchar units to avoid spending too much time in this optimization.
+ */
if (study != NULL && (study->flags & PCRE_STUDY_MINLEN) != 0 &&
(pcre_uint32)(end_subject - current_subject) < study->minlength)
return PCRE_ERROR_NOMATCH;
- /* If req_char is set, we know that that character must appear in the
- subject for the match to succeed. If the first character is set, req_char
- must be later in the subject; otherwise the test starts at the match
- point. This optimization can save a huge amount of work in patterns with
- nested unlimited repeats that aren't going to match. Writing separate
- code for cased/caseless versions makes it go faster, as does using an
- autoincrement and backing off on a match.
+ /* If req_char is set, we know that that pcre_uchar must appear in the
+ subject for the match to succeed. If the first pcre_uchar is set,
+ req_char must be later in the subject; otherwise the test starts at the
+ match point. This optimization can save a huge amount of work in patterns
+ with nested unlimited repeats that aren't going to match. Writing
+ separate code for cased/caseless versions makes it go faster, as does
+ using an autoincrement and backing off on a match.
HOWEVER: when the subject string is very, very long, searching to its end
can take a long time, and give bad performance on quite ordinary
@@ -3523,7 +3589,7 @@ for (;;)
{
while (p < end_subject)
{
- register pcre_uint32 pp = RAWUCHARINCTEST(p);
+ register pcre_uint32 pp = UCHAR21INCTEST(p);
if (pp == req_char || pp == req_char2) { p--; break; }
}
}
@@ -3531,18 +3597,18 @@ for (;;)
{
while (p < end_subject)
{
- if (RAWUCHARINCTEST(p) == req_char) { p--; break; }
+ if (UCHAR21INCTEST(p) == req_char) { p--; break; }
}
}
- /* If we can't find the required character, break the matching loop,
+ /* If we can't find the required pcre_uchar, break the matching loop,
which will cause a return or PCRE_ERROR_NOMATCH. */
if (p >= end_subject) break;
- /* If we have found the required character, save the point where we
+ /* If we have found the required pcre_uchar, save the point where we
found it, so that we don't search again next time round the loop if
- the start hasn't passed this character yet. */
+ the start hasn't passed this point yet. */
req_char_ptr = p;
}
@@ -3599,9 +3665,9 @@ for (;;)
not contain any explicit matches for \r or \n, and the newline option is CRLF
or ANY or ANYCRLF, advance the match position by one more character. */
- if (RAWUCHARTEST(current_subject - 1) == CHAR_CR &&
+ if (UCHAR21TEST(current_subject - 1) == CHAR_CR &&
current_subject < end_subject &&
- RAWUCHARTEST(current_subject) == CHAR_NL &&
+ UCHAR21TEST(current_subject) == CHAR_NL &&
(re->flags & PCRE_HASCRORLF) == 0 &&
(md->nltype == NLTYPE_ANY ||
md->nltype == NLTYPE_ANYCRLF ||
diff --git a/erts/emulator/pcre/pcre_exec.c b/erts/emulator/pcre/pcre_exec.c
index 1cab78cdd8..6708ba92a6 100644
--- a/erts/emulator/pcre/pcre_exec.c
+++ b/erts/emulator/pcre/pcre_exec.c
@@ -6,7 +6,7 @@
and semantics are as close as possible to those of the Perl 5 language.
Written by Philip Hazel
- Copyright (c) 1997-2013 University of Cambridge
+ Copyright (c) 1997-2014 University of Cambridge
-----------------------------------------------------------------------------
Redistribution and use in source and binary forms, with or without
@@ -111,8 +111,8 @@ because the offset vector is always a multiple of 3 long. */
/* Min and max values for the common repeats; for the maxima, 0 => infinity */
-static const char rep_min[] = { 0, 0, 1, 1, 0, 0 };
-static const char rep_max[] = { 0, 0, 0, 0, 1, 1 };
+static const char rep_min[] = { 0, 0, 1, 1, 0, 0, 0, 0, 0, 1, 0, };
+static const char rep_max[] = { 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1, };
#ifdef PCRE_DEBUG
/*************************************************
@@ -138,7 +138,7 @@ pcre_uint32 c;
BOOL utf = md->utf;
if (is_subject && length > md->end_subject - p) length = md->end_subject - p;
while (length-- > 0)
- if (isprint(c = RAWUCHARINCTEST(p))) printf("%c", (char)c); else printf("\\x{%02x}", c);
+ if (isprint(c = UCHAR21INCTEST(p))) printf("%c", (char)c); else printf("\\x{%02x}", c);
}
#endif
@@ -187,7 +187,7 @@ match_ref(int offset, register PCRE_PUCHAR eptr, int length, match_data *md,
{
PCRE_PUCHAR eptr_start = eptr;
register PCRE_PUCHAR p = md->start_subject + md->offset_vector[offset];
-#ifdef SUPPORT_UTF
+#if defined SUPPORT_UTF && defined SUPPORT_UCP
BOOL utf = md->utf;
#endif
@@ -215,8 +215,7 @@ ASCII characters. */
if (caseless)
{
-#ifdef SUPPORT_UTF
-#ifdef SUPPORT_UCP
+#if defined SUPPORT_UTF && defined SUPPORT_UCP
if (utf)
{
/* Match characters up to the end of the reference. NOTE: the number of
@@ -250,7 +249,6 @@ if (caseless)
}
else
#endif
-#endif
/* The same code works when not in UTF-8 mode and in UTF-8 mode when there
is no UCP support. */
@@ -259,8 +257,8 @@ if (caseless)
{
pcre_uint32 cc, cp;
if (eptr >= md->end_subject) return -2; /* Partial match */
- cc = RAWUCHARTEST(eptr);
- cp = RAWUCHARTEST(p);
+ cc = UCHAR21TEST(eptr);
+ cp = UCHAR21TEST(p);
if (TABLE_GET(cp, md->lcc, cp) != TABLE_GET(cc, md->lcc, cc)) return -1;
p++;
eptr++;
@@ -276,7 +274,7 @@ else
while (length-- > 0)
{
if (eptr >= md->end_subject) return -2; /* Partial match */
- if (RAWUCHARINCTEST(p) != RAWUCHARINCTEST(eptr)) return -1;
+ if (UCHAR21INCTEST(p) != UCHAR21INCTEST(eptr)) return -1;
}
}
@@ -332,17 +330,13 @@ enum { RM1=1, RM2, RM3, RM4, RM5, RM6, RM7, RM8, RM9, RM10,
RM31, RM32, RM33, RM34, RM35, RM36, RM37, RM38, RM39, RM40,
RM41, RM42, RM43, RM44, RM45, RM46, RM47, RM48, RM49, RM50,
RM51, RM52, RM53, RM54, RM55, RM56, RM57, RM58, RM59, RM60,
- RM61, RM62, RM63, RM64, RM65, RM66, RM67, RM68
-};
+ RM61, RM62, RM63, RM64, RM65, RM66, RM67 };
/* These versions of the macros use the stack, as normal. There are debugging
versions and production versions. Note that the "rw" argument of RMATCH isn't
actually used in this definition. */
#ifndef NO_RECURSE
-#ifdef ERLANG_INTEGRATION
-#error ERLANG_INTEGRATION only together with NO_RECURSE
-#endif
#define REGISTER register
#ifdef PCRE_DEBUG
@@ -761,7 +755,7 @@ if (ecode == NULL)
return match((PCRE_PUCHAR)&rdepth, NULL, NULL, 0, NULL, NULL, 1);
else
{
- int len = (char *)&rdepth - (char *)eptr;
+ int len = (int)((char *)&rdepth - (char *)eptr);
return (len > 0)? -len : len;
}
}
@@ -997,7 +991,7 @@ for (;;)
/* Continue as from after the group, updating the offsets high water
mark, since extracts may have been taken. */
- do ecode += GET(ecode, 1); while (*ecode == OP_ALT);
+ do ecode += GET(ecode, 1); while (*ecode == OP_ALT); /* LOOP_COUNT: Ok */
offset_top = md->end_offset_top;
eptr = md->end_match_ptr;
@@ -1134,7 +1128,7 @@ for (;;)
the result of a recursive call to match() whatever happened so it was
possible to reduce stack usage by turning this into a tail recursion,
except in the case of a possibly empty group. However, now that there is
- the possiblity of (*THEN) occurring in the final alternative, this
+ the possibility of (*THEN) occurring in the final alternative, this
optimization is no longer always possible.
We can optimize if we know there are no (*THEN)s in the pattern; at present
@@ -1192,7 +1186,7 @@ for (;;)
const pcre_uchar *scode = ecode;
if (*scode != OP_ONCE) /* If not at start, find it */
{
- while (*scode == OP_ALT) scode += GET(scode, 1);
+ while (*scode == OP_ALT) scode += GET(scode, 1); /* LOOP_COUNT: Ok */
scode -= GET(scode, 1);
}
if (md->once_target == scode) rrc = MATCH_NOMATCH;
@@ -1230,87 +1224,81 @@ for (;;)
printf("\n");
#endif
- if (offset < md->offset_max)
- {
- matched_once = FALSE;
- code_offset = (int)(ecode - md->start_code);
-
- save_offset1 = md->offset_vector[offset];
- save_offset2 = md->offset_vector[offset+1];
- save_offset3 = md->offset_vector[md->offset_end - number];
- save_capture_last = md->capture_last;
+ if (offset >= md->offset_max) goto POSSESSIVE_NON_CAPTURE;
- DPRINTF(("saving %d %d %d\n", save_offset1, save_offset2, save_offset3));
+ matched_once = FALSE;
+ code_offset = (int)(ecode - md->start_code);
- /* Each time round the loop, save the current subject position for use
- when the group matches. For MATCH_MATCH, the group has matched, so we
- restart it with a new subject starting position, remembering that we had
- at least one match. For MATCH_NOMATCH, carry on with the alternatives, as
- usual. If we haven't matched any alternatives in any iteration, check to
- see if a previous iteration matched. If so, the group has matched;
- continue from afterwards. Otherwise it has failed; restore the previous
- capture values before returning NOMATCH. */
+ save_offset1 = md->offset_vector[offset];
+ save_offset2 = md->offset_vector[offset+1];
+ save_offset3 = md->offset_vector[md->offset_end - number];
+ save_capture_last = md->capture_last;
- for (;;) /* LOOP_COUNT: Ok */
- {
- md->offset_vector[md->offset_end - number] =
- (int)(eptr - md->start_subject);
- if (op >= OP_SBRA) md->match_function_type = MATCH_CBEGROUP;
- RMATCH(eptr, ecode + PRIV(OP_lengths)[*ecode], offset_top, md,
- eptrb, RM63);
- if (rrc == MATCH_KETRPOS)
- {
- offset_top = md->end_offset_top;
- eptr = md->end_match_ptr;
- ecode = md->start_code + code_offset;
- save_capture_last = md->capture_last;
- matched_once = TRUE;
- continue;
- }
+ DPRINTF(("saving %d %d %d\n", save_offset1, save_offset2, save_offset3));
- /* See comment in the code for capturing groups above about handling
- THEN. */
+ /* Each time round the loop, save the current subject position for use
+ when the group matches. For MATCH_MATCH, the group has matched, so we
+ restart it with a new subject starting position, remembering that we had
+ at least one match. For MATCH_NOMATCH, carry on with the alternatives, as
+ usual. If we haven't matched any alternatives in any iteration, check to
+ see if a previous iteration matched. If so, the group has matched;
+ continue from afterwards. Otherwise it has failed; restore the previous
+ capture values before returning NOMATCH. */
- if (rrc == MATCH_THEN)
+ for (;;) /* LOOP_COUNT: Ok */
+ {
+ md->offset_vector[md->offset_end - number] =
+ (int)(eptr - md->start_subject);
+ if (op >= OP_SBRA) md->match_function_type = MATCH_CBEGROUP;
+ RMATCH(eptr, ecode + PRIV(OP_lengths)[*ecode], offset_top, md,
+ eptrb, RM63);
+ if (rrc == MATCH_KETRPOS)
+ {
+ offset_top = md->end_offset_top;
+ ecode = md->start_code + code_offset;
+ save_capture_last = md->capture_last;
+ matched_once = TRUE;
+ mstart = md->start_match_ptr; /* In case \K changed it */
+ if (eptr == md->end_match_ptr) /* Matched an empty string */
{
- next = ecode + GET(ecode,1);
- if (md->start_match_ptr < next &&
- (*ecode == OP_ALT || *next == OP_ALT))
- rrc = MATCH_NOMATCH;
+ do ecode += GET(ecode, 1); while (*ecode == OP_ALT); /* LOOP_COUNT: Ok */
+ break;
}
-
- if (rrc != MATCH_NOMATCH) RRETURN(rrc);
- md->capture_last = save_capture_last;
- ecode += GET(ecode, 1);
- if (*ecode != OP_ALT) break;
+ eptr = md->end_match_ptr;
+ continue;
}
- if (!matched_once)
- {
- md->offset_vector[offset] = save_offset1;
- md->offset_vector[offset+1] = save_offset2;
- md->offset_vector[md->offset_end - number] = save_offset3;
- }
+ /* See comment in the code for capturing groups above about handling
+ THEN. */
- if (allow_zero || matched_once)
+ if (rrc == MATCH_THEN)
{
- ecode += 1 + LINK_SIZE;
- break;
+ next = ecode + GET(ecode,1);
+ if (md->start_match_ptr < next &&
+ (*ecode == OP_ALT || *next == OP_ALT))
+ rrc = MATCH_NOMATCH;
}
- RRETURN(MATCH_NOMATCH);
+ if (rrc != MATCH_NOMATCH) RRETURN(rrc);
+ md->capture_last = save_capture_last;
+ ecode += GET(ecode, 1);
+ if (*ecode != OP_ALT) break;
}
- /* FALL THROUGH ... Insufficient room for saving captured contents. Treat
- as a non-capturing bracket. */
-
- /* VVVVVVVVVVVVVVVVVVVVVVVVV */
- /* VVVVVVVVVVVVVVVVVVVVVVVVV */
+ if (!matched_once)
+ {
+ md->offset_vector[offset] = save_offset1;
+ md->offset_vector[offset+1] = save_offset2;
+ md->offset_vector[md->offset_end - number] = save_offset3;
+ }
- DPRINTF(("insufficient capture room: treat as non-capturing\n"));
+ if (allow_zero || matched_once)
+ {
+ ecode += 1 + LINK_SIZE;
+ break;
+ }
- /* VVVVVVVVVVVVVVVVVVVVVVVVV */
- /* VVVVVVVVVVVVVVVVVVVVVVVVV */
+ RRETURN(MATCH_NOMATCH);
/* Non-capturing possessive bracket with unlimited repeat. We come here
from BRAZERO with allow_zero = TRUE. The code is similar to the above,
@@ -1334,9 +1322,15 @@ for (;;)
if (rrc == MATCH_KETRPOS)
{
offset_top = md->end_offset_top;
- eptr = md->end_match_ptr;
ecode = md->start_code + code_offset;
matched_once = TRUE;
+ mstart = md->start_match_ptr; /* In case \K reset it */
+ if (eptr == md->end_match_ptr) /* Matched an empty string */
+ {
+ do ecode += GET(ecode, 1); while (*ecode == OP_ALT); /* LOOP_COUNT: Ok */
+ break;
+ }
+ eptr = md->end_match_ptr;
continue;
}
@@ -1366,25 +1360,32 @@ for (;;)
/* Control never reaches here. */
- /* Conditional group: compilation checked that there are no more than
- two branches. If the condition is false, skipping the first branch takes us
- past the end if there is only one branch, but that's OK because that is
- exactly what going to the ket would do. */
+ /* Conditional group: compilation checked that there are no more than two
+ branches. If the condition is false, skipping the first branch takes us
+ past the end of the item if there is only one branch, but that's exactly
+ what we want. */
case OP_COND:
case OP_SCOND:
- codelink = GET(ecode, 1);
+
+ /* The variable codelink will be added to ecode when the condition is
+ false, to get to the second branch. Setting it to the offset to the ALT
+ or KET, then incrementing ecode achieves this effect. We now have ecode
+ pointing to the condition or callout. */
+
+ codelink = GET(ecode, 1); /* Offset to the second branch */
+ ecode += 1 + LINK_SIZE; /* From this opcode */
/* Because of the way auto-callout works during compile, a callout item is
inserted between OP_COND and an assertion condition. */
- if (ecode[LINK_SIZE+1] == OP_CALLOUT)
+ if (*ecode == OP_CALLOUT)
{
if (PUBL(callout) != NULL)
{
PUBL(callout_block) cb;
cb.version = 2; /* Version 1 of the callout block */
- cb.callout_number = ecode[LINK_SIZE+2];
+ cb.callout_number = ecode[1];
cb.offset_vector = md->offset_vector;
#if defined COMPILE_PCRE8
cb.subject = (PCRE_SPTR)md->start_subject;
@@ -1396,8 +1397,8 @@ for (;;)
cb.subject_length = (int)(md->end_subject - md->start_subject);
cb.start_match = (int)(mstart - md->start_subject);
cb.current_position = (int)(eptr - md->start_subject);
- cb.pattern_position = GET(ecode, LINK_SIZE + 3);
- cb.next_item_length = GET(ecode, 3 + 2*LINK_SIZE);
+ cb.pattern_position = GET(ecode, 2);
+ cb.next_item_length = GET(ecode, 2 + LINK_SIZE);
cb.capture_top = offset_top/2;
cb.capture_last = md->capture_last & CAPLMASK;
/* Internal change requires this for API compatibility. */
@@ -1407,213 +1408,125 @@ for (;;)
if ((rrc = (*PUBL(callout))(&cb)) > 0) RRETURN(MATCH_NOMATCH);
if (rrc < 0) RRETURN(rrc);
}
+
+ /* Advance ecode past the callout, so it now points to the condition. We
+ must adjust codelink so that the value of ecode+codelink is unchanged. */
+
ecode += PRIV(OP_lengths)[OP_CALLOUT];
codelink -= PRIV(OP_lengths)[OP_CALLOUT];
}
- condcode = ecode[LINK_SIZE+1];
+ /* Test the various possible conditions */
- /* Now see what the actual condition is */
-
- if (condcode == OP_RREF || condcode == OP_NRREF) /* Recursion test */
+ condition = FALSE;
+ switch(condcode = *ecode)
{
- if (md->recursive == NULL) /* Not recursing => FALSE */
+ case OP_RREF: /* Numbered group recursion test */
+ if (md->recursive != NULL) /* Not recursing => FALSE */
{
- condition = FALSE;
- ecode += GET(ecode, 1);
- }
- else
- { /* LOOP_COUNT: Warning, No CHK in this block */
- unsigned int recno = GET2(ecode, LINK_SIZE + 2); /* Recursion group number*/
+ unsigned int recno = GET2(ecode, 1); /* Recursion group number*/
condition = (recno == RREF_ANY || recno == md->recursive->group_num);
+ }
+ break;
- /* If the test is for recursion into a specific subpattern, and it is
- false, but the test was set up by name, scan the table to see if the
- name refers to any other numbers, and test them. The condition is true
- if any one is set. */
-
- if (!condition && condcode == OP_NRREF)
+ case OP_DNRREF: /* Duplicate named group recursion test */
+ if (md->recursive != NULL)
+ {
+ int count = GET2(ecode, 1 + IMM2_SIZE);
+ pcre_uchar *slot = md->name_table + GET2(ecode, 1) * md->name_entry_size;
+ while (count-- > 0) /* LOOP_COUNT: COST */
{
- pcre_uchar *slotA = md->name_table;
- for (i = 0; i < md->name_count; i++)/* LOOP_COUNT: COST */
- {
- if (GET2(slotA, 0) == recno) break;
- slotA += md->name_entry_size;
- COST(1);
- }
-
- /* Found a name for the number - there can be only one; duplicate
- names for different numbers are allowed, but not vice versa. First
- scan down for duplicates. */
-
- if (i < md->name_count)
- {
- pcre_uchar *slotB = slotA;
- while (slotB > md->name_table) /* LOOP_COUNT: COST */
- {
- slotB -= md->name_entry_size;
- if (STRCMP_UC_UC(slotA + IMM2_SIZE, slotB + IMM2_SIZE) == 0)
- {
- condition = GET2(slotB, 0) == md->recursive->group_num;
- if (condition) break;
- }
- else break;
- COST(1);
- }
-
- /* Scan up for duplicates */
-
- if (!condition)
- {
- slotB = slotA;
- for (i++; i < md->name_count; i++)/* LOOP_COUNT: COST */
- {
- slotB += md->name_entry_size;
- if (STRCMP_UC_UC(slotA + IMM2_SIZE, slotB + IMM2_SIZE) == 0)
- {
- condition = GET2(slotB, 0) == md->recursive->group_num;
- if (condition) break;
- }
- else break;
- COST(1);
- }
- }
- }
+ unsigned int recno = GET2(slot, 0);
+ condition = recno == md->recursive->group_num;
+ if (condition) break;
+ slot += md->name_entry_size;
+ COST(1);
}
-
- /* Chose branch according to the condition */
-
- ecode += condition? 1 + IMM2_SIZE : GET(ecode, 1);
}
- }
+ break;
- else if (condcode == OP_CREF || condcode == OP_NCREF) /* Group used test */
- {
- offset = GET2(ecode, LINK_SIZE+2) << 1; /* Doubled ref number */
+ case OP_CREF: /* Numbered group used test */
+ offset = GET2(ecode, 1) << 1; /* Doubled ref number */
condition = offset < offset_top && md->offset_vector[offset] >= 0;
+ break;
- /* If the numbered capture is unset, but the reference was by name,
- scan the table to see if the name refers to any other numbers, and test
- them. The condition is true if any one is set. This is tediously similar
- to the code above, but not close enough to try to amalgamate. */
-
- if (!condition && condcode == OP_NCREF)
+ case OP_DNCREF: /* Duplicate named group used test */
{
- unsigned int refno = offset >> 1;
- pcre_uchar *slotA = md->name_table;/* LOOP_COUNT: Warning, no CHK in this block */
-
- for (i = 0; i < md->name_count; i++) /* LOOP_COUNT: COST */
+ int count = GET2(ecode, 1 + IMM2_SIZE);
+ pcre_uchar *slot = md->name_table + GET2(ecode, 1) * md->name_entry_size;
+ while (count-- > 0) /* LOOP_COUNT: COST */
{
- if (GET2(slotA, 0) == refno) break;
- slotA += md->name_entry_size;
+ offset = GET2(slot, 0) << 1;
+ condition = offset < offset_top && md->offset_vector[offset] >= 0;
+ if (condition) break;
+ slot += md->name_entry_size;
COST(1);
}
-
- /* Found a name for the number - there can be only one; duplicate names
- for different numbers are allowed, but not vice versa. First scan down
- for duplicates. */
-
- if (i < md->name_count)
- {
- pcre_uchar *slotB = slotA;
- while (slotB > md->name_table) /* LOOP_COUNT: COST */
- {
- slotB -= md->name_entry_size;
- if (STRCMP_UC_UC(slotA + IMM2_SIZE, slotB + IMM2_SIZE) == 0)
- {
- offset = GET2(slotB, 0) << 1;
- condition = offset < offset_top &&
- md->offset_vector[offset] >= 0;
- if (condition) break;
- }
- else break;
- COST(1);
- }
-
- /* Scan up for duplicates */
-
- if (!condition)
- {
- slotB = slotA;
- for (i++; i < md->name_count; i++) /* LOOP_COUNT: COST */
- {
- slotB += md->name_entry_size;
- if (STRCMP_UC_UC(slotA + IMM2_SIZE, slotB + IMM2_SIZE) == 0)
- {
- offset = GET2(slotB, 0) << 1;
- condition = offset < offset_top &&
- md->offset_vector[offset] >= 0;
- if (condition) break;
- }
- else break;
- COST(1);
- }
- }
- }
}
+ break;
- /* Chose branch according to the condition */
-
- ecode += condition? 1 + IMM2_SIZE : GET(ecode, 1);
- }
-
- else if (condcode == OP_DEF) /* DEFINE - always false */
- {
- condition = FALSE;
- ecode += GET(ecode, 1);
- }
+ case OP_DEF: /* DEFINE - always false */
+ case OP_FAIL: /* From optimized (?!) condition */
+ break;
- /* The condition is an assertion. Call match() to evaluate it - setting
- md->match_function_type to MATCH_CONDASSERT causes it to stop at the end of
- an assertion. */
+ /* The condition is an assertion. Call match() to evaluate it - setting
+ md->match_function_type to MATCH_CONDASSERT causes it to stop at the end
+ of an assertion. */
- else
- {
+ default:
md->match_function_type = MATCH_CONDASSERT;
- RMATCH(eptr, ecode + 1 + LINK_SIZE, offset_top, md, NULL, RM3);
+ RMATCH(eptr, ecode, offset_top, md, NULL, RM3);
if (rrc == MATCH_MATCH)
{
if (md->end_offset_top > offset_top)
offset_top = md->end_offset_top; /* Captures may have happened */
condition = TRUE;
- ecode += 1 + LINK_SIZE + GET(ecode, LINK_SIZE + 2);
+
+ /* Advance ecode past the assertion to the start of the first branch,
+ but adjust it so that the general choosing code below works. If the
+ assertion has a quantifier that allows zero repeats we must skip over
+ the BRAZERO. This is a lunatic thing to do, but somebody did! */
+
+ if (*ecode == OP_BRAZERO) ecode++;
+ ecode += GET(ecode, 1);
while (*ecode == OP_ALT) ecode += GET(ecode, 1); /* LOOP_COUNT: Ok */
+ ecode += 1 + LINK_SIZE - PRIV(OP_lengths)[condcode];
}
/* PCRE doesn't allow the effect of (*THEN) to escape beyond an
- assertion; it is therefore treated as NOMATCH. */
+ assertion; it is therefore treated as NOMATCH. Any other return is an
+ error. */
else if (rrc != MATCH_NOMATCH && rrc != MATCH_THEN)
{
RRETURN(rrc); /* Need braces because of following else */
}
- else
- {
- condition = FALSE;
- ecode += codelink;
- }
+ break;
}
- /* We are now at the branch that is to be obeyed. As there is only one, can
- use tail recursion to avoid using another stack frame, except when there is
- unlimited repeat of a possibly empty group. In the latter case, a recursive
- call to match() is always required, unless the second alternative doesn't
- exist, in which case we can just plough on. Note that, for compatibility
- with Perl, the | in a conditional group is NOT treated as creating two
- alternatives. If a THEN is encountered in the branch, it propagates out to
- the enclosing alternative (unless nested in a deeper set of alternatives,
- of course). */
-
- if (condition || *ecode == OP_ALT)
+ /* Choose branch according to the condition */
+
+ ecode += condition? PRIV(OP_lengths)[condcode] : codelink;
+
+ /* We are now at the branch that is to be obeyed. As there is only one, we
+ can use tail recursion to avoid using another stack frame, except when
+ there is unlimited repeat of a possibly empty group. In the latter case, a
+ recursive call to match() is always required, unless the second alternative
+ doesn't exist, in which case we can just plough on. Note that, for
+ compatibility with Perl, the | in a conditional group is NOT treated as
+ creating two alternatives. If a THEN is encountered in the branch, it
+ propagates out to the enclosing alternative (unless nested in a deeper set
+ of alternatives, of course). */
+
+ if (condition || ecode[-(1+LINK_SIZE)] == OP_ALT)
{
if (op != OP_SCOND)
{
- ecode += 1 + LINK_SIZE;
goto TAIL_RECURSE;
}
md->match_function_type = MATCH_CBEGROUP;
- RMATCH(eptr, ecode + 1 + LINK_SIZE, offset_top, md, eptrb, RM49);
+ RMATCH(eptr, ecode, offset_top, md, eptrb, RM49);
RRETURN(rrc);
}
@@ -1621,7 +1534,6 @@ for (;;)
else
{
- ecode += 1 + LINK_SIZE;
}
break;
@@ -1644,7 +1556,22 @@ for (;;)
md->offset_vector[offset] =
md->offset_vector[md->offset_end - number];
md->offset_vector[offset+1] = (int)(eptr - md->start_subject);
- if (offset_top <= offset) offset_top = offset + 2;
+
+ /* If this group is at or above the current highwater mark, ensure that
+ any groups between the current high water mark and this group are marked
+ unset and then update the high water mark. */
+
+ if (offset >= offset_top)
+ {
+ register int *iptr = md->offset_vector + offset_top;
+ register int *iend = md->offset_vector + offset;
+ if (iptr < iend)
+ {
+ COST(iend - iptr);
+ while (iptr < iend) *iptr++ = -1; /* LOOP_COUNT: COST */
+ }
+ offset_top = offset + 2;
+ }
}
ecode += 1 + IMM2_SIZE;
break;
@@ -2000,7 +1927,11 @@ for (;;)
are defined in a range that can be tested for. */
if (rrc >= MATCH_BACKTRACK_MIN && rrc <= MATCH_BACKTRACK_MAX)
+ {
+ if (new_recursive.offset_save != stacksave)
+ (PUBL(free))(new_recursive.offset_save);
RRETURN(MATCH_NOMATCH);
+ }
/* Any return code other than NOMATCH is an error. */
@@ -2151,7 +2082,11 @@ for (;;)
{
register int *iptr = md->offset_vector + offset_top;
register int *iend = md->offset_vector + offset;
- while (iptr < iend) *iptr++ = -1; /* LOOP_COUNT: CHK */
+ if (iptr < iend)
+ {
+ COST(iend - iptr);
+ while (iptr < iend) *iptr++ = -1; /* LOOP_COUNT: COST */
+ }
}
/* Now make the extraction */
@@ -2163,6 +2098,19 @@ for (;;)
}
}
+ /* OP_KETRPOS is a possessive repeating ket. Remember the current position,
+ and return the MATCH_KETRPOS. This makes it possible to do the repeats one
+ at a time from the outer level, thus saving stack. This must precede the
+ empty string test - in this case that test is done at the outer level. */
+
+ if (*ecode == OP_KETRPOS)
+ {
+ md->start_match_ptr = mstart; /* In case \K reset it */
+ md->end_match_ptr = eptr;
+ md->end_offset_top = offset_top;
+ RRETURN(MATCH_KETRPOS);
+ }
+
/* For an ordinary non-repeating ket, just continue at this level. This
also happens for a repeating ket if no characters were matched in the
group. This is the forcible breaking of infinite loops as implemented in
@@ -2185,17 +2133,6 @@ for (;;)
break;
}
- /* OP_KETRPOS is a possessive repeating ket. Remember the current position,
- and return the MATCH_KETRPOS. This makes it possible to do the repeats one
- at a time from the outer level, thus saving stack. */
-
- if (*ecode == OP_KETRPOS)
- {
- md->end_match_ptr = eptr;
- md->end_offset_top = offset_top;
- RRETURN(MATCH_KETRPOS);
- }
-
/* The normal repeating kets try the rest of the pattern or restart from
the preceding bracket, in the appropriate order. In the second case, we can
use tail recursion to avoid using another stack frame, unless we have an
@@ -2286,7 +2223,7 @@ for (;;)
eptr + 1 >= md->end_subject &&
NLBLOCK->nltype == NLTYPE_FIXED &&
NLBLOCK->nllen == 2 &&
- RAWUCHARTEST(eptr) == NLBLOCK->nl[0])
+ UCHAR21TEST(eptr) == NLBLOCK->nl[0])
{
md->hitend = TRUE;
if (md->partial > 1) RRETURN(PCRE_ERROR_PARTIAL);
@@ -2330,7 +2267,7 @@ for (;;)
eptr + 1 >= md->end_subject &&
NLBLOCK->nltype == NLTYPE_FIXED &&
NLBLOCK->nllen == 2 &&
- RAWUCHARTEST(eptr) == NLBLOCK->nl[0])
+ UCHAR21TEST(eptr) == NLBLOCK->nl[0])
{
md->hitend = TRUE;
if (md->partial > 1) RRETURN(PCRE_ERROR_PARTIAL);
@@ -2473,7 +2410,7 @@ for (;;)
eptr + 1 >= md->end_subject &&
NLBLOCK->nltype == NLTYPE_FIXED &&
NLBLOCK->nllen == 2 &&
- RAWUCHARTEST(eptr) == NLBLOCK->nl[0])
+ UCHAR21TEST(eptr) == NLBLOCK->nl[0])
{
md->hitend = TRUE;
if (md->partial > 1) RRETURN(PCRE_ERROR_PARTIAL);
@@ -2627,7 +2564,7 @@ for (;;)
{
SCHECK_PARTIAL();
}
- else if (RAWUCHARTEST(eptr) == CHAR_LF) eptr++;
+ else if (UCHAR21TEST(eptr) == CHAR_LF) eptr++;
break;
case CHAR_LF:
@@ -2758,19 +2695,24 @@ for (;;)
RRETURN(MATCH_NOMATCH);
break;
- case PT_SPACE: /* Perl space */
- if ((PRIV(ucp_gentype)[prop->chartype] == ucp_Z ||
- c == CHAR_HT || c == CHAR_NL || c == CHAR_FF || c == CHAR_CR)
- == (op == OP_NOTPROP))
- RRETURN(MATCH_NOMATCH);
- break;
+ /* Perl space used to exclude VT, but from Perl 5.18 it is included,
+ which means that Perl space and POSIX space are now identical. PCRE
+ was changed at release 8.34. */
+ case PT_SPACE: /* Perl space */
case PT_PXSPACE: /* POSIX space */
- if ((PRIV(ucp_gentype)[prop->chartype] == ucp_Z ||
- c == CHAR_HT || c == CHAR_NL || c == CHAR_VT ||
- c == CHAR_FF || c == CHAR_CR)
- == (op == OP_NOTPROP))
- RRETURN(MATCH_NOMATCH);
+ switch(c)
+ {
+ HSPACE_CASES:
+ VSPACE_CASES:
+ if (op == OP_NOTPROP) RRETURN(MATCH_NOMATCH);
+ break;
+
+ default:
+ if ((PRIV(ucp_gentype)[prop->chartype] == ucp_Z) ==
+ (op == OP_NOTPROP)) RRETURN(MATCH_NOMATCH);
+ break;
+ }
break;
case PT_WORD:
@@ -2848,15 +2790,7 @@ for (;;)
similar code to character type repeats - written out again for speed.
However, if the referenced string is the empty string, always treat
it as matched, any number of times (otherwise there could be infinite
- loops). */
-
- case OP_REF:
- case OP_REFI:
- caseless = op == OP_REFI;
- offset = GET2(ecode, 1) << 1; /* Doubled ref number */
- ecode += 1 + IMM2_SIZE;
-
- /* If the reference is unset, there are two possibilities:
+ loops). If the reference is unset, there are two possibilities:
(a) In the default, Perl-compatible state, set the length negative;
this ensures that every attempt at a match fails. We can't just fail
@@ -2866,8 +2800,46 @@ for (;;)
so that the back reference matches an empty string.
Otherwise, set the length to the length of what was matched by the
- referenced subpattern. */
+ referenced subpattern.
+
+ The OP_REF and OP_REFI opcodes are used for a reference to a numbered group
+ or to a non-duplicated named group. For a duplicated named group, OP_DNREF
+ and OP_DNREFI are used. In this case we must scan the list of groups to
+ which the name refers, and use the first one that is set. */
+
+ case OP_DNREF:
+ case OP_DNREFI:
+ caseless = op == OP_DNREFI;
+ {
+ int count = GET2(ecode, 1+IMM2_SIZE);
+ pcre_uchar *slot = md->name_table + GET2(ecode, 1) * md->name_entry_size;
+ ecode += 1 + 2*IMM2_SIZE;
+
+ /* Setting the default length first and initializing 'offset' avoids
+ compiler warnings in the REF_REPEAT code. */
+
+ length = (md->jscript_compat)? 0 : -1;
+ offset = 0;
+ while (count-- > 0) /* LOOP_COUNT: COST */
+ {
+ offset = GET2(slot, 0) << 1;
+ if (offset < offset_top && md->offset_vector[offset] >= 0)
+ {
+ length = md->offset_vector[offset+1] - md->offset_vector[offset];
+ break;
+ }
+ slot += md->name_entry_size;
+ }
+ COST(1);
+ }
+ goto REF_REPEAT;
+
+ case OP_REF:
+ case OP_REFI:
+ caseless = op == OP_REFI;
+ offset = GET2(ecode, 1) << 1; /* Doubled ref number */
+ ecode += 1 + IMM2_SIZE;
if (offset >= offset_top || md->offset_vector[offset] < 0)
length = (md->jscript_compat)? 0 : -1;
else
@@ -2875,6 +2847,7 @@ for (;;)
/* Set up for repetition, or handle the non-repeated case */
+ REF_REPEAT:
switch (*ecode)
{
case OP_CRSTAR:
@@ -3027,8 +3000,12 @@ for (;;)
case OP_CRMINPLUS:
case OP_CRQUERY:
case OP_CRMINQUERY:
+ case OP_CRPOSSTAR:
+ case OP_CRPOSPLUS:
+ case OP_CRPOSQUERY:
c = *ecode++ - OP_CRSTAR;
- minimize = (c & 1) != 0;
+ if (c < OP_CRPOSSTAR - OP_CRSTAR) minimize = (c & 1) != 0;
+ else possessive = TRUE;
min = rep_min[c]; /* Pick up values from tables; */
max = rep_max[c]; /* zero for max => infinity */
if (max == 0) max = INT_MAX;
@@ -3036,7 +3013,9 @@ for (;;)
case OP_CRRANGE:
case OP_CRMINRANGE:
+ case OP_CRPOSRANGE:
minimize = (*ecode == OP_CRMINRANGE);
+ possessive = (*ecode == OP_CRPOSRANGE);
min = GET2(ecode, 1);
max = GET2(ecode, 1 + IMM2_SIZE);
if (max == 0) max = INT_MAX;
@@ -3181,6 +3160,9 @@ for (;;)
eptr += len;
COST_CHK(1);
}
+
+ if (possessive) continue; /* No backtracking */
+
for (;;) /* LOOP_COUNT: Ok */
{
RMATCH(eptr, ecode, offset_top, md, eptrb, RM18);
@@ -3212,7 +3194,10 @@ for (;;)
COST_CHK(1);
eptr++;
}
- while (eptr >= pp) /* LOOP_COUNT: Ok */
+
+ if (possessive) continue; /* No backtracking */
+
+ while (eptr >= pp) /* LOOP_COUNT: Ok */
{
RMATCH(eptr, ecode, offset_top, md, eptrb, RM19);
if (rrc != MATCH_NOMATCH) RRETURN(rrc);
@@ -3227,9 +3212,10 @@ for (;;)
/* Control never gets here */
- /* Match an extended character class. This opcode is encountered only
- when UTF-8 mode mode is supported. Nevertheless, we may not be in UTF-8
- mode, because Unicode properties are supported in non-UTF-8 mode. */
+ /* Match an extended character class. In the 8-bit library, this opcode is
+ encountered only when UTF-8 mode mode is supported. In the 16-bit and
+ 32-bit libraries, codepoints greater than 255 may be encountered even when
+ UTF is not supported. */
#if defined SUPPORT_UTF || !defined COMPILE_PCRE8
case OP_XCLASS:
@@ -3245,8 +3231,12 @@ for (;;)
case OP_CRMINPLUS:
case OP_CRQUERY:
case OP_CRMINQUERY:
+ case OP_CRPOSSTAR:
+ case OP_CRPOSPLUS:
+ case OP_CRPOSQUERY:
c = *ecode++ - OP_CRSTAR;
- minimize = (c & 1) != 0;
+ if (c < OP_CRPOSSTAR - OP_CRSTAR) minimize = (c & 1) != 0;
+ else possessive = TRUE;
min = rep_min[c]; /* Pick up values from tables; */
max = rep_max[c]; /* zero for max => infinity */
if (max == 0) max = INT_MAX;
@@ -3254,7 +3244,9 @@ for (;;)
case OP_CRRANGE:
case OP_CRMINRANGE:
+ case OP_CRPOSRANGE:
minimize = (*ecode == OP_CRMINRANGE);
+ possessive = (*ecode == OP_CRPOSRANGE);
min = GET2(ecode, 1);
max = GET2(ecode, 1 + IMM2_SIZE);
if (max == 0) max = INT_MAX;
@@ -3327,6 +3319,9 @@ for (;;)
eptr += len;
COST_CHK(1);
}
+
+ if (possessive) continue; /* No backtracking */
+
for(;;) /* LOOP_COUNT: Ok */
{
RMATCH(eptr, ecode, offset_top, md, eptrb, RM21);
@@ -3357,7 +3352,7 @@ for (;;)
CHECK_PARTIAL(); /* Not SCHECK_PARTIAL() */
RRETURN(MATCH_NOMATCH);
}
- while (length-- > 0) if (*ecode++ != RAWUCHARINC(eptr)) RRETURN(MATCH_NOMATCH); /* LOOP_COUNT: Ok */
+ while (length-- > 0) if (*ecode++ != UCHAR21INC(eptr)) RRETURN(MATCH_NOMATCH); /* LOOP_COUNT: Ok */
}
else
#endif
@@ -3398,7 +3393,7 @@ for (;;)
if (fc < 128)
{
- pcre_uint32 cc = RAWUCHAR(eptr);
+ pcre_uint32 cc = UCHAR21(eptr);
if (md->lcc[fc] != TABLE_GET(cc, md->lcc, cc)) RRETURN(MATCH_NOMATCH);
ecode++;
eptr++;
@@ -3606,7 +3601,7 @@ for (;;)
if (possessive) continue; /* No backtracking */
for(;;) /* LOOP_COUNT: Ok */
{
- if (eptr == pp) goto TAIL_RECURSE;
+ if (eptr <= pp) goto TAIL_RECURSE;
RMATCH(eptr, ecode, offset_top, md, eptrb, RM23);
if (rrc != MATCH_NOMATCH) RRETURN(rrc);
#ifdef SUPPORT_UCP
@@ -3668,7 +3663,7 @@ for (;;)
SCHECK_PARTIAL();
RRETURN(MATCH_NOMATCH);
}
- cc = RAWUCHARTEST(eptr);
+ cc = UCHAR21TEST(eptr);
if (fc != cc && foc != cc) RRETURN(MATCH_NOMATCH);
eptr++;
COST_CHK(1);
@@ -3687,7 +3682,7 @@ for (;;)
SCHECK_PARTIAL();
RRETURN(MATCH_NOMATCH);
}
- cc = RAWUCHARTEST(eptr);
+ cc = UCHAR21TEST(eptr);
if (fc != cc && foc != cc) RRETURN(MATCH_NOMATCH);
eptr++;
}
@@ -3704,12 +3699,11 @@ for (;;)
SCHECK_PARTIAL();
break;
}
- cc = RAWUCHARTEST(eptr);
+ cc = UCHAR21TEST(eptr);
if (fc != cc && foc != cc) break;
eptr++;
COST_CHK(1);
}
-
if (possessive) continue; /* No backtracking */
for (;;) /* LOOP_COUNT: Ok */
{
@@ -3718,9 +3712,8 @@ for (;;)
eptr--;
if (rrc != MATCH_NOMATCH) RRETURN(rrc);
}
- RRETURN(MATCH_NOMATCH);
+ /* Control never gets here */
}
- /* Control never gets here */
}
/* Caseful comparisons (includes all multi-byte characters) */
@@ -3735,7 +3728,7 @@ for (;;)
SCHECK_PARTIAL();
RRETURN(MATCH_NOMATCH);
}
- if (fc != RAWUCHARINCTEST(eptr)) RRETURN(MATCH_NOMATCH);
+ if (fc != UCHAR21INCTEST(eptr)) RRETURN(MATCH_NOMATCH);
}
if (min == max) continue;
@@ -3752,7 +3745,7 @@ for (;;)
SCHECK_PARTIAL();
RRETURN(MATCH_NOMATCH);
}
- if (fc != RAWUCHARINCTEST(eptr)) RRETURN(MATCH_NOMATCH);
+ if (fc != UCHAR21INCTEST(eptr)) RRETURN(MATCH_NOMATCH);
}
/* Control never gets here */
}
@@ -3766,7 +3759,7 @@ for (;;)
SCHECK_PARTIAL();
break;
}
- if (fc != RAWUCHARTEST(eptr)) break;
+ if (fc != UCHAR21TEST(eptr)) break;
eptr++;
COST_CHK(1);
}
@@ -3778,7 +3771,7 @@ for (;;)
eptr--;
if (rrc != MATCH_NOMATCH) RRETURN(rrc);
}
- RRETURN(MATCH_NOMATCH);
+ /* Control never gets here */
}
}
/* Control never gets here */
@@ -4036,7 +4029,7 @@ for (;;)
if (possessive) continue; /* No backtracking */
for(;;) /* LOOP_COUNT: Ok */
{
- if (eptr == pp) goto TAIL_RECURSE;
+ if (eptr <= pp) goto TAIL_RECURSE;
RMATCH(eptr, ecode, offset_top, md, eptrb, RM30);
if (rrc != MATCH_NOMATCH) RRETURN(rrc);
eptr--;
@@ -4067,10 +4060,8 @@ for (;;)
eptr--;
}
}
-
- RRETURN(MATCH_NOMATCH);
+ /* Control never gets here */
}
- /* Control never gets here */
}
/* Caseful comparisons */
@@ -4098,7 +4089,7 @@ for (;;)
/* Not UTF mode */
{
COST(min);
- for (i = 1; i <= min; i++) /* LOOP_COUNT: Ok */
+ for (i = 1; i <= min; i++) /* LOOP_COUNT: Cost */
{
if (eptr >= md->end_subject)
{
@@ -4177,7 +4168,7 @@ for (;;)
if (possessive) continue; /* No backtracking */
for(;;) /* LOOP_COUNT: Ok */
{
- if (eptr == pp) goto TAIL_RECURSE;
+ if (eptr <= pp) goto TAIL_RECURSE;
RMATCH(eptr, ecode, offset_top, md, eptrb, RM34);
if (rrc != MATCH_NOMATCH) RRETURN(rrc);
eptr--;
@@ -4208,8 +4199,7 @@ for (;;)
eptr--;
}
}
-
- RRETURN(MATCH_NOMATCH);
+ /* Control never gets here */
}
}
/* Control never gets here */
@@ -4392,7 +4382,12 @@ for (;;)
}
break;
+ /* Perl space used to exclude VT, but from Perl 5.18 it is included,
+ which means that Perl space and POSIX space are now identical. PCRE
+ was changed at release 8.34. */
+
case PT_SPACE: /* Perl space */
+ case PT_PXSPACE: /* POSIX space */
for (i = 1; i <= min; i++) /* LOOP_COUNT: COST (above) */
{
if (eptr >= md->end_subject)
@@ -4401,26 +4396,18 @@ for (;;)
RRETURN(MATCH_NOMATCH);
}
GETCHARINCTEST(c, eptr);
- if ((UCD_CATEGORY(c) == ucp_Z || c == CHAR_HT || c == CHAR_NL ||
- c == CHAR_FF || c == CHAR_CR)
- == prop_fail_result)
- RRETURN(MATCH_NOMATCH);
- }
- break;
-
- case PT_PXSPACE: /* POSIX space */
- for (i = 1; i <= min; i++) /* LOOP_COUNT: COST (above) */
- {
- if (eptr >= md->end_subject)
+ switch(c)
{
- SCHECK_PARTIAL();
- RRETURN(MATCH_NOMATCH);
+ HSPACE_CASES:
+ VSPACE_CASES:
+ if (prop_fail_result) RRETURN(MATCH_NOMATCH);
+ break;
+
+ default:
+ if ((UCD_CATEGORY(c) == ucp_Z) == prop_fail_result)
+ RRETURN(MATCH_NOMATCH);
+ break;
}
- GETCHARINCTEST(c, eptr);
- if ((UCD_CATEGORY(c) == ucp_Z || c == CHAR_HT || c == CHAR_NL ||
- c == CHAR_VT || c == CHAR_FF || c == CHAR_CR)
- == prop_fail_result)
- RRETURN(MATCH_NOMATCH);
}
break;
@@ -4543,7 +4530,7 @@ for (;;)
eptr + 1 >= md->end_subject &&
NLBLOCK->nltype == NLTYPE_FIXED &&
NLBLOCK->nllen == 2 &&
- RAWUCHAR(eptr) == NLBLOCK->nl[0])
+ UCHAR21(eptr) == NLBLOCK->nl[0])
{
md->hitend = TRUE;
if (md->partial > 1) RRETURN(PCRE_ERROR_PARTIAL);
@@ -4587,7 +4574,7 @@ for (;;)
default: RRETURN(MATCH_NOMATCH);
case CHAR_CR:
- if (eptr < md->end_subject && RAWUCHAR(eptr) == CHAR_LF) eptr++;
+ if (eptr < md->end_subject && UCHAR21(eptr) == CHAR_LF) eptr++;
break;
case CHAR_LF:
@@ -4703,7 +4690,7 @@ for (;;)
SCHECK_PARTIAL();
RRETURN(MATCH_NOMATCH);
}
- cc = RAWUCHAR(eptr);
+ cc = UCHAR21(eptr);
if (cc >= 128 || (md->ctypes[cc] & ctype_digit) == 0)
RRETURN(MATCH_NOMATCH);
eptr++;
@@ -4721,7 +4708,7 @@ for (;;)
SCHECK_PARTIAL();
RRETURN(MATCH_NOMATCH);
}
- cc = RAWUCHAR(eptr);
+ cc = UCHAR21(eptr);
if (cc < 128 && (md->ctypes[cc] & ctype_space) != 0)
RRETURN(MATCH_NOMATCH);
eptr++;
@@ -4739,7 +4726,7 @@ for (;;)
SCHECK_PARTIAL();
RRETURN(MATCH_NOMATCH);
}
- cc = RAWUCHAR(eptr);
+ cc = UCHAR21(eptr);
if (cc >= 128 || (md->ctypes[cc] & ctype_space) == 0)
RRETURN(MATCH_NOMATCH);
eptr++;
@@ -4757,7 +4744,7 @@ for (;;)
SCHECK_PARTIAL();
RRETURN(MATCH_NOMATCH);
}
- cc = RAWUCHAR(eptr);
+ cc = UCHAR21(eptr);
if (cc < 128 && (md->ctypes[cc] & ctype_word) != 0)
RRETURN(MATCH_NOMATCH);
eptr++;
@@ -4775,7 +4762,7 @@ for (;;)
SCHECK_PARTIAL();
RRETURN(MATCH_NOMATCH);
}
- cc = RAWUCHAR(eptr);
+ cc = UCHAR21(eptr);
if (cc >= 128 || (md->ctypes[cc] & ctype_word) == 0)
RRETURN(MATCH_NOMATCH);
eptr++;
@@ -5170,25 +5157,11 @@ for (;;)
}
/* Control never gets here */
- case PT_SPACE: /* Perl space */
- for (fi = min;; fi++) /* LOOP_COUNT: Ok */
- {
- RMATCH(eptr, ecode, offset_top, md, eptrb, RM60);
- if (rrc != MATCH_NOMATCH) RRETURN(rrc);
- if (fi >= max) RRETURN(MATCH_NOMATCH);
- if (eptr >= md->end_subject)
- {
- SCHECK_PARTIAL();
- RRETURN(MATCH_NOMATCH);
- }
- GETCHARINCTEST(c, eptr);
- if ((UCD_CATEGORY(c) == ucp_Z || c == CHAR_HT || c == CHAR_NL ||
- c == CHAR_FF || c == CHAR_CR)
- == prop_fail_result)
- RRETURN(MATCH_NOMATCH);
- }
- /* Control never gets here */
+ /* Perl space used to exclude VT, but from Perl 5.18 it is included,
+ which means that Perl space and POSIX space are now identical. PCRE
+ was changed at release 8.34. */
+ case PT_SPACE: /* Perl space */
case PT_PXSPACE: /* POSIX space */
for (fi = min;; fi++) /* LOOP_COUNT: Ok */
{
@@ -5201,10 +5174,18 @@ for (;;)
RRETURN(MATCH_NOMATCH);
}
GETCHARINCTEST(c, eptr);
- if ((UCD_CATEGORY(c) == ucp_Z || c == CHAR_HT || c == CHAR_NL ||
- c == CHAR_VT || c == CHAR_FF || c == CHAR_CR)
- == prop_fail_result)
- RRETURN(MATCH_NOMATCH);
+ switch(c)
+ {
+ HSPACE_CASES:
+ VSPACE_CASES:
+ if (prop_fail_result) RRETURN(MATCH_NOMATCH);
+ break;
+
+ default:
+ if ((UCD_CATEGORY(c) == ucp_Z) == prop_fail_result)
+ RRETURN(MATCH_NOMATCH);
+ break;
+ }
}
/* Control never gets here */
@@ -5258,7 +5239,7 @@ for (;;)
case PT_UCNC:
for (fi = min;; fi++) /* LOOP_COUNT: Ok */
{
- RMATCH(eptr, ecode, offset_top, md, eptrb, RM68);
+ RMATCH(eptr, ecode, offset_top, md, eptrb, RM60);
if (rrc != MATCH_NOMATCH) RRETURN(rrc);
if (fi >= max) RRETURN(MATCH_NOMATCH);
if (eptr >= md->end_subject)
@@ -5358,7 +5339,7 @@ for (;;)
{
default: RRETURN(MATCH_NOMATCH);
case CHAR_CR:
- if (eptr < md->end_subject && RAWUCHAR(eptr) == CHAR_LF) eptr++;
+ if (eptr < md->end_subject && UCHAR21(eptr) == CHAR_LF) eptr++;
break;
case CHAR_LF:
@@ -5698,7 +5679,12 @@ for (;;)
}
break;
+ /* Perl space used to exclude VT, but from Perl 5.18 it is included,
+ which means that Perl space and POSIX space are now identical. PCRE
+ was changed at release 8.34. */
+
case PT_SPACE: /* Perl space */
+ case PT_PXSPACE: /* POSIX space */
for (i = min; i < max; i++) /* LOOP_COUNT: CHK */
{
int len = 1;
@@ -5708,32 +5694,22 @@ for (;;)
break;
}
GETCHARLENTEST(c, eptr, len);
- if ((UCD_CATEGORY(c) == ucp_Z || c == CHAR_HT || c == CHAR_NL ||
- c == CHAR_FF || c == CHAR_CR)
- == prop_fail_result)
+ switch(c)
+ {
+ HSPACE_CASES:
+ VSPACE_CASES:
+ if (prop_fail_result) goto ENDLOOP99; /* Break the loop */
break;
- eptr+= len;
- COST_CHK(1);
- }
- break;
- case PT_PXSPACE: /* POSIX space */
- for (i = min; i < max; i++) /* LOOP_COUNT: CHK */
- {
- int len = 1;
- if (eptr >= md->end_subject)
- {
- SCHECK_PARTIAL();
+ default:
+ if ((UCD_CATEGORY(c) == ucp_Z) == prop_fail_result)
+ goto ENDLOOP99; /* Break the loop */
break;
}
- GETCHARLENTEST(c, eptr, len);
- if ((UCD_CATEGORY(c) == ucp_Z || c == CHAR_HT || c == CHAR_NL ||
- c == CHAR_VT || c == CHAR_FF || c == CHAR_CR)
- == prop_fail_result)
- break;
eptr+= len;
COST_CHK(1);
}
+ ENDLOOP99:
break;
case PT_WORD:
@@ -5741,7 +5717,7 @@ for (;;)
{
int category;
int len = 1;
- if (eptr >= md->end_subject)
+ if (eptr >= md->end_subject)
{
SCHECK_PARTIAL();
break;
@@ -5810,7 +5786,7 @@ for (;;)
if (possessive) continue; /* No backtracking */
for(;;) /* LOOP_COUNT: Ok */
{
- if (eptr == pp) goto TAIL_RECURSE;
+ if (eptr <= pp) goto TAIL_RECURSE;
RMATCH(eptr, ecode, offset_top, md, eptrb, RM44);
if (rrc != MATCH_NOMATCH) RRETURN(rrc);
eptr--;
@@ -5855,22 +5831,27 @@ for (;;)
/* eptr is now past the end of the maximum run */
if (possessive) continue; /* No backtracking */
-
+
+ /* We use <= pp rather than == pp to detect the start of the run while
+ backtracking because the use of \C in UTF mode can cause BACKCHAR to
+ move back past pp. This is just palliative; the use of \C in UTF mode
+ is fraught with danger. */
+
for(;;) /* LOOP_COUNT: Ok */
{
#ifndef ERLANG_INTEGRATION
- int lgb, rgb;
+ int lgb, rgb;
#endif
PCRE_PUCHAR fptr;
-
- if (eptr == pp) goto TAIL_RECURSE; /* At start of char run */
+
+ if (eptr <= pp) goto TAIL_RECURSE; /* At start of char run */
RMATCH(eptr, ecode, offset_top, md, eptrb, RM45);
if (rrc != MATCH_NOMATCH) RRETURN(rrc);
/* Backtracking over an extended grapheme cluster involves inspecting
the previous two characters (if present) to see if a break is
permitted between them. */
-
+
eptr--;
if (!utf) c = *eptr; else
{
@@ -5881,14 +5862,14 @@ for (;;)
for (;;) /* LOOP_COUNT: COST */
{
- if (eptr == pp) goto TAIL_RECURSE; /* At start of char run */
+ if (eptr <= pp) goto TAIL_RECURSE; /* At start of char run */
fptr = eptr - 1;
if (!utf) c = *fptr; else
{
BACKCHAR(fptr);
GETCHAR(c, fptr);
}
- lgb = UCD_GRAPHBREAK(c);
+ lgb = UCD_GRAPHBREAK(c);
if ((PRIV(ucp_gbtable)[lgb] & (1 << rgb)) == 0) break;
eptr = fptr;
rgb = lgb;
@@ -5906,56 +5887,26 @@ for (;;)
switch(ctype)
{
case OP_ANY:
- if (max < INT_MAX)
+ for (i = min; i < max; i++) /* LOOP_COUNT: CHK */
{
- for (i = min; i < max; i++) /* LOOP_COUNT: CHK */
+ if (eptr >= md->end_subject)
{
- if (eptr >= md->end_subject)
- {
- SCHECK_PARTIAL();
- break;
- }
- if (IS_NEWLINE(eptr)) break;
- if (md->partial != 0 && /* Take care with CRLF partial */
- eptr + 1 >= md->end_subject &&
- NLBLOCK->nltype == NLTYPE_FIXED &&
- NLBLOCK->nllen == 2 &&
- RAWUCHAR(eptr) == NLBLOCK->nl[0])
- {
- md->hitend = TRUE;
- if (md->partial > 1) RRETURN(PCRE_ERROR_PARTIAL);
- }
- eptr++;
- ACROSSCHAR(eptr < md->end_subject, *eptr, eptr++);
- COST_CHK(1);
+ SCHECK_PARTIAL();
+ break;
}
- }
-
- /* Handle unlimited UTF-8 repeat */
-
- else
- {
- for (i = min; i < max; i++) /* LOOP_COUNT: CHK */
+ if (IS_NEWLINE(eptr)) break;
+ if (md->partial != 0 && /* Take care with CRLF partial */
+ eptr + 1 >= md->end_subject &&
+ NLBLOCK->nltype == NLTYPE_FIXED &&
+ NLBLOCK->nllen == 2 &&
+ UCHAR21(eptr) == NLBLOCK->nl[0])
{
- if (eptr >= md->end_subject)
- {
- SCHECK_PARTIAL();
- break;
- }
- if (IS_NEWLINE(eptr)) break;
- if (md->partial != 0 && /* Take care with CRLF partial */
- eptr + 1 >= md->end_subject &&
- NLBLOCK->nltype == NLTYPE_FIXED &&
- NLBLOCK->nllen == 2 &&
- RAWUCHAR(eptr) == NLBLOCK->nl[0])
- {
- md->hitend = TRUE;
- if (md->partial > 1) RRETURN(PCRE_ERROR_PARTIAL);
- }
- eptr++;
- ACROSSCHAR(eptr < md->end_subject, *eptr, eptr++);
- COST_CHK(1);
+ md->hitend = TRUE;
+ if (md->partial > 1) RRETURN(PCRE_ERROR_PARTIAL);
}
+ eptr++;
+ ACROSSCHAR(eptr < md->end_subject, *eptr, eptr++);
+ COST_CHK(1);
}
break;
@@ -6006,7 +5957,7 @@ for (;;)
if (c == CHAR_CR)
{
if (++eptr >= md->end_subject) break;
- if (RAWUCHAR(eptr) == CHAR_LF) eptr++;
+ if (UCHAR21(eptr) == CHAR_LF) eptr++;
}
else
{
@@ -6173,13 +6124,13 @@ for (;;)
if (possessive) continue; /* No backtracking */
for(;;) /* LOOP_COUNT: Ok */
{
- if (eptr == pp) goto TAIL_RECURSE;
+ if (eptr <= pp) goto TAIL_RECURSE;
RMATCH(eptr, ecode, offset_top, md, eptrb, RM46);
if (rrc != MATCH_NOMATCH) RRETURN(rrc);
eptr--;
BACKCHAR(eptr);
- if (ctype == OP_ANYNL && eptr > pp && RAWUCHAR(eptr) == CHAR_NL &&
- RAWUCHAR(eptr - 1) == CHAR_CR) eptr--;
+ if (ctype == OP_ANYNL && eptr > pp && UCHAR21(eptr) == CHAR_NL &&
+ UCHAR21(eptr - 1) == CHAR_CR) eptr--;
}
}
else
@@ -6438,11 +6389,8 @@ for (;;)
}
}
- /* Get here if we can't make it match with any permitted repetitions */
-
- RRETURN(MATCH_NOMATCH);
+ /* Control never gets here */
}
- /* Control never gets here */
/* There's been some horrible disaster. Arrival here can only mean there is
something seriously wrong in the code above or the OP_xxx definitions. */
@@ -6476,15 +6424,15 @@ switch (frame->Xwhere)
LBL(53) LBL(54) LBL(55) LBL(56) LBL(57) LBL(58) LBL(63) LBL(64)
LBL(65) LBL(66)
#if defined SUPPORT_UTF || !defined COMPILE_PCRE8
- LBL(21)
+ LBL(20) LBL(21)
#endif
#ifdef SUPPORT_UTF
- LBL(16) LBL(18) LBL(20)
+ LBL(16) LBL(18)
LBL(22) LBL(23) LBL(28) LBL(30)
LBL(32) LBL(34) LBL(42) LBL(46)
#ifdef SUPPORT_UCP
LBL(36) LBL(37) LBL(38) LBL(39) LBL(40) LBL(41) LBL(44) LBL(45)
- LBL(59) LBL(60) LBL(61) LBL(62) LBL(67) LBL(68)
+ LBL(59) LBL(60) LBL(61) LBL(62) LBL(67)
#endif /* SUPPORT_UCP */
#endif /* SUPPORT_UTF */
default:
@@ -6747,7 +6695,7 @@ const pcre_uint8 *start_bits = NULL;
PCRE_PUCHAR start_match = (PCRE_PUCHAR)subject + start_offset;
PCRE_PUCHAR end_subject;
PCRE_PUCHAR start_partial = NULL;
-PCRE_PUCHAR match_partial;
+PCRE_PUCHAR match_partial = NULL;
PCRE_PUCHAR req_char_ptr = start_match - 1;
const pcre_study_data *study;
@@ -6852,6 +6800,7 @@ pcre_uchar req_char;
start_bits = NULL;
start_match = (PCRE_PUCHAR)subject + start_offset;
start_partial = NULL;
+ match_partial = NULL;
req_char_ptr = start_match - 1;
re = (REAL_PCRE *)argument_re;
@@ -6988,7 +6937,7 @@ tables = re->tables;
if (extra_data != NULL)
{
- register unsigned int flags = extra_data->flags;
+ unsigned long int flags = extra_data->flags;
if ((flags & PCRE_EXTRA_STUDY_DATA) != 0)
study = (const pcre_study_data *)extra_data->study_data;
if ((flags & PCRE_EXTRA_MATCH_LIMIT) != 0)
@@ -7166,7 +7115,8 @@ if (md->offset_vector != NULL)
register int *iend = iptr - re->top_bracket;
if (iend < md->offset_vector + 2) iend = md->offset_vector + 2;
while (--iptr >= iend) *iptr = -1;
- md->offset_vector[0] = md->offset_vector[1] = -1;
+ if (offsetcount > 0) md->offset_vector[0] = -1;
+ if (offsetcount > 1) md->offset_vector[1] = -1;
}
/* Set up the first character to match, if available. The first_char value is
@@ -7264,10 +7214,10 @@ for(;;)
if (first_char != first_char2)
while (start_match < end_subject &&
- (smc = RAWUCHARTEST(start_match)) != first_char && smc != first_char2)
+ (smc = UCHAR21TEST(start_match)) != first_char && smc != first_char2)
start_match++;
else
- while (start_match < end_subject && RAWUCHARTEST(start_match) != first_char)
+ while (start_match < end_subject && UCHAR21TEST(start_match) != first_char)
start_match++;
}
@@ -7299,7 +7249,7 @@ for(;;)
if (start_match[-1] == CHAR_CR &&
(md->nltype == NLTYPE_ANY || md->nltype == NLTYPE_ANYCRLF) &&
start_match < end_subject &&
- RAWUCHARTEST(start_match) == CHAR_NL)
+ UCHAR21TEST(start_match) == CHAR_NL)
start_match++;
}
}
@@ -7310,33 +7260,22 @@ for(;;)
{
while (start_match < end_subject)
{
- register pcre_uint32 c = RAWUCHARTEST(start_match);
+ register pcre_uint32 c = UCHAR21TEST(start_match);
#ifndef COMPILE_PCRE8
if (c > 255) c = 255;
#endif
- if ((start_bits[c/8] & (1 << (c&7))) == 0)
- {
- start_match++;
-#if defined SUPPORT_UTF && defined COMPILE_PCRE8
- /* In non 8-bit mode, the iteration will stop for
- characters > 255 at the beginning or not stop at all. */
- if (utf)
- ACROSSCHAR(start_match < end_subject, *start_match,
- start_match++);
-#endif
- }
-#ifdef ERLANG_INTEGRATION
- else {
- if ((extra_data->flags & PCRE_EXTRA_LOOP_LIMIT) != 0)
+ if ((start_bits[c/8] & (1 << (c&7))) != 0)
{
- *extra_data->loop_counter_return =
- (extra_data->loop_limit - md->loop_limit);
- }
- break;
- }
-#else
- else break;
+#ifdef ERLANG_INTEGRATION
+ if ((extra_data->flags & PCRE_EXTRA_LOOP_LIMIT) != 0)
+ {
+ *extra_data->loop_counter_return =
+ (extra_data->loop_limit - md->loop_limit);
+ }
#endif
+ break;
+ }
+ start_match++;
}
}
} /* Starting optimizations */
@@ -7396,7 +7335,7 @@ for(;;)
{
while (p < end_subject)
{
- register pcre_uint32 pp = RAWUCHARINCTEST(p);
+ register pcre_uint32 pp = UCHAR21INCTEST(p);
if (pp == req_char || pp == req_char2) { p--; break; }
}
}
@@ -7404,7 +7343,7 @@ for(;;)
{
while (p < end_subject)
{
- if (RAWUCHARINCTEST(p) == req_char) { p--; break; }
+ if (UCHAR21INCTEST(p) == req_char) { p--; break; }
}
}
@@ -7684,7 +7623,7 @@ if (rc != MATCH_NOMATCH && rc != PCRE_ERROR_PARTIAL)
/* Handle partial matches - disable any mark data */
-if (start_partial != NULL)
+if (match_partial != NULL)
{
DPRINTF((">>>> returning PCRE_ERROR_PARTIAL\n"));
md->mark = NULL;
diff --git a/erts/emulator/pcre/pcre_fullinfo.c b/erts/emulator/pcre/pcre_fullinfo.c
index 1636c5978f..4e22430a1c 100644
--- a/erts/emulator/pcre/pcre_fullinfo.c
+++ b/erts/emulator/pcre/pcre_fullinfo.c
@@ -239,6 +239,10 @@ switch (what)
*((pcre_uint32 *)where) = re->limit_recursion;
break;
+ case PCRE_INFO_MATCH_EMPTY:
+ *((int *)where) = (re->flags & PCRE_MATCH_EMPTY) != 0;
+ break;
+
default: return PCRE_ERROR_BADOPTION;
}
diff --git a/erts/emulator/pcre/pcre_get.c b/erts/emulator/pcre/pcre_get.c
index c0bb21bbbf..86ab8fe5c5 100644
--- a/erts/emulator/pcre/pcre_get.c
+++ b/erts/emulator/pcre/pcre_get.c
@@ -284,6 +284,7 @@ Arguments:
code the compiled regex
stringname the name of the capturing substring
ovector the vector of matched substrings
+ stringcount number of captured substrings
Returns: the number of the first that is set,
or the number of the last one if none are set,
@@ -292,13 +293,16 @@ Returns: the number of the first that is set,
#if defined COMPILE_PCRE8
static int
-get_first_set(const pcre *code, const char *stringname, int *ovector)
+get_first_set(const pcre *code, const char *stringname, int *ovector,
+ int stringcount)
#elif defined COMPILE_PCRE16
static int
-get_first_set(const pcre16 *code, PCRE_SPTR16 stringname, int *ovector)
+get_first_set(const pcre16 *code, PCRE_SPTR16 stringname, int *ovector,
+ int stringcount)
#elif defined COMPILE_PCRE32
static int
-get_first_set(const pcre32 *code, PCRE_SPTR32 stringname, int *ovector)
+get_first_set(const pcre32 *code, PCRE_SPTR32 stringname, int *ovector,
+ int stringcount)
#endif
{
const REAL_PCRE *re = (const REAL_PCRE *)code;
@@ -335,7 +339,7 @@ if (entrysize <= 0) return entrysize;
for (entry = (pcre_uchar *)first; entry <= (pcre_uchar *)last; entry += entrysize)
{
int n = GET2(entry, 0);
- if (ovector[n*2] >= 0) return n;
+ if (n < stringcount && ovector[n*2] >= 0) return n;
}
return GET2(entry, 0);
}
@@ -455,7 +459,7 @@ pcre32_copy_named_substring(const pcre32 *code, PCRE_SPTR32 subject,
PCRE_UCHAR32 *buffer, int size)
#endif
{
-int n = get_first_set(code, stringname, ovector);
+int n = get_first_set(code, stringname, ovector, stringcount);
if (n <= 0) return n;
#if defined COMPILE_PCRE8
#if defined(ERLANG_INTEGRATION)
@@ -520,7 +524,10 @@ pcre_uchar **stringlist;
pcre_uchar *p;
for (i = 0; i < double_count; i += 2)
- size += sizeof(pcre_uchar *) + IN_UCHARS(ovector[i+1] - ovector[i] + 1);
+ {
+ size += sizeof(pcre_uchar *) + IN_UCHARS(1);
+ if (ovector[i+1] > ovector[i]) size += IN_UCHARS(ovector[i+1] - ovector[i]);
+ }
stringlist = (pcre_uchar **)(PUBL(malloc))(size);
if (stringlist == NULL) return PCRE_ERROR_NOMEMORY;
@@ -536,7 +543,7 @@ p = (pcre_uchar *)(stringlist + stringcount + 1);
for (i = 0; i < double_count; i += 2)
{
- int len = ovector[i+1] - ovector[i];
+ int len = (ovector[i+1] > ovector[i])? (ovector[i+1] - ovector[i]) : 0;
memcpy(p, subject + ovector[i], IN_UCHARS(len));
*stringlist++ = p;
p += len;
@@ -700,7 +707,7 @@ pcre32_get_named_substring(const pcre32 *code, PCRE_SPTR32 subject,
PCRE_SPTR32 *stringptr)
#endif
{
-int n = get_first_set(code, stringname, ovector);
+int n = get_first_set(code, stringname, ovector, stringcount);
if (n <= 0) return n;
#if defined COMPILE_PCRE8
#if defined(ERLANG_INTEGRATION)
diff --git a/erts/emulator/pcre/pcre_globals.c b/erts/emulator/pcre/pcre_globals.c
index ce143b8c21..4d83606a61 100644
--- a/erts/emulator/pcre/pcre_globals.c
+++ b/erts/emulator/pcre/pcre_globals.c
@@ -6,7 +6,7 @@
and semantics are as close as possible to those of the Perl 5 language.
Written by Philip Hazel
- Copyright (c) 1997-2012 University of Cambridge
+ Copyright (c) 1997-2014 University of Cambridge
-----------------------------------------------------------------------------
Redistribution and use in source and binary forms, with or without
@@ -74,6 +74,7 @@ PCRE_EXP_DATA_DEFN void (*PUBL(free))(void *) = LocalPcreFree;
PCRE_EXP_DATA_DEFN void *(*PUBL(stack_malloc))(size_t) = LocalPcreMalloc;
PCRE_EXP_DATA_DEFN void (*PUBL(stack_free))(void *) = LocalPcreFree;
PCRE_EXP_DATA_DEFN int (*PUBL(callout))(PUBL(callout_block) *) = NULL;
+PCRE_EXP_DATA_DEFN int (*PUBL(stack_guard))(void) = NULL;
#elif !defined VPCOMPAT
PCRE_EXP_DATA_DEFN void *(*PUBL(malloc))(size_t) = malloc;
@@ -81,6 +82,7 @@ PCRE_EXP_DATA_DEFN void (*PUBL(free))(void *) = free;
PCRE_EXP_DATA_DEFN void *(*PUBL(stack_malloc))(size_t) = malloc;
PCRE_EXP_DATA_DEFN void (*PUBL(stack_free))(void *) = free;
PCRE_EXP_DATA_DEFN int (*PUBL(callout))(PUBL(callout_block) *) = NULL;
+PCRE_EXP_DATA_DEFN int (*PUBL(stack_guard))(void) = NULL;
#endif
/* End of pcre_globals.c */
diff --git a/erts/emulator/pcre/pcre_internal.h b/erts/emulator/pcre/pcre_internal.h
index af436bd99b..c84dcb5a38 100644
--- a/erts/emulator/pcre/pcre_internal.h
+++ b/erts/emulator/pcre/pcre_internal.h
@@ -7,7 +7,7 @@
and semantics are as close as possible to those of the Perl 5 language.
Written by Philip Hazel
- Copyright (c) 1997-2013 University of Cambridge
+ Copyright (c) 1997-2016 University of Cambridge
-----------------------------------------------------------------------------
Redistribution and use in source and binary forms, with or without
@@ -281,7 +281,7 @@ pcre.h(.in) and disable (comment out) this message. */
typedef pcre_uint16 pcre_uchar;
#define UCHAR_SHIFT (1)
-#define IN_UCHARS(x) ((x) << UCHAR_SHIFT)
+#define IN_UCHARS(x) ((x) * 2)
#define MAX_255(c) ((c) <= 255u)
#define TABLE_GET(c, table, default) (MAX_255(c)? ((table)[c]):(default))
@@ -289,7 +289,7 @@ typedef pcre_uint16 pcre_uchar;
typedef pcre_uint32 pcre_uchar;
#define UCHAR_SHIFT (2)
-#define IN_UCHARS(x) ((x) << UCHAR_SHIFT)
+#define IN_UCHARS(x) ((x) * 4)
#define MAX_255(c) ((c) <= 255u)
#define TABLE_GET(c, table, default) (MAX_255(c)? ((table)[c]):(default))
@@ -322,8 +322,8 @@ start/end of string field names are. */
&(NLBLOCK->nllen), utf)) \
: \
((p) <= NLBLOCK->PSEND - NLBLOCK->nllen && \
- RAWUCHARTEST(p) == NLBLOCK->nl[0] && \
- (NLBLOCK->nllen == 1 || RAWUCHARTEST(p+1) == NLBLOCK->nl[1]) \
+ UCHAR21TEST(p) == NLBLOCK->nl[0] && \
+ (NLBLOCK->nllen == 1 || UCHAR21TEST(p+1) == NLBLOCK->nl[1]) \
) \
)
@@ -336,8 +336,8 @@ start/end of string field names are. */
&(NLBLOCK->nllen), utf)) \
: \
((p) >= NLBLOCK->PSSTART + NLBLOCK->nllen && \
- RAWUCHARTEST(p - NLBLOCK->nllen) == NLBLOCK->nl[0] && \
- (NLBLOCK->nllen == 1 || RAWUCHARTEST(p - NLBLOCK->nllen + 1) == NLBLOCK->nl[1]) \
+ UCHAR21TEST(p - NLBLOCK->nllen) == NLBLOCK->nl[0] && \
+ (NLBLOCK->nllen == 1 || UCHAR21TEST(p - NLBLOCK->nllen + 1) == NLBLOCK->nl[1]) \
) \
)
@@ -588,12 +588,27 @@ changed in future to be a fixed number of bytes or to depend on LINK_SIZE. */
#define MAX_MARK ((1u << 8) - 1)
#endif
+/* There is a proposed future special "UTF-21" mode, in which only the lowest
+21 bits of a 32-bit character are interpreted as UTF, with the remaining 11
+high-order bits available to the application for other uses. In preparation for
+the future implementation of this mode, there are macros that load a data item
+and, if in this special mode, mask it to 21 bits. These macros all have names
+starting with UCHAR21. In all other modes, including the normal 32-bit
+library, the macros all have the same simple definitions. When the new mode is
+implemented, it is expected that these definitions will be varied appropriately
+using #ifdef when compiling the library that supports the special mode. */
+
+#define UCHAR21(eptr) (*(eptr))
+#define UCHAR21TEST(eptr) (*(eptr))
+#define UCHAR21INC(eptr) (*(eptr)++)
+#define UCHAR21INCTEST(eptr) (*(eptr)++)
+
/* When UTF encoding is being used, a character is no longer just a single
-byte. The macros for character handling generate simple sequences when used in
-character-mode, and more complicated ones for UTF characters. GETCHARLENTEST
-and other macros are not used when UTF is not supported, so they are not
-defined. To make sure they can never even appear when UTF support is omitted,
-we don't even define them. */
+byte in 8-bit mode or a single short in 16-bit mode. The macros for character
+handling generate simple sequences when used in the basic mode, and more
+complicated ones for UTF characters. GETCHARLENTEST and other macros are not
+used when UTF is not supported. To make sure they can never even appear when
+UTF support is omitted, we don't even define them. */
#ifndef SUPPORT_UTF
@@ -606,10 +621,6 @@ we don't even define them. */
#define GETCHARINC(c, eptr) c = *eptr++;
#define GETCHARINCTEST(c, eptr) c = *eptr++;
#define GETCHARLEN(c, eptr, len) c = *eptr;
-#define RAWUCHAR(eptr) (*(eptr))
-#define RAWUCHARINC(eptr) (*(eptr)++)
-#define RAWUCHARTEST(eptr) (*(eptr))
-#define RAWUCHARINCTEST(eptr) (*(eptr)++)
/* #define GETCHARLENTEST(c, eptr, len) */
/* #define BACKCHAR(eptr) */
/* #define FORWARDCHAR(eptr) */
@@ -782,30 +793,6 @@ do not know if we are in UTF-8 mode. */
c = *eptr; \
if (utf && c >= 0xc0) GETUTF8LEN(c, eptr, len);
-/* Returns the next uchar, not advancing the pointer. This is called when
-we know we are in UTF mode. */
-
-#define RAWUCHAR(eptr) \
- (*(eptr))
-
-/* Returns the next uchar, advancing the pointer. This is called when
-we know we are in UTF mode. */
-
-#define RAWUCHARINC(eptr) \
- (*((eptr)++))
-
-/* Returns the next uchar, testing for UTF mode, and not advancing the
-pointer. */
-
-#define RAWUCHARTEST(eptr) \
- (*(eptr))
-
-/* Returns the next uchar, testing for UTF mode, advancing the
-pointer. */
-
-#define RAWUCHARINCTEST(eptr) \
- (*((eptr)++))
-
/* If the pointer is not at the start of a character, move it back until
it is. This is called only in UTF-8 mode - we don't put a test within the macro
because almost all calls are already within a block of UTF-8 only code. */
@@ -901,30 +888,6 @@ we do not know if we are in UTF-16 mode. */
c = *eptr; \
if (utf && (c & 0xfc00) == 0xd800) GETUTF16LEN(c, eptr, len);
-/* Returns the next uchar, not advancing the pointer. This is called when
-we know we are in UTF mode. */
-
-#define RAWUCHAR(eptr) \
- (*(eptr))
-
-/* Returns the next uchar, advancing the pointer. This is called when
-we know we are in UTF mode. */
-
-#define RAWUCHARINC(eptr) \
- (*((eptr)++))
-
-/* Returns the next uchar, testing for UTF mode, and not advancing the
-pointer. */
-
-#define RAWUCHARTEST(eptr) \
- (*(eptr))
-
-/* Returns the next uchar, testing for UTF mode, advancing the
-pointer. */
-
-#define RAWUCHARINCTEST(eptr) \
- (*((eptr)++))
-
/* If the pointer is not at the start of a character, move it back until
it is. This is called only in UTF-16 mode - we don't put a test within the
macro because almost all calls are already within a block of UTF-16 only
@@ -986,30 +949,6 @@ This is called when we do not know if we are in UTF-32 mode. */
#define GETCHARLENTEST(c, eptr, len) \
GETCHARTEST(c, eptr)
-/* Returns the next uchar, not advancing the pointer. This is called when
-we know we are in UTF mode. */
-
-#define RAWUCHAR(eptr) \
- (*(eptr))
-
-/* Returns the next uchar, advancing the pointer. This is called when
-we know we are in UTF mode. */
-
-#define RAWUCHARINC(eptr) \
- (*((eptr)++))
-
-/* Returns the next uchar, testing for UTF mode, and not advancing the
-pointer. */
-
-#define RAWUCHARTEST(eptr) \
- (*(eptr))
-
-/* Returns the next uchar, testing for UTF mode, advancing the
-pointer. */
-
-#define RAWUCHARINCTEST(eptr) \
- (*((eptr)++))
-
/* If the pointer is not at the start of a character, move it back until
it is. This is called only in UTF-32 mode - we don't put a test within the
macro because almost all calls are already within a block of UTF-32 only
@@ -1051,7 +990,7 @@ other. NOTE: The values also appear in pcre_jit_compile.c. */
#ifndef EBCDIC
#define HSPACE_LIST \
- CHAR_HT, CHAR_SPACE, 0xa0, \
+ CHAR_HT, CHAR_SPACE, CHAR_NBSP, \
0x1680, 0x180e, 0x2000, 0x2001, 0x2002, 0x2003, 0x2004, 0x2005, \
0x2006, 0x2007, 0x2008, 0x2009, 0x200A, 0x202f, 0x205f, 0x3000, \
NOTACHAR
@@ -1077,7 +1016,7 @@ other. NOTE: The values also appear in pcre_jit_compile.c. */
#define HSPACE_BYTE_CASES \
case CHAR_HT: \
case CHAR_SPACE: \
- case 0xa0 /* NBSP */
+ case CHAR_NBSP
#define HSPACE_CASES \
HSPACE_BYTE_CASES: \
@@ -1104,11 +1043,12 @@ other. NOTE: The values also appear in pcre_jit_compile.c. */
/* ------ EBCDIC environments ------ */
#else
-#define HSPACE_LIST CHAR_HT, CHAR_SPACE
+#define HSPACE_LIST CHAR_HT, CHAR_SPACE, CHAR_NBSP, NOTACHAR
#define HSPACE_BYTE_CASES \
case CHAR_HT: \
- case CHAR_SPACE
+ case CHAR_SPACE: \
+ case CHAR_NBSP
#define HSPACE_CASES HSPACE_BYTE_CASES
@@ -1155,6 +1095,7 @@ compatibility. */
#define PCRE_HASTHEN 0x00001000 /* pattern contains (*THEN) */
#define PCRE_MLSET 0x00002000 /* match limit set by regex */
#define PCRE_RLSET 0x00004000 /* recursion limit set by regex */
+#define PCRE_MATCH_EMPTY 0x00008000 /* pattern can match empty string */
#if defined COMPILE_PCRE8
#define PCRE_MODE PCRE_MODE8
@@ -1179,7 +1120,8 @@ time, run time, or study time, respectively. */
#define PUBLIC_COMPILE_OPTIONS \
(PCRE_CASELESS|PCRE_EXTENDED|PCRE_ANCHORED|PCRE_MULTILINE| \
PCRE_DOTALL|PCRE_DOLLAR_ENDONLY|PCRE_EXTRA|PCRE_UNGREEDY|PCRE_UTF8| \
- PCRE_NO_AUTO_CAPTURE|PCRE_NO_UTF8_CHECK|PCRE_AUTO_CALLOUT|PCRE_FIRSTLINE| \
+ PCRE_NO_AUTO_CAPTURE|PCRE_NO_AUTO_POSSESS| \
+ PCRE_NO_UTF8_CHECK|PCRE_AUTO_CALLOUT|PCRE_FIRSTLINE| \
PCRE_DUPNAMES|PCRE_NEWLINE_BITS|PCRE_BSR_ANYCRLF|PCRE_BSR_UNICODE| \
PCRE_JAVASCRIPT_COMPAT|PCRE_UCP|PCRE_NO_START_OPTIMIZE|PCRE_NEVER_UTF)
@@ -1280,6 +1222,7 @@ same code point. */
#define CHAR_ESC '\047'
#define CHAR_DEL '\007'
+#define CHAR_NBSP '\x41'
#define STR_ESC "\047"
#define STR_DEL "\007"
@@ -1294,6 +1237,7 @@ a positive value. */
#define CHAR_NEL ((unsigned char)'\x85')
#define CHAR_ESC '\033'
#define CHAR_DEL '\177'
+#define CHAR_NBSP ((unsigned char)'\xa0')
#define STR_LF "\n"
#define STR_NL STR_LF
@@ -1537,22 +1481,25 @@ a positive value. */
#define STRING_xdigit "xdigit"
#define STRING_DEFINE "DEFINE"
-
-#define STRING_CR_RIGHTPAR "CR)"
-#define STRING_LF_RIGHTPAR "LF)"
-#define STRING_CRLF_RIGHTPAR "CRLF)"
-#define STRING_ANY_RIGHTPAR "ANY)"
-#define STRING_ANYCRLF_RIGHTPAR "ANYCRLF)"
-#define STRING_BSR_ANYCRLF_RIGHTPAR "BSR_ANYCRLF)"
-#define STRING_BSR_UNICODE_RIGHTPAR "BSR_UNICODE)"
-#define STRING_UTF8_RIGHTPAR "UTF8)"
-#define STRING_UTF16_RIGHTPAR "UTF16)"
-#define STRING_UTF32_RIGHTPAR "UTF32)"
-#define STRING_UTF_RIGHTPAR "UTF)"
-#define STRING_UCP_RIGHTPAR "UCP)"
-#define STRING_NO_START_OPT_RIGHTPAR "NO_START_OPT)"
-#define STRING_LIMIT_MATCH_EQ "LIMIT_MATCH="
-#define STRING_LIMIT_RECURSION_EQ "LIMIT_RECURSION="
+#define STRING_WEIRD_STARTWORD "[:<:]]"
+#define STRING_WEIRD_ENDWORD "[:>:]]"
+
+#define STRING_CR_RIGHTPAR "CR)"
+#define STRING_LF_RIGHTPAR "LF)"
+#define STRING_CRLF_RIGHTPAR "CRLF)"
+#define STRING_ANY_RIGHTPAR "ANY)"
+#define STRING_ANYCRLF_RIGHTPAR "ANYCRLF)"
+#define STRING_BSR_ANYCRLF_RIGHTPAR "BSR_ANYCRLF)"
+#define STRING_BSR_UNICODE_RIGHTPAR "BSR_UNICODE)"
+#define STRING_UTF8_RIGHTPAR "UTF8)"
+#define STRING_UTF16_RIGHTPAR "UTF16)"
+#define STRING_UTF32_RIGHTPAR "UTF32)"
+#define STRING_UTF_RIGHTPAR "UTF)"
+#define STRING_UCP_RIGHTPAR "UCP)"
+#define STRING_NO_AUTO_POSSESS_RIGHTPAR "NO_AUTO_POSSESS)"
+#define STRING_NO_START_OPT_RIGHTPAR "NO_START_OPT)"
+#define STRING_LIMIT_MATCH_EQ "LIMIT_MATCH="
+#define STRING_LIMIT_RECURSION_EQ "LIMIT_RECURSION="
#else /* SUPPORT_UTF */
@@ -1668,6 +1615,7 @@ only. */
#define CHAR_VERTICAL_LINE '\174'
#define CHAR_RIGHT_CURLY_BRACKET '\175'
#define CHAR_TILDE '\176'
+#define CHAR_NBSP ((unsigned char)'\xa0')
#define STR_HT "\011"
#define STR_VT "\013"
@@ -1800,27 +1748,34 @@ only. */
#define STRING_xdigit STR_x STR_d STR_i STR_g STR_i STR_t
#define STRING_DEFINE STR_D STR_E STR_F STR_I STR_N STR_E
-
-#define STRING_CR_RIGHTPAR STR_C STR_R STR_RIGHT_PARENTHESIS
-#define STRING_LF_RIGHTPAR STR_L STR_F STR_RIGHT_PARENTHESIS
-#define STRING_CRLF_RIGHTPAR STR_C STR_R STR_L STR_F STR_RIGHT_PARENTHESIS
-#define STRING_ANY_RIGHTPAR STR_A STR_N STR_Y STR_RIGHT_PARENTHESIS
-#define STRING_ANYCRLF_RIGHTPAR STR_A STR_N STR_Y STR_C STR_R STR_L STR_F STR_RIGHT_PARENTHESIS
-#define STRING_BSR_ANYCRLF_RIGHTPAR STR_B STR_S STR_R STR_UNDERSCORE STR_A STR_N STR_Y STR_C STR_R STR_L STR_F STR_RIGHT_PARENTHESIS
-#define STRING_BSR_UNICODE_RIGHTPAR STR_B STR_S STR_R STR_UNDERSCORE STR_U STR_N STR_I STR_C STR_O STR_D STR_E STR_RIGHT_PARENTHESIS
-#define STRING_UTF8_RIGHTPAR STR_U STR_T STR_F STR_8 STR_RIGHT_PARENTHESIS
-#define STRING_UTF16_RIGHTPAR STR_U STR_T STR_F STR_1 STR_6 STR_RIGHT_PARENTHESIS
-#define STRING_UTF32_RIGHTPAR STR_U STR_T STR_F STR_3 STR_2 STR_RIGHT_PARENTHESIS
-#define STRING_UTF_RIGHTPAR STR_U STR_T STR_F STR_RIGHT_PARENTHESIS
-#define STRING_UCP_RIGHTPAR STR_U STR_C STR_P STR_RIGHT_PARENTHESIS
-#define STRING_NO_START_OPT_RIGHTPAR STR_N STR_O STR_UNDERSCORE STR_S STR_T STR_A STR_R STR_T STR_UNDERSCORE STR_O STR_P STR_T STR_RIGHT_PARENTHESIS
-#define STRING_LIMIT_MATCH_EQ STR_L STR_I STR_M STR_I STR_T STR_UNDERSCORE STR_M STR_A STR_T STR_C STR_H STR_EQUALS_SIGN
-#define STRING_LIMIT_RECURSION_EQ STR_L STR_I STR_M STR_I STR_T STR_UNDERSCORE STR_R STR_E STR_C STR_U STR_R STR_S STR_I STR_O STR_N STR_EQUALS_SIGN
+#define STRING_WEIRD_STARTWORD STR_LEFT_SQUARE_BRACKET STR_COLON STR_LESS_THAN_SIGN STR_COLON STR_RIGHT_SQUARE_BRACKET STR_RIGHT_SQUARE_BRACKET
+#define STRING_WEIRD_ENDWORD STR_LEFT_SQUARE_BRACKET STR_COLON STR_GREATER_THAN_SIGN STR_COLON STR_RIGHT_SQUARE_BRACKET STR_RIGHT_SQUARE_BRACKET
+
+#define STRING_CR_RIGHTPAR STR_C STR_R STR_RIGHT_PARENTHESIS
+#define STRING_LF_RIGHTPAR STR_L STR_F STR_RIGHT_PARENTHESIS
+#define STRING_CRLF_RIGHTPAR STR_C STR_R STR_L STR_F STR_RIGHT_PARENTHESIS
+#define STRING_ANY_RIGHTPAR STR_A STR_N STR_Y STR_RIGHT_PARENTHESIS
+#define STRING_ANYCRLF_RIGHTPAR STR_A STR_N STR_Y STR_C STR_R STR_L STR_F STR_RIGHT_PARENTHESIS
+#define STRING_BSR_ANYCRLF_RIGHTPAR STR_B STR_S STR_R STR_UNDERSCORE STR_A STR_N STR_Y STR_C STR_R STR_L STR_F STR_RIGHT_PARENTHESIS
+#define STRING_BSR_UNICODE_RIGHTPAR STR_B STR_S STR_R STR_UNDERSCORE STR_U STR_N STR_I STR_C STR_O STR_D STR_E STR_RIGHT_PARENTHESIS
+#define STRING_UTF8_RIGHTPAR STR_U STR_T STR_F STR_8 STR_RIGHT_PARENTHESIS
+#define STRING_UTF16_RIGHTPAR STR_U STR_T STR_F STR_1 STR_6 STR_RIGHT_PARENTHESIS
+#define STRING_UTF32_RIGHTPAR STR_U STR_T STR_F STR_3 STR_2 STR_RIGHT_PARENTHESIS
+#define STRING_UTF_RIGHTPAR STR_U STR_T STR_F STR_RIGHT_PARENTHESIS
+#define STRING_UCP_RIGHTPAR STR_U STR_C STR_P STR_RIGHT_PARENTHESIS
+#define STRING_NO_AUTO_POSSESS_RIGHTPAR STR_N STR_O STR_UNDERSCORE STR_A STR_U STR_T STR_O STR_UNDERSCORE STR_P STR_O STR_S STR_S STR_E STR_S STR_S STR_RIGHT_PARENTHESIS
+#define STRING_NO_START_OPT_RIGHTPAR STR_N STR_O STR_UNDERSCORE STR_S STR_T STR_A STR_R STR_T STR_UNDERSCORE STR_O STR_P STR_T STR_RIGHT_PARENTHESIS
+#define STRING_LIMIT_MATCH_EQ STR_L STR_I STR_M STR_I STR_T STR_UNDERSCORE STR_M STR_A STR_T STR_C STR_H STR_EQUALS_SIGN
+#define STRING_LIMIT_RECURSION_EQ STR_L STR_I STR_M STR_I STR_T STR_UNDERSCORE STR_R STR_E STR_C STR_U STR_R STR_S STR_I STR_O STR_N STR_EQUALS_SIGN
#endif /* SUPPORT_UTF */
/* Escape items that are just an encoding of a particular data value. */
+#ifndef ESC_a
+#define ESC_a CHAR_BEL
+#endif
+
#ifndef ESC_e
#define ESC_e CHAR_ESC
#endif
@@ -1857,12 +1812,24 @@ only. */
#define PT_WORD 8 /* Word - L plus N plus underscore */
#define PT_CLIST 9 /* Pseudo-property: match character list */
#define PT_UCNC 10 /* Universal Character nameable character */
+#define PT_TABSIZE 11 /* Size of square table for autopossessify tests */
+
+/* The following special properties are used only in XCLASS items, when POSIX
+classes are specified and PCRE_UCP is set - in other words, for Unicode
+handling of these classes. They are not available via the \p or \P escapes like
+those in the above list, and so they do not take part in the autopossessifying
+table. */
+
+#define PT_PXGRAPH 11 /* [:graph:] - characters that mark the paper */
+#define PT_PXPRINT 12 /* [:print:] - [:graph:] plus non-control spaces */
+#define PT_PXPUNCT 13 /* [:punct:] - punctuation characters */
/* Flag bits and data types for the extended class (OP_XCLASS) for classes that
contain characters with values greater than 255. */
-#define XCL_NOT 0x01 /* Flag: this is a negative class */
-#define XCL_MAP 0x02 /* Flag: a 32-byte map is present */
+#define XCL_NOT 0x01 /* Flag: this is a negative class */
+#define XCL_MAP 0x02 /* Flag: a 32-byte map is present */
+#define XCL_HASPROP 0x04 /* Flag: property checks are present. */
#define XCL_END 0 /* Marks end of individual items */
#define XCL_SINGLE 1 /* Single item (one multibyte char) follows */
@@ -1871,9 +1838,9 @@ contain characters with values greater than 255. */
#define XCL_NOTPROP 4 /* Unicode inverted property (ditto) */
/* These are escaped items that aren't just an encoding of a particular data
-value such as \n. They must have non-zero values, as check_escape() returns
-0 for a data character. Also, they must appear in the same order as in the opcode
-definitions below, up to ESC_z. There's a dummy for OP_ALLANY because it
+value such as \n. They must have non-zero values, as check_escape() returns 0
+for a data character. Also, they must appear in the same order as in the
+opcode definitions below, up to ESC_z. There's a dummy for OP_ALLANY because it
corresponds to "." in DOTALL mode rather than an escape sequence. It is also
used for [^] in JavaScript compatibility mode, and for \C in non-utf mode. In
non-DOTALL mode, "." behaves like \N.
@@ -1896,12 +1863,31 @@ enum { ESC_A = 1, ESC_G, ESC_K, ESC_B, ESC_b, ESC_D, ESC_d, ESC_S, ESC_s,
ESC_E, ESC_Q, ESC_g, ESC_k,
ESC_DU, ESC_du, ESC_SU, ESC_su, ESC_WU, ESC_wu };
-/* Opcode table: Starting from 1 (i.e. after OP_END), the values up to
-OP_EOD must correspond in order to the list of escapes immediately above.
-*** NOTE NOTE NOTE *** Whenever this list is updated, the two macro definitions
-that follow must also be updated to match. There are also tables called
-"coptable" and "poptable" in pcre_dfa_exec.c that must be updated. */
+/********************** Opcode definitions ******************/
+
+/****** NOTE NOTE NOTE ******
+
+Starting from 1 (i.e. after OP_END), the values up to OP_EOD must correspond in
+order to the list of escapes immediately above. Furthermore, values up to
+OP_DOLLM must not be changed without adjusting the table called autoposstab in
+pcre_compile.c
+
+Whenever this list is updated, the two macro definitions that follow must be
+updated to match. The possessification table called "opcode_possessify" in
+pcre_compile.c must also be updated, and also the tables called "coptable"
+and "poptable" in pcre_dfa_exec.c.
+
+****** NOTE NOTE NOTE ******/
+
+
+/* The values between FIRST_AUTOTAB_OP and LAST_AUTOTAB_RIGHT_OP, inclusive,
+are used in a table for deciding whether a repeated character type can be
+auto-possessified. */
+
+#define FIRST_AUTOTAB_OP OP_NOT_DIGIT
+#define LAST_AUTOTAB_LEFT_OP OP_EXTUNI
+#define LAST_AUTOTAB_RIGHT_OP OP_DOLLM
enum {
OP_END, /* 0 End of pattern */
@@ -1934,10 +1920,15 @@ enum {
OP_EODN, /* 23 End of data or \n at end of data (\Z) */
OP_EOD, /* 24 End of data (\z) */
- OP_CIRC, /* 25 Start of line - not multiline */
- OP_CIRCM, /* 26 Start of line - multiline */
- OP_DOLL, /* 27 End of line - not multiline */
- OP_DOLLM, /* 28 End of line - multiline */
+ /* Line end assertions */
+
+ OP_DOLL, /* 25 End of line - not multiline */
+ OP_DOLLM, /* 26 End of line - multiline */
+ OP_CIRC, /* 27 Start of line - not multiline */
+ OP_CIRCM, /* 28 Start of line - multiline */
+
+ /* Single characters; caseful must precede the caseless ones */
+
OP_CHAR, /* 29 Match one character, casefully */
OP_CHARI, /* 30 Match one character, caselessly */
OP_NOT, /* 31 Match one character, not the given one, casefully */
@@ -1946,7 +1937,7 @@ enum {
/* The following sets of 13 opcodes must always be kept in step because
the offset from the first one is used to generate the others. */
- /**** Single characters, caseful, must precede the caseless ones ****/
+ /* Repeated characters; caseful must precede the caseless ones */
OP_STAR, /* 33 The maximizing and minimizing versions of */
OP_MINSTAR, /* 34 these six opcodes must come in pairs, with */
@@ -1964,7 +1955,7 @@ enum {
OP_POSQUERY, /* 44 Posesssified query, caseful */
OP_POSUPTO, /* 45 Possessified upto, caseful */
- /**** Single characters, caseless, must follow the caseful ones */
+ /* Repeated characters; caseless must follow the caseful ones */
OP_STARI, /* 46 */
OP_MINSTARI, /* 47 */
@@ -1982,8 +1973,8 @@ enum {
OP_POSQUERYI, /* 57 Posesssified query, caseless */
OP_POSUPTOI, /* 58 Possessified upto, caseless */
- /**** The negated ones must follow the non-negated ones, and match them ****/
- /**** Negated single character, caseful; must precede the caseless ones ****/
+ /* The negated ones must follow the non-negated ones, and match them */
+ /* Negated repeated character, caseful; must precede the caseless ones */
OP_NOTSTAR, /* 59 The maximizing and minimizing versions of */
OP_NOTMINSTAR, /* 60 these six opcodes must come in pairs, with */
@@ -2001,7 +1992,7 @@ enum {
OP_NOTPOSQUERY, /* 70 */
OP_NOTPOSUPTO, /* 71 */
- /**** Negated single character, caseless; must follow the caseful ones ****/
+ /* Negated repeated character, caseless; must follow the caseful ones */
OP_NOTSTARI, /* 72 */
OP_NOTMINSTARI, /* 73 */
@@ -2019,7 +2010,7 @@ enum {
OP_NOTPOSQUERYI, /* 83 */
OP_NOTPOSUPTOI, /* 84 */
- /**** Character types ****/
+ /* Character types */
OP_TYPESTAR, /* 85 The maximizing and minimizing versions of */
OP_TYPEMINSTAR, /* 86 these six opcodes must come in pairs, with */
@@ -2050,89 +2041,96 @@ enum {
OP_CRRANGE, /* 104 These are different to the three sets above. */
OP_CRMINRANGE, /* 105 */
+ OP_CRPOSSTAR, /* 106 Possessified versions */
+ OP_CRPOSPLUS, /* 107 */
+ OP_CRPOSQUERY, /* 108 */
+ OP_CRPOSRANGE, /* 109 */
+
/* End of quantifier opcodes */
- OP_CLASS, /* 106 Match a character class, chars < 256 only */
- OP_NCLASS, /* 107 Same, but the bitmap was created from a negative
+ OP_CLASS, /* 110 Match a character class, chars < 256 only */
+ OP_NCLASS, /* 111 Same, but the bitmap was created from a negative
class - the difference is relevant only when a
character > 255 is encountered. */
- OP_XCLASS, /* 108 Extended class for handling > 255 chars within the
+ OP_XCLASS, /* 112 Extended class for handling > 255 chars within the
class. This does both positive and negative. */
- OP_REF, /* 109 Match a back reference, casefully */
- OP_REFI, /* 110 Match a back reference, caselessly */
- OP_RECURSE, /* 111 Match a numbered subpattern (possibly recursive) */
- OP_CALLOUT, /* 112 Call out to external function if provided */
-
- OP_ALT, /* 113 Start of alternation */
- OP_KET, /* 114 End of group that doesn't have an unbounded repeat */
- OP_KETRMAX, /* 115 These two must remain together and in this */
- OP_KETRMIN, /* 116 order. They are for groups the repeat for ever. */
- OP_KETRPOS, /* 117 Possessive unlimited repeat. */
+ OP_REF, /* 113 Match a back reference, casefully */
+ OP_REFI, /* 114 Match a back reference, caselessly */
+ OP_DNREF, /* 115 Match a duplicate name backref, casefully */
+ OP_DNREFI, /* 116 Match a duplicate name backref, caselessly */
+ OP_RECURSE, /* 117 Match a numbered subpattern (possibly recursive) */
+ OP_CALLOUT, /* 118 Call out to external function if provided */
+
+ OP_ALT, /* 119 Start of alternation */
+ OP_KET, /* 120 End of group that doesn't have an unbounded repeat */
+ OP_KETRMAX, /* 121 These two must remain together and in this */
+ OP_KETRMIN, /* 122 order. They are for groups the repeat for ever. */
+ OP_KETRPOS, /* 123 Possessive unlimited repeat. */
/* The assertions must come before BRA, CBRA, ONCE, and COND, and the four
asserts must remain in order. */
- OP_REVERSE, /* 118 Move pointer back - used in lookbehind assertions */
- OP_ASSERT, /* 119 Positive lookahead */
- OP_ASSERT_NOT, /* 120 Negative lookahead */
- OP_ASSERTBACK, /* 121 Positive lookbehind */
- OP_ASSERTBACK_NOT, /* 122 Negative lookbehind */
+ OP_REVERSE, /* 124 Move pointer back - used in lookbehind assertions */
+ OP_ASSERT, /* 125 Positive lookahead */
+ OP_ASSERT_NOT, /* 126 Negative lookahead */
+ OP_ASSERTBACK, /* 127 Positive lookbehind */
+ OP_ASSERTBACK_NOT, /* 128 Negative lookbehind */
/* ONCE, ONCE_NC, BRA, BRAPOS, CBRA, CBRAPOS, and COND must come immediately
after the assertions, with ONCE first, as there's a test for >= ONCE for a
subpattern that isn't an assertion. The POS versions must immediately follow
the non-POS versions in each case. */
- OP_ONCE, /* 123 Atomic group, contains captures */
- OP_ONCE_NC, /* 124 Atomic group containing no captures */
- OP_BRA, /* 125 Start of non-capturing bracket */
- OP_BRAPOS, /* 126 Ditto, with unlimited, possessive repeat */
- OP_CBRA, /* 127 Start of capturing bracket */
- OP_CBRAPOS, /* 128 Ditto, with unlimited, possessive repeat */
- OP_COND, /* 129 Conditional group */
+ OP_ONCE, /* 129 Atomic group, contains captures */
+ OP_ONCE_NC, /* 130 Atomic group containing no captures */
+ OP_BRA, /* 131 Start of non-capturing bracket */
+ OP_BRAPOS, /* 132 Ditto, with unlimited, possessive repeat */
+ OP_CBRA, /* 133 Start of capturing bracket */
+ OP_CBRAPOS, /* 134 Ditto, with unlimited, possessive repeat */
+ OP_COND, /* 135 Conditional group */
/* These five must follow the previous five, in the same order. There's a
check for >= SBRA to distinguish the two sets. */
- OP_SBRA, /* 130 Start of non-capturing bracket, check empty */
- OP_SBRAPOS, /* 131 Ditto, with unlimited, possessive repeat */
- OP_SCBRA, /* 132 Start of capturing bracket, check empty */
- OP_SCBRAPOS, /* 133 Ditto, with unlimited, possessive repeat */
- OP_SCOND, /* 134 Conditional group, check empty */
+ OP_SBRA, /* 136 Start of non-capturing bracket, check empty */
+ OP_SBRAPOS, /* 137 Ditto, with unlimited, possessive repeat */
+ OP_SCBRA, /* 138 Start of capturing bracket, check empty */
+ OP_SCBRAPOS, /* 139 Ditto, with unlimited, possessive repeat */
+ OP_SCOND, /* 140 Conditional group, check empty */
/* The next two pairs must (respectively) be kept together. */
- OP_CREF, /* 135 Used to hold a capture number as condition */
- OP_NCREF, /* 136 Same, but generated by a name reference*/
- OP_RREF, /* 137 Used to hold a recursion number as condition */
- OP_NRREF, /* 138 Same, but generated by a name reference*/
- OP_DEF, /* 139 The DEFINE condition */
+ OP_CREF, /* 141 Used to hold a capture number as condition */
+ OP_DNCREF, /* 142 Used to point to duplicate names as a condition */
+ OP_RREF, /* 143 Used to hold a recursion number as condition */
+ OP_DNRREF, /* 144 Used to point to duplicate names as a condition */
+ OP_DEF, /* 145 The DEFINE condition */
- OP_BRAZERO, /* 140 These two must remain together and in this */
- OP_BRAMINZERO, /* 141 order. */
- OP_BRAPOSZERO, /* 142 */
+ OP_BRAZERO, /* 146 These two must remain together and in this */
+ OP_BRAMINZERO, /* 147 order. */
+ OP_BRAPOSZERO, /* 148 */
/* These are backtracking control verbs */
- OP_MARK, /* 143 always has an argument */
- OP_PRUNE, /* 144 */
- OP_PRUNE_ARG, /* 145 same, but with argument */
- OP_SKIP, /* 146 */
- OP_SKIP_ARG, /* 147 same, but with argument */
- OP_THEN, /* 148 */
- OP_THEN_ARG, /* 149 same, but with argument */
- OP_COMMIT, /* 150 */
+ OP_MARK, /* 149 always has an argument */
+ OP_PRUNE, /* 150 */
+ OP_PRUNE_ARG, /* 151 same, but with argument */
+ OP_SKIP, /* 152 */
+ OP_SKIP_ARG, /* 153 same, but with argument */
+ OP_THEN, /* 154 */
+ OP_THEN_ARG, /* 155 same, but with argument */
+ OP_COMMIT, /* 156 */
/* These are forced failure and success verbs */
- OP_FAIL, /* 151 */
- OP_ACCEPT, /* 152 */
- OP_ASSERT_ACCEPT, /* 153 Used inside assertions */
- OP_CLOSE, /* 154 Used before OP_ACCEPT to close open captures */
+ OP_FAIL, /* 157 */
+ OP_ACCEPT, /* 158 */
+ OP_ASSERT_ACCEPT, /* 159 Used inside assertions */
+ OP_CLOSE, /* 160 Used before OP_ACCEPT to close open captures */
/* This is used to skip a subpattern with a {0} quantifier */
- OP_SKIPZERO, /* 155 */
+ OP_SKIPZERO, /* 161 */
/* This is not an opcode, but is used to check that tables indexed by opcode
are the correct length, in order to catch updating errors - there have been
@@ -2143,7 +2141,8 @@ enum {
/* *** NOTE NOTE NOTE *** Whenever the list above is updated, the two macro
definitions that follow must also be updated to match. There are also tables
-called "coptable" and "poptable" in pcre_dfa_exec.c that must be updated. */
+called "opcode_possessify" in pcre_compile.c and "coptable" and "poptable" in
+pcre_dfa_exec.c that must be updated. */
/* This macro defines textual names for all the opcodes. These are used only
@@ -2156,7 +2155,7 @@ some cases doesn't actually use these names at all). */
"\\S", "\\s", "\\W", "\\w", "Any", "AllAny", "Anybyte", \
"notprop", "prop", "\\R", "\\H", "\\h", "\\V", "\\v", \
"extuni", "\\Z", "\\z", \
- "^", "^", "$", "$", "char", "chari", "not", "noti", \
+ "$", "$", "^", "^", "char", "chari", "not", "noti", \
"*", "*?", "+", "+?", "?", "??", \
"{", "{", "{", \
"*+","++", "?+", "{", \
@@ -2172,7 +2171,8 @@ some cases doesn't actually use these names at all). */
"*", "*?", "+", "+?", "?", "??", "{", "{", "{", \
"*+","++", "?+", "{", \
"*", "*?", "+", "+?", "?", "??", "{", "{", \
- "class", "nclass", "xclass", "Ref", "Refi", \
+ "*+","++", "?+", "{", \
+ "class", "nclass", "xclass", "Ref", "Refi", "DnRef", "DnRefi", \
"Recurse", "Callout", \
"Alt", "Ket", "KetRmax", "KetRmin", "KetRpos", \
"Reverse", "Assert", "Assert not", "AssertB", "AssertB not", \
@@ -2181,7 +2181,7 @@ some cases doesn't actually use these names at all). */
"Cond", \
"SBra", "SBraPos", "SCBra", "SCBraPos", \
"SCond", \
- "Cond ref", "Cond nref", "Cond rec", "Cond nrec", "Cond def", \
+ "Cond ref", "Cond dnref", "Cond rec", "Cond dnrec", "Cond def", \
"Brazero", "Braminzero", "Braposzero", \
"*MARK", "*PRUNE", "*PRUNE", "*SKIP", "*SKIP", \
"*THEN", "*THEN", "*COMMIT", "*FAIL", \
@@ -2206,7 +2206,7 @@ in UTF-8 mode. The code that uses this table must know about such things. */
3, 3, /* \P, \p */ \
1, 1, 1, 1, 1, /* \R, \H, \h, \V, \v */ \
1, /* \X */ \
- 1, 1, 1, 1, 1, 1, /* \Z, \z, ^, ^M, $, $M */ \
+ 1, 1, 1, 1, 1, 1, /* \Z, \z, $, $M ^, ^M */ \
2, /* Char - the minimum length */ \
2, /* Chari - the minimum length */ \
2, /* not */ \
@@ -2237,11 +2237,14 @@ in UTF-8 mode. The code that uses this table must know about such things. */
/* Character class & ref repeats */ \
1, 1, 1, 1, 1, 1, /* *, *?, +, +?, ?, ?? */ \
1+2*IMM2_SIZE, 1+2*IMM2_SIZE, /* CRRANGE, CRMINRANGE */ \
+ 1, 1, 1, 1+2*IMM2_SIZE, /* Possessive *+, ++, ?+, CRPOSRANGE */ \
1+(32/sizeof(pcre_uchar)), /* CLASS */ \
1+(32/sizeof(pcre_uchar)), /* NCLASS */ \
0, /* XCLASS - variable length */ \
1+IMM2_SIZE, /* REF */ \
1+IMM2_SIZE, /* REFI */ \
+ 1+2*IMM2_SIZE, /* DNREF */ \
+ 1+2*IMM2_SIZE, /* DNREFI */ \
1+LINK_SIZE, /* RECURSE */ \
2+2*LINK_SIZE, /* CALLOUT */ \
1+LINK_SIZE, /* Alt */ \
@@ -2266,8 +2269,8 @@ in UTF-8 mode. The code that uses this table must know about such things. */
1+LINK_SIZE+IMM2_SIZE, /* SCBRA */ \
1+LINK_SIZE+IMM2_SIZE, /* SCBRAPOS */ \
1+LINK_SIZE, /* SCOND */ \
- 1+IMM2_SIZE, 1+IMM2_SIZE, /* CREF, NCREF */ \
- 1+IMM2_SIZE, 1+IMM2_SIZE, /* RREF, NRREF */ \
+ 1+IMM2_SIZE, 1+2*IMM2_SIZE, /* CREF, DNCREF */ \
+ 1+IMM2_SIZE, 1+2*IMM2_SIZE, /* RREF, DNRREF */ \
1, /* DEF */ \
1, 1, 1, /* BRAZERO, BRAMINZERO, BRAPOSZERO */ \
3, 1, 3, /* MARK, PRUNE, PRUNE_ARG */ \
@@ -2276,8 +2279,7 @@ in UTF-8 mode. The code that uses this table must know about such things. */
1, 1, 1, 1, /* COMMIT, FAIL, ACCEPT, ASSERT_ACCEPT */ \
1+IMM2_SIZE, 1 /* CLOSE, SKIPZERO */
-/* A magic value for OP_RREF and OP_NRREF to indicate the "any recursion"
-condition. */
+/* A magic value for OP_RREF to indicate the "any recursion" condition. */
#define RREF_ANY 0xffff
@@ -2292,9 +2294,11 @@ enum { ERR0, ERR1, ERR2, ERR3, ERR4, ERR5, ERR6, ERR7, ERR8, ERR9,
ERR40, ERR41, ERR42, ERR43, ERR44, ERR45, ERR46, ERR47, ERR48, ERR49,
ERR50, ERR51, ERR52, ERR53, ERR54, ERR55, ERR56, ERR57, ERR58, ERR59,
ERR60, ERR61, ERR62, ERR63, ERR64, ERR65, ERR66, ERR67, ERR68, ERR69,
- ERR70, ERR71, ERR72, ERR73, ERR74, ERR75, ERR76, ERR77, ERR78, ERRCOUNT };
+ ERR70, ERR71, ERR72, ERR73, ERR74, ERR75, ERR76, ERR77, ERR78, ERR79,
+ ERR80, ERR81, ERR82, ERR83, ERR84, ERR85, ERR86, ERR87, ERRCOUNT };
/* JIT compiling modes. The function list is indexed by them. */
+
enum { JIT_COMPILE, JIT_PARTIAL_SOFT_COMPILE, JIT_PARTIAL_HARD_COMPILE,
JIT_NUMBER_OF_COMPILE_MODES };
@@ -2412,6 +2416,15 @@ typedef struct open_capitem {
pcre_uint16 flag; /* Set TRUE if recursive back ref */
} open_capitem;
+/* Structure for building a list of named groups during the first pass of
+compiling. */
+
+typedef struct named_group {
+ const pcre_uchar *name; /* Points to the name in the pattern */
+ int length; /* Length of the name */
+ pcre_uint32 number; /* Group number */
+} named_group;
+
/* Structure for passing "static" information around between the functions
doing the compiling, so that they are thread-safe. */
@@ -2424,17 +2437,21 @@ typedef struct compile_data {
const pcre_uchar *start_code; /* The start of the compiled code */
const pcre_uchar *start_pattern; /* The start of the pattern */
const pcre_uchar *end_pattern; /* The end of the pattern */
- open_capitem *open_caps; /* Chain of open capture items */
pcre_uchar *hwm; /* High watermark of workspace */
+ open_capitem *open_caps; /* Chain of open capture items */
+ named_group *named_groups; /* Points to vector in pre-compile */
pcre_uchar *name_table; /* The name/number table */
int names_found; /* Number of entries so far */
int name_entry_size; /* Size of each entry */
+ int named_group_list_size; /* Number of entries in the list */
int workspace_size; /* Size of workspace */
unsigned int bracount; /* Count of capturing parens as we compile */
int final_bracount; /* Saved value after first pass */
int max_lookbehind; /* Maximum lookbehind (characters) */
int top_backref; /* Maximum back reference */
unsigned int backref_map; /* Bitmap of low back refs */
+ unsigned int namedrefcount; /* Number of backreferences by name */
+ int parens_depth; /* Depth of nested parentheses */
int assert_depth; /* Depth of nested assertions */
pcre_uint32 external_options; /* External (initial) options */
pcre_uint32 external_flags; /* External flag bits to be set */
@@ -2442,6 +2459,9 @@ typedef struct compile_data {
BOOL had_accept; /* (*ACCEPT) encountered */
BOOL had_pruneorskip; /* (*PRUNE) or (*SKIP) encountered */
BOOL check_lookbehind; /* Lookbehinds need later checking */
+ BOOL dupnames; /* Duplicate names exist */
+ BOOL dupgroups; /* Duplicate groups exist: (?| found */
+ BOOL iscondassert; /* Next assert is a condition */
int nltype; /* Newline type */
int nllen; /* Newline string length */
pcre_uchar nl[4]; /* Newline string when fixed length */
@@ -2455,6 +2475,13 @@ typedef struct branch_chain {
pcre_uchar *current_branch;
} branch_chain;
+/* Structure for mutual recursion detection. */
+
+typedef struct recurse_check {
+ struct recurse_check *prev;
+ const pcre_uchar *group;
+} recurse_check;
+
/* Structure for items in a linked list that represents an explicit recursive
call within the pattern; used by pcre_exec(). */
@@ -2764,6 +2791,9 @@ extern const pcre_uint8 PRIV(ucd_stage1)[];
extern const pcre_uint16 PRIV(ucd_stage2)[];
extern const pcre_uint32 PRIV(ucp_gentype)[];
extern const pcre_uint32 PRIV(ucp_gbtable)[];
+#ifdef COMPILE_PCRE32
+extern const ucd_record PRIV(dummy_ucd_record)[];
+#endif
#ifdef SUPPORT_JIT
extern const int PRIV(ucp_typerange)[];
#endif
@@ -2772,10 +2802,16 @@ extern const int PRIV(ucp_typerange)[];
/* UCD access macros */
#define UCD_BLOCK_SIZE 128
-#define GET_UCD(ch) (PRIV(ucd_records) + \
+#define REAL_GET_UCD(ch) (PRIV(ucd_records) + \
PRIV(ucd_stage2)[PRIV(ucd_stage1)[(int)(ch) / UCD_BLOCK_SIZE] * \
UCD_BLOCK_SIZE + (int)(ch) % UCD_BLOCK_SIZE])
+#ifdef COMPILE_PCRE32
+#define GET_UCD(ch) ((ch > 0x10ffff)? PRIV(dummy_ucd_record) : REAL_GET_UCD(ch))
+#else
+#define GET_UCD(ch) REAL_GET_UCD(ch)
+#endif
+
#define UCD_CHARTYPE(ch) GET_UCD(ch)->chartype
#define UCD_SCRIPT(ch) GET_UCD(ch)->script
#define UCD_CATEGORY(ch) PRIV(ucp_gentype)[UCD_CHARTYPE(ch)]
diff --git a/erts/emulator/pcre/pcre_jit_compile.c b/erts/emulator/pcre/pcre_jit_compile.c
index fb26c62817..932ca2c389 100644
--- a/erts/emulator/pcre/pcre_jit_compile.c
+++ b/erts/emulator/pcre/pcre_jit_compile.c
@@ -52,8 +52,8 @@ POSSIBILITY OF SUCH DAMAGE.
we just include it. This way we don't need to touch the build
system files. */
-#define SLJIT_MALLOC(size) (PUBL(malloc))(size)
-#define SLJIT_FREE(ptr) (PUBL(free))(ptr)
+#define SLJIT_MALLOC(size, allocator_data) (PUBL(malloc))(size)
+#define SLJIT_FREE(ptr, allocator_data) (PUBL(free))(ptr)
#define SLJIT_CONFIG_AUTO 1
#define SLJIT_CONFIG_STATIC 1
#define SLJIT_VERBOSE 0
@@ -168,22 +168,23 @@ typedef struct jit_arguments {
pcre_uchar *mark_ptr;
void *callout_data;
/* Everything else after. */
- pcre_uint32 limit_match;
+ sljit_u32 limit_match;
int real_offset_count;
int offset_count;
- pcre_uint8 notbol;
- pcre_uint8 noteol;
- pcre_uint8 notempty;
- pcre_uint8 notempty_atstart;
+ sljit_u8 notbol;
+ sljit_u8 noteol;
+ sljit_u8 notempty;
+ sljit_u8 notempty_atstart;
} jit_arguments;
typedef struct executable_functions {
void *executable_funcs[JIT_NUMBER_OF_COMPILE_MODES];
+ void *read_only_data_heads[JIT_NUMBER_OF_COMPILE_MODES];
+ sljit_uw executable_sizes[JIT_NUMBER_OF_COMPILE_MODES];
PUBL(jit_callback) callback;
void *userdata;
- pcre_uint32 top_bracket;
- pcre_uint32 limit_match;
- sljit_uw executable_sizes[JIT_NUMBER_OF_COMPILE_MODES];
+ sljit_u32 top_bracket;
+ sljit_u32 limit_match;
} executable_functions;
typedef struct jump_list {
@@ -197,6 +198,12 @@ typedef struct stub_list {
struct stub_list *next;
} stub_list;
+typedef struct label_addr_list {
+ struct sljit_label *label;
+ sljit_uw *update_addr;
+ struct label_addr_list *next;
+} label_addr_list;
+
enum frame_types {
no_frame = -1,
no_stack = -2
@@ -270,11 +277,25 @@ typedef struct braminzero_backtrack {
struct sljit_label *matchingpath;
} braminzero_backtrack;
-typedef struct iterator_backtrack {
+typedef struct char_iterator_backtrack {
+ backtrack_common common;
+ /* Next iteration. */
+ struct sljit_label *matchingpath;
+ union {
+ jump_list *backtracks;
+ struct {
+ unsigned int othercasebit;
+ pcre_uchar chr;
+ BOOL enabled;
+ } charpos;
+ } u;
+} char_iterator_backtrack;
+
+typedef struct ref_iterator_backtrack {
backtrack_common common;
/* Next iteration. */
struct sljit_label *matchingpath;
-} iterator_backtrack;
+} ref_iterator_backtrack;
typedef struct recurse_entry {
struct recurse_entry *next;
@@ -306,7 +327,7 @@ typedef struct then_trap_backtrack {
int framesize;
} then_trap_backtrack;
-#define MAX_RANGE_SIZE 6
+#define MAX_RANGE_SIZE 4
typedef struct compiler_common {
/* The sljit ceneric compiler. */
@@ -314,64 +335,77 @@ typedef struct compiler_common {
/* First byte code. */
pcre_uchar *start;
/* Maps private data offset to each opcode. */
- sljit_si *private_data_ptrs;
+ sljit_s32 *private_data_ptrs;
+ /* Chain list of read-only data ptrs. */
+ void *read_only_data_head;
/* Tells whether the capturing bracket is optimized. */
- pcre_uint8 *optimized_cbracket;
+ sljit_u8 *optimized_cbracket;
/* Tells whether the starting offset is a target of then. */
- pcre_uint8 *then_offsets;
+ sljit_u8 *then_offsets;
/* Current position where a THEN must jump. */
then_trap_backtrack *then_trap;
/* Starting offset of private data for capturing brackets. */
- int cbra_ptr;
+ sljit_s32 cbra_ptr;
/* Output vector starting point. Must be divisible by 2. */
- int ovector_start;
+ sljit_s32 ovector_start;
+ /* Points to the starting character of the current match. */
+ sljit_s32 start_ptr;
/* Last known position of the requested byte. */
- int req_char_ptr;
+ sljit_s32 req_char_ptr;
/* Head of the last recursion. */
- int recursive_head_ptr;
- /* First inspected character for partial matching. */
- int start_used_ptr;
+ sljit_s32 recursive_head_ptr;
+ /* First inspected character for partial matching.
+ (Needed for avoiding zero length partial matches.) */
+ sljit_s32 start_used_ptr;
/* Starting pointer for partial soft matches. */
- int hit_start;
- /* End pointer of the first line. */
- int first_line_end;
+ sljit_s32 hit_start;
+ /* Pointer of the match end position. */
+ sljit_s32 match_end_ptr;
/* Points to the marked string. */
- int mark_ptr;
+ sljit_s32 mark_ptr;
/* Recursive control verb management chain. */
- int control_head_ptr;
+ sljit_s32 control_head_ptr;
/* Points to the last matched capture block index. */
- int capture_last_ptr;
- /* Points to the starting position of the current match. */
- int start_ptr;
+ sljit_s32 capture_last_ptr;
+ /* Fast forward skipping byte code pointer. */
+ pcre_uchar *fast_forward_bc_ptr;
+ /* Locals used by fast fail optimization. */
+ sljit_s32 fast_fail_start_ptr;
+ sljit_s32 fast_fail_end_ptr;
/* Flipped and lower case tables. */
- const pcre_uint8 *fcc;
+ const sljit_u8 *fcc;
sljit_sw lcc;
/* Mode can be PCRE_STUDY_JIT_COMPILE and others. */
int mode;
+ /* TRUE, when minlength is greater than 0. */
+ BOOL might_be_empty;
/* \K is found in the pattern. */
BOOL has_set_som;
/* (*SKIP:arg) is found in the pattern. */
BOOL has_skip_arg;
/* (*THEN) is found in the pattern. */
BOOL has_then;
- /* Needs to know the start position anytime. */
- BOOL needs_start_ptr;
+ /* (*SKIP) or (*SKIP:arg) is found in lookbehind assertion. */
+ BOOL has_skip_in_assert_back;
/* Currently in recurse or negative assert. */
BOOL local_exit;
/* Currently in a positive assert. */
BOOL positive_assert;
/* Newline control. */
int nltype;
+ sljit_u32 nlmax;
+ sljit_u32 nlmin;
int newline;
int bsr_nltype;
+ sljit_u32 bsr_nlmax;
+ sljit_u32 bsr_nlmin;
/* Dollar endonly. */
int endonly;
/* Tables. */
sljit_sw ctypes;
- int digits[2 + MAX_RANGE_SIZE];
/* Named capturing brackets. */
- sljit_uw name_table;
+ pcre_uchar *name_table;
sljit_sw name_count;
sljit_sw name_entry_size;
@@ -380,7 +414,9 @@ typedef struct compiler_common {
struct sljit_label *quit_label;
struct sljit_label *forced_quit_label;
struct sljit_label *accept_label;
+ struct sljit_label *ff_newline_shortcut;
stub_list *stubs;
+ label_addr_list *label_addrs;
recurse_entry *entries;
recurse_entry *currententry;
jump_list *partialmatch;
@@ -403,17 +439,14 @@ typedef struct compiler_common {
BOOL utf;
#ifdef SUPPORT_UCP
BOOL use_ucp;
-#endif
-#ifndef COMPILE_PCRE32
- jump_list *utfreadchar;
+ jump_list *getucd;
#endif
#ifdef COMPILE_PCRE8
+ jump_list *utfreadchar;
+ jump_list *utfreadchar16;
jump_list *utfreadtype8;
#endif
#endif /* SUPPORT_UTF */
-#ifdef SUPPORT_UCP
- jump_list *getucd;
-#endif
} compiler_common;
/* For byte_sequence_compare. */
@@ -424,27 +457,27 @@ typedef struct compare_context {
#if defined SLJIT_UNALIGNED && SLJIT_UNALIGNED
int ucharptr;
union {
- sljit_si asint;
- sljit_uh asushort;
+ sljit_s32 asint;
+ sljit_u16 asushort;
#if defined COMPILE_PCRE8
- sljit_ub asbyte;
- sljit_ub asuchars[4];
+ sljit_u8 asbyte;
+ sljit_u8 asuchars[4];
#elif defined COMPILE_PCRE16
- sljit_uh asuchars[2];
+ sljit_u16 asuchars[2];
#elif defined COMPILE_PCRE32
- sljit_ui asuchars[1];
+ sljit_u32 asuchars[1];
#endif
} c;
union {
- sljit_si asint;
- sljit_uh asushort;
+ sljit_s32 asint;
+ sljit_u16 asushort;
#if defined COMPILE_PCRE8
- sljit_ub asbyte;
- sljit_ub asuchars[4];
+ sljit_u8 asbyte;
+ sljit_u8 asuchars[4];
#elif defined COMPILE_PCRE16
- sljit_uh asuchars[2];
+ sljit_u16 asuchars[2];
#elif defined COMPILE_PCRE32
- sljit_ui asuchars[1];
+ sljit_u32 asuchars[1];
#endif
} oc;
#endif
@@ -454,18 +487,18 @@ typedef struct compare_context {
#undef CMP
/* Used for accessing the elements of the stack. */
-#define STACK(i) ((-(i) - 1) * (int)sizeof(sljit_sw))
-
-#define TMP1 SLJIT_SCRATCH_REG1
-#define TMP2 SLJIT_SCRATCH_REG3
-#define TMP3 SLJIT_TEMPORARY_EREG2
-#define STR_PTR SLJIT_SAVED_REG1
-#define STR_END SLJIT_SAVED_REG2
-#define STACK_TOP SLJIT_SCRATCH_REG2
-#define STACK_LIMIT SLJIT_SAVED_REG3
-#define ARGUMENTS SLJIT_SAVED_EREG1
-#define COUNT_MATCH SLJIT_SAVED_EREG2
-#define RETURN_ADDR SLJIT_TEMPORARY_EREG1
+#define STACK(i) ((i) * (int)sizeof(sljit_sw))
+
+#define TMP1 SLJIT_R0
+#define TMP2 SLJIT_R2
+#define TMP3 SLJIT_R3
+#define STR_PTR SLJIT_S0
+#define STR_END SLJIT_S1
+#define STACK_TOP SLJIT_R1
+#define STACK_LIMIT SLJIT_S2
+#define COUNT_MATCH SLJIT_S3
+#define ARGUMENTS SLJIT_S4
+#define RETURN_ADDR SLJIT_R4
/* Local space layout. */
/* These two locals can be used by the current opcode. */
@@ -481,19 +514,19 @@ to characters. The vector data is divided into two groups: the first
group contains the start / end character pointers, and the second is
the start pointers when the end of the capturing group has not yet reached. */
#define OVECTOR_START (common->ovector_start)
-#define OVECTOR(i) (OVECTOR_START + (i) * sizeof(sljit_sw))
-#define OVECTOR_PRIV(i) (common->cbra_ptr + (i) * sizeof(sljit_sw))
+#define OVECTOR(i) (OVECTOR_START + (i) * (sljit_sw)sizeof(sljit_sw))
+#define OVECTOR_PRIV(i) (common->cbra_ptr + (i) * (sljit_sw)sizeof(sljit_sw))
#define PRIVATE_DATA(cc) (common->private_data_ptrs[(cc) - common->start])
#if defined COMPILE_PCRE8
-#define MOV_UCHAR SLJIT_MOV_UB
-#define MOVU_UCHAR SLJIT_MOVU_UB
+#define MOV_UCHAR SLJIT_MOV_U8
+#define MOVU_UCHAR SLJIT_MOVU_U8
#elif defined COMPILE_PCRE16
-#define MOV_UCHAR SLJIT_MOV_UH
-#define MOVU_UCHAR SLJIT_MOVU_UH
+#define MOV_UCHAR SLJIT_MOV_U16
+#define MOVU_UCHAR SLJIT_MOVU_U16
#elif defined COMPILE_PCRE32
-#define MOV_UCHAR SLJIT_MOV_UI
-#define MOVU_UCHAR SLJIT_MOVU_UI
+#define MOV_UCHAR SLJIT_MOV_U32
+#define MOVU_UCHAR SLJIT_MOVU_U32
#else
#error Unsupported compiling mode
#endif
@@ -519,12 +552,16 @@ the start pointers when the end of the capturing group has not yet reached. */
sljit_emit_cmp(compiler, (type), (src1), (src1w), (src2), (src2w))
#define CMPTO(type, src1, src1w, src2, src2w, label) \
sljit_set_label(sljit_emit_cmp(compiler, (type), (src1), (src1w), (src2), (src2w)), (label))
-#define OP_FLAGS(op, dst, dstw, src, srcw, type) \
- sljit_emit_op_flags(compiler, (op), (dst), (dstw), (src), (srcw), (type))
+#define OP_FLAGS(op, dst, dstw, type) \
+ sljit_emit_op_flags(compiler, (op), (dst), (dstw), (type))
#define GET_LOCAL_BASE(dst, dstw, offset) \
sljit_get_local_base(compiler, (dst), (dstw), (offset))
-static pcre_uchar* bracketend(pcre_uchar* cc)
+#define READ_CHAR_MAX 0x7fffffff
+
+#define INVALID_UTF_CHAR 888
+
+static pcre_uchar *bracketend(pcre_uchar *cc)
{
SLJIT_ASSERT((*cc >= OP_ASSERT && *cc <= OP_ASSERTBACK_NOT) || (*cc >= OP_ONCE && *cc <= OP_SCOND));
do cc += GET(cc, 1); while (*cc == OP_ALT);
@@ -533,6 +570,20 @@ cc += 1 + LINK_SIZE;
return cc;
}
+static int no_alternatives(pcre_uchar *cc)
+{
+int count = 0;
+SLJIT_ASSERT((*cc >= OP_ASSERT && *cc <= OP_ASSERTBACK_NOT) || (*cc >= OP_ONCE && *cc <= OP_SCOND));
+do
+ {
+ cc += GET(cc, 1);
+ count++;
+ }
+while (*cc == OP_ALT);
+SLJIT_ASSERT(*cc >= OP_KET && *cc <= OP_KETRPOS);
+return count;
+}
+
/* Functions whose might need modification for all new supported opcodes:
next_opcode
check_opcode_types
@@ -585,10 +636,16 @@ switch(*cc)
case OP_CRMINQUERY:
case OP_CRRANGE:
case OP_CRMINRANGE:
+ case OP_CRPOSSTAR:
+ case OP_CRPOSPLUS:
+ case OP_CRPOSQUERY:
+ case OP_CRPOSRANGE:
case OP_CLASS:
case OP_NCLASS:
case OP_REF:
case OP_REFI:
+ case OP_DNREF:
+ case OP_DNREFI:
case OP_RECURSE:
case OP_CALLOUT:
case OP_ALT:
@@ -614,9 +671,9 @@ switch(*cc)
case OP_SCBRAPOS:
case OP_SCOND:
case OP_CREF:
- case OP_NCREF:
+ case OP_DNCREF:
case OP_RREF:
- case OP_NRREF:
+ case OP_DNRREF:
case OP_DEF:
case OP_BRAZERO:
case OP_BRAMINZERO:
@@ -729,17 +786,16 @@ switch(*cc)
default:
/* All opcodes are supported now! */
- SLJIT_ASSERT_STOP();
+ SLJIT_UNREACHABLE();
return NULL;
}
}
static BOOL check_opcode_types(compiler_common *common, pcre_uchar *cc, pcre_uchar *ccend)
{
-pcre_uchar *name;
-pcre_uchar *name2;
-unsigned int cbra_index;
-int i;
+int count;
+pcre_uchar *slot;
+pcre_uchar *assert_back_end = cc - 1;
/* Calculate important variables (like stack size) and checks whether all opcodes are supported. */
while (cc < ccend)
@@ -748,6 +804,7 @@ while (cc < ccend)
{
case OP_SET_SOM:
common->has_set_som = TRUE;
+ common->might_be_empty = TRUE;
cc += 1;
break;
@@ -773,29 +830,21 @@ while (cc < ccend)
break;
case OP_CREF:
- i = GET2(cc, 1);
- common->optimized_cbracket[i] = 0;
+ common->optimized_cbracket[GET2(cc, 1)] = 0;
cc += 1 + IMM2_SIZE;
break;
- case OP_NCREF:
- cbra_index = GET2(cc, 1);
- name = (pcre_uchar *)common->name_table;
- name2 = name;
- for (i = 0; i < common->name_count; i++)
- {
- if (GET2(name, 0) == cbra_index) break;
- name += common->name_entry_size;
- }
- SLJIT_ASSERT(i != common->name_count);
-
- for (i = 0; i < common->name_count; i++)
+ case OP_DNREF:
+ case OP_DNREFI:
+ case OP_DNCREF:
+ count = GET2(cc, 1 + IMM2_SIZE);
+ slot = common->name_table + GET2(cc, 1) * common->name_entry_size;
+ while (count-- > 0)
{
- if (STRCMP_UC_UC(name2 + IMM2_SIZE, name + IMM2_SIZE) == 0)
- common->optimized_cbracket[GET2(name2, 0)] = 0;
- name2 += common->name_entry_size;
+ common->optimized_cbracket[GET2(slot, 0)] = 0;
+ slot += common->name_entry_size;
}
- cc += 1 + IMM2_SIZE;
+ cc += 1 + 2 * IMM2_SIZE;
break;
case OP_RECURSE:
@@ -817,15 +866,19 @@ while (cc < ccend)
cc += 2 + 2 * LINK_SIZE;
break;
+ case OP_ASSERTBACK:
+ slot = bracketend(cc);
+ if (slot > assert_back_end)
+ assert_back_end = slot;
+ cc += 1 + LINK_SIZE;
+ break;
+
case OP_THEN_ARG:
common->has_then = TRUE;
common->control_head_ptr = 1;
/* Fall through. */
case OP_PRUNE_ARG:
- common->needs_start_ptr = TRUE;
- /* Fall through. */
-
case OP_MARK:
if (common->mark_ptr == 0)
{
@@ -838,17 +891,20 @@ while (cc < ccend)
case OP_THEN:
common->has_then = TRUE;
common->control_head_ptr = 1;
- /* Fall through. */
+ cc += 1;
+ break;
- case OP_PRUNE:
case OP_SKIP:
- common->needs_start_ptr = TRUE;
+ if (cc < assert_back_end)
+ common->has_skip_in_assert_back = TRUE;
cc += 1;
break;
case OP_SKIP_ARG:
common->control_head_ptr = 1;
common->has_skip_arg = TRUE;
+ if (cc < assert_back_end)
+ common->has_skip_in_assert_back = TRUE;
cc += 1 + 2 + cc[1];
break;
@@ -862,8 +918,189 @@ while (cc < ccend)
return TRUE;
}
+static BOOL is_accelerated_repeat(pcre_uchar *cc)
+{
+switch(*cc)
+ {
+ case OP_TYPESTAR:
+ case OP_TYPEMINSTAR:
+ case OP_TYPEPLUS:
+ case OP_TYPEMINPLUS:
+ case OP_TYPEPOSSTAR:
+ case OP_TYPEPOSPLUS:
+ return (cc[1] != OP_ANYNL && cc[1] != OP_EXTUNI);
+
+ case OP_STAR:
+ case OP_MINSTAR:
+ case OP_PLUS:
+ case OP_MINPLUS:
+ case OP_POSSTAR:
+ case OP_POSPLUS:
+
+ case OP_STARI:
+ case OP_MINSTARI:
+ case OP_PLUSI:
+ case OP_MINPLUSI:
+ case OP_POSSTARI:
+ case OP_POSPLUSI:
+
+ case OP_NOTSTAR:
+ case OP_NOTMINSTAR:
+ case OP_NOTPLUS:
+ case OP_NOTMINPLUS:
+ case OP_NOTPOSSTAR:
+ case OP_NOTPOSPLUS:
+
+ case OP_NOTSTARI:
+ case OP_NOTMINSTARI:
+ case OP_NOTPLUSI:
+ case OP_NOTMINPLUSI:
+ case OP_NOTPOSSTARI:
+ case OP_NOTPOSPLUSI:
+ return TRUE;
+
+ case OP_CLASS:
+ case OP_NCLASS:
+#if defined SUPPORT_UTF || !defined COMPILE_PCRE8
+ case OP_XCLASS:
+ cc += (*cc == OP_XCLASS) ? GET(cc, 1) : (int)(1 + (32 / sizeof(pcre_uchar)));
+#else
+ cc += (1 + (32 / sizeof(pcre_uchar)));
+#endif
+
+ switch(*cc)
+ {
+ case OP_CRSTAR:
+ case OP_CRMINSTAR:
+ case OP_CRPLUS:
+ case OP_CRMINPLUS:
+ case OP_CRPOSSTAR:
+ case OP_CRPOSPLUS:
+ return TRUE;
+ }
+ break;
+ }
+return FALSE;
+}
+
+static SLJIT_INLINE BOOL detect_fast_forward_skip(compiler_common *common, int *private_data_start)
+{
+pcre_uchar *cc = common->start;
+pcre_uchar *end;
+
+/* Skip not repeated brackets. */
+while (TRUE)
+ {
+ switch(*cc)
+ {
+ case OP_SOD:
+ case OP_SOM:
+ case OP_SET_SOM:
+ case OP_NOT_WORD_BOUNDARY:
+ case OP_WORD_BOUNDARY:
+ case OP_EODN:
+ case OP_EOD:
+ case OP_CIRC:
+ case OP_CIRCM:
+ case OP_DOLL:
+ case OP_DOLLM:
+ /* Zero width assertions. */
+ cc++;
+ continue;
+ }
+
+ if (*cc != OP_BRA && *cc != OP_CBRA)
+ break;
+
+ end = cc + GET(cc, 1);
+ if (*end != OP_KET || PRIVATE_DATA(end) != 0)
+ return FALSE;
+ if (*cc == OP_CBRA)
+ {
+ if (common->optimized_cbracket[GET2(cc, 1 + LINK_SIZE)] == 0)
+ return FALSE;
+ cc += IMM2_SIZE;
+ }
+ cc += 1 + LINK_SIZE;
+ }
+
+if (is_accelerated_repeat(cc))
+ {
+ common->fast_forward_bc_ptr = cc;
+ common->private_data_ptrs[(cc + 1) - common->start] = *private_data_start;
+ *private_data_start += sizeof(sljit_sw);
+ return TRUE;
+ }
+return FALSE;
+}
+
+static SLJIT_INLINE void detect_fast_fail(compiler_common *common, pcre_uchar *cc, int *private_data_start, sljit_s32 depth)
+{
+ pcre_uchar *next_alt;
+
+ SLJIT_ASSERT(*cc == OP_BRA || *cc == OP_CBRA);
+
+ if (*cc == OP_CBRA && common->optimized_cbracket[GET2(cc, 1 + LINK_SIZE)] == 0)
+ return;
+
+ next_alt = bracketend(cc) - (1 + LINK_SIZE);
+ if (*next_alt != OP_KET || PRIVATE_DATA(next_alt) != 0)
+ return;
+
+ do
+ {
+ next_alt = cc + GET(cc, 1);
+
+ cc += 1 + LINK_SIZE + ((*cc == OP_CBRA) ? IMM2_SIZE : 0);
+
+ while (TRUE)
+ {
+ switch(*cc)
+ {
+ case OP_SOD:
+ case OP_SOM:
+ case OP_SET_SOM:
+ case OP_NOT_WORD_BOUNDARY:
+ case OP_WORD_BOUNDARY:
+ case OP_EODN:
+ case OP_EOD:
+ case OP_CIRC:
+ case OP_CIRCM:
+ case OP_DOLL:
+ case OP_DOLLM:
+ /* Zero width assertions. */
+ cc++;
+ continue;
+ }
+ break;
+ }
+
+ if (depth > 0 && (*cc == OP_BRA || *cc == OP_CBRA))
+ detect_fast_fail(common, cc, private_data_start, depth - 1);
+
+ if (is_accelerated_repeat(cc))
+ {
+ common->private_data_ptrs[(cc + 1) - common->start] = *private_data_start;
+
+ if (common->fast_fail_start_ptr == 0)
+ common->fast_fail_start_ptr = *private_data_start;
+
+ *private_data_start += sizeof(sljit_sw);
+ common->fast_fail_end_ptr = *private_data_start;
+
+ if (*private_data_start > SLJIT_MAX_LOCAL_SIZE)
+ return;
+ }
+
+ cc = next_alt;
+ }
+ while (*cc == OP_ALT);
+}
+
static int get_class_iterator_size(pcre_uchar *cc)
{
+sljit_u32 min;
+sljit_u32 max;
switch(*cc)
{
case OP_CRSTAR:
@@ -878,9 +1115,14 @@ switch(*cc)
case OP_CRRANGE:
case OP_CRMINRANGE:
- if (GET2(cc, 1) == GET2(cc, 1 + IMM2_SIZE))
- return 0;
- return 2;
+ min = GET2(cc, 1);
+ max = GET2(cc, 1 + IMM2_SIZE);
+ if (max == 0)
+ return (*cc == OP_CRRANGE) ? 2 : 1;
+ max -= min;
+ if (max > 2)
+ max = 2;
+ return max;
default:
return 0;
@@ -1031,6 +1273,7 @@ pcre_uchar *alternative;
pcre_uchar *end = NULL;
int private_data_ptr = *private_data_start;
int space, size, bracketlen;
+BOOL repeat_check = TRUE;
while (cc < ccend)
{
@@ -1038,9 +1281,10 @@ while (cc < ccend)
size = 0;
bracketlen = 0;
if (private_data_ptr > SLJIT_MAX_LOCAL_SIZE)
- return;
+ break;
- if (*cc == OP_ONCE || *cc == OP_ONCE_NC || *cc == OP_BRA || *cc == OP_CBRA || *cc == OP_COND)
+ if (repeat_check && (*cc == OP_ONCE || *cc == OP_ONCE_NC || *cc == OP_BRA || *cc == OP_CBRA || *cc == OP_COND))
+ {
if (detect_repeat(common, cc))
{
/* These brackets are converted to repeats, so no global
@@ -1048,6 +1292,8 @@ while (cc < ccend)
if (cc >= end)
end = bracketend(cc);
}
+ }
+ repeat_check = TRUE;
switch(*cc)
{
@@ -1103,6 +1349,13 @@ while (cc < ccend)
bracketlen = 1 + LINK_SIZE + IMM2_SIZE;
break;
+ case OP_BRAZERO:
+ case OP_BRAMINZERO:
+ case OP_BRAPOSZERO:
+ repeat_check = FALSE;
+ size = 1;
+ break;
+
CASE_ITERATOR_PRIVATE_DATA_1
space = 1;
size = -2;
@@ -1129,22 +1382,27 @@ while (cc < ccend)
size = 1;
break;
- CASE_ITERATOR_TYPE_PRIVATE_DATA_2B
+ case OP_TYPEUPTO:
if (cc[1 + IMM2_SIZE] != OP_ANYNL && cc[1 + IMM2_SIZE] != OP_EXTUNI)
space = 2;
size = 1 + IMM2_SIZE;
break;
+ case OP_TYPEMINUPTO:
+ space = 2;
+ size = 1 + IMM2_SIZE;
+ break;
+
case OP_CLASS:
case OP_NCLASS:
- size += 1 + 32 / sizeof(pcre_uchar);
space = get_class_iterator_size(cc + size);
+ size = 1 + 32 / sizeof(pcre_uchar);
break;
#if defined SUPPORT_UTF || !defined COMPILE_PCRE8
case OP_XCLASS:
- size = GET(cc, 1);
space = get_class_iterator_size(cc + size);
+ size = GET(cc, 1);
break;
#endif
@@ -1190,7 +1448,7 @@ while (cc < ccend)
}
/* Returns with a frame_types (always < 0) if no need for frame. */
-static int get_framesize(compiler_common *common, pcre_uchar *cc, pcre_uchar *ccend, BOOL recursive, BOOL* needs_control_head)
+static int get_framesize(compiler_common *common, pcre_uchar *cc, pcre_uchar *ccend, BOOL recursive, BOOL *needs_control_head)
{
int length = 0;
int possessive = 0;
@@ -1283,6 +1541,13 @@ while (cc < ccend)
cc += 1 + LINK_SIZE + IMM2_SIZE;
break;
+ case OP_THEN:
+ stack_restore = TRUE;
+ if (common->control_head_ptr != 0)
+ *needs_control_head = TRUE;
+ cc ++;
+ break;
+
default:
stack_restore = TRUE;
/* Fall through. */
@@ -1350,6 +1615,7 @@ while (cc < ccend)
case OP_CLASS:
case OP_NCLASS:
case OP_XCLASS:
+ case OP_CALLOUT:
cc = next_opcode(common, cc);
SLJIT_ASSERT(cc != NULL);
@@ -1394,11 +1660,11 @@ while (cc < ccend)
SLJIT_ASSERT(common->has_set_som);
if (!setsom_found)
{
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(0));
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(0));
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), stackpos, SLJIT_IMM, -OVECTOR(0));
- stackpos += (int)sizeof(sljit_sw);
+ stackpos -= (int)sizeof(sljit_sw);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), stackpos, TMP1, 0);
- stackpos += (int)sizeof(sljit_sw);
+ stackpos -= (int)sizeof(sljit_sw);
setsom_found = TRUE;
}
cc += 1;
@@ -1410,11 +1676,11 @@ while (cc < ccend)
SLJIT_ASSERT(common->mark_ptr != 0);
if (!setmark_found)
{
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->mark_ptr);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), common->mark_ptr);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), stackpos, SLJIT_IMM, -common->mark_ptr);
- stackpos += (int)sizeof(sljit_sw);
+ stackpos -= (int)sizeof(sljit_sw);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), stackpos, TMP1, 0);
- stackpos += (int)sizeof(sljit_sw);
+ stackpos -= (int)sizeof(sljit_sw);
setmark_found = TRUE;
}
cc += 1 + 2 + cc[1];
@@ -1423,29 +1689,29 @@ while (cc < ccend)
case OP_RECURSE:
if (common->has_set_som && !setsom_found)
{
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(0));
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(0));
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), stackpos, SLJIT_IMM, -OVECTOR(0));
- stackpos += (int)sizeof(sljit_sw);
+ stackpos -= (int)sizeof(sljit_sw);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), stackpos, TMP1, 0);
- stackpos += (int)sizeof(sljit_sw);
+ stackpos -= (int)sizeof(sljit_sw);
setsom_found = TRUE;
}
if (common->mark_ptr != 0 && !setmark_found)
{
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->mark_ptr);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), common->mark_ptr);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), stackpos, SLJIT_IMM, -common->mark_ptr);
- stackpos += (int)sizeof(sljit_sw);
+ stackpos -= (int)sizeof(sljit_sw);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), stackpos, TMP1, 0);
- stackpos += (int)sizeof(sljit_sw);
+ stackpos -= (int)sizeof(sljit_sw);
setmark_found = TRUE;
}
if (common->capture_last_ptr != 0 && !capture_last_found)
{
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->capture_last_ptr);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), common->capture_last_ptr);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), stackpos, SLJIT_IMM, -common->capture_last_ptr);
- stackpos += (int)sizeof(sljit_sw);
+ stackpos -= (int)sizeof(sljit_sw);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), stackpos, TMP1, 0);
- stackpos += (int)sizeof(sljit_sw);
+ stackpos -= (int)sizeof(sljit_sw);
capture_last_found = TRUE;
}
cc += 1 + LINK_SIZE;
@@ -1457,22 +1723,22 @@ while (cc < ccend)
case OP_SCBRAPOS:
if (common->capture_last_ptr != 0 && !capture_last_found)
{
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->capture_last_ptr);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), common->capture_last_ptr);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), stackpos, SLJIT_IMM, -common->capture_last_ptr);
- stackpos += (int)sizeof(sljit_sw);
+ stackpos -= (int)sizeof(sljit_sw);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), stackpos, TMP1, 0);
- stackpos += (int)sizeof(sljit_sw);
+ stackpos -= (int)sizeof(sljit_sw);
capture_last_found = TRUE;
}
offset = (GET2(cc, 1 + LINK_SIZE)) << 1;
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), stackpos, SLJIT_IMM, OVECTOR(offset));
- stackpos += (int)sizeof(sljit_sw);
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(offset));
- OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(offset + 1));
+ stackpos -= (int)sizeof(sljit_sw);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset));
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset + 1));
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), stackpos, TMP1, 0);
- stackpos += (int)sizeof(sljit_sw);
+ stackpos -= (int)sizeof(sljit_sw);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), stackpos, TMP2, 0);
- stackpos += (int)sizeof(sljit_sw);
+ stackpos -= (int)sizeof(sljit_sw);
cc += 1 + LINK_SIZE + IMM2_SIZE;
break;
@@ -1500,7 +1766,11 @@ while (cc < ccend)
{
case OP_KET:
if (PRIVATE_DATA(cc) != 0)
+ {
private_data_length++;
+ SLJIT_ASSERT(PRIVATE_DATA(cc + 1) != 0);
+ cc += PRIVATE_DATA(cc + 1);
+ }
cc += 1 + LINK_SIZE;
break;
@@ -1515,6 +1785,7 @@ while (cc < ccend)
case OP_SBRAPOS:
case OP_SCOND:
private_data_length++;
+ SLJIT_ASSERT(PRIVATE_DATA(cc) != 0);
cc += 1 + LINK_SIZE;
break;
@@ -1618,18 +1889,17 @@ BOOL tmp1empty = TRUE;
BOOL tmp2empty = TRUE;
pcre_uchar *alternative;
enum {
- start,
loop,
end
} status;
-status = save ? start : loop;
-stackptr = STACK(stackptr - 2);
+status = loop;
+stackptr = STACK(stackptr);
stacktop = STACK(stacktop - 1);
if (!save)
{
- stackptr += (needs_control_head ? 2 : 1) * sizeof(sljit_sw);
+ stacktop -= (needs_control_head ? 2 : 1) * sizeof(sljit_sw);
if (stackptr < stacktop)
{
OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), stackptr);
@@ -1645,194 +1915,186 @@ if (!save)
/* The tmp1next must be TRUE in either way. */
}
+SLJIT_ASSERT(common->recursive_head_ptr != 0);
+
do
{
count = 0;
- switch(status)
+ if (cc >= ccend)
{
- case start:
- SLJIT_ASSERT(save && common->recursive_head_ptr != 0);
+ if (!save)
+ break;
+
count = 1;
srcw[0] = common->recursive_head_ptr;
if (needs_control_head)
{
SLJIT_ASSERT(common->control_head_ptr != 0);
count = 2;
- srcw[1] = common->control_head_ptr;
+ srcw[0] = common->control_head_ptr;
+ srcw[1] = common->recursive_head_ptr;
+ }
+ status = end;
+ }
+ else switch(*cc)
+ {
+ case OP_KET:
+ if (PRIVATE_DATA(cc) != 0)
+ {
+ count = 1;
+ srcw[0] = PRIVATE_DATA(cc);
+ SLJIT_ASSERT(PRIVATE_DATA(cc + 1) != 0);
+ cc += PRIVATE_DATA(cc + 1);
}
- status = loop;
+ cc += 1 + LINK_SIZE;
break;
- case loop:
- if (cc >= ccend)
+ case OP_ASSERT:
+ case OP_ASSERT_NOT:
+ case OP_ASSERTBACK:
+ case OP_ASSERTBACK_NOT:
+ case OP_ONCE:
+ case OP_ONCE_NC:
+ case OP_BRAPOS:
+ case OP_SBRA:
+ case OP_SBRAPOS:
+ case OP_SCOND:
+ count = 1;
+ srcw[0] = PRIVATE_DATA(cc);
+ SLJIT_ASSERT(srcw[0] != 0);
+ cc += 1 + LINK_SIZE;
+ break;
+
+ case OP_CBRA:
+ case OP_SCBRA:
+ if (common->optimized_cbracket[GET2(cc, 1 + LINK_SIZE)] == 0)
{
- status = end;
- break;
+ count = 1;
+ srcw[0] = OVECTOR_PRIV(GET2(cc, 1 + LINK_SIZE));
}
+ cc += 1 + LINK_SIZE + IMM2_SIZE;
+ break;
- switch(*cc)
- {
- case OP_KET:
- if (PRIVATE_DATA(cc) != 0)
- {
- count = 1;
- srcw[0] = PRIVATE_DATA(cc);
- }
- cc += 1 + LINK_SIZE;
- break;
+ case OP_CBRAPOS:
+ case OP_SCBRAPOS:
+ count = 2;
+ srcw[0] = PRIVATE_DATA(cc);
+ srcw[1] = OVECTOR_PRIV(GET2(cc, 1 + LINK_SIZE));
+ SLJIT_ASSERT(srcw[0] != 0 && srcw[1] != 0);
+ cc += 1 + LINK_SIZE + IMM2_SIZE;
+ break;
- case OP_ASSERT:
- case OP_ASSERT_NOT:
- case OP_ASSERTBACK:
- case OP_ASSERTBACK_NOT:
- case OP_ONCE:
- case OP_ONCE_NC:
- case OP_BRAPOS:
- case OP_SBRA:
- case OP_SBRAPOS:
- case OP_SCOND:
+ case OP_COND:
+ /* Might be a hidden SCOND. */
+ alternative = cc + GET(cc, 1);
+ if (*alternative == OP_KETRMAX || *alternative == OP_KETRMIN)
+ {
count = 1;
srcw[0] = PRIVATE_DATA(cc);
SLJIT_ASSERT(srcw[0] != 0);
- cc += 1 + LINK_SIZE;
- break;
-
- case OP_CBRA:
- case OP_SCBRA:
- if (common->optimized_cbracket[GET2(cc, 1 + LINK_SIZE)] == 0)
- {
- count = 1;
- srcw[0] = OVECTOR_PRIV(GET2(cc, 1 + LINK_SIZE));
- }
- cc += 1 + LINK_SIZE + IMM2_SIZE;
- break;
+ }
+ cc += 1 + LINK_SIZE;
+ break;
- case OP_CBRAPOS:
- case OP_SCBRAPOS:
- count = 2;
+ CASE_ITERATOR_PRIVATE_DATA_1
+ if (PRIVATE_DATA(cc))
+ {
+ count = 1;
srcw[0] = PRIVATE_DATA(cc);
- srcw[1] = OVECTOR_PRIV(GET2(cc, 1 + LINK_SIZE));
- SLJIT_ASSERT(srcw[0] != 0 && srcw[1] != 0);
- cc += 1 + LINK_SIZE + IMM2_SIZE;
- break;
-
- case OP_COND:
- /* Might be a hidden SCOND. */
- alternative = cc + GET(cc, 1);
- if (*alternative == OP_KETRMAX || *alternative == OP_KETRMIN)
- {
- count = 1;
- srcw[0] = PRIVATE_DATA(cc);
- SLJIT_ASSERT(srcw[0] != 0);
- }
- cc += 1 + LINK_SIZE;
- break;
-
- CASE_ITERATOR_PRIVATE_DATA_1
- if (PRIVATE_DATA(cc))
- {
- count = 1;
- srcw[0] = PRIVATE_DATA(cc);
- }
- cc += 2;
+ }
+ cc += 2;
#ifdef SUPPORT_UTF
- if (common->utf && HAS_EXTRALEN(cc[-1])) cc += GET_EXTRALEN(cc[-1]);
+ if (common->utf && HAS_EXTRALEN(cc[-1])) cc += GET_EXTRALEN(cc[-1]);
#endif
- break;
+ break;
- CASE_ITERATOR_PRIVATE_DATA_2A
- if (PRIVATE_DATA(cc))
- {
- count = 2;
- srcw[0] = PRIVATE_DATA(cc);
- srcw[1] = PRIVATE_DATA(cc) + sizeof(sljit_sw);
- }
- cc += 2;
+ CASE_ITERATOR_PRIVATE_DATA_2A
+ if (PRIVATE_DATA(cc))
+ {
+ count = 2;
+ srcw[0] = PRIVATE_DATA(cc);
+ srcw[1] = PRIVATE_DATA(cc) + sizeof(sljit_sw);
+ }
+ cc += 2;
#ifdef SUPPORT_UTF
- if (common->utf && HAS_EXTRALEN(cc[-1])) cc += GET_EXTRALEN(cc[-1]);
+ if (common->utf && HAS_EXTRALEN(cc[-1])) cc += GET_EXTRALEN(cc[-1]);
#endif
- break;
+ break;
- CASE_ITERATOR_PRIVATE_DATA_2B
- if (PRIVATE_DATA(cc))
- {
- count = 2;
- srcw[0] = PRIVATE_DATA(cc);
- srcw[1] = PRIVATE_DATA(cc) + sizeof(sljit_sw);
- }
- cc += 2 + IMM2_SIZE;
+ CASE_ITERATOR_PRIVATE_DATA_2B
+ if (PRIVATE_DATA(cc))
+ {
+ count = 2;
+ srcw[0] = PRIVATE_DATA(cc);
+ srcw[1] = PRIVATE_DATA(cc) + sizeof(sljit_sw);
+ }
+ cc += 2 + IMM2_SIZE;
#ifdef SUPPORT_UTF
- if (common->utf && HAS_EXTRALEN(cc[-1])) cc += GET_EXTRALEN(cc[-1]);
+ if (common->utf && HAS_EXTRALEN(cc[-1])) cc += GET_EXTRALEN(cc[-1]);
#endif
- break;
+ break;
+
+ CASE_ITERATOR_TYPE_PRIVATE_DATA_1
+ if (PRIVATE_DATA(cc))
+ {
+ count = 1;
+ srcw[0] = PRIVATE_DATA(cc);
+ }
+ cc += 1;
+ break;
- CASE_ITERATOR_TYPE_PRIVATE_DATA_1
- if (PRIVATE_DATA(cc))
+ CASE_ITERATOR_TYPE_PRIVATE_DATA_2A
+ if (PRIVATE_DATA(cc))
+ {
+ count = 2;
+ srcw[0] = PRIVATE_DATA(cc);
+ srcw[1] = srcw[0] + sizeof(sljit_sw);
+ }
+ cc += 1;
+ break;
+
+ CASE_ITERATOR_TYPE_PRIVATE_DATA_2B
+ if (PRIVATE_DATA(cc))
+ {
+ count = 2;
+ srcw[0] = PRIVATE_DATA(cc);
+ srcw[1] = srcw[0] + sizeof(sljit_sw);
+ }
+ cc += 1 + IMM2_SIZE;
+ break;
+
+ case OP_CLASS:
+ case OP_NCLASS:
+#if defined SUPPORT_UTF || !defined COMPILE_PCRE8
+ case OP_XCLASS:
+ size = (*cc == OP_XCLASS) ? GET(cc, 1) : 1 + 32 / (int)sizeof(pcre_uchar);
+#else
+ size = 1 + 32 / (int)sizeof(pcre_uchar);
+#endif
+ if (PRIVATE_DATA(cc))
+ switch(get_class_iterator_size(cc + size))
{
+ case 1:
count = 1;
srcw[0] = PRIVATE_DATA(cc);
- }
- cc += 1;
- break;
+ break;
- CASE_ITERATOR_TYPE_PRIVATE_DATA_2A
- if (PRIVATE_DATA(cc))
- {
+ case 2:
count = 2;
srcw[0] = PRIVATE_DATA(cc);
srcw[1] = srcw[0] + sizeof(sljit_sw);
- }
- cc += 1;
- break;
+ break;
- CASE_ITERATOR_TYPE_PRIVATE_DATA_2B
- if (PRIVATE_DATA(cc))
- {
- count = 2;
- srcw[0] = PRIVATE_DATA(cc);
- srcw[1] = srcw[0] + sizeof(sljit_sw);
+ default:
+ SLJIT_UNREACHABLE();
+ break;
}
- cc += 1 + IMM2_SIZE;
- break;
-
- case OP_CLASS:
- case OP_NCLASS:
-#if defined SUPPORT_UTF || !defined COMPILE_PCRE8
- case OP_XCLASS:
- size = (*cc == OP_XCLASS) ? GET(cc, 1) : 1 + 32 / (int)sizeof(pcre_uchar);
-#else
- size = 1 + 32 / (int)sizeof(pcre_uchar);
-#endif
- if (PRIVATE_DATA(cc))
- switch(get_class_iterator_size(cc + size))
- {
- case 1:
- count = 1;
- srcw[0] = PRIVATE_DATA(cc);
- break;
-
- case 2:
- count = 2;
- srcw[0] = PRIVATE_DATA(cc);
- srcw[1] = srcw[0] + sizeof(sljit_sw);
- break;
-
- default:
- SLJIT_ASSERT_STOP();
- break;
- }
- cc += size;
- break;
-
- default:
- cc = next_opcode(common, cc);
- SLJIT_ASSERT(cc != NULL);
- break;
- }
+ cc += size;
break;
- case end:
- SLJIT_ASSERT_STOP();
+ default:
+ cc = next_opcode(common, cc);
+ SLJIT_ASSERT(cc != NULL);
break;
}
@@ -1848,7 +2110,7 @@ do
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), stackptr, TMP1, 0);
stackptr += sizeof(sljit_sw);
}
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), srcw[count]);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), srcw[count]);
tmp1empty = FALSE;
tmp1next = FALSE;
}
@@ -1859,7 +2121,7 @@ do
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), stackptr, TMP2, 0);
stackptr += sizeof(sljit_sw);
}
- OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), srcw[count]);
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), srcw[count]);
tmp2empty = FALSE;
tmp1next = TRUE;
}
@@ -1869,7 +2131,7 @@ do
if (tmp1next)
{
SLJIT_ASSERT(!tmp1empty);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), srcw[count], TMP1, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), srcw[count], TMP1, 0);
tmp1empty = stackptr >= stacktop;
if (!tmp1empty)
{
@@ -1881,7 +2143,7 @@ do
else
{
SLJIT_ASSERT(!tmp2empty);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), srcw[count], TMP2, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), srcw[count], TMP2, 0);
tmp2empty = stackptr >= stacktop;
if (!tmp2empty)
{
@@ -1927,7 +2189,7 @@ if (save)
SLJIT_ASSERT(cc == ccend && stackptr == stacktop && (save || (tmp1empty && tmp2empty)));
}
-static SLJIT_INLINE pcre_uchar *set_then_offsets(compiler_common *common, pcre_uchar *cc, pcre_uint8 *current_offset)
+static SLJIT_INLINE pcre_uchar *set_then_offsets(compiler_common *common, pcre_uchar *cc, sljit_u8 *current_offset)
{
pcre_uchar *end = bracketend(cc);
BOOL has_alternatives = cc[GET(cc, 1)] == OP_ALT;
@@ -1983,7 +2245,7 @@ while (list)
}
}
-static SLJIT_INLINE void add_jump(struct sljit_compiler *compiler, jump_list **list, struct sljit_jump* jump)
+static SLJIT_INLINE void add_jump(struct sljit_compiler *compiler, jump_list **list, struct sljit_jump *jump)
{
jump_list *list_item = sljit_alloc_memory(compiler, sizeof(jump_list));
if (list_item)
@@ -1997,7 +2259,7 @@ if (list_item)
static void add_stub(compiler_common *common, struct sljit_jump *start)
{
DEFINE_COMPILER;
-stub_list* list_item = sljit_alloc_memory(compiler, sizeof(stub_list));
+stub_list *list_item = sljit_alloc_memory(compiler, sizeof(stub_list));
if (list_item)
{
@@ -2011,7 +2273,7 @@ if (list_item)
static void flush_stubs(compiler_common *common)
{
DEFINE_COMPILER;
-stub_list* list_item = common->stubs;
+stub_list *list_item = common->stubs;
while (list_item)
{
@@ -2023,12 +2285,26 @@ while (list_item)
common->stubs = NULL;
}
+static void add_label_addr(compiler_common *common, sljit_uw *update_addr)
+{
+DEFINE_COMPILER;
+label_addr_list *label_addr;
+
+label_addr = sljit_alloc_memory(compiler, sizeof(label_addr_list));
+if (label_addr == NULL)
+ return;
+label_addr->label = LABEL();
+label_addr->update_addr = update_addr;
+label_addr->next = common->label_addrs;
+common->label_addrs = label_addr;
+}
+
static SLJIT_INLINE void count_match(compiler_common *common)
{
DEFINE_COMPILER;
-OP2(SLJIT_SUB | SLJIT_SET_E, COUNT_MATCH, 0, COUNT_MATCH, 0, SLJIT_IMM, 1);
-add_jump(compiler, &common->calllimit, JUMP(SLJIT_C_ZERO));
+OP2(SLJIT_SUB | SLJIT_SET_Z, COUNT_MATCH, 0, COUNT_MATCH, 0, SLJIT_IMM, 1);
+add_jump(compiler, &common->calllimit, JUMP(SLJIT_ZERO));
}
static SLJIT_INLINE void allocate_stack(compiler_common *common, int size)
@@ -2036,21 +2312,58 @@ static SLJIT_INLINE void allocate_stack(compiler_common *common, int size)
/* May destroy all locals and registers except TMP2. */
DEFINE_COMPILER;
-OP2(SLJIT_ADD, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, size * sizeof(sljit_sw));
+SLJIT_ASSERT(size > 0);
+OP2(SLJIT_SUB, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, size * sizeof(sljit_sw));
#ifdef DESTROY_REGISTERS
OP1(SLJIT_MOV, TMP1, 0, SLJIT_IMM, 12345);
OP1(SLJIT_MOV, TMP3, 0, TMP1, 0);
OP1(SLJIT_MOV, RETURN_ADDR, 0, TMP1, 0);
-OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), LOCALS0, TMP1, 0);
-OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), LOCALS1, TMP1, 0);
+OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), LOCALS0, TMP1, 0);
+OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), LOCALS1, TMP1, 0);
#endif
-add_stub(common, CMP(SLJIT_C_GREATER, STACK_TOP, 0, STACK_LIMIT, 0));
+add_stub(common, CMP(SLJIT_LESS, STACK_TOP, 0, STACK_LIMIT, 0));
}
static SLJIT_INLINE void free_stack(compiler_common *common, int size)
{
DEFINE_COMPILER;
-OP2(SLJIT_SUB, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, size * sizeof(sljit_sw));
+
+SLJIT_ASSERT(size > 0);
+OP2(SLJIT_ADD, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, size * sizeof(sljit_sw));
+}
+
+static sljit_uw * allocate_read_only_data(compiler_common *common, sljit_uw size)
+{
+DEFINE_COMPILER;
+sljit_uw *result;
+
+if (SLJIT_UNLIKELY(sljit_get_compiler_error(compiler)))
+ return NULL;
+
+result = (sljit_uw *)SLJIT_MALLOC(size + sizeof(sljit_uw), compiler->allocator_data);
+if (SLJIT_UNLIKELY(result == NULL))
+ {
+ sljit_set_compiler_memory_error(compiler);
+ return NULL;
+ }
+
+*(void**)result = common->read_only_data_head;
+common->read_only_data_head = (void *)result;
+return result + 1;
+}
+
+static void free_read_only_data(void *current, void *allocator_data)
+{
+void *next;
+
+SLJIT_UNUSED_ARG(allocator_data);
+
+while (current != NULL)
+ {
+ next = *(void**)current;
+ SLJIT_FREE(current, allocator_data);
+ current = next;
+ }
}
static SLJIT_INLINE void reset_ovector(compiler_common *common, int length)
@@ -2062,23 +2375,35 @@ int i;
/* At this point we can freely use all temporary registers. */
SLJIT_ASSERT(length > 1);
/* TMP1 returns with begin - 1. */
-OP2(SLJIT_SUB, SLJIT_SCRATCH_REG1, 0, SLJIT_MEM1(SLJIT_SAVED_REG1), SLJIT_OFFSETOF(jit_arguments, begin), SLJIT_IMM, IN_UCHARS(1));
+OP2(SLJIT_SUB, SLJIT_R0, 0, SLJIT_MEM1(SLJIT_S0), SLJIT_OFFSETOF(jit_arguments, begin), SLJIT_IMM, IN_UCHARS(1));
if (length < 8)
{
for (i = 1; i < length; i++)
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(i), SLJIT_SCRATCH_REG1, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), OVECTOR(i), SLJIT_R0, 0);
}
else
{
- GET_LOCAL_BASE(SLJIT_SCRATCH_REG2, 0, OVECTOR_START);
- OP1(SLJIT_MOV, SLJIT_SCRATCH_REG3, 0, SLJIT_IMM, length - 1);
+ GET_LOCAL_BASE(SLJIT_R1, 0, OVECTOR_START);
+ OP1(SLJIT_MOV, SLJIT_R2, 0, SLJIT_IMM, length - 1);
loop = LABEL();
- OP1(SLJIT_MOVU, SLJIT_MEM1(SLJIT_SCRATCH_REG2), sizeof(sljit_sw), SLJIT_SCRATCH_REG1, 0);
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_SCRATCH_REG3, 0, SLJIT_SCRATCH_REG3, 0, SLJIT_IMM, 1);
- JUMPTO(SLJIT_C_NOT_ZERO, loop);
+ OP1(SLJIT_MOVU, SLJIT_MEM1(SLJIT_R1), sizeof(sljit_sw), SLJIT_R0, 0);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_R2, 0, SLJIT_R2, 0, SLJIT_IMM, 1);
+ JUMPTO(SLJIT_NOT_ZERO, loop);
}
}
+static SLJIT_INLINE void reset_fast_fail(compiler_common *common)
+{
+DEFINE_COMPILER;
+sljit_s32 i;
+
+SLJIT_ASSERT(common->fast_fail_start_ptr < common->fast_fail_end_ptr);
+
+OP2(SLJIT_SUB, TMP1, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
+for (i = common->fast_fail_start_ptr; i < common->fast_fail_end_ptr; i += sizeof(sljit_sw))
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), i, TMP1, 0);
+}
+
static SLJIT_INLINE void do_reset_match(compiler_common *common, int length)
{
DEFINE_COMPILER;
@@ -2088,11 +2413,11 @@ int i;
SLJIT_ASSERT(length > 1);
/* OVECTOR(1) contains the "string begin - 1" constant. */
if (length > 2)
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(1));
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(1));
if (length < 8)
{
for (i = 2; i < length; i++)
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(i), TMP1, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), OVECTOR(i), TMP1, 0);
}
else
{
@@ -2100,17 +2425,17 @@ else
OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_IMM, length - 2);
loop = LABEL();
OP1(SLJIT_MOVU, SLJIT_MEM1(TMP2), sizeof(sljit_sw), TMP1, 0);
- OP2(SLJIT_SUB | SLJIT_SET_E, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, 1);
- JUMPTO(SLJIT_C_NOT_ZERO, loop);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, 1);
+ JUMPTO(SLJIT_NOT_ZERO, loop);
}
OP1(SLJIT_MOV, STACK_TOP, 0, ARGUMENTS, 0);
if (common->mark_ptr != 0)
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->mark_ptr, SLJIT_IMM, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->mark_ptr, SLJIT_IMM, 0);
if (common->control_head_ptr != 0)
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->control_head_ptr, SLJIT_IMM, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr, SLJIT_IMM, 0);
OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(STACK_TOP), SLJIT_OFFSETOF(jit_arguments, stack));
-OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->start_ptr);
+OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), common->start_ptr);
OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(STACK_TOP), SLJIT_OFFSETOF(struct sljit_stack, base));
}
@@ -2118,21 +2443,22 @@ static sljit_sw SLJIT_CALL do_search_mark(sljit_sw *current, const pcre_uchar *s
{
while (current != NULL)
{
- switch (current[-2])
+ switch (current[1])
{
case type_then_trap:
break;
case type_mark:
- if (STRCMP_UC_UC(skip_arg, (pcre_uchar *)current[-3]) == 0)
- return current[-4];
+ if (STRCMP_UC_UC(skip_arg, (pcre_uchar *)current[2]) == 0)
+ return current[3];
break;
default:
- SLJIT_ASSERT_STOP();
+ SLJIT_UNREACHABLE();
break;
}
- current = (sljit_sw*)current[-1];
+ SLJIT_ASSERT(current[0] == 0 || current < (sljit_sw*)current[0]);
+ current = (sljit_sw*)current[0];
}
return -1;
}
@@ -2144,44 +2470,44 @@ struct sljit_label *loop;
struct sljit_jump *early_quit;
/* At this point we can freely use all registers. */
-OP1(SLJIT_MOV, SLJIT_SAVED_REG3, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(1));
-OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(1), STR_PTR, 0);
+OP1(SLJIT_MOV, SLJIT_S2, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(1));
+OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), OVECTOR(1), STR_PTR, 0);
-OP1(SLJIT_MOV, SLJIT_SCRATCH_REG1, 0, ARGUMENTS, 0);
+OP1(SLJIT_MOV, SLJIT_R0, 0, ARGUMENTS, 0);
if (common->mark_ptr != 0)
- OP1(SLJIT_MOV, SLJIT_SCRATCH_REG3, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->mark_ptr);
-OP1(SLJIT_MOV_SI, SLJIT_SCRATCH_REG2, 0, SLJIT_MEM1(SLJIT_SCRATCH_REG1), SLJIT_OFFSETOF(jit_arguments, offset_count));
+ OP1(SLJIT_MOV, SLJIT_R2, 0, SLJIT_MEM1(SLJIT_SP), common->mark_ptr);
+OP1(SLJIT_MOV_S32, SLJIT_R1, 0, SLJIT_MEM1(SLJIT_R0), SLJIT_OFFSETOF(jit_arguments, offset_count));
if (common->mark_ptr != 0)
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SCRATCH_REG1), SLJIT_OFFSETOF(jit_arguments, mark_ptr), SLJIT_SCRATCH_REG3, 0);
-OP2(SLJIT_SUB, SLJIT_SCRATCH_REG3, 0, SLJIT_MEM1(SLJIT_SCRATCH_REG1), SLJIT_OFFSETOF(jit_arguments, offsets), SLJIT_IMM, sizeof(int));
-OP1(SLJIT_MOV, SLJIT_SCRATCH_REG1, 0, SLJIT_MEM1(SLJIT_SCRATCH_REG1), SLJIT_OFFSETOF(jit_arguments, begin));
-GET_LOCAL_BASE(SLJIT_SAVED_REG1, 0, OVECTOR_START);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_R0), SLJIT_OFFSETOF(jit_arguments, mark_ptr), SLJIT_R2, 0);
+OP2(SLJIT_SUB, SLJIT_R2, 0, SLJIT_MEM1(SLJIT_R0), SLJIT_OFFSETOF(jit_arguments, offsets), SLJIT_IMM, sizeof(int));
+OP1(SLJIT_MOV, SLJIT_R0, 0, SLJIT_MEM1(SLJIT_R0), SLJIT_OFFSETOF(jit_arguments, begin));
+GET_LOCAL_BASE(SLJIT_S0, 0, OVECTOR_START);
/* Unlikely, but possible */
-early_quit = CMP(SLJIT_C_EQUAL, SLJIT_SCRATCH_REG2, 0, SLJIT_IMM, 0);
+early_quit = CMP(SLJIT_EQUAL, SLJIT_R1, 0, SLJIT_IMM, 0);
loop = LABEL();
-OP2(SLJIT_SUB, SLJIT_SAVED_REG2, 0, SLJIT_MEM1(SLJIT_SAVED_REG1), 0, SLJIT_SCRATCH_REG1, 0);
-OP2(SLJIT_ADD, SLJIT_SAVED_REG1, 0, SLJIT_SAVED_REG1, 0, SLJIT_IMM, sizeof(sljit_sw));
+OP2(SLJIT_SUB, SLJIT_S1, 0, SLJIT_MEM1(SLJIT_S0), 0, SLJIT_R0, 0);
+OP2(SLJIT_ADD, SLJIT_S0, 0, SLJIT_S0, 0, SLJIT_IMM, sizeof(sljit_sw));
/* Copy the integer value to the output buffer */
#if defined COMPILE_PCRE16 || defined COMPILE_PCRE32
-OP2(SLJIT_ASHR, SLJIT_SAVED_REG2, 0, SLJIT_SAVED_REG2, 0, SLJIT_IMM, UCHAR_SHIFT);
+OP2(SLJIT_ASHR, SLJIT_S1, 0, SLJIT_S1, 0, SLJIT_IMM, UCHAR_SHIFT);
#endif
-OP1(SLJIT_MOVU_SI, SLJIT_MEM1(SLJIT_SCRATCH_REG3), sizeof(int), SLJIT_SAVED_REG2, 0);
-OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_SCRATCH_REG2, 0, SLJIT_SCRATCH_REG2, 0, SLJIT_IMM, 1);
-JUMPTO(SLJIT_C_NOT_ZERO, loop);
+OP1(SLJIT_MOVU_S32, SLJIT_MEM1(SLJIT_R2), sizeof(int), SLJIT_S1, 0);
+OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_R1, 0, SLJIT_R1, 0, SLJIT_IMM, 1);
+JUMPTO(SLJIT_NOT_ZERO, loop);
JUMPHERE(early_quit);
/* Calculate the return value, which is the maximum ovector value. */
if (topbracket > 1)
{
- GET_LOCAL_BASE(SLJIT_SCRATCH_REG1, 0, OVECTOR_START + topbracket * 2 * sizeof(sljit_sw));
- OP1(SLJIT_MOV, SLJIT_SCRATCH_REG2, 0, SLJIT_IMM, topbracket + 1);
+ GET_LOCAL_BASE(SLJIT_R0, 0, OVECTOR_START + topbracket * 2 * sizeof(sljit_sw));
+ OP1(SLJIT_MOV, SLJIT_R1, 0, SLJIT_IMM, topbracket + 1);
- /* OVECTOR(0) is never equal to SLJIT_SAVED_REG3. */
+ /* OVECTOR(0) is never equal to SLJIT_S2. */
loop = LABEL();
- OP1(SLJIT_MOVU, SLJIT_SCRATCH_REG3, 0, SLJIT_MEM1(SLJIT_SCRATCH_REG1), -(2 * (sljit_sw)sizeof(sljit_sw)));
- OP2(SLJIT_SUB, SLJIT_SCRATCH_REG2, 0, SLJIT_SCRATCH_REG2, 0, SLJIT_IMM, 1);
- CMPTO(SLJIT_C_EQUAL, SLJIT_SCRATCH_REG3, 0, SLJIT_SAVED_REG3, 0, loop);
- OP1(SLJIT_MOV, SLJIT_RETURN_REG, 0, SLJIT_SCRATCH_REG2, 0);
+ OP1(SLJIT_MOVU, SLJIT_R2, 0, SLJIT_MEM1(SLJIT_R0), -(2 * (sljit_sw)sizeof(sljit_sw)));
+ OP2(SLJIT_SUB, SLJIT_R1, 0, SLJIT_R1, 0, SLJIT_IMM, 1);
+ CMPTO(SLJIT_EQUAL, SLJIT_R2, 0, SLJIT_S2, 0, loop);
+ OP1(SLJIT_MOV, SLJIT_RETURN_REG, 0, SLJIT_R1, 0);
}
else
OP1(SLJIT_MOV, SLJIT_RETURN_REG, 0, SLJIT_IMM, 1);
@@ -2192,39 +2518,39 @@ static SLJIT_INLINE void return_with_partial_match(compiler_common *common, stru
DEFINE_COMPILER;
struct sljit_jump *jump;
-SLJIT_COMPILE_ASSERT(STR_END == SLJIT_SAVED_REG2, str_end_must_be_saved_reg2);
+SLJIT_COMPILE_ASSERT(STR_END == SLJIT_S1, str_end_must_be_saved_reg2);
SLJIT_ASSERT(common->start_used_ptr != 0 && common->start_ptr != 0
&& (common->mode == JIT_PARTIAL_SOFT_COMPILE ? common->hit_start != 0 : common->hit_start == 0));
-OP1(SLJIT_MOV, SLJIT_SCRATCH_REG2, 0, ARGUMENTS, 0);
+OP1(SLJIT_MOV, SLJIT_R1, 0, ARGUMENTS, 0);
OP1(SLJIT_MOV, SLJIT_RETURN_REG, 0, SLJIT_IMM, PCRE_ERROR_PARTIAL);
-OP1(SLJIT_MOV_SI, SLJIT_SCRATCH_REG3, 0, SLJIT_MEM1(SLJIT_SCRATCH_REG2), SLJIT_OFFSETOF(jit_arguments, real_offset_count));
-CMPTO(SLJIT_C_SIG_LESS, SLJIT_SCRATCH_REG3, 0, SLJIT_IMM, 2, quit);
+OP1(SLJIT_MOV_S32, SLJIT_R2, 0, SLJIT_MEM1(SLJIT_R1), SLJIT_OFFSETOF(jit_arguments, real_offset_count));
+CMPTO(SLJIT_SIG_LESS, SLJIT_R2, 0, SLJIT_IMM, 2, quit);
/* Store match begin and end. */
-OP1(SLJIT_MOV, SLJIT_SAVED_REG1, 0, SLJIT_MEM1(SLJIT_SCRATCH_REG2), SLJIT_OFFSETOF(jit_arguments, begin));
-OP1(SLJIT_MOV, SLJIT_SCRATCH_REG2, 0, SLJIT_MEM1(SLJIT_SCRATCH_REG2), SLJIT_OFFSETOF(jit_arguments, offsets));
+OP1(SLJIT_MOV, SLJIT_S0, 0, SLJIT_MEM1(SLJIT_R1), SLJIT_OFFSETOF(jit_arguments, begin));
+OP1(SLJIT_MOV, SLJIT_R1, 0, SLJIT_MEM1(SLJIT_R1), SLJIT_OFFSETOF(jit_arguments, offsets));
-jump = CMP(SLJIT_C_SIG_LESS, SLJIT_SCRATCH_REG3, 0, SLJIT_IMM, 3);
-OP2(SLJIT_SUB, SLJIT_SCRATCH_REG3, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->mode == JIT_PARTIAL_HARD_COMPILE ? common->start_ptr : (common->hit_start + (int)sizeof(sljit_sw)), SLJIT_SAVED_REG1, 0);
+jump = CMP(SLJIT_SIG_LESS, SLJIT_R2, 0, SLJIT_IMM, 3);
+OP2(SLJIT_SUB, SLJIT_R2, 0, SLJIT_MEM1(SLJIT_SP), common->mode == JIT_PARTIAL_HARD_COMPILE ? common->start_ptr : (common->hit_start + (int)sizeof(sljit_sw)), SLJIT_S0, 0);
#if defined COMPILE_PCRE16 || defined COMPILE_PCRE32
-OP2(SLJIT_ASHR, SLJIT_SCRATCH_REG3, 0, SLJIT_SCRATCH_REG3, 0, SLJIT_IMM, UCHAR_SHIFT);
+OP2(SLJIT_ASHR, SLJIT_R2, 0, SLJIT_R2, 0, SLJIT_IMM, UCHAR_SHIFT);
#endif
-OP1(SLJIT_MOV_SI, SLJIT_MEM1(SLJIT_SCRATCH_REG2), 2 * sizeof(int), SLJIT_SCRATCH_REG3, 0);
+OP1(SLJIT_MOV_S32, SLJIT_MEM1(SLJIT_R1), 2 * sizeof(int), SLJIT_R2, 0);
JUMPHERE(jump);
-OP1(SLJIT_MOV, SLJIT_SCRATCH_REG3, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->mode == JIT_PARTIAL_HARD_COMPILE ? common->start_used_ptr : common->hit_start);
-OP2(SLJIT_SUB, SLJIT_SAVED_REG2, 0, STR_END, 0, SLJIT_SAVED_REG1, 0);
+OP1(SLJIT_MOV, SLJIT_R2, 0, SLJIT_MEM1(SLJIT_SP), common->mode == JIT_PARTIAL_HARD_COMPILE ? common->start_used_ptr : common->hit_start);
+OP2(SLJIT_SUB, SLJIT_S1, 0, STR_END, 0, SLJIT_S0, 0);
#if defined COMPILE_PCRE16 || defined COMPILE_PCRE32
-OP2(SLJIT_ASHR, SLJIT_SAVED_REG2, 0, SLJIT_SAVED_REG2, 0, SLJIT_IMM, UCHAR_SHIFT);
+OP2(SLJIT_ASHR, SLJIT_S1, 0, SLJIT_S1, 0, SLJIT_IMM, UCHAR_SHIFT);
#endif
-OP1(SLJIT_MOV_SI, SLJIT_MEM1(SLJIT_SCRATCH_REG2), sizeof(int), SLJIT_SAVED_REG2, 0);
+OP1(SLJIT_MOV_S32, SLJIT_MEM1(SLJIT_R1), sizeof(int), SLJIT_S1, 0);
-OP2(SLJIT_SUB, SLJIT_SCRATCH_REG3, 0, SLJIT_SCRATCH_REG3, 0, SLJIT_SAVED_REG1, 0);
+OP2(SLJIT_SUB, SLJIT_R2, 0, SLJIT_R2, 0, SLJIT_S0, 0);
#if defined COMPILE_PCRE16 || defined COMPILE_PCRE32
-OP2(SLJIT_ASHR, SLJIT_SCRATCH_REG3, 0, SLJIT_SCRATCH_REG3, 0, SLJIT_IMM, UCHAR_SHIFT);
+OP2(SLJIT_ASHR, SLJIT_R2, 0, SLJIT_R2, 0, SLJIT_IMM, UCHAR_SHIFT);
#endif
-OP1(SLJIT_MOV_SI, SLJIT_MEM1(SLJIT_SCRATCH_REG2), 0, SLJIT_SCRATCH_REG3, 0);
+OP1(SLJIT_MOV_S32, SLJIT_MEM1(SLJIT_R1), 0, SLJIT_R2, 0);
JUMPTO(SLJIT_JUMP, quit);
}
@@ -2238,22 +2564,22 @@ struct sljit_jump *jump;
if (common->mode == JIT_PARTIAL_SOFT_COMPILE)
{
/* The value of -1 must be kept for start_used_ptr! */
- OP2(SLJIT_ADD, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->start_used_ptr, SLJIT_IMM, 1);
+ OP2(SLJIT_ADD, TMP1, 0, SLJIT_MEM1(SLJIT_SP), common->start_used_ptr, SLJIT_IMM, 1);
/* Jumps if start_used_ptr < STR_PTR, or start_used_ptr == -1. Although overwriting
is not necessary if start_used_ptr == STR_PTR, it does not hurt as well. */
- jump = CMP(SLJIT_C_LESS_EQUAL, TMP1, 0, STR_PTR, 0);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->start_used_ptr, STR_PTR, 0);
+ jump = CMP(SLJIT_LESS_EQUAL, TMP1, 0, STR_PTR, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->start_used_ptr, STR_PTR, 0);
JUMPHERE(jump);
}
else if (common->mode == JIT_PARTIAL_HARD_COMPILE)
{
- jump = CMP(SLJIT_C_LESS_EQUAL, SLJIT_MEM1(SLJIT_LOCALS_REG), common->start_used_ptr, STR_PTR, 0);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->start_used_ptr, STR_PTR, 0);
+ jump = CMP(SLJIT_LESS_EQUAL, SLJIT_MEM1(SLJIT_SP), common->start_used_ptr, STR_PTR, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->start_used_ptr, STR_PTR, 0);
JUMPHERE(jump);
}
}
-static SLJIT_INLINE BOOL char_has_othercase(compiler_common *common, pcre_uchar* cc)
+static SLJIT_INLINE BOOL char_has_othercase(compiler_common *common, pcre_uchar *cc)
{
/* Detects if the character has an othercase. */
unsigned int c;
@@ -2296,7 +2622,7 @@ if (common->utf && c > 127)
return TABLE_GET(c, common->fcc, c);
}
-static unsigned int char_get_othercase_bit(compiler_common *common, pcre_uchar* cc)
+static unsigned int char_get_othercase_bit(compiler_common *common, pcre_uchar *cc)
{
/* Detects if the character and its othercase has only 1 bit difference. */
unsigned int c, oc, bit;
@@ -2384,12 +2710,12 @@ if (common->mode == JIT_COMPILE)
return;
if (!force)
- jump = CMP(SLJIT_C_GREATER_EQUAL, SLJIT_MEM1(SLJIT_LOCALS_REG), common->start_used_ptr, STR_PTR, 0);
+ jump = CMP(SLJIT_GREATER_EQUAL, SLJIT_MEM1(SLJIT_SP), common->start_used_ptr, STR_PTR, 0);
else if (common->mode == JIT_PARTIAL_SOFT_COMPILE)
- jump = CMP(SLJIT_C_EQUAL, SLJIT_MEM1(SLJIT_LOCALS_REG), common->start_used_ptr, SLJIT_IMM, -1);
+ jump = CMP(SLJIT_EQUAL, SLJIT_MEM1(SLJIT_SP), common->start_used_ptr, SLJIT_IMM, -1);
if (common->mode == JIT_PARTIAL_SOFT_COMPILE)
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->hit_start, SLJIT_IMM, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->hit_start, SLJIT_IMM, 0);
else
{
if (common->partialmatchlabel != NULL)
@@ -2410,20 +2736,20 @@ struct sljit_jump *jump;
if (common->mode == JIT_COMPILE)
{
- add_jump(compiler, end_reached, CMP(SLJIT_C_GREATER_EQUAL, STR_PTR, 0, STR_END, 0));
+ add_jump(compiler, end_reached, CMP(SLJIT_GREATER_EQUAL, STR_PTR, 0, STR_END, 0));
return;
}
-jump = CMP(SLJIT_C_LESS, STR_PTR, 0, STR_END, 0);
+jump = CMP(SLJIT_LESS, STR_PTR, 0, STR_END, 0);
if (common->mode == JIT_PARTIAL_SOFT_COMPILE)
{
- add_jump(compiler, end_reached, CMP(SLJIT_C_GREATER_EQUAL, SLJIT_MEM1(SLJIT_LOCALS_REG), common->start_used_ptr, STR_PTR, 0));
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->hit_start, SLJIT_IMM, 0);
+ add_jump(compiler, end_reached, CMP(SLJIT_GREATER_EQUAL, SLJIT_MEM1(SLJIT_SP), common->start_used_ptr, STR_PTR, 0));
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->hit_start, SLJIT_IMM, 0);
add_jump(compiler, end_reached, JUMP(SLJIT_JUMP));
}
else
{
- add_jump(compiler, end_reached, CMP(SLJIT_C_GREATER_EQUAL, SLJIT_MEM1(SLJIT_LOCALS_REG), common->start_used_ptr, STR_PTR, 0));
+ add_jump(compiler, end_reached, CMP(SLJIT_GREATER_EQUAL, SLJIT_MEM1(SLJIT_SP), common->start_used_ptr, STR_PTR, 0));
if (common->partialmatchlabel != NULL)
JUMPTO(SLJIT_JUMP, common->partialmatchlabel);
else
@@ -2439,16 +2765,16 @@ struct sljit_jump *jump;
if (common->mode == JIT_COMPILE)
{
- add_jump(compiler, backtracks, CMP(SLJIT_C_GREATER_EQUAL, STR_PTR, 0, STR_END, 0));
+ add_jump(compiler, backtracks, CMP(SLJIT_GREATER_EQUAL, STR_PTR, 0, STR_END, 0));
return;
}
/* Partial matching mode. */
-jump = CMP(SLJIT_C_LESS, STR_PTR, 0, STR_END, 0);
-add_jump(compiler, backtracks, CMP(SLJIT_C_GREATER_EQUAL, SLJIT_MEM1(SLJIT_LOCALS_REG), common->start_used_ptr, STR_PTR, 0));
+jump = CMP(SLJIT_LESS, STR_PTR, 0, STR_END, 0);
+add_jump(compiler, backtracks, CMP(SLJIT_GREATER_EQUAL, SLJIT_MEM1(SLJIT_SP), common->start_used_ptr, STR_PTR, 0));
if (common->mode == JIT_PARTIAL_SOFT_COMPILE)
{
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->hit_start, SLJIT_IMM, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->hit_start, SLJIT_IMM, 0);
add_jump(compiler, backtracks, JUMP(SLJIT_JUMP));
}
else
@@ -2461,107 +2787,290 @@ else
JUMPHERE(jump);
}
-static void read_char(compiler_common *common)
+static void peek_char(compiler_common *common, sljit_u32 max)
{
-/* Reads the character into TMP1, updates STR_PTR.
+/* Reads the character into TMP1, keeps STR_PTR.
Does not check STR_END. TMP2 Destroyed. */
DEFINE_COMPILER;
#if defined SUPPORT_UTF && !defined COMPILE_PCRE32
struct sljit_jump *jump;
#endif
+SLJIT_UNUSED_ARG(max);
+
OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), 0);
-#if defined SUPPORT_UTF && !defined COMPILE_PCRE32
+#if defined SUPPORT_UTF && defined COMPILE_PCRE8
if (common->utf)
{
-#if defined COMPILE_PCRE8
- jump = CMP(SLJIT_C_LESS, TMP1, 0, SLJIT_IMM, 0xc0);
-#elif defined COMPILE_PCRE16
- jump = CMP(SLJIT_C_LESS, TMP1, 0, SLJIT_IMM, 0xd800);
-#endif /* COMPILE_PCRE[8|16] */
+ if (max < 128) return;
+
+ jump = CMP(SLJIT_LESS, TMP1, 0, SLJIT_IMM, 0xc0);
+ OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
add_jump(compiler, &common->utfreadchar, JUMP(SLJIT_FAST_CALL));
+ OP2(SLJIT_SUB, STR_PTR, 0, STR_PTR, 0, TMP2, 0);
JUMPHERE(jump);
}
#endif /* SUPPORT_UTF && !COMPILE_PCRE32 */
+
+#if defined SUPPORT_UTF && defined COMPILE_PCRE16
+if (common->utf)
+ {
+ if (max < 0xd800) return;
+
+ OP2(SLJIT_SUB, TMP2, 0, TMP1, 0, SLJIT_IMM, 0xd800);
+ jump = CMP(SLJIT_GREATER, TMP2, 0, SLJIT_IMM, 0xdc00 - 0xd800 - 1);
+ /* TMP2 contains the high surrogate. */
+ OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(0));
+ OP2(SLJIT_ADD, TMP2, 0, TMP2, 0, SLJIT_IMM, 0x40);
+ OP2(SLJIT_SHL, TMP2, 0, TMP2, 0, SLJIT_IMM, 10);
+ OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, 0x3ff);
+ OP2(SLJIT_OR, TMP1, 0, TMP1, 0, TMP2, 0);
+ JUMPHERE(jump);
+ }
+#endif
+}
+
+#if defined SUPPORT_UTF && defined COMPILE_PCRE8
+
+static BOOL is_char7_bitset(const sljit_u8 *bitset, BOOL nclass)
+{
+/* Tells whether the character codes below 128 are enough
+to determine a match. */
+const sljit_u8 value = nclass ? 0xff : 0;
+const sljit_u8 *end = bitset + 32;
+
+bitset += 16;
+do
+ {
+ if (*bitset++ != value)
+ return FALSE;
+ }
+while (bitset < end);
+return TRUE;
+}
+
+static void read_char7_type(compiler_common *common, BOOL full_read)
+{
+/* Reads the precise character type of a character into TMP1, if the character
+is less than 128. Otherwise it returns with zero. Does not check STR_END. The
+full_read argument tells whether characters above max are accepted or not. */
+DEFINE_COMPILER;
+struct sljit_jump *jump;
+
+SLJIT_ASSERT(common->utf);
+
+OP1(MOV_UCHAR, TMP2, 0, SLJIT_MEM1(STR_PTR), 0);
OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
+
+OP1(SLJIT_MOV_U8, TMP1, 0, SLJIT_MEM1(TMP2), common->ctypes);
+
+if (full_read)
+ {
+ jump = CMP(SLJIT_LESS, TMP2, 0, SLJIT_IMM, 0xc0);
+ OP1(SLJIT_MOV_U8, TMP2, 0, SLJIT_MEM1(TMP2), (sljit_sw)PRIV(utf8_table4) - 0xc0);
+ OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, TMP2, 0);
+ JUMPHERE(jump);
+ }
}
-static void peek_char(compiler_common *common)
+#endif /* SUPPORT_UTF && COMPILE_PCRE8 */
+
+static void read_char_range(compiler_common *common, sljit_u32 min, sljit_u32 max, BOOL update_str_ptr)
{
-/* Reads the character into TMP1, keeps STR_PTR.
-Does not check STR_END. TMP2 Destroyed. */
+/* Reads the precise value of a character into TMP1, if the character is
+between min and max (c >= min && c <= max). Otherwise it returns with a value
+outside the range. Does not check STR_END. */
DEFINE_COMPILER;
#if defined SUPPORT_UTF && !defined COMPILE_PCRE32
struct sljit_jump *jump;
#endif
+#if defined SUPPORT_UTF && defined COMPILE_PCRE8
+struct sljit_jump *jump2;
+#endif
-OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), 0);
-#if defined SUPPORT_UTF && !defined COMPILE_PCRE32
+SLJIT_UNUSED_ARG(update_str_ptr);
+SLJIT_UNUSED_ARG(min);
+SLJIT_UNUSED_ARG(max);
+SLJIT_ASSERT(min <= max);
+
+OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(0));
+OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
+
+#if defined SUPPORT_UTF && defined COMPILE_PCRE8
if (common->utf)
{
-#if defined COMPILE_PCRE8
- jump = CMP(SLJIT_C_LESS, TMP1, 0, SLJIT_IMM, 0xc0);
-#elif defined COMPILE_PCRE16
- jump = CMP(SLJIT_C_LESS, TMP1, 0, SLJIT_IMM, 0xd800);
-#endif /* COMPILE_PCRE[8|16] */
- add_jump(compiler, &common->utfreadchar, JUMP(SLJIT_FAST_CALL));
- OP2(SLJIT_SUB, STR_PTR, 0, STR_PTR, 0, TMP2, 0);
+ if (max < 128 && !update_str_ptr) return;
+
+ jump = CMP(SLJIT_LESS, TMP1, 0, SLJIT_IMM, 0xc0);
+ if (min >= 0x10000)
+ {
+ OP2(SLJIT_SUB, TMP2, 0, TMP1, 0, SLJIT_IMM, 0xf0);
+ if (update_str_ptr)
+ OP1(SLJIT_MOV_U8, RETURN_ADDR, 0, SLJIT_MEM1(TMP1), (sljit_sw)PRIV(utf8_table4) - 0xc0);
+ OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(0));
+ jump2 = CMP(SLJIT_GREATER, TMP2, 0, SLJIT_IMM, 0x7);
+ OP2(SLJIT_SHL, TMP2, 0, TMP2, 0, SLJIT_IMM, 6);
+ OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, 0x3f);
+ OP2(SLJIT_OR, TMP1, 0, TMP1, 0, TMP2, 0);
+ OP1(MOV_UCHAR, TMP2, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(1));
+ OP2(SLJIT_SHL, TMP1, 0, TMP1, 0, SLJIT_IMM, 6);
+ OP2(SLJIT_AND, TMP2, 0, TMP2, 0, SLJIT_IMM, 0x3f);
+ OP2(SLJIT_OR, TMP1, 0, TMP1, 0, TMP2, 0);
+ OP1(MOV_UCHAR, TMP2, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(2));
+ if (!update_str_ptr)
+ OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(3));
+ OP2(SLJIT_SHL, TMP1, 0, TMP1, 0, SLJIT_IMM, 6);
+ OP2(SLJIT_AND, TMP2, 0, TMP2, 0, SLJIT_IMM, 0x3f);
+ OP2(SLJIT_OR, TMP1, 0, TMP1, 0, TMP2, 0);
+ JUMPHERE(jump2);
+ if (update_str_ptr)
+ OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, RETURN_ADDR, 0);
+ }
+ else if (min >= 0x800 && max <= 0xffff)
+ {
+ OP2(SLJIT_SUB, TMP2, 0, TMP1, 0, SLJIT_IMM, 0xe0);
+ if (update_str_ptr)
+ OP1(SLJIT_MOV_U8, RETURN_ADDR, 0, SLJIT_MEM1(TMP1), (sljit_sw)PRIV(utf8_table4) - 0xc0);
+ OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(0));
+ jump2 = CMP(SLJIT_GREATER, TMP2, 0, SLJIT_IMM, 0xf);
+ OP2(SLJIT_SHL, TMP2, 0, TMP2, 0, SLJIT_IMM, 6);
+ OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, 0x3f);
+ OP2(SLJIT_OR, TMP1, 0, TMP1, 0, TMP2, 0);
+ OP1(MOV_UCHAR, TMP2, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(1));
+ if (!update_str_ptr)
+ OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(2));
+ OP2(SLJIT_SHL, TMP1, 0, TMP1, 0, SLJIT_IMM, 6);
+ OP2(SLJIT_AND, TMP2, 0, TMP2, 0, SLJIT_IMM, 0x3f);
+ OP2(SLJIT_OR, TMP1, 0, TMP1, 0, TMP2, 0);
+ JUMPHERE(jump2);
+ if (update_str_ptr)
+ OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, RETURN_ADDR, 0);
+ }
+ else if (max >= 0x800)
+ add_jump(compiler, (max < 0x10000) ? &common->utfreadchar16 : &common->utfreadchar, JUMP(SLJIT_FAST_CALL));
+ else if (max < 128)
+ {
+ OP1(SLJIT_MOV_U8, TMP2, 0, SLJIT_MEM1(TMP1), (sljit_sw)PRIV(utf8_table4) - 0xc0);
+ OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, TMP2, 0);
+ }
+ else
+ {
+ OP1(MOV_UCHAR, TMP2, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(0));
+ if (!update_str_ptr)
+ OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
+ else
+ OP1(SLJIT_MOV_U8, RETURN_ADDR, 0, SLJIT_MEM1(TMP1), (sljit_sw)PRIV(utf8_table4) - 0xc0);
+ OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, 0x3f);
+ OP2(SLJIT_SHL, TMP1, 0, TMP1, 0, SLJIT_IMM, 6);
+ OP2(SLJIT_AND, TMP2, 0, TMP2, 0, SLJIT_IMM, 0x3f);
+ OP2(SLJIT_OR, TMP1, 0, TMP1, 0, TMP2, 0);
+ if (update_str_ptr)
+ OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, RETURN_ADDR, 0);
+ }
JUMPHERE(jump);
}
-#endif /* SUPPORT_UTF && !COMPILE_PCRE32 */
+#endif
+
+#if defined SUPPORT_UTF && defined COMPILE_PCRE16
+if (common->utf)
+ {
+ if (max >= 0x10000)
+ {
+ OP2(SLJIT_SUB, TMP2, 0, TMP1, 0, SLJIT_IMM, 0xd800);
+ jump = CMP(SLJIT_GREATER, TMP2, 0, SLJIT_IMM, 0xdc00 - 0xd800 - 1);
+ /* TMP2 contains the high surrogate. */
+ OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(0));
+ OP2(SLJIT_ADD, TMP2, 0, TMP2, 0, SLJIT_IMM, 0x40);
+ OP2(SLJIT_SHL, TMP2, 0, TMP2, 0, SLJIT_IMM, 10);
+ OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
+ OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, 0x3ff);
+ OP2(SLJIT_OR, TMP1, 0, TMP1, 0, TMP2, 0);
+ JUMPHERE(jump);
+ return;
+ }
+
+ if (max < 0xd800 && !update_str_ptr) return;
+
+ /* Skip low surrogate if necessary. */
+ OP2(SLJIT_SUB, TMP2, 0, TMP1, 0, SLJIT_IMM, 0xd800);
+ jump = CMP(SLJIT_GREATER, TMP2, 0, SLJIT_IMM, 0xdc00 - 0xd800 - 1);
+ if (update_str_ptr)
+ OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
+ if (max >= 0xd800)
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_IMM, 0x10000);
+ JUMPHERE(jump);
+ }
+#endif
}
-static void read_char8_type(compiler_common *common)
+static SLJIT_INLINE void read_char(compiler_common *common)
+{
+read_char_range(common, 0, READ_CHAR_MAX, TRUE);
+}
+
+static void read_char8_type(compiler_common *common, BOOL update_str_ptr)
{
/* Reads the character type into TMP1, updates STR_PTR. Does not check STR_END. */
DEFINE_COMPILER;
-#if defined SUPPORT_UTF || defined COMPILE_PCRE16 || defined COMPILE_PCRE32
+#if defined SUPPORT_UTF || !defined COMPILE_PCRE8
struct sljit_jump *jump;
#endif
+#if defined SUPPORT_UTF && defined COMPILE_PCRE8
+struct sljit_jump *jump2;
+#endif
-#ifdef SUPPORT_UTF
+SLJIT_UNUSED_ARG(update_str_ptr);
+
+OP1(MOV_UCHAR, TMP2, 0, SLJIT_MEM1(STR_PTR), 0);
+OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
+
+#if defined SUPPORT_UTF && defined COMPILE_PCRE8
if (common->utf)
{
- OP1(MOV_UCHAR, TMP2, 0, SLJIT_MEM1(STR_PTR), 0);
- OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
-#if defined COMPILE_PCRE8
/* This can be an extra read in some situations, but hopefully
it is needed in most cases. */
- OP1(SLJIT_MOV_UB, TMP1, 0, SLJIT_MEM1(TMP2), common->ctypes);
- jump = CMP(SLJIT_C_LESS, TMP2, 0, SLJIT_IMM, 0xc0);
- add_jump(compiler, &common->utfreadtype8, JUMP(SLJIT_FAST_CALL));
- JUMPHERE(jump);
-#elif defined COMPILE_PCRE16
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_IMM, 0);
- jump = CMP(SLJIT_C_GREATER, TMP2, 0, SLJIT_IMM, 255);
- OP1(SLJIT_MOV_UB, TMP1, 0, SLJIT_MEM1(TMP2), common->ctypes);
- JUMPHERE(jump);
- /* Skip low surrogate if necessary. */
- OP2(SLJIT_AND, TMP2, 0, TMP2, 0, SLJIT_IMM, 0xfc00);
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP2, 0, SLJIT_IMM, 0xd800);
- OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_C_EQUAL);
- OP2(SLJIT_SHL, TMP2, 0, TMP2, 0, SLJIT_IMM, 1);
- OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, TMP2, 0);
-#elif defined COMPILE_PCRE32
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_IMM, 0);
- jump = CMP(SLJIT_C_GREATER, TMP2, 0, SLJIT_IMM, 255);
- OP1(SLJIT_MOV_UB, TMP1, 0, SLJIT_MEM1(TMP2), common->ctypes);
+ OP1(SLJIT_MOV_U8, TMP1, 0, SLJIT_MEM1(TMP2), common->ctypes);
+ jump = CMP(SLJIT_LESS, TMP2, 0, SLJIT_IMM, 0xc0);
+ if (!update_str_ptr)
+ {
+ OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(0));
+ OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
+ OP2(SLJIT_AND, TMP2, 0, TMP2, 0, SLJIT_IMM, 0x3f);
+ OP2(SLJIT_SHL, TMP2, 0, TMP2, 0, SLJIT_IMM, 6);
+ OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, 0x3f);
+ OP2(SLJIT_OR, TMP2, 0, TMP2, 0, TMP1, 0);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_IMM, 0);
+ jump2 = CMP(SLJIT_GREATER, TMP2, 0, SLJIT_IMM, 255);
+ OP1(SLJIT_MOV_U8, TMP1, 0, SLJIT_MEM1(TMP2), common->ctypes);
+ JUMPHERE(jump2);
+ }
+ else
+ add_jump(compiler, &common->utfreadtype8, JUMP(SLJIT_FAST_CALL));
JUMPHERE(jump);
-#endif /* COMPILE_PCRE[8|16|32] */
return;
}
-#endif /* SUPPORT_UTF */
-OP1(MOV_UCHAR, TMP2, 0, SLJIT_MEM1(STR_PTR), 0);
-OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
-#if defined COMPILE_PCRE16 || defined COMPILE_PCRE32
+#endif /* SUPPORT_UTF && COMPILE_PCRE8 */
+
+#if !defined COMPILE_PCRE8
/* The ctypes array contains only 256 values. */
OP1(SLJIT_MOV, TMP1, 0, SLJIT_IMM, 0);
-jump = CMP(SLJIT_C_GREATER, TMP2, 0, SLJIT_IMM, 255);
+jump = CMP(SLJIT_GREATER, TMP2, 0, SLJIT_IMM, 255);
#endif
-OP1(SLJIT_MOV_UB, TMP1, 0, SLJIT_MEM1(TMP2), common->ctypes);
-#if defined COMPILE_PCRE16 || defined COMPILE_PCRE32
+OP1(SLJIT_MOV_U8, TMP1, 0, SLJIT_MEM1(TMP2), common->ctypes);
+#if !defined COMPILE_PCRE8
JUMPHERE(jump);
#endif
+
+#if defined SUPPORT_UTF && defined COMPILE_PCRE16
+if (common->utf && update_str_ptr)
+ {
+ /* Skip low surrogate if necessary. */
+ OP2(SLJIT_SUB, TMP2, 0, TMP2, 0, SLJIT_IMM, 0xd800);
+ jump = CMP(SLJIT_GREATER, TMP2, 0, SLJIT_IMM, 0xdc00 - 0xd800 - 1);
+ OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
+ JUMPHERE(jump);
+ }
+#endif /* SUPPORT_UTF && COMPILE_PCRE16 */
}
static void skip_char_back(compiler_common *common)
@@ -2578,7 +3087,7 @@ if (common->utf)
OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), -IN_UCHARS(1));
OP2(SLJIT_SUB, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, 0xc0);
- CMPTO(SLJIT_C_EQUAL, TMP1, 0, SLJIT_IMM, 0x80, label);
+ CMPTO(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, 0x80, label);
return;
}
#elif defined COMPILE_PCRE16
@@ -2588,8 +3097,8 @@ if (common->utf)
OP2(SLJIT_SUB, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
/* Skip low surrogate if necessary. */
OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, 0xfc00);
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0xdc00);
- OP_FLAGS(SLJIT_MOV, TMP1, 0, SLJIT_UNUSED, 0, SLJIT_C_EQUAL);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0xdc00);
+ OP_FLAGS(SLJIT_MOV, TMP1, 0, SLJIT_EQUAL);
OP2(SLJIT_SHL, TMP1, 0, TMP1, 0, SLJIT_IMM, 1);
OP2(SLJIT_SUB, STR_PTR, 0, STR_PTR, 0, TMP1, 0);
return;
@@ -2599,28 +3108,36 @@ if (common->utf)
OP2(SLJIT_SUB, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
}
-static void check_newlinechar(compiler_common *common, int nltype, jump_list **backtracks, BOOL jumpiftrue)
+static void check_newlinechar(compiler_common *common, int nltype, jump_list **backtracks, BOOL jumpifmatch)
{
/* Character comes in TMP1. Checks if it is a newline. TMP2 may be destroyed. */
DEFINE_COMPILER;
+struct sljit_jump *jump;
if (nltype == NLTYPE_ANY)
{
add_jump(compiler, &common->anynewline, JUMP(SLJIT_FAST_CALL));
- add_jump(compiler, backtracks, JUMP(jumpiftrue ? SLJIT_C_NOT_ZERO : SLJIT_C_ZERO));
+ sljit_set_current_flags(compiler, SLJIT_SET_Z);
+ add_jump(compiler, backtracks, JUMP(jumpifmatch ? SLJIT_NOT_ZERO : SLJIT_ZERO));
}
else if (nltype == NLTYPE_ANYCRLF)
{
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, CHAR_CR);
- OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_C_EQUAL);
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, CHAR_NL);
- OP_FLAGS(SLJIT_OR | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_C_EQUAL);
- add_jump(compiler, backtracks, JUMP(jumpiftrue ? SLJIT_C_NOT_ZERO : SLJIT_C_ZERO));
+ if (jumpifmatch)
+ {
+ add_jump(compiler, backtracks, CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, CHAR_CR));
+ add_jump(compiler, backtracks, CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, CHAR_NL));
+ }
+ else
+ {
+ jump = CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, CHAR_CR);
+ add_jump(compiler, backtracks, CMP(SLJIT_NOT_EQUAL, TMP1, 0, SLJIT_IMM, CHAR_NL));
+ JUMPHERE(jump);
+ }
}
else
{
SLJIT_ASSERT(nltype == NLTYPE_FIXED && common->newline < 256);
- add_jump(compiler, backtracks, CMP(jumpiftrue ? SLJIT_C_EQUAL : SLJIT_C_NOT_EQUAL, TMP1, 0, SLJIT_IMM, common->newline));
+ add_jump(compiler, backtracks, CMP(jumpifmatch ? SLJIT_EQUAL : SLJIT_NOT_EQUAL, TMP1, 0, SLJIT_IMM, common->newline));
}
}
@@ -2630,58 +3147,84 @@ else
static void do_utfreadchar(compiler_common *common)
{
/* Fast decoding a UTF-8 character. TMP1 contains the first byte
-of the character (>= 0xc0). Return char value in TMP1, length - 1 in TMP2. */
+of the character (>= 0xc0). Return char value in TMP1, length in TMP2. */
DEFINE_COMPILER;
struct sljit_jump *jump;
sljit_emit_fast_enter(compiler, RETURN_ADDR, 0);
-/* Searching for the first zero. */
-OP2(SLJIT_AND | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x20);
-jump = JUMP(SLJIT_C_NOT_ZERO);
-/* Two byte sequence. */
-OP1(MOV_UCHAR, TMP2, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(1));
-OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
-OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, 0x1f);
+OP1(MOV_UCHAR, TMP2, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(0));
+OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, 0x3f);
OP2(SLJIT_SHL, TMP1, 0, TMP1, 0, SLJIT_IMM, 6);
OP2(SLJIT_AND, TMP2, 0, TMP2, 0, SLJIT_IMM, 0x3f);
OP2(SLJIT_OR, TMP1, 0, TMP1, 0, TMP2, 0);
-OP1(SLJIT_MOV, TMP2, 0, SLJIT_IMM, IN_UCHARS(1));
+
+/* Searching for the first zero. */
+OP2(SLJIT_AND | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x800);
+jump = JUMP(SLJIT_NOT_ZERO);
+/* Two byte sequence. */
+OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
+OP1(SLJIT_MOV, TMP2, 0, SLJIT_IMM, IN_UCHARS(2));
sljit_emit_fast_return(compiler, RETURN_ADDR, 0);
-JUMPHERE(jump);
-OP2(SLJIT_AND | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x10);
-jump = JUMP(SLJIT_C_NOT_ZERO);
-/* Three byte sequence. */
+JUMPHERE(jump);
OP1(MOV_UCHAR, TMP2, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(1));
-OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, 0x0f);
-OP2(SLJIT_SHL, TMP1, 0, TMP1, 0, SLJIT_IMM, 12);
+OP2(SLJIT_XOR, TMP1, 0, TMP1, 0, SLJIT_IMM, 0x800);
+OP2(SLJIT_SHL, TMP1, 0, TMP1, 0, SLJIT_IMM, 6);
OP2(SLJIT_AND, TMP2, 0, TMP2, 0, SLJIT_IMM, 0x3f);
-OP2(SLJIT_SHL, TMP2, 0, TMP2, 0, SLJIT_IMM, 6);
OP2(SLJIT_OR, TMP1, 0, TMP1, 0, TMP2, 0);
-OP1(MOV_UCHAR, TMP2, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(2));
+
+OP2(SLJIT_AND | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x10000);
+jump = JUMP(SLJIT_NOT_ZERO);
+/* Three byte sequence. */
OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(2));
-OP2(SLJIT_AND, TMP2, 0, TMP2, 0, SLJIT_IMM, 0x3f);
-OP2(SLJIT_OR, TMP1, 0, TMP1, 0, TMP2, 0);
-OP1(SLJIT_MOV, TMP2, 0, SLJIT_IMM, IN_UCHARS(2));
+OP1(SLJIT_MOV, TMP2, 0, SLJIT_IMM, IN_UCHARS(3));
sljit_emit_fast_return(compiler, RETURN_ADDR, 0);
-JUMPHERE(jump);
/* Four byte sequence. */
-OP1(MOV_UCHAR, TMP2, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(1));
-OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, 0x07);
-OP2(SLJIT_SHL, TMP1, 0, TMP1, 0, SLJIT_IMM, 18);
+JUMPHERE(jump);
+OP1(MOV_UCHAR, TMP2, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(2));
+OP2(SLJIT_XOR, TMP1, 0, TMP1, 0, SLJIT_IMM, 0x10000);
+OP2(SLJIT_SHL, TMP1, 0, TMP1, 0, SLJIT_IMM, 6);
+OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(3));
OP2(SLJIT_AND, TMP2, 0, TMP2, 0, SLJIT_IMM, 0x3f);
-OP2(SLJIT_SHL, TMP2, 0, TMP2, 0, SLJIT_IMM, 12);
OP2(SLJIT_OR, TMP1, 0, TMP1, 0, TMP2, 0);
-OP1(MOV_UCHAR, TMP2, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(2));
+OP1(SLJIT_MOV, TMP2, 0, SLJIT_IMM, IN_UCHARS(4));
+sljit_emit_fast_return(compiler, RETURN_ADDR, 0);
+}
+
+static void do_utfreadchar16(compiler_common *common)
+{
+/* Fast decoding a UTF-8 character. TMP1 contains the first byte
+of the character (>= 0xc0). Return value in TMP1. */
+DEFINE_COMPILER;
+struct sljit_jump *jump;
+
+sljit_emit_fast_enter(compiler, RETURN_ADDR, 0);
+OP1(MOV_UCHAR, TMP2, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(0));
+OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, 0x3f);
+OP2(SLJIT_SHL, TMP1, 0, TMP1, 0, SLJIT_IMM, 6);
OP2(SLJIT_AND, TMP2, 0, TMP2, 0, SLJIT_IMM, 0x3f);
-OP2(SLJIT_SHL, TMP2, 0, TMP2, 0, SLJIT_IMM, 6);
OP2(SLJIT_OR, TMP1, 0, TMP1, 0, TMP2, 0);
-OP1(MOV_UCHAR, TMP2, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(3));
-OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(3));
+
+/* Searching for the first zero. */
+OP2(SLJIT_AND | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x800);
+jump = JUMP(SLJIT_NOT_ZERO);
+/* Two byte sequence. */
+OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
+sljit_emit_fast_return(compiler, RETURN_ADDR, 0);
+
+JUMPHERE(jump);
+OP2(SLJIT_AND | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x400);
+OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_NOT_ZERO);
+/* This code runs only in 8 bit mode. No need to shift the value. */
+OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, TMP2, 0);
+OP1(MOV_UCHAR, TMP2, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(1));
+OP2(SLJIT_XOR, TMP1, 0, TMP1, 0, SLJIT_IMM, 0x800);
+OP2(SLJIT_SHL, TMP1, 0, TMP1, 0, SLJIT_IMM, 6);
OP2(SLJIT_AND, TMP2, 0, TMP2, 0, SLJIT_IMM, 0x3f);
OP2(SLJIT_OR, TMP1, 0, TMP1, 0, TMP2, 0);
-OP1(SLJIT_MOV, TMP2, 0, SLJIT_IMM, IN_UCHARS(3));
+/* Three byte sequence. */
+OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(2));
sljit_emit_fast_return(compiler, RETURN_ADDR, 0);
}
@@ -2695,59 +3238,33 @@ struct sljit_jump *compare;
sljit_emit_fast_enter(compiler, RETURN_ADDR, 0);
-OP2(SLJIT_AND | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP2, 0, SLJIT_IMM, 0x20);
-jump = JUMP(SLJIT_C_NOT_ZERO);
+OP2(SLJIT_AND | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP2, 0, SLJIT_IMM, 0x20);
+jump = JUMP(SLJIT_NOT_ZERO);
/* Two byte sequence. */
OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(0));
OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
OP2(SLJIT_AND, TMP2, 0, TMP2, 0, SLJIT_IMM, 0x1f);
+/* The upper 5 bits are known at this point. */
+compare = CMP(SLJIT_GREATER, TMP2, 0, SLJIT_IMM, 0x3);
OP2(SLJIT_SHL, TMP2, 0, TMP2, 0, SLJIT_IMM, 6);
OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, 0x3f);
OP2(SLJIT_OR, TMP2, 0, TMP2, 0, TMP1, 0);
-compare = CMP(SLJIT_C_GREATER, TMP2, 0, SLJIT_IMM, 255);
-OP1(SLJIT_MOV_UB, TMP1, 0, SLJIT_MEM1(TMP2), common->ctypes);
+OP1(SLJIT_MOV_U8, TMP1, 0, SLJIT_MEM1(TMP2), common->ctypes);
sljit_emit_fast_return(compiler, RETURN_ADDR, 0);
JUMPHERE(compare);
OP1(SLJIT_MOV, TMP1, 0, SLJIT_IMM, 0);
sljit_emit_fast_return(compiler, RETURN_ADDR, 0);
-JUMPHERE(jump);
/* We only have types for characters less than 256. */
-OP1(SLJIT_MOV_UB, TMP1, 0, SLJIT_MEM1(TMP2), (sljit_sw)PRIV(utf8_table4) - 0xc0);
-OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, TMP1, 0);
-OP1(SLJIT_MOV, TMP1, 0, SLJIT_IMM, 0);
-sljit_emit_fast_return(compiler, RETURN_ADDR, 0);
-}
-
-#elif defined COMPILE_PCRE16
-
-static void do_utfreadchar(compiler_common *common)
-{
-/* Fast decoding a UTF-16 character. TMP1 contains the first 16 bit char
-of the character (>= 0xd800). Return char value in TMP1, length - 1 in TMP2. */
-DEFINE_COMPILER;
-struct sljit_jump *jump;
-
-sljit_emit_fast_enter(compiler, RETURN_ADDR, 0);
-jump = CMP(SLJIT_C_LESS, TMP1, 0, SLJIT_IMM, 0xdc00);
-/* Do nothing, only return. */
-sljit_emit_fast_return(compiler, RETURN_ADDR, 0);
-
JUMPHERE(jump);
-/* Combine two 16 bit characters. */
-OP1(MOV_UCHAR, TMP2, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(1));
-OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
-OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, 0x3ff);
-OP2(SLJIT_SHL, TMP1, 0, TMP1, 0, SLJIT_IMM, 10);
-OP2(SLJIT_AND, TMP2, 0, TMP2, 0, SLJIT_IMM, 0x3ff);
-OP2(SLJIT_OR, TMP1, 0, TMP1, 0, TMP2, 0);
-OP1(SLJIT_MOV, TMP2, 0, SLJIT_IMM, IN_UCHARS(1));
-OP2(SLJIT_ADD, TMP1, 0, TMP1, 0, SLJIT_IMM, 0x10000);
+OP1(SLJIT_MOV_U8, TMP2, 0, SLJIT_MEM1(TMP2), (sljit_sw)PRIV(utf8_table4) - 0xc0);
+OP1(SLJIT_MOV, TMP1, 0, SLJIT_IMM, 0);
+OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, TMP2, 0);
sljit_emit_fast_return(compiler, RETURN_ADDR, 0);
}
-#endif /* COMPILE_PCRE[8|16] */
+#endif /* COMPILE_PCRE8 */
#endif /* SUPPORT_UTF */
@@ -2762,31 +3279,51 @@ static void do_getucd(compiler_common *common)
/* Search the UCD record for the character comes in TMP1.
Returns chartype in TMP1 and UCD offset in TMP2. */
DEFINE_COMPILER;
+#ifdef COMPILE_PCRE32
+struct sljit_jump *jump;
+#endif
+
+#if defined SLJIT_DEBUG && SLJIT_DEBUG
+/* dummy_ucd_record */
+const ucd_record *record = GET_UCD(INVALID_UTF_CHAR);
+SLJIT_ASSERT(record->script == ucp_Common && record->chartype == ucp_Cn && record->gbprop == ucp_gbOther);
+SLJIT_ASSERT(record->caseset == 0 && record->other_case == 0);
+#endif
SLJIT_ASSERT(UCD_BLOCK_SIZE == 128 && sizeof(ucd_record) == 8);
sljit_emit_fast_enter(compiler, RETURN_ADDR, 0);
+
+#ifdef COMPILE_PCRE32
+if (!common->utf)
+ {
+ jump = CMP(SLJIT_LESS, TMP1, 0, SLJIT_IMM, 0x10ffff + 1);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_IMM, INVALID_UTF_CHAR);
+ JUMPHERE(jump);
+ }
+#endif
+
OP2(SLJIT_LSHR, TMP2, 0, TMP1, 0, SLJIT_IMM, UCD_BLOCK_SHIFT);
-OP1(SLJIT_MOV_UB, TMP2, 0, SLJIT_MEM1(TMP2), (sljit_sw)PRIV(ucd_stage1));
+OP1(SLJIT_MOV_U8, TMP2, 0, SLJIT_MEM1(TMP2), (sljit_sw)PRIV(ucd_stage1));
OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, UCD_BLOCK_MASK);
OP2(SLJIT_SHL, TMP2, 0, TMP2, 0, SLJIT_IMM, UCD_BLOCK_SHIFT);
OP2(SLJIT_ADD, TMP1, 0, TMP1, 0, TMP2, 0);
OP1(SLJIT_MOV, TMP2, 0, SLJIT_IMM, (sljit_sw)PRIV(ucd_stage2));
-OP1(SLJIT_MOV_UH, TMP2, 0, SLJIT_MEM2(TMP2, TMP1), 1);
+OP1(SLJIT_MOV_U16, TMP2, 0, SLJIT_MEM2(TMP2, TMP1), 1);
OP1(SLJIT_MOV, TMP1, 0, SLJIT_IMM, (sljit_sw)PRIV(ucd_records) + SLJIT_OFFSETOF(ucd_record, chartype));
-OP1(SLJIT_MOV_UB, TMP1, 0, SLJIT_MEM2(TMP1, TMP2), 3);
+OP1(SLJIT_MOV_U8, TMP1, 0, SLJIT_MEM2(TMP1, TMP2), 3);
sljit_emit_fast_return(compiler, RETURN_ADDR, 0);
}
#endif
-static SLJIT_INLINE struct sljit_label *mainloop_entry(compiler_common *common, BOOL hascrorlf, BOOL firstline)
+static SLJIT_INLINE struct sljit_label *mainloop_entry(compiler_common *common, BOOL hascrorlf)
{
DEFINE_COMPILER;
struct sljit_label *mainloop;
struct sljit_label *newlinelabel = NULL;
struct sljit_jump *start;
struct sljit_jump *end = NULL;
-struct sljit_jump *nl = NULL;
+struct sljit_jump *end2 = NULL;
#if defined SUPPORT_UTF && !defined COMPILE_PCRE32
struct sljit_jump *singlechar;
#endif
@@ -2794,39 +3331,38 @@ jump_list *newline = NULL;
BOOL newlinecheck = FALSE;
BOOL readuchar = FALSE;
-if (!(hascrorlf || firstline) && (common->nltype == NLTYPE_ANY ||
- common->nltype == NLTYPE_ANYCRLF || common->newline > 255))
+if (!(hascrorlf || (common->match_end_ptr != 0)) &&
+ (common->nltype == NLTYPE_ANY || common->nltype == NLTYPE_ANYCRLF || common->newline > 255))
newlinecheck = TRUE;
-if (firstline)
+if (common->match_end_ptr != 0)
{
/* Search for the end of the first line. */
- SLJIT_ASSERT(common->first_line_end != 0);
OP1(SLJIT_MOV, TMP3, 0, STR_PTR, 0);
if (common->nltype == NLTYPE_FIXED && common->newline > 255)
{
mainloop = LABEL();
OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
- end = CMP(SLJIT_C_GREATER_EQUAL, STR_PTR, 0, STR_END, 0);
+ end = CMP(SLJIT_GREATER_EQUAL, STR_PTR, 0, STR_END, 0);
OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(-1));
OP1(MOV_UCHAR, TMP2, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(0));
- CMPTO(SLJIT_C_NOT_EQUAL, TMP1, 0, SLJIT_IMM, (common->newline >> 8) & 0xff, mainloop);
- CMPTO(SLJIT_C_NOT_EQUAL, TMP2, 0, SLJIT_IMM, common->newline & 0xff, mainloop);
+ CMPTO(SLJIT_NOT_EQUAL, TMP1, 0, SLJIT_IMM, (common->newline >> 8) & 0xff, mainloop);
+ CMPTO(SLJIT_NOT_EQUAL, TMP2, 0, SLJIT_IMM, common->newline & 0xff, mainloop);
JUMPHERE(end);
- OP2(SLJIT_SUB, SLJIT_MEM1(SLJIT_LOCALS_REG), common->first_line_end, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
+ OP2(SLJIT_SUB, SLJIT_MEM1(SLJIT_SP), common->match_end_ptr, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
}
else
{
- end = CMP(SLJIT_C_GREATER_EQUAL, STR_PTR, 0, STR_END, 0);
+ end = CMP(SLJIT_GREATER_EQUAL, STR_PTR, 0, STR_END, 0);
mainloop = LABEL();
/* Continual stores does not cause data dependency. */
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->first_line_end, STR_PTR, 0);
- read_char(common);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->match_end_ptr, STR_PTR, 0);
+ read_char_range(common, common->nlmin, common->nlmax, TRUE);
check_newlinechar(common, common->nltype, &newline, TRUE);
- CMPTO(SLJIT_C_LESS, STR_PTR, 0, STR_END, 0, mainloop);
+ CMPTO(SLJIT_LESS, STR_PTR, 0, STR_END, 0, mainloop);
JUMPHERE(end);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->first_line_end, STR_PTR, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->match_end_ptr, STR_PTR, 0);
set_jumps(newline, LABEL());
}
@@ -2839,15 +3375,15 @@ if (newlinecheck)
{
newlinelabel = LABEL();
OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
- end = CMP(SLJIT_C_GREATER_EQUAL, STR_PTR, 0, STR_END, 0);
+ end = CMP(SLJIT_GREATER_EQUAL, STR_PTR, 0, STR_END, 0);
OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), 0);
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, common->newline & 0xff);
- OP_FLAGS(SLJIT_MOV, TMP1, 0, SLJIT_UNUSED, 0, SLJIT_C_EQUAL);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, common->newline & 0xff);
+ OP_FLAGS(SLJIT_MOV, TMP1, 0, SLJIT_EQUAL);
#if defined COMPILE_PCRE16 || defined COMPILE_PCRE32
OP2(SLJIT_SHL, TMP1, 0, TMP1, 0, SLJIT_IMM, UCHAR_SHIFT);
#endif
OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, TMP1, 0);
- nl = JUMP(SLJIT_JUMP);
+ end2 = JUMP(SLJIT_JUMP);
}
mainloop = LABEL();
@@ -2862,25 +3398,25 @@ if (readuchar)
OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), 0);
if (newlinecheck)
- CMPTO(SLJIT_C_EQUAL, TMP1, 0, SLJIT_IMM, (common->newline >> 8) & 0xff, newlinelabel);
+ CMPTO(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, (common->newline >> 8) & 0xff, newlinelabel);
OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
#if defined SUPPORT_UTF && !defined COMPILE_PCRE32
#if defined COMPILE_PCRE8
if (common->utf)
{
- singlechar = CMP(SLJIT_C_LESS, TMP1, 0, SLJIT_IMM, 0xc0);
- OP1(SLJIT_MOV_UB, TMP1, 0, SLJIT_MEM1(TMP1), (sljit_sw)PRIV(utf8_table4) - 0xc0);
+ singlechar = CMP(SLJIT_LESS, TMP1, 0, SLJIT_IMM, 0xc0);
+ OP1(SLJIT_MOV_U8, TMP1, 0, SLJIT_MEM1(TMP1), (sljit_sw)PRIV(utf8_table4) - 0xc0);
OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, TMP1, 0);
JUMPHERE(singlechar);
}
#elif defined COMPILE_PCRE16
if (common->utf)
{
- singlechar = CMP(SLJIT_C_LESS, TMP1, 0, SLJIT_IMM, 0xd800);
+ singlechar = CMP(SLJIT_LESS, TMP1, 0, SLJIT_IMM, 0xd800);
OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, 0xfc00);
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0xd800);
- OP_FLAGS(SLJIT_MOV, TMP1, 0, SLJIT_UNUSED, 0, SLJIT_C_EQUAL);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0xd800);
+ OP_FLAGS(SLJIT_MOV, TMP1, 0, SLJIT_EQUAL);
OP2(SLJIT_SHL, TMP1, 0, TMP1, 0, SLJIT_IMM, 1);
OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, TMP1, 0);
JUMPHERE(singlechar);
@@ -2892,43 +3428,79 @@ JUMPHERE(start);
if (newlinecheck)
{
JUMPHERE(end);
- JUMPHERE(nl);
+ JUMPHERE(end2);
}
return mainloop;
}
-#define MAX_N_CHARS 3
+#define MAX_N_CHARS 16
+#define MAX_DIFF_CHARS 6
-static SLJIT_INLINE BOOL fast_forward_first_n_chars(compiler_common *common, BOOL firstline)
+static SLJIT_INLINE void add_prefix_char(pcre_uchar chr, pcre_uchar *chars)
{
-DEFINE_COMPILER;
-struct sljit_label *start;
-struct sljit_jump *quit;
-pcre_uint32 chars[MAX_N_CHARS * 2];
-pcre_uchar *cc = common->start + 1 + LINK_SIZE;
-int location = 0;
-pcre_int32 len, c, bit, caseless;
-int must_stop;
-
-/* We do not support alternatives now. */
-if (*(common->start + GET(common->start, 1)) == OP_ALT)
- return FALSE;
+pcre_uchar i, len;
+len = chars[0];
+if (len == 255)
+ return;
+
+if (len == 0)
+ {
+ chars[0] = 1;
+ chars[1] = chr;
+ return;
+ }
+
+for (i = len; i > 0; i--)
+ if (chars[i] == chr)
+ return;
+
+if (len >= MAX_DIFF_CHARS - 1)
+ {
+ chars[0] = 255;
+ return;
+ }
+
+len++;
+chars[len] = chr;
+chars[0] = len;
+}
+
+static int scan_prefix(compiler_common *common, pcre_uchar *cc, pcre_uchar *chars, int max_chars, sljit_u32 *rec_count)
+{
+/* Recursive function, which scans prefix literals. */
+BOOL last, any, class, caseless;
+int len, repeat, len_save, consumed = 0;
+sljit_u32 chr; /* Any unicode character. */
+sljit_u8 *bytes, *bytes_end, byte;
+pcre_uchar *alternative, *cc_save, *oc;
+#if defined SUPPORT_UTF && defined COMPILE_PCRE8
+pcre_uchar othercase[8];
+#elif defined SUPPORT_UTF && defined COMPILE_PCRE16
+pcre_uchar othercase[2];
+#else
+pcre_uchar othercase[1];
+#endif
+
+repeat = 1;
while (TRUE)
{
- caseless = 0;
- must_stop = 1;
- switch(*cc)
- {
- case OP_CHAR:
- must_stop = 0;
- cc++;
- break;
+ if (*rec_count == 0)
+ return 0;
+ (*rec_count)--;
+ last = TRUE;
+ any = FALSE;
+ class = FALSE;
+ caseless = FALSE;
+
+ switch (*cc)
+ {
case OP_CHARI:
- caseless = 1;
- must_stop = 0;
+ caseless = TRUE;
+ case OP_CHAR:
+ last = FALSE;
cc++;
break;
@@ -2947,184 +3519,1037 @@ while (TRUE)
cc++;
continue;
+ case OP_ASSERT:
+ case OP_ASSERT_NOT:
+ case OP_ASSERTBACK:
+ case OP_ASSERTBACK_NOT:
+ cc = bracketend(cc);
+ continue;
+
+ case OP_PLUSI:
+ case OP_MINPLUSI:
+ case OP_POSPLUSI:
+ caseless = TRUE;
case OP_PLUS:
case OP_MINPLUS:
case OP_POSPLUS:
cc++;
break;
+ case OP_EXACTI:
+ caseless = TRUE;
case OP_EXACT:
+ repeat = GET2(cc, 1);
+ last = FALSE;
cc += 1 + IMM2_SIZE;
break;
- case OP_PLUSI:
- case OP_MINPLUSI:
- case OP_POSPLUSI:
- caseless = 1;
+ case OP_QUERYI:
+ case OP_MINQUERYI:
+ case OP_POSQUERYI:
+ caseless = TRUE;
+ case OP_QUERY:
+ case OP_MINQUERY:
+ case OP_POSQUERY:
+ len = 1;
cc++;
+#ifdef SUPPORT_UTF
+ if (common->utf && HAS_EXTRALEN(*cc)) len += GET_EXTRALEN(*cc);
+#endif
+ max_chars = scan_prefix(common, cc + len, chars, max_chars, rec_count);
+ if (max_chars == 0)
+ return consumed;
+ last = FALSE;
break;
- case OP_EXACTI:
- caseless = 1;
+ case OP_KET:
+ cc += 1 + LINK_SIZE;
+ continue;
+
+ case OP_ALT:
+ cc += GET(cc, 1);
+ continue;
+
+ case OP_ONCE:
+ case OP_ONCE_NC:
+ case OP_BRA:
+ case OP_BRAPOS:
+ case OP_CBRA:
+ case OP_CBRAPOS:
+ alternative = cc + GET(cc, 1);
+ while (*alternative == OP_ALT)
+ {
+ max_chars = scan_prefix(common, alternative + 1 + LINK_SIZE, chars, max_chars, rec_count);
+ if (max_chars == 0)
+ return consumed;
+ alternative += GET(alternative, 1);
+ }
+
+ if (*cc == OP_CBRA || *cc == OP_CBRAPOS)
+ cc += IMM2_SIZE;
+ cc += 1 + LINK_SIZE;
+ continue;
+
+ case OP_CLASS:
+#if defined SUPPORT_UTF && defined COMPILE_PCRE8
+ if (common->utf && !is_char7_bitset((const sljit_u8 *)(cc + 1), FALSE))
+ return consumed;
+#endif
+ class = TRUE;
+ break;
+
+ case OP_NCLASS:
+#if defined SUPPORT_UTF && !defined COMPILE_PCRE32
+ if (common->utf) return consumed;
+#endif
+ class = TRUE;
+ break;
+
+#if defined SUPPORT_UTF || !defined COMPILE_PCRE8
+ case OP_XCLASS:
+#if defined SUPPORT_UTF && !defined COMPILE_PCRE32
+ if (common->utf) return consumed;
+#endif
+ any = TRUE;
+ cc += GET(cc, 1);
+ break;
+#endif
+
+ case OP_DIGIT:
+#if defined SUPPORT_UTF && defined COMPILE_PCRE8
+ if (common->utf && !is_char7_bitset((const sljit_u8 *)common->ctypes - cbit_length + cbit_digit, FALSE))
+ return consumed;
+#endif
+ any = TRUE;
+ cc++;
+ break;
+
+ case OP_WHITESPACE:
+#if defined SUPPORT_UTF && defined COMPILE_PCRE8
+ if (common->utf && !is_char7_bitset((const sljit_u8 *)common->ctypes - cbit_length + cbit_space, FALSE))
+ return consumed;
+#endif
+ any = TRUE;
+ cc++;
+ break;
+
+ case OP_WORDCHAR:
+#if defined SUPPORT_UTF && defined COMPILE_PCRE8
+ if (common->utf && !is_char7_bitset((const sljit_u8 *)common->ctypes - cbit_length + cbit_word, FALSE))
+ return consumed;
+#endif
+ any = TRUE;
+ cc++;
+ break;
+
+ case OP_NOT:
+ case OP_NOTI:
+ cc++;
+ /* Fall through. */
+ case OP_NOT_DIGIT:
+ case OP_NOT_WHITESPACE:
+ case OP_NOT_WORDCHAR:
+ case OP_ANY:
+ case OP_ALLANY:
+#if defined SUPPORT_UTF && !defined COMPILE_PCRE32
+ if (common->utf) return consumed;
+#endif
+ any = TRUE;
+ cc++;
+ break;
+
+#ifdef SUPPORT_UTF
+ case OP_NOTPROP:
+ case OP_PROP:
+#ifndef COMPILE_PCRE32
+ if (common->utf) return consumed;
+#endif
+ any = TRUE;
+ cc += 1 + 2;
+ break;
+#endif
+
+ case OP_TYPEEXACT:
+ repeat = GET2(cc, 1);
cc += 1 + IMM2_SIZE;
+ continue;
+
+ case OP_NOTEXACT:
+ case OP_NOTEXACTI:
+#if defined SUPPORT_UTF && !defined COMPILE_PCRE32
+ if (common->utf) return consumed;
+#endif
+ any = TRUE;
+ repeat = GET2(cc, 1);
+ cc += 1 + IMM2_SIZE + 1;
break;
default:
- must_stop = 2;
- break;
+ return consumed;
}
- if (must_stop == 2)
+ if (any)
+ {
+ do
+ {
+ chars[0] = 255;
+
+ consumed++;
+ if (--max_chars == 0)
+ return consumed;
+ chars += MAX_DIFF_CHARS;
+ }
+ while (--repeat > 0);
+
+ repeat = 1;
+ continue;
+ }
+
+ if (class)
+ {
+ bytes = (sljit_u8*) (cc + 1);
+ cc += 1 + 32 / sizeof(pcre_uchar);
+
+ switch (*cc)
+ {
+ case OP_CRSTAR:
+ case OP_CRMINSTAR:
+ case OP_CRPOSSTAR:
+ case OP_CRQUERY:
+ case OP_CRMINQUERY:
+ case OP_CRPOSQUERY:
+ max_chars = scan_prefix(common, cc + 1, chars, max_chars, rec_count);
+ if (max_chars == 0)
+ return consumed;
+ break;
+
+ default:
+ case OP_CRPLUS:
+ case OP_CRMINPLUS:
+ case OP_CRPOSPLUS:
break;
+ case OP_CRRANGE:
+ case OP_CRMINRANGE:
+ case OP_CRPOSRANGE:
+ repeat = GET2(cc, 1);
+ if (repeat <= 0)
+ return consumed;
+ break;
+ }
+
+ do
+ {
+ if (bytes[31] & 0x80)
+ chars[0] = 255;
+ else if (chars[0] != 255)
+ {
+ bytes_end = bytes + 32;
+ chr = 0;
+ do
+ {
+ byte = *bytes++;
+ SLJIT_ASSERT((chr & 0x7) == 0);
+ if (byte == 0)
+ chr += 8;
+ else
+ {
+ do
+ {
+ if ((byte & 0x1) != 0)
+ add_prefix_char(chr, chars);
+ byte >>= 1;
+ chr++;
+ }
+ while (byte != 0);
+ chr = (chr + 7) & ~7;
+ }
+ }
+ while (chars[0] != 255 && bytes < bytes_end);
+ bytes = bytes_end - 32;
+ }
+
+ consumed++;
+ if (--max_chars == 0)
+ return consumed;
+ chars += MAX_DIFF_CHARS;
+ }
+ while (--repeat > 0);
+
+ switch (*cc)
+ {
+ case OP_CRSTAR:
+ case OP_CRMINSTAR:
+ case OP_CRPOSSTAR:
+ return consumed;
+
+ case OP_CRQUERY:
+ case OP_CRMINQUERY:
+ case OP_CRPOSQUERY:
+ cc++;
+ break;
+
+ case OP_CRRANGE:
+ case OP_CRMINRANGE:
+ case OP_CRPOSRANGE:
+ if (GET2(cc, 1) != GET2(cc, 1 + IMM2_SIZE))
+ return consumed;
+ cc += 1 + 2 * IMM2_SIZE;
+ break;
+ }
+
+ repeat = 1;
+ continue;
+ }
+
len = 1;
#ifdef SUPPORT_UTF
- if (common->utf && HAS_EXTRALEN(cc[0])) len += GET_EXTRALEN(cc[0]);
+ if (common->utf && HAS_EXTRALEN(*cc)) len += GET_EXTRALEN(*cc);
#endif
if (caseless && char_has_othercase(common, cc))
{
- caseless = char_get_othercase_bit(common, cc);
- if (caseless == 0)
- return FALSE;
-#ifdef COMPILE_PCRE8
- caseless = ((caseless & 0xff) << 8) | (len - (caseless >> 8));
-#else
- if ((caseless & 0x100) != 0)
- caseless = ((caseless & 0xff) << 16) | (len - (caseless >> 9));
+#ifdef SUPPORT_UTF
+ if (common->utf)
+ {
+ GETCHAR(chr, cc);
+ if ((int)PRIV(ord2utf)(char_othercase(common, chr), othercase) != len)
+ return consumed;
+ }
else
- caseless = ((caseless & 0xff) << 8) | (len - (caseless >> 9));
#endif
+ {
+ chr = *cc;
+ othercase[0] = TABLE_GET(chr, common->fcc, chr);
+ }
}
else
- caseless = 0;
+ {
+ caseless = FALSE;
+ othercase[0] = 0; /* Stops compiler warning - PH */
+ }
- while (len > 0 && location < MAX_N_CHARS * 2)
+ len_save = len;
+ cc_save = cc;
+ while (TRUE)
{
- c = *cc;
- bit = 0;
- if (len == (caseless & 0xff))
+ oc = othercase;
+ do
{
- bit = caseless >> 8;
- c |= bit;
+ chr = *cc;
+ add_prefix_char(*cc, chars);
+
+ if (caseless)
+ add_prefix_char(*oc, chars);
+
+ len--;
+ consumed++;
+ if (--max_chars == 0)
+ return consumed;
+ chars += MAX_DIFF_CHARS;
+ cc++;
+ oc++;
}
+ while (len > 0);
- chars[location] = c;
- chars[location + 1] = bit;
+ if (--repeat == 0)
+ break;
- len--;
- location += 2;
- cc++;
+ len = len_save;
+ cc = cc_save;
}
- if (location >= MAX_N_CHARS * 2 || must_stop != 0)
- break;
+ repeat = 1;
+ if (last)
+ return consumed;
}
+}
-/* At least two characters are required. */
-if (location < 2 * 2)
- return FALSE;
+#if (defined SLJIT_CONFIG_X86 && SLJIT_CONFIG_X86) && !(defined SUPPORT_VALGRIND)
+
+static sljit_s32 character_to_int32(pcre_uchar chr)
+{
+sljit_s32 value = (sljit_s32)chr;
+#if defined COMPILE_PCRE8
+#define SSE2_COMPARE_TYPE_INDEX 0
+return (value << 24) | (value << 16) | (value << 8) | value;
+#elif defined COMPILE_PCRE16
+#define SSE2_COMPARE_TYPE_INDEX 1
+return (value << 16) | value;
+#elif defined COMPILE_PCRE32
+#define SSE2_COMPARE_TYPE_INDEX 2
+return value;
+#else
+#error "Unsupported unit width"
+#endif
+}
+
+static SLJIT_INLINE void fast_forward_first_char2_sse2(compiler_common *common, pcre_uchar char1, pcre_uchar char2)
+{
+DEFINE_COMPILER;
+struct sljit_label *start;
+struct sljit_jump *quit[3];
+struct sljit_jump *nomatch;
+sljit_u8 instruction[8];
+sljit_s32 tmp1_ind = sljit_get_register_index(TMP1);
+sljit_s32 tmp2_ind = sljit_get_register_index(TMP2);
+sljit_s32 str_ptr_ind = sljit_get_register_index(STR_PTR);
+BOOL load_twice = FALSE;
+pcre_uchar bit;
+
+bit = char1 ^ char2;
+if (!is_powerof2(bit))
+ bit = 0;
+
+if ((char1 != char2) && bit == 0)
+ load_twice = TRUE;
+
+quit[0] = CMP(SLJIT_GREATER_EQUAL, STR_PTR, 0, STR_END, 0);
+
+/* First part (unaligned start) */
-if (firstline)
+OP1(SLJIT_MOV, TMP1, 0, SLJIT_IMM, character_to_int32(char1 | bit));
+
+SLJIT_ASSERT(tmp1_ind < 8 && tmp2_ind == 1);
+
+/* MOVD xmm, r/m32 */
+instruction[0] = 0x66;
+instruction[1] = 0x0f;
+instruction[2] = 0x6e;
+instruction[3] = 0xc0 | (2 << 3) | tmp1_ind;
+sljit_emit_op_custom(compiler, instruction, 4);
+
+if (char1 != char2)
{
- SLJIT_ASSERT(common->first_line_end != 0);
- OP1(SLJIT_MOV, TMP3, 0, STR_END, 0);
- OP2(SLJIT_SUB, STR_END, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->first_line_end, SLJIT_IMM, IN_UCHARS((location >> 1) - 1));
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_IMM, character_to_int32(bit != 0 ? bit : char2));
+
+ /* MOVD xmm, r/m32 */
+ instruction[3] = 0xc0 | (3 << 3) | tmp1_ind;
+ sljit_emit_op_custom(compiler, instruction, 4);
+ }
+
+/* PSHUFD xmm1, xmm2/m128, imm8 */
+instruction[2] = 0x70;
+instruction[3] = 0xc0 | (2 << 3) | 2;
+instruction[4] = 0;
+sljit_emit_op_custom(compiler, instruction, 5);
+
+if (char1 != char2)
+ {
+ /* PSHUFD xmm1, xmm2/m128, imm8 */
+ instruction[3] = 0xc0 | (3 << 3) | 3;
+ instruction[4] = 0;
+ sljit_emit_op_custom(compiler, instruction, 5);
+ }
+
+OP2(SLJIT_AND, TMP2, 0, STR_PTR, 0, SLJIT_IMM, 0xf);
+OP2(SLJIT_AND, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, ~0xf);
+
+/* MOVDQA xmm1, xmm2/m128 */
+#if (defined SLJIT_CONFIG_X86_64 && SLJIT_CONFIG_X86_64)
+
+if (str_ptr_ind < 8)
+ {
+ instruction[2] = 0x6f;
+ instruction[3] = (0 << 3) | str_ptr_ind;
+ sljit_emit_op_custom(compiler, instruction, 4);
+
+ if (load_twice)
+ {
+ instruction[3] = (1 << 3) | str_ptr_ind;
+ sljit_emit_op_custom(compiler, instruction, 4);
+ }
}
else
- OP2(SLJIT_SUB, STR_END, 0, STR_END, 0, SLJIT_IMM, IN_UCHARS((location >> 1) - 1));
+ {
+ instruction[1] = 0x41;
+ instruction[2] = 0x0f;
+ instruction[3] = 0x6f;
+ instruction[4] = (0 << 3) | (str_ptr_ind & 0x7);
+ sljit_emit_op_custom(compiler, instruction, 5);
-start = LABEL();
-quit = CMP(SLJIT_C_GREATER_EQUAL, STR_PTR, 0, STR_END, 0);
+ if (load_twice)
+ {
+ instruction[4] = (1 << 3) | str_ptr_ind;
+ sljit_emit_op_custom(compiler, instruction, 5);
+ }
+ instruction[1] = 0x0f;
+ }
-OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(0));
-OP1(MOV_UCHAR, TMP2, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(1));
-OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
-if (chars[1] != 0)
- OP2(SLJIT_OR, TMP1, 0, TMP1, 0, SLJIT_IMM, chars[1]);
-CMPTO(SLJIT_C_NOT_EQUAL, TMP1, 0, SLJIT_IMM, chars[0], start);
-if (location > 2 * 2)
- OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(1));
-if (chars[3] != 0)
- OP2(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_IMM, chars[3]);
-CMPTO(SLJIT_C_NOT_EQUAL, TMP2, 0, SLJIT_IMM, chars[2], start);
-if (location > 2 * 2)
- {
- if (chars[5] != 0)
- OP2(SLJIT_OR, TMP1, 0, TMP1, 0, SLJIT_IMM, chars[5]);
- CMPTO(SLJIT_C_NOT_EQUAL, TMP1, 0, SLJIT_IMM, chars[4], start);
+#else
+
+instruction[2] = 0x6f;
+instruction[3] = (0 << 3) | str_ptr_ind;
+sljit_emit_op_custom(compiler, instruction, 4);
+
+if (load_twice)
+ {
+ instruction[3] = (1 << 3) | str_ptr_ind;
+ sljit_emit_op_custom(compiler, instruction, 4);
}
-OP2(SLJIT_SUB, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
-JUMPHERE(quit);
+#endif
-if (firstline)
- OP1(SLJIT_MOV, STR_END, 0, TMP3, 0);
+if (bit != 0)
+ {
+ /* POR xmm1, xmm2/m128 */
+ instruction[2] = 0xeb;
+ instruction[3] = 0xc0 | (0 << 3) | 3;
+ sljit_emit_op_custom(compiler, instruction, 4);
+ }
+
+/* PCMPEQB/W/D xmm1, xmm2/m128 */
+instruction[2] = 0x74 + SSE2_COMPARE_TYPE_INDEX;
+instruction[3] = 0xc0 | (0 << 3) | 2;
+sljit_emit_op_custom(compiler, instruction, 4);
+
+if (load_twice)
+ {
+ instruction[3] = 0xc0 | (1 << 3) | 3;
+ sljit_emit_op_custom(compiler, instruction, 4);
+ }
+
+/* PMOVMSKB reg, xmm */
+instruction[2] = 0xd7;
+instruction[3] = 0xc0 | (tmp1_ind << 3) | 0;
+sljit_emit_op_custom(compiler, instruction, 4);
+
+if (load_twice)
+ {
+ OP1(SLJIT_MOV, RETURN_ADDR, 0, TMP2, 0);
+ instruction[3] = 0xc0 | (tmp2_ind << 3) | 1;
+ sljit_emit_op_custom(compiler, instruction, 4);
+
+ OP2(SLJIT_OR, TMP1, 0, TMP1, 0, TMP2, 0);
+ OP1(SLJIT_MOV, TMP2, 0, RETURN_ADDR, 0);
+ }
+
+OP2(SLJIT_ASHR, TMP1, 0, TMP1, 0, TMP2, 0);
+
+/* BSF r32, r/m32 */
+instruction[0] = 0x0f;
+instruction[1] = 0xbc;
+instruction[2] = 0xc0 | (tmp1_ind << 3) | tmp1_ind;
+sljit_emit_op_custom(compiler, instruction, 3);
+sljit_set_current_flags(compiler, SLJIT_SET_Z);
+
+nomatch = JUMP(SLJIT_ZERO);
+
+OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, TMP2, 0);
+OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, TMP1, 0);
+quit[1] = JUMP(SLJIT_JUMP);
+
+JUMPHERE(nomatch);
+
+start = LABEL();
+OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, 16);
+quit[2] = CMP(SLJIT_GREATER_EQUAL, STR_PTR, 0, STR_END, 0);
+
+/* Second part (aligned) */
+
+instruction[0] = 0x66;
+instruction[1] = 0x0f;
+
+/* MOVDQA xmm1, xmm2/m128 */
+#if (defined SLJIT_CONFIG_X86_64 && SLJIT_CONFIG_X86_64)
+
+if (str_ptr_ind < 8)
+ {
+ instruction[2] = 0x6f;
+ instruction[3] = (0 << 3) | str_ptr_ind;
+ sljit_emit_op_custom(compiler, instruction, 4);
+
+ if (load_twice)
+ {
+ instruction[3] = (1 << 3) | str_ptr_ind;
+ sljit_emit_op_custom(compiler, instruction, 4);
+ }
+ }
else
- OP2(SLJIT_ADD, STR_END, 0, STR_END, 0, SLJIT_IMM, IN_UCHARS((location >> 1) - 1));
-return TRUE;
+ {
+ instruction[1] = 0x41;
+ instruction[2] = 0x0f;
+ instruction[3] = 0x6f;
+ instruction[4] = (0 << 3) | (str_ptr_ind & 0x7);
+ sljit_emit_op_custom(compiler, instruction, 5);
+
+ if (load_twice)
+ {
+ instruction[4] = (1 << 3) | str_ptr_ind;
+ sljit_emit_op_custom(compiler, instruction, 5);
+ }
+ instruction[1] = 0x0f;
+ }
+
+#else
+
+instruction[2] = 0x6f;
+instruction[3] = (0 << 3) | str_ptr_ind;
+sljit_emit_op_custom(compiler, instruction, 4);
+
+if (load_twice)
+ {
+ instruction[3] = (1 << 3) | str_ptr_ind;
+ sljit_emit_op_custom(compiler, instruction, 4);
+ }
+
+#endif
+
+if (bit != 0)
+ {
+ /* POR xmm1, xmm2/m128 */
+ instruction[2] = 0xeb;
+ instruction[3] = 0xc0 | (0 << 3) | 3;
+ sljit_emit_op_custom(compiler, instruction, 4);
+ }
+
+/* PCMPEQB/W/D xmm1, xmm2/m128 */
+instruction[2] = 0x74 + SSE2_COMPARE_TYPE_INDEX;
+instruction[3] = 0xc0 | (0 << 3) | 2;
+sljit_emit_op_custom(compiler, instruction, 4);
+
+if (load_twice)
+ {
+ instruction[3] = 0xc0 | (1 << 3) | 3;
+ sljit_emit_op_custom(compiler, instruction, 4);
+ }
+
+/* PMOVMSKB reg, xmm */
+instruction[2] = 0xd7;
+instruction[3] = 0xc0 | (tmp1_ind << 3) | 0;
+sljit_emit_op_custom(compiler, instruction, 4);
+
+if (load_twice)
+ {
+ instruction[3] = 0xc0 | (tmp2_ind << 3) | 1;
+ sljit_emit_op_custom(compiler, instruction, 4);
+
+ OP2(SLJIT_OR, TMP1, 0, TMP1, 0, TMP2, 0);
+ }
+
+/* BSF r32, r/m32 */
+instruction[0] = 0x0f;
+instruction[1] = 0xbc;
+instruction[2] = 0xc0 | (tmp1_ind << 3) | tmp1_ind;
+sljit_emit_op_custom(compiler, instruction, 3);
+sljit_set_current_flags(compiler, SLJIT_SET_Z);
+
+JUMPTO(SLJIT_ZERO, start);
+
+OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, TMP1, 0);
+
+start = LABEL();
+SET_LABEL(quit[0], start);
+SET_LABEL(quit[1], start);
+SET_LABEL(quit[2], start);
}
-#undef MAX_N_CHARS
+#undef SSE2_COMPARE_TYPE_INDEX
+
+#endif
-static SLJIT_INLINE void fast_forward_first_char(compiler_common *common, pcre_uchar first_char, BOOL caseless, BOOL firstline)
+static void fast_forward_first_char2(compiler_common *common, pcre_uchar char1, pcre_uchar char2, sljit_s32 offset)
{
DEFINE_COMPILER;
struct sljit_label *start;
struct sljit_jump *quit;
struct sljit_jump *found;
-pcre_uchar oc, bit;
+pcre_uchar mask;
+#if defined SUPPORT_UTF && !defined COMPILE_PCRE32
+struct sljit_label *utf_start = NULL;
+struct sljit_jump *utf_quit = NULL;
+#endif
+BOOL has_match_end = (common->match_end_ptr != 0);
-if (firstline)
+if (offset > 0)
+ OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(offset));
+
+if (has_match_end)
{
- SLJIT_ASSERT(common->first_line_end != 0);
OP1(SLJIT_MOV, TMP3, 0, STR_END, 0);
- OP1(SLJIT_MOV, STR_END, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->first_line_end);
+
+ OP2(SLJIT_ADD, STR_END, 0, SLJIT_MEM1(SLJIT_SP), common->match_end_ptr, SLJIT_IMM, IN_UCHARS(offset + 1));
+ OP2(SLJIT_SUB | SLJIT_SET_GREATER, SLJIT_UNUSED, 0, STR_END, 0, TMP3, 0);
+ sljit_emit_cmov(compiler, SLJIT_GREATER, STR_END, TMP3, 0);
}
-start = LABEL();
-quit = CMP(SLJIT_C_GREATER_EQUAL, STR_PTR, 0, STR_END, 0);
-OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), 0);
+#if defined SUPPORT_UTF && !defined COMPILE_PCRE32
+if (common->utf && offset > 0)
+ utf_start = LABEL();
+#endif
-oc = first_char;
-if (caseless)
+#if (defined SLJIT_CONFIG_X86 && SLJIT_CONFIG_X86) && !(defined SUPPORT_VALGRIND)
+
+/* SSE2 accelerated first character search. */
+
+if (sljit_has_cpu_feature(SLJIT_HAS_SSE2))
{
- oc = TABLE_GET(first_char, common->fcc, first_char);
-#if defined SUPPORT_UCP && !(defined COMPILE_PCRE8)
- if (first_char > 127 && common->utf)
- oc = UCD_OTHERCASE(first_char);
+ fast_forward_first_char2_sse2(common, char1, char2);
+
+ SLJIT_ASSERT(common->mode == JIT_COMPILE || offset == 0);
+ if (common->mode == JIT_COMPILE)
+ {
+ /* In complete mode, we don't need to run a match when STR_PTR == STR_END. */
+ SLJIT_ASSERT(common->forced_quit_label == NULL);
+ OP1(SLJIT_MOV, SLJIT_RETURN_REG, 0, SLJIT_IMM, PCRE_ERROR_NOMATCH);
+ add_jump(compiler, &common->forced_quit, CMP(SLJIT_GREATER_EQUAL, STR_PTR, 0, STR_END, 0));
+
+#if defined SUPPORT_UTF && !defined COMPILE_PCRE32
+ if (common->utf && offset > 0)
+ {
+ SLJIT_ASSERT(common->mode == JIT_COMPILE);
+
+ OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(-offset));
+ OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
+#if defined COMPILE_PCRE8
+ OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, 0xc0);
+ CMPTO(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, 0x80, utf_start);
+#elif defined COMPILE_PCRE16
+ OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, 0xfc00);
+ CMPTO(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, 0xdc00, utf_start);
+#else
+#error "Unknown code width"
+#endif
+ OP2(SLJIT_SUB, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
+ }
#endif
+
+ if (offset > 0)
+ OP2(SLJIT_SUB, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(offset));
+ }
+ else
+ {
+ OP2(SLJIT_SUB | SLJIT_SET_GREATER_EQUAL, SLJIT_UNUSED, 0, STR_PTR, 0, STR_END, 0);
+ if (has_match_end)
+ {
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), common->match_end_ptr);
+ sljit_emit_cmov(compiler, SLJIT_GREATER_EQUAL, STR_PTR, TMP1, 0);
+ }
+ else
+ sljit_emit_cmov(compiler, SLJIT_GREATER_EQUAL, STR_PTR, STR_END, 0);
+ }
+
+ if (has_match_end)
+ OP1(SLJIT_MOV, STR_END, 0, TMP3, 0);
+ return;
}
-if (first_char == oc)
- found = CMP(SLJIT_C_EQUAL, TMP1, 0, SLJIT_IMM, first_char);
+
+#endif
+
+quit = CMP(SLJIT_GREATER_EQUAL, STR_PTR, 0, STR_END, 0);
+
+start = LABEL();
+OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), 0);
+
+if (char1 == char2)
+ found = CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, char1);
else
{
- bit = first_char ^ oc;
- if (is_powerof2(bit))
+ mask = char1 ^ char2;
+ if (is_powerof2(mask))
{
- OP2(SLJIT_OR, TMP2, 0, TMP1, 0, SLJIT_IMM, bit);
- found = CMP(SLJIT_C_EQUAL, TMP2, 0, SLJIT_IMM, first_char | bit);
+ OP2(SLJIT_OR, TMP1, 0, TMP1, 0, SLJIT_IMM, mask);
+ found = CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, char1 | mask);
}
else
{
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, first_char);
- OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_C_EQUAL);
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, oc);
- OP_FLAGS(SLJIT_OR | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_C_EQUAL);
- found = JUMP(SLJIT_C_NOT_ZERO);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, char1);
+ OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_EQUAL);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, char2);
+ OP_FLAGS(SLJIT_OR | SLJIT_SET_Z, TMP2, 0, SLJIT_EQUAL);
+ found = JUMP(SLJIT_NOT_ZERO);
}
}
OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
-JUMPTO(SLJIT_JUMP, start);
+CMPTO(SLJIT_LESS, STR_PTR, 0, STR_END, 0, start);
+
+#if defined SUPPORT_UTF && !defined COMPILE_PCRE32
+if (common->utf && offset > 0)
+ utf_quit = JUMP(SLJIT_JUMP);
+#endif
+
JUMPHERE(found);
+
+#if defined SUPPORT_UTF && !defined COMPILE_PCRE32
+if (common->utf && offset > 0)
+ {
+ OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(-offset));
+ OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
+#if defined COMPILE_PCRE8
+ OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, 0xc0);
+ CMPTO(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, 0x80, utf_start);
+#elif defined COMPILE_PCRE16
+ OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, 0xfc00);
+ CMPTO(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, 0xdc00, utf_start);
+#else
+#error "Unknown code width"
+#endif
+ OP2(SLJIT_SUB, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
+ JUMPHERE(utf_quit);
+ }
+#endif
+
+JUMPHERE(quit);
+
+if (has_match_end)
+ {
+ quit = CMP(SLJIT_LESS, STR_PTR, 0, STR_END, 0);
+ OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(SLJIT_SP), common->match_end_ptr);
+ if (offset > 0)
+ OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(offset));
+ JUMPHERE(quit);
+ OP1(SLJIT_MOV, STR_END, 0, TMP3, 0);
+ }
+
+if (offset > 0)
+ OP2(SLJIT_SUB, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(offset));
+}
+
+static SLJIT_INLINE BOOL fast_forward_first_n_chars(compiler_common *common)
+{
+DEFINE_COMPILER;
+struct sljit_label *start;
+struct sljit_jump *quit;
+struct sljit_jump *match;
+/* bytes[0] represent the number of characters between 0
+and MAX_N_BYTES - 1, 255 represents any character. */
+pcre_uchar chars[MAX_N_CHARS * MAX_DIFF_CHARS];
+sljit_s32 offset;
+pcre_uchar mask;
+pcre_uchar *char_set, *char_set_end;
+int i, max, from;
+int range_right = -1, range_len;
+sljit_u8 *update_table = NULL;
+BOOL in_range;
+sljit_u32 rec_count;
+
+for (i = 0; i < MAX_N_CHARS; i++)
+ chars[i * MAX_DIFF_CHARS] = 0;
+
+rec_count = 10000;
+max = scan_prefix(common, common->start, chars, MAX_N_CHARS, &rec_count);
+
+if (max < 1)
+ return FALSE;
+
+in_range = FALSE;
+/* Prevent compiler "uninitialized" warning */
+from = 0;
+range_len = 4 /* minimum length */ - 1;
+for (i = 0; i <= max; i++)
+ {
+ if (in_range && (i - from) > range_len && (chars[(i - 1) * MAX_DIFF_CHARS] < 255))
+ {
+ range_len = i - from;
+ range_right = i - 1;
+ }
+
+ if (i < max && chars[i * MAX_DIFF_CHARS] < 255)
+ {
+ SLJIT_ASSERT(chars[i * MAX_DIFF_CHARS] > 0);
+ if (!in_range)
+ {
+ in_range = TRUE;
+ from = i;
+ }
+ }
+ else
+ in_range = FALSE;
+ }
+
+if (range_right >= 0)
+ {
+ update_table = (sljit_u8 *)allocate_read_only_data(common, 256);
+ if (update_table == NULL)
+ return TRUE;
+ memset(update_table, IN_UCHARS(range_len), 256);
+
+ for (i = 0; i < range_len; i++)
+ {
+ char_set = chars + ((range_right - i) * MAX_DIFF_CHARS);
+ SLJIT_ASSERT(char_set[0] > 0 && char_set[0] < 255);
+ char_set_end = char_set + char_set[0];
+ char_set++;
+ while (char_set <= char_set_end)
+ {
+ if (update_table[(*char_set) & 0xff] > IN_UCHARS(i))
+ update_table[(*char_set) & 0xff] = IN_UCHARS(i);
+ char_set++;
+ }
+ }
+ }
+
+offset = -1;
+/* Scan forward. */
+for (i = 0; i < max; i++)
+ {
+ if (offset == -1)
+ {
+ if (chars[i * MAX_DIFF_CHARS] <= 2)
+ offset = i;
+ }
+ else if (chars[offset * MAX_DIFF_CHARS] == 2 && chars[i * MAX_DIFF_CHARS] <= 2)
+ {
+ if (chars[i * MAX_DIFF_CHARS] == 1)
+ offset = i;
+ else
+ {
+ mask = chars[offset * MAX_DIFF_CHARS + 1] ^ chars[offset * MAX_DIFF_CHARS + 2];
+ if (!is_powerof2(mask))
+ {
+ mask = chars[i * MAX_DIFF_CHARS + 1] ^ chars[i * MAX_DIFF_CHARS + 2];
+ if (is_powerof2(mask))
+ offset = i;
+ }
+ }
+ }
+ }
+
+if (range_right < 0)
+ {
+ if (offset < 0)
+ return FALSE;
+ SLJIT_ASSERT(chars[offset * MAX_DIFF_CHARS] >= 1 && chars[offset * MAX_DIFF_CHARS] <= 2);
+ /* Works regardless the value is 1 or 2. */
+ mask = chars[offset * MAX_DIFF_CHARS + chars[offset * MAX_DIFF_CHARS]];
+ fast_forward_first_char2(common, chars[offset * MAX_DIFF_CHARS + 1], mask, offset);
+ return TRUE;
+ }
+
+if (range_right == offset)
+ offset = -1;
+
+SLJIT_ASSERT(offset == -1 || (chars[offset * MAX_DIFF_CHARS] >= 1 && chars[offset * MAX_DIFF_CHARS] <= 2));
+
+max -= 1;
+SLJIT_ASSERT(max > 0);
+if (common->match_end_ptr != 0)
+ {
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), common->match_end_ptr);
+ OP1(SLJIT_MOV, TMP3, 0, STR_END, 0);
+ OP2(SLJIT_SUB, STR_END, 0, STR_END, 0, SLJIT_IMM, IN_UCHARS(max));
+ quit = CMP(SLJIT_LESS_EQUAL, STR_END, 0, TMP1, 0);
+ OP1(SLJIT_MOV, STR_END, 0, TMP1, 0);
+ JUMPHERE(quit);
+ }
+else
+ OP2(SLJIT_SUB, STR_END, 0, STR_END, 0, SLJIT_IMM, IN_UCHARS(max));
+
+SLJIT_ASSERT(range_right >= 0);
+
+#if !(defined SLJIT_CONFIG_X86_32 && SLJIT_CONFIG_X86_32)
+OP1(SLJIT_MOV, RETURN_ADDR, 0, SLJIT_IMM, (sljit_sw)update_table);
+#endif
+
+start = LABEL();
+quit = CMP(SLJIT_GREATER_EQUAL, STR_PTR, 0, STR_END, 0);
+
+#if defined COMPILE_PCRE8 || (defined SLJIT_LITTLE_ENDIAN && SLJIT_LITTLE_ENDIAN)
+OP1(SLJIT_MOV_U8, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(range_right));
+#else
+OP1(SLJIT_MOV_U8, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(range_right + 1) - 1);
+#endif
+
+#if !(defined SLJIT_CONFIG_X86_32 && SLJIT_CONFIG_X86_32)
+OP1(SLJIT_MOV_U8, TMP1, 0, SLJIT_MEM2(RETURN_ADDR, TMP1), 0);
+#else
+OP1(SLJIT_MOV_U8, TMP1, 0, SLJIT_MEM1(TMP1), (sljit_sw)update_table);
+#endif
+OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, TMP1, 0);
+CMPTO(SLJIT_NOT_EQUAL, TMP1, 0, SLJIT_IMM, 0, start);
+
+if (offset >= 0)
+ {
+ OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(offset));
+ OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
+
+ if (chars[offset * MAX_DIFF_CHARS] == 1)
+ CMPTO(SLJIT_NOT_EQUAL, TMP1, 0, SLJIT_IMM, chars[offset * MAX_DIFF_CHARS + 1], start);
+ else
+ {
+ mask = chars[offset * MAX_DIFF_CHARS + 1] ^ chars[offset * MAX_DIFF_CHARS + 2];
+ if (is_powerof2(mask))
+ {
+ OP2(SLJIT_OR, TMP1, 0, TMP1, 0, SLJIT_IMM, mask);
+ CMPTO(SLJIT_NOT_EQUAL, TMP1, 0, SLJIT_IMM, chars[offset * MAX_DIFF_CHARS + 1] | mask, start);
+ }
+ else
+ {
+ match = CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, chars[offset * MAX_DIFF_CHARS + 1]);
+ CMPTO(SLJIT_NOT_EQUAL, TMP1, 0, SLJIT_IMM, chars[offset * MAX_DIFF_CHARS + 2], start);
+ JUMPHERE(match);
+ }
+ }
+ }
+
+#if defined SUPPORT_UTF && !defined COMPILE_PCRE32
+if (common->utf && offset != 0)
+ {
+ if (offset < 0)
+ {
+ OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), 0);
+ OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
+ }
+ else
+ OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(-1));
+#if defined COMPILE_PCRE8
+ OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, 0xc0);
+ CMPTO(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, 0x80, start);
+#elif defined COMPILE_PCRE16
+ OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, 0xfc00);
+ CMPTO(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, 0xdc00, start);
+#else
+#error "Unknown code width"
+#endif
+ if (offset < 0)
+ OP2(SLJIT_SUB, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
+ }
+#endif
+
+if (offset >= 0)
+ OP2(SLJIT_SUB, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
+
JUMPHERE(quit);
-if (firstline)
+if (common->match_end_ptr != 0)
+ {
+ if (range_right >= 0)
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), common->match_end_ptr);
OP1(SLJIT_MOV, STR_END, 0, TMP3, 0);
+ if (range_right >= 0)
+ {
+ quit = CMP(SLJIT_LESS_EQUAL, STR_PTR, 0, TMP1, 0);
+ OP1(SLJIT_MOV, STR_PTR, 0, TMP1, 0);
+ JUMPHERE(quit);
+ }
+ }
+else
+ OP2(SLJIT_ADD, STR_END, 0, STR_END, 0, SLJIT_IMM, IN_UCHARS(max));
+return TRUE;
+}
+
+#undef MAX_N_CHARS
+#undef MAX_DIFF_CHARS
+
+static SLJIT_INLINE void fast_forward_first_char(compiler_common *common, pcre_uchar first_char, BOOL caseless)
+{
+pcre_uchar oc;
+
+oc = first_char;
+if (caseless)
+ {
+ oc = TABLE_GET(first_char, common->fcc, first_char);
+#if defined SUPPORT_UCP && !defined COMPILE_PCRE8
+ if (first_char > 127 && common->utf)
+ oc = UCD_OTHERCASE(first_char);
+#endif
+ }
+
+fast_forward_first_char2(common, first_char, oc, 0);
}
-static SLJIT_INLINE void fast_forward_newline(compiler_common *common, BOOL firstline)
+static SLJIT_INLINE void fast_forward_newline(compiler_common *common)
{
DEFINE_COMPILER;
struct sljit_label *loop;
@@ -3135,24 +4560,23 @@ struct sljit_jump *foundcr = NULL;
struct sljit_jump *notfoundnl;
jump_list *newline = NULL;
-if (firstline)
+if (common->match_end_ptr != 0)
{
- SLJIT_ASSERT(common->first_line_end != 0);
OP1(SLJIT_MOV, TMP3, 0, STR_END, 0);
- OP1(SLJIT_MOV, STR_END, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->first_line_end);
+ OP1(SLJIT_MOV, STR_END, 0, SLJIT_MEM1(SLJIT_SP), common->match_end_ptr);
}
if (common->nltype == NLTYPE_FIXED && common->newline > 255)
{
- lastchar = CMP(SLJIT_C_GREATER_EQUAL, STR_PTR, 0, STR_END, 0);
+ lastchar = CMP(SLJIT_GREATER_EQUAL, STR_PTR, 0, STR_END, 0);
OP1(SLJIT_MOV, TMP1, 0, ARGUMENTS, 0);
OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, str));
OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, begin));
- firstchar = CMP(SLJIT_C_LESS_EQUAL, STR_PTR, 0, TMP2, 0);
+ firstchar = CMP(SLJIT_LESS_EQUAL, STR_PTR, 0, TMP2, 0);
OP2(SLJIT_ADD, TMP1, 0, TMP1, 0, SLJIT_IMM, IN_UCHARS(2));
- OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, STR_PTR, 0, TMP1, 0);
- OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_C_GREATER_EQUAL);
+ OP2(SLJIT_SUB | SLJIT_SET_GREATER_EQUAL, SLJIT_UNUSED, 0, STR_PTR, 0, TMP1, 0);
+ OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_GREATER_EQUAL);
#if defined COMPILE_PCRE16 || defined COMPILE_PCRE32
OP2(SLJIT_SHL, TMP2, 0, TMP2, 0, SLJIT_IMM, UCHAR_SHIFT);
#endif
@@ -3160,31 +4584,33 @@ if (common->nltype == NLTYPE_FIXED && common->newline > 255)
loop = LABEL();
OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
- quit = CMP(SLJIT_C_GREATER_EQUAL, STR_PTR, 0, STR_END, 0);
+ quit = CMP(SLJIT_GREATER_EQUAL, STR_PTR, 0, STR_END, 0);
OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(-2));
OP1(MOV_UCHAR, TMP2, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(-1));
- CMPTO(SLJIT_C_NOT_EQUAL, TMP1, 0, SLJIT_IMM, (common->newline >> 8) & 0xff, loop);
- CMPTO(SLJIT_C_NOT_EQUAL, TMP2, 0, SLJIT_IMM, common->newline & 0xff, loop);
+ CMPTO(SLJIT_NOT_EQUAL, TMP1, 0, SLJIT_IMM, (common->newline >> 8) & 0xff, loop);
+ CMPTO(SLJIT_NOT_EQUAL, TMP2, 0, SLJIT_IMM, common->newline & 0xff, loop);
JUMPHERE(quit);
JUMPHERE(firstchar);
JUMPHERE(lastchar);
- if (firstline)
- OP1(SLJIT_MOV, STR_END, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), POSSESSIVE0);
+ if (common->match_end_ptr != 0)
+ OP1(SLJIT_MOV, STR_END, 0, TMP3, 0);
return;
}
OP1(SLJIT_MOV, TMP1, 0, ARGUMENTS, 0);
OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, str));
-firstchar = CMP(SLJIT_C_LESS_EQUAL, STR_PTR, 0, TMP2, 0);
+firstchar = CMP(SLJIT_LESS_EQUAL, STR_PTR, 0, TMP2, 0);
skip_char_back(common);
loop = LABEL();
-read_char(common);
-lastchar = CMP(SLJIT_C_GREATER_EQUAL, STR_PTR, 0, STR_END, 0);
+common->ff_newline_shortcut = loop;
+
+read_char_range(common, common->nlmin, common->nlmax, TRUE);
+lastchar = CMP(SLJIT_GREATER_EQUAL, STR_PTR, 0, STR_END, 0);
if (common->nltype == NLTYPE_ANY || common->nltype == NLTYPE_ANYCRLF)
- foundcr = CMP(SLJIT_C_EQUAL, TMP1, 0, SLJIT_IMM, CHAR_CR);
+ foundcr = CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, CHAR_CR);
check_newlinechar(common, common->nltype, &newline, FALSE);
set_jumps(newline, loop);
@@ -3192,10 +4618,10 @@ if (common->nltype == NLTYPE_ANY || common->nltype == NLTYPE_ANYCRLF)
{
quit = JUMP(SLJIT_JUMP);
JUMPHERE(foundcr);
- notfoundnl = CMP(SLJIT_C_GREATER_EQUAL, STR_PTR, 0, STR_END, 0);
+ notfoundnl = CMP(SLJIT_GREATER_EQUAL, STR_PTR, 0, STR_END, 0);
OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), 0);
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, CHAR_NL);
- OP_FLAGS(SLJIT_MOV, TMP1, 0, SLJIT_UNUSED, 0, SLJIT_C_EQUAL);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, CHAR_NL);
+ OP_FLAGS(SLJIT_MOV, TMP1, 0, SLJIT_EQUAL);
#if defined COMPILE_PCRE16 || defined COMPILE_PCRE32
OP2(SLJIT_SHL, TMP1, 0, TMP1, 0, SLJIT_IMM, UCHAR_SHIFT);
#endif
@@ -3206,56 +4632,50 @@ if (common->nltype == NLTYPE_ANY || common->nltype == NLTYPE_ANYCRLF)
JUMPHERE(lastchar);
JUMPHERE(firstchar);
-if (firstline)
+if (common->match_end_ptr != 0)
OP1(SLJIT_MOV, STR_END, 0, TMP3, 0);
}
-static BOOL check_class_ranges(compiler_common *common, const pcre_uint8 *bits, BOOL nclass, jump_list **backtracks);
+static BOOL check_class_ranges(compiler_common *common, const sljit_u8 *bits, BOOL nclass, BOOL invert, jump_list **backtracks);
-static SLJIT_INLINE void fast_forward_start_bits(compiler_common *common, sljit_uw start_bits, BOOL firstline)
+static SLJIT_INLINE void fast_forward_start_bits(compiler_common *common, const sljit_u8 *start_bits)
{
DEFINE_COMPILER;
struct sljit_label *start;
struct sljit_jump *quit;
struct sljit_jump *found = NULL;
jump_list *matches = NULL;
-pcre_uint8 inverted_start_bits[32];
-int i;
#ifndef COMPILE_PCRE8
struct sljit_jump *jump;
#endif
-for (i = 0; i < 32; ++i)
- inverted_start_bits[i] = ~(((pcre_uint8*)start_bits)[i]);
-
-if (firstline)
+if (common->match_end_ptr != 0)
{
- SLJIT_ASSERT(common->first_line_end != 0);
OP1(SLJIT_MOV, RETURN_ADDR, 0, STR_END, 0);
- OP1(SLJIT_MOV, STR_END, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->first_line_end);
+ OP1(SLJIT_MOV, STR_END, 0, SLJIT_MEM1(SLJIT_SP), common->match_end_ptr);
}
start = LABEL();
-quit = CMP(SLJIT_C_GREATER_EQUAL, STR_PTR, 0, STR_END, 0);
+quit = CMP(SLJIT_GREATER_EQUAL, STR_PTR, 0, STR_END, 0);
OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), 0);
#ifdef SUPPORT_UTF
if (common->utf)
OP1(SLJIT_MOV, TMP3, 0, TMP1, 0);
#endif
-if (!check_class_ranges(common, inverted_start_bits, (inverted_start_bits[31] & 0x80) != 0, &matches))
+if (!check_class_ranges(common, start_bits, (start_bits[31] & 0x80) != 0, TRUE, &matches))
{
#ifndef COMPILE_PCRE8
- jump = CMP(SLJIT_C_LESS, TMP1, 0, SLJIT_IMM, 255);
+ jump = CMP(SLJIT_LESS, TMP1, 0, SLJIT_IMM, 255);
OP1(SLJIT_MOV, TMP1, 0, SLJIT_IMM, 255);
JUMPHERE(jump);
#endif
OP2(SLJIT_AND, TMP2, 0, TMP1, 0, SLJIT_IMM, 0x7);
OP2(SLJIT_LSHR, TMP1, 0, TMP1, 0, SLJIT_IMM, 3);
- OP1(SLJIT_MOV_UB, TMP1, 0, SLJIT_MEM1(TMP1), start_bits);
+ OP1(SLJIT_MOV_U8, TMP1, 0, SLJIT_MEM1(TMP1), (sljit_sw)start_bits);
OP2(SLJIT_SHL, TMP2, 0, SLJIT_IMM, 1, TMP2, 0);
- OP2(SLJIT_AND | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, TMP2, 0);
- found = JUMP(SLJIT_C_NOT_ZERO);
+ OP2(SLJIT_AND | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, TMP2, 0);
+ found = JUMP(SLJIT_NOT_ZERO);
}
#ifdef SUPPORT_UTF
@@ -3267,17 +4687,17 @@ OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
#if defined COMPILE_PCRE8
if (common->utf)
{
- CMPTO(SLJIT_C_LESS, TMP1, 0, SLJIT_IMM, 0xc0, start);
- OP1(SLJIT_MOV_UB, TMP1, 0, SLJIT_MEM1(TMP1), (sljit_sw)PRIV(utf8_table4) - 0xc0);
+ CMPTO(SLJIT_LESS, TMP1, 0, SLJIT_IMM, 0xc0, start);
+ OP1(SLJIT_MOV_U8, TMP1, 0, SLJIT_MEM1(TMP1), (sljit_sw)PRIV(utf8_table4) - 0xc0);
OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, TMP1, 0);
}
#elif defined COMPILE_PCRE16
if (common->utf)
{
- CMPTO(SLJIT_C_LESS, TMP1, 0, SLJIT_IMM, 0xd800, start);
+ CMPTO(SLJIT_LESS, TMP1, 0, SLJIT_IMM, 0xd800, start);
OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, 0xfc00);
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0xd800);
- OP_FLAGS(SLJIT_MOV, TMP1, 0, SLJIT_UNUSED, 0, SLJIT_C_EQUAL);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0xd800);
+ OP_FLAGS(SLJIT_MOV, TMP1, 0, SLJIT_EQUAL);
OP2(SLJIT_SHL, TMP1, 0, TMP1, 0, SLJIT_IMM, 1);
OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, TMP1, 0);
}
@@ -3290,7 +4710,7 @@ if (matches != NULL)
set_jumps(matches, LABEL());
JUMPHERE(quit);
-if (firstline)
+if (common->match_end_ptr != 0)
OP1(SLJIT_MOV, STR_END, 0, RETURN_ADDR, 0);
}
@@ -3303,13 +4723,13 @@ struct sljit_jump *alreadyfound;
struct sljit_jump *found;
struct sljit_jump *foundoc = NULL;
struct sljit_jump *notfound;
-pcre_uint32 oc, bit;
+sljit_u32 oc, bit;
SLJIT_ASSERT(common->req_char_ptr != 0);
-OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->req_char_ptr);
+OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), common->req_char_ptr);
OP2(SLJIT_ADD, TMP1, 0, STR_PTR, 0, SLJIT_IMM, REQ_BYTE_MAX);
-toolong = CMP(SLJIT_C_LESS, TMP1, 0, STR_END, 0);
-alreadyfound = CMP(SLJIT_C_LESS, STR_PTR, 0, TMP2, 0);
+toolong = CMP(SLJIT_LESS, TMP1, 0, STR_END, 0);
+alreadyfound = CMP(SLJIT_LESS, STR_PTR, 0, TMP2, 0);
if (has_firstchar)
OP2(SLJIT_ADD, TMP1, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
@@ -3317,7 +4737,7 @@ else
OP1(SLJIT_MOV, TMP1, 0, STR_PTR, 0);
loop = LABEL();
-notfound = CMP(SLJIT_C_GREATER_EQUAL, TMP1, 0, STR_END, 0);
+notfound = CMP(SLJIT_GREATER_EQUAL, TMP1, 0, STR_END, 0);
OP1(MOV_UCHAR, TMP2, 0, SLJIT_MEM1(TMP1), 0);
oc = req_char;
@@ -3330,19 +4750,19 @@ if (caseless)
#endif
}
if (req_char == oc)
- found = CMP(SLJIT_C_EQUAL, TMP2, 0, SLJIT_IMM, req_char);
+ found = CMP(SLJIT_EQUAL, TMP2, 0, SLJIT_IMM, req_char);
else
{
bit = req_char ^ oc;
if (is_powerof2(bit))
{
OP2(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_IMM, bit);
- found = CMP(SLJIT_C_EQUAL, TMP2, 0, SLJIT_IMM, req_char | bit);
+ found = CMP(SLJIT_EQUAL, TMP2, 0, SLJIT_IMM, req_char | bit);
}
else
{
- found = CMP(SLJIT_C_EQUAL, TMP2, 0, SLJIT_IMM, req_char);
- foundoc = CMP(SLJIT_C_EQUAL, TMP2, 0, SLJIT_IMM, oc);
+ found = CMP(SLJIT_EQUAL, TMP2, 0, SLJIT_IMM, req_char);
+ foundoc = CMP(SLJIT_EQUAL, TMP2, 0, SLJIT_IMM, oc);
}
}
OP2(SLJIT_ADD, TMP1, 0, TMP1, 0, SLJIT_IMM, IN_UCHARS(1));
@@ -3351,7 +4771,7 @@ JUMPTO(SLJIT_JUMP, loop);
JUMPHERE(found);
if (foundoc)
JUMPHERE(foundoc);
-OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->req_char_ptr, TMP1, 0);
+OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->req_char_ptr, TMP1, 0);
JUMPHERE(alreadyfound);
JUMPHERE(toolong);
return notfound;
@@ -3364,31 +4784,31 @@ struct sljit_jump *jump;
struct sljit_label *mainloop;
sljit_emit_fast_enter(compiler, RETURN_ADDR, 0);
-OP1(SLJIT_MOV, TMP1, 0, STACK_TOP, 0);
-GET_LOCAL_BASE(TMP3, 0, 0);
+OP1(SLJIT_MOV, TMP3, 0, STACK_TOP, 0);
+GET_LOCAL_BASE(TMP1, 0, 0);
/* Drop frames until we reach STACK_TOP. */
mainloop = LABEL();
-OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(TMP1), 0);
-OP2(SLJIT_SUB | SLJIT_SET_S, SLJIT_UNUSED, 0, TMP2, 0, SLJIT_IMM, 0);
-jump = JUMP(SLJIT_C_SIG_LESS_EQUAL);
-
-OP2(SLJIT_ADD, TMP2, 0, TMP2, 0, TMP3, 0);
-OP1(SLJIT_MOV, SLJIT_MEM1(TMP2), 0, SLJIT_MEM1(TMP1), sizeof(sljit_sw));
-OP1(SLJIT_MOV, SLJIT_MEM1(TMP2), sizeof(sljit_sw), SLJIT_MEM1(TMP1), 2 * sizeof(sljit_sw));
-OP2(SLJIT_ADD, TMP1, 0, TMP1, 0, SLJIT_IMM, 3 * sizeof(sljit_sw));
+OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(STACK_TOP), -sizeof(sljit_sw));
+jump = CMP(SLJIT_SIG_LESS_EQUAL, TMP2, 0, SLJIT_IMM, 0);
+
+OP2(SLJIT_ADD, TMP2, 0, TMP2, 0, TMP1, 0);
+OP1(SLJIT_MOV, SLJIT_MEM1(TMP2), 0, SLJIT_MEM1(STACK_TOP), -2 * sizeof(sljit_sw));
+OP1(SLJIT_MOV, SLJIT_MEM1(TMP2), sizeof(sljit_sw), SLJIT_MEM1(STACK_TOP), -3 * sizeof(sljit_sw));
+OP2(SLJIT_SUB, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, 3 * sizeof(sljit_sw));
JUMPTO(SLJIT_JUMP, mainloop);
JUMPHERE(jump);
-jump = JUMP(SLJIT_C_SIG_LESS);
-/* End of dropping frames. */
+jump = CMP(SLJIT_NOT_ZERO /* SIG_LESS */, TMP2, 0, SLJIT_IMM, 0);
+/* End of reverting values. */
+OP1(SLJIT_MOV, STACK_TOP, 0, TMP3, 0);
sljit_emit_fast_return(compiler, RETURN_ADDR, 0);
JUMPHERE(jump);
OP1(SLJIT_NEG, TMP2, 0, TMP2, 0);
-OP2(SLJIT_ADD, TMP2, 0, TMP2, 0, TMP3, 0);
-OP1(SLJIT_MOV, SLJIT_MEM1(TMP2), 0, SLJIT_MEM1(TMP1), sizeof(sljit_sw));
-OP2(SLJIT_ADD, TMP1, 0, TMP1, 0, SLJIT_IMM, 2 * sizeof(sljit_sw));
+OP2(SLJIT_ADD, TMP2, 0, TMP2, 0, TMP1, 0);
+OP1(SLJIT_MOV, SLJIT_MEM1(TMP2), 0, SLJIT_MEM1(STACK_TOP), -2 * sizeof(sljit_sw));
+OP2(SLJIT_SUB, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, 2 * sizeof(sljit_sw));
JUMPTO(SLJIT_JUMP, mainloop);
}
@@ -3403,12 +4823,12 @@ struct sljit_jump *jump;
SLJIT_COMPILE_ASSERT(ctype_word == 0x10, ctype_word_must_be_16);
-sljit_emit_fast_enter(compiler, SLJIT_MEM1(SLJIT_LOCALS_REG), LOCALS0);
+sljit_emit_fast_enter(compiler, SLJIT_MEM1(SLJIT_SP), LOCALS0);
/* Get type of the previous char, and put it to LOCALS1. */
OP1(SLJIT_MOV, TMP1, 0, ARGUMENTS, 0);
OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, begin));
-OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), LOCALS1, SLJIT_IMM, 0);
-skipread = CMP(SLJIT_C_LESS_EQUAL, STR_PTR, 0, TMP1, 0);
+OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), LOCALS1, SLJIT_IMM, 0);
+skipread = CMP(SLJIT_LESS_EQUAL, STR_PTR, 0, TMP1, 0);
skip_char_back(common);
check_start_used_ptr(common);
read_char(common);
@@ -3418,32 +4838,32 @@ read_char(common);
if (common->use_ucp)
{
OP1(SLJIT_MOV, TMP2, 0, SLJIT_IMM, 1);
- jump = CMP(SLJIT_C_EQUAL, TMP1, 0, SLJIT_IMM, CHAR_UNDERSCORE);
+ jump = CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, CHAR_UNDERSCORE);
add_jump(compiler, &common->getucd, JUMP(SLJIT_FAST_CALL));
OP2(SLJIT_SUB, TMP1, 0, TMP1, 0, SLJIT_IMM, ucp_Ll);
- OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, ucp_Lu - ucp_Ll);
- OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_C_LESS_EQUAL);
+ OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, ucp_Lu - ucp_Ll);
+ OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_LESS_EQUAL);
OP2(SLJIT_SUB, TMP1, 0, TMP1, 0, SLJIT_IMM, ucp_Nd - ucp_Ll);
- OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, ucp_No - ucp_Nd);
- OP_FLAGS(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_C_LESS_EQUAL);
+ OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, ucp_No - ucp_Nd);
+ OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_LESS_EQUAL);
JUMPHERE(jump);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), LOCALS1, TMP2, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), LOCALS1, TMP2, 0);
}
else
#endif
{
#ifndef COMPILE_PCRE8
- jump = CMP(SLJIT_C_GREATER, TMP1, 0, SLJIT_IMM, 255);
+ jump = CMP(SLJIT_GREATER, TMP1, 0, SLJIT_IMM, 255);
#elif defined SUPPORT_UTF
/* Here LOCALS1 has already been zeroed. */
jump = NULL;
if (common->utf)
- jump = CMP(SLJIT_C_GREATER, TMP1, 0, SLJIT_IMM, 255);
+ jump = CMP(SLJIT_GREATER, TMP1, 0, SLJIT_IMM, 255);
#endif /* COMPILE_PCRE8 */
- OP1(SLJIT_MOV_UB, TMP1, 0, SLJIT_MEM1(TMP1), common->ctypes);
+ OP1(SLJIT_MOV_U8, TMP1, 0, SLJIT_MEM1(TMP1), common->ctypes);
OP2(SLJIT_LSHR, TMP1, 0, TMP1, 0, SLJIT_IMM, 4 /* ctype_word */);
OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, 1);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), LOCALS1, TMP1, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), LOCALS1, TMP1, 0);
#ifndef COMPILE_PCRE8
JUMPHERE(jump);
#elif defined SUPPORT_UTF
@@ -3455,21 +4875,21 @@ JUMPHERE(skipread);
OP1(SLJIT_MOV, TMP2, 0, SLJIT_IMM, 0);
check_str_end(common, &skipread_list);
-peek_char(common);
+peek_char(common, READ_CHAR_MAX);
/* Testing char type. This is a code duplication. */
#ifdef SUPPORT_UCP
if (common->use_ucp)
{
OP1(SLJIT_MOV, TMP2, 0, SLJIT_IMM, 1);
- jump = CMP(SLJIT_C_EQUAL, TMP1, 0, SLJIT_IMM, CHAR_UNDERSCORE);
+ jump = CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, CHAR_UNDERSCORE);
add_jump(compiler, &common->getucd, JUMP(SLJIT_FAST_CALL));
OP2(SLJIT_SUB, TMP1, 0, TMP1, 0, SLJIT_IMM, ucp_Ll);
- OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, ucp_Lu - ucp_Ll);
- OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_C_LESS_EQUAL);
+ OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, ucp_Lu - ucp_Ll);
+ OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_LESS_EQUAL);
OP2(SLJIT_SUB, TMP1, 0, TMP1, 0, SLJIT_IMM, ucp_Nd - ucp_Ll);
- OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, ucp_No - ucp_Nd);
- OP_FLAGS(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_C_LESS_EQUAL);
+ OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, ucp_No - ucp_Nd);
+ OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_LESS_EQUAL);
JUMPHERE(jump);
}
else
@@ -3478,14 +4898,14 @@ else
#ifndef COMPILE_PCRE8
/* TMP2 may be destroyed by peek_char. */
OP1(SLJIT_MOV, TMP2, 0, SLJIT_IMM, 0);
- jump = CMP(SLJIT_C_GREATER, TMP1, 0, SLJIT_IMM, 255);
+ jump = CMP(SLJIT_GREATER, TMP1, 0, SLJIT_IMM, 255);
#elif defined SUPPORT_UTF
OP1(SLJIT_MOV, TMP2, 0, SLJIT_IMM, 0);
jump = NULL;
if (common->utf)
- jump = CMP(SLJIT_C_GREATER, TMP1, 0, SLJIT_IMM, 255);
+ jump = CMP(SLJIT_GREATER, TMP1, 0, SLJIT_IMM, 255);
#endif
- OP1(SLJIT_MOV_UB, TMP2, 0, SLJIT_MEM1(TMP1), common->ctypes);
+ OP1(SLJIT_MOV_U8, TMP2, 0, SLJIT_MEM1(TMP1), common->ctypes);
OP2(SLJIT_LSHR, TMP2, 0, TMP2, 0, SLJIT_IMM, 4 /* ctype_word */);
OP2(SLJIT_AND, TMP2, 0, TMP2, 0, SLJIT_IMM, 1);
#ifndef COMPILE_PCRE8
@@ -3497,114 +4917,20 @@ else
}
set_jumps(skipread_list, LABEL());
-OP2(SLJIT_XOR | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), LOCALS1);
-sljit_emit_fast_return(compiler, SLJIT_MEM1(SLJIT_LOCALS_REG), LOCALS0);
+OP2(SLJIT_XOR | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP2, 0, SLJIT_MEM1(SLJIT_SP), LOCALS1);
+sljit_emit_fast_return(compiler, SLJIT_MEM1(SLJIT_SP), LOCALS0);
}
-/*
- range format:
-
- ranges[0] = length of the range (max MAX_RANGE_SIZE, -1 means invalid range).
- ranges[1] = first bit (0 or 1)
- ranges[2-length] = position of the bit change (when the current bit is not equal to the previous)
-*/
-
-static BOOL check_ranges(compiler_common *common, int *ranges, jump_list **backtracks, BOOL readch)
+static BOOL check_class_ranges(compiler_common *common, const sljit_u8 *bits, BOOL nclass, BOOL invert, jump_list **backtracks)
{
+/* May destroy TMP1. */
DEFINE_COMPILER;
-struct sljit_jump *jump;
-
-if (ranges[0] < 0)
- return FALSE;
-
-switch(ranges[0])
- {
- case 1:
- if (readch)
- read_char(common);
- add_jump(compiler, backtracks, CMP(ranges[1] == 0 ? SLJIT_C_LESS : SLJIT_C_GREATER_EQUAL, TMP1, 0, SLJIT_IMM, ranges[2]));
- return TRUE;
-
- case 2:
- if (readch)
- read_char(common);
- OP2(SLJIT_SUB, TMP1, 0, TMP1, 0, SLJIT_IMM, ranges[2]);
- add_jump(compiler, backtracks, CMP(ranges[1] != 0 ? SLJIT_C_LESS : SLJIT_C_GREATER_EQUAL, TMP1, 0, SLJIT_IMM, ranges[3] - ranges[2]));
- return TRUE;
-
- case 4:
- if (ranges[2] + 1 == ranges[3] && ranges[4] + 1 == ranges[5])
- {
- if (readch)
- read_char(common);
- if (ranges[1] != 0)
- {
- add_jump(compiler, backtracks, CMP(SLJIT_C_EQUAL, TMP1, 0, SLJIT_IMM, ranges[2]));
- add_jump(compiler, backtracks, CMP(SLJIT_C_EQUAL, TMP1, 0, SLJIT_IMM, ranges[4]));
- }
- else
- {
- jump = CMP(SLJIT_C_EQUAL, TMP1, 0, SLJIT_IMM, ranges[2]);
- add_jump(compiler, backtracks, CMP(SLJIT_C_NOT_EQUAL, TMP1, 0, SLJIT_IMM, ranges[4]));
- JUMPHERE(jump);
- }
- return TRUE;
- }
- if ((ranges[3] - ranges[2]) == (ranges[5] - ranges[4]) && is_powerof2(ranges[4] - ranges[2]))
- {
- if (readch)
- read_char(common);
- OP2(SLJIT_OR, TMP1, 0, TMP1, 0, SLJIT_IMM, ranges[4] - ranges[2]);
- OP2(SLJIT_SUB, TMP1, 0, TMP1, 0, SLJIT_IMM, ranges[4]);
- add_jump(compiler, backtracks, CMP(ranges[1] != 0 ? SLJIT_C_LESS : SLJIT_C_GREATER_EQUAL, TMP1, 0, SLJIT_IMM, ranges[5] - ranges[4]));
- return TRUE;
- }
- return FALSE;
-
- default:
- return FALSE;
- }
-}
-
-static void get_ctype_ranges(compiler_common *common, int flag, int *ranges)
-{
-int i, bit, length;
-const pcre_uint8 *ctypes = (const pcre_uint8*)common->ctypes;
-
-bit = ctypes[0] & flag;
-ranges[0] = -1;
-ranges[1] = bit != 0 ? 1 : 0;
-length = 0;
-
-for (i = 1; i < 256; i++)
- if ((ctypes[i] & flag) != bit)
- {
- if (length >= MAX_RANGE_SIZE)
- return;
- ranges[2 + length] = i;
- length++;
- bit ^= flag;
- }
-
-if (bit != 0)
- {
- if (length >= MAX_RANGE_SIZE)
- return;
- ranges[2 + length] = 256;
- length++;
- }
-ranges[0] = length;
-}
-
-static BOOL check_class_ranges(compiler_common *common, const pcre_uint8 *bits, BOOL nclass, jump_list **backtracks)
-{
-int ranges[2 + MAX_RANGE_SIZE];
-pcre_uint8 bit, cbit, all;
+int ranges[MAX_RANGE_SIZE];
+sljit_u8 bit, cbit, all;
int i, byte, length = 0;
bit = bits[0] & 0x1;
-ranges[1] = bit;
-/* Can be 0 or 255. */
+/* All bits will be zero or one (since bit is zero or one). */
all = -bit;
for (i = 0; i < 256; )
@@ -3619,7 +4945,7 @@ for (i = 0; i < 256; )
{
if (length >= MAX_RANGE_SIZE)
return FALSE;
- ranges[2 + length] = i;
+ ranges[length] = i;
length++;
bit = cbit;
all = -cbit;
@@ -3632,12 +4958,119 @@ if (((bit == 0) && nclass) || ((bit == 1) && !nclass))
{
if (length >= MAX_RANGE_SIZE)
return FALSE;
- ranges[2 + length] = 256;
+ ranges[length] = 256;
length++;
}
-ranges[0] = length;
-return check_ranges(common, ranges, backtracks, FALSE);
+if (length < 0 || length > 4)
+ return FALSE;
+
+bit = bits[0] & 0x1;
+if (invert) bit ^= 0x1;
+
+/* No character is accepted. */
+if (length == 0 && bit == 0)
+ add_jump(compiler, backtracks, JUMP(SLJIT_JUMP));
+
+switch(length)
+ {
+ case 0:
+ /* When bit != 0, all characters are accepted. */
+ return TRUE;
+
+ case 1:
+ add_jump(compiler, backtracks, CMP(bit == 0 ? SLJIT_LESS : SLJIT_GREATER_EQUAL, TMP1, 0, SLJIT_IMM, ranges[0]));
+ return TRUE;
+
+ case 2:
+ if (ranges[0] + 1 != ranges[1])
+ {
+ OP2(SLJIT_SUB, TMP1, 0, TMP1, 0, SLJIT_IMM, ranges[0]);
+ add_jump(compiler, backtracks, CMP(bit != 0 ? SLJIT_LESS : SLJIT_GREATER_EQUAL, TMP1, 0, SLJIT_IMM, ranges[1] - ranges[0]));
+ }
+ else
+ add_jump(compiler, backtracks, CMP(bit != 0 ? SLJIT_EQUAL : SLJIT_NOT_EQUAL, TMP1, 0, SLJIT_IMM, ranges[0]));
+ return TRUE;
+
+ case 3:
+ if (bit != 0)
+ {
+ add_jump(compiler, backtracks, CMP(SLJIT_GREATER_EQUAL, TMP1, 0, SLJIT_IMM, ranges[2]));
+ if (ranges[0] + 1 != ranges[1])
+ {
+ OP2(SLJIT_SUB, TMP1, 0, TMP1, 0, SLJIT_IMM, ranges[0]);
+ add_jump(compiler, backtracks, CMP(SLJIT_LESS, TMP1, 0, SLJIT_IMM, ranges[1] - ranges[0]));
+ }
+ else
+ add_jump(compiler, backtracks, CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, ranges[0]));
+ return TRUE;
+ }
+
+ add_jump(compiler, backtracks, CMP(SLJIT_LESS, TMP1, 0, SLJIT_IMM, ranges[0]));
+ if (ranges[1] + 1 != ranges[2])
+ {
+ OP2(SLJIT_SUB, TMP1, 0, TMP1, 0, SLJIT_IMM, ranges[1]);
+ add_jump(compiler, backtracks, CMP(SLJIT_LESS, TMP1, 0, SLJIT_IMM, ranges[2] - ranges[1]));
+ }
+ else
+ add_jump(compiler, backtracks, CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, ranges[1]));
+ return TRUE;
+
+ case 4:
+ if ((ranges[1] - ranges[0]) == (ranges[3] - ranges[2])
+ && (ranges[0] | (ranges[2] - ranges[0])) == ranges[2]
+ && (ranges[1] & (ranges[2] - ranges[0])) == 0
+ && is_powerof2(ranges[2] - ranges[0]))
+ {
+ SLJIT_ASSERT((ranges[0] & (ranges[2] - ranges[0])) == 0 && (ranges[2] & ranges[3] & (ranges[2] - ranges[0])) != 0);
+ OP2(SLJIT_OR, TMP1, 0, TMP1, 0, SLJIT_IMM, ranges[2] - ranges[0]);
+ if (ranges[2] + 1 != ranges[3])
+ {
+ OP2(SLJIT_SUB, TMP1, 0, TMP1, 0, SLJIT_IMM, ranges[2]);
+ add_jump(compiler, backtracks, CMP(bit != 0 ? SLJIT_LESS : SLJIT_GREATER_EQUAL, TMP1, 0, SLJIT_IMM, ranges[3] - ranges[2]));
+ }
+ else
+ add_jump(compiler, backtracks, CMP(bit != 0 ? SLJIT_EQUAL : SLJIT_NOT_EQUAL, TMP1, 0, SLJIT_IMM, ranges[2]));
+ return TRUE;
+ }
+
+ if (bit != 0)
+ {
+ i = 0;
+ if (ranges[0] + 1 != ranges[1])
+ {
+ OP2(SLJIT_SUB, TMP1, 0, TMP1, 0, SLJIT_IMM, ranges[0]);
+ add_jump(compiler, backtracks, CMP(SLJIT_LESS, TMP1, 0, SLJIT_IMM, ranges[1] - ranges[0]));
+ i = ranges[0];
+ }
+ else
+ add_jump(compiler, backtracks, CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, ranges[0]));
+
+ if (ranges[2] + 1 != ranges[3])
+ {
+ OP2(SLJIT_SUB, TMP1, 0, TMP1, 0, SLJIT_IMM, ranges[2] - i);
+ add_jump(compiler, backtracks, CMP(SLJIT_LESS, TMP1, 0, SLJIT_IMM, ranges[3] - ranges[2]));
+ }
+ else
+ add_jump(compiler, backtracks, CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, ranges[2] - i));
+ return TRUE;
+ }
+
+ OP2(SLJIT_SUB, TMP1, 0, TMP1, 0, SLJIT_IMM, ranges[0]);
+ add_jump(compiler, backtracks, CMP(SLJIT_GREATER_EQUAL, TMP1, 0, SLJIT_IMM, ranges[3] - ranges[0]));
+ if (ranges[1] + 1 != ranges[2])
+ {
+ OP2(SLJIT_SUB, TMP1, 0, TMP1, 0, SLJIT_IMM, ranges[1] - ranges[0]);
+ add_jump(compiler, backtracks, CMP(SLJIT_LESS, TMP1, 0, SLJIT_IMM, ranges[2] - ranges[1]));
+ }
+ else
+ add_jump(compiler, backtracks, CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, ranges[1] - ranges[0]));
+ return TRUE;
+
+ default:
+ SLJIT_UNREACHABLE();
+ return FALSE;
+ }
}
static void check_anynewline(compiler_common *common)
@@ -3648,22 +5081,22 @@ DEFINE_COMPILER;
sljit_emit_fast_enter(compiler, RETURN_ADDR, 0);
OP2(SLJIT_SUB, TMP1, 0, TMP1, 0, SLJIT_IMM, 0x0a);
-OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x0d - 0x0a);
-OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_C_LESS_EQUAL);
-OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x85 - 0x0a);
+OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x0d - 0x0a);
+OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_LESS_EQUAL);
+OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x85 - 0x0a);
#if defined SUPPORT_UTF || defined COMPILE_PCRE16 || defined COMPILE_PCRE32
#ifdef COMPILE_PCRE8
if (common->utf)
{
#endif
- OP_FLAGS(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_C_EQUAL);
+ OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_EQUAL);
OP2(SLJIT_OR, TMP1, 0, TMP1, 0, SLJIT_IMM, 0x1);
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x2029 - 0x0a);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x2029 - 0x0a);
#ifdef COMPILE_PCRE8
}
#endif
#endif /* SUPPORT_UTF || COMPILE_PCRE16 || COMPILE_PCRE32 */
-OP_FLAGS(SLJIT_OR | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_C_EQUAL);
+OP_FLAGS(SLJIT_OR | SLJIT_SET_Z, TMP2, 0, SLJIT_EQUAL);
sljit_emit_fast_return(compiler, RETURN_ADDR, 0);
}
@@ -3674,34 +5107,34 @@ DEFINE_COMPILER;
sljit_emit_fast_enter(compiler, RETURN_ADDR, 0);
-OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x09);
-OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_C_EQUAL);
-OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x20);
-OP_FLAGS(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_C_EQUAL);
-OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0xa0);
+OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x09);
+OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_EQUAL);
+OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x20);
+OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_EQUAL);
+OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0xa0);
#if defined SUPPORT_UTF || defined COMPILE_PCRE16 || defined COMPILE_PCRE32
#ifdef COMPILE_PCRE8
if (common->utf)
{
#endif
- OP_FLAGS(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_C_EQUAL);
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x1680);
- OP_FLAGS(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_C_EQUAL);
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x180e);
- OP_FLAGS(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_C_EQUAL);
+ OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_EQUAL);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x1680);
+ OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_EQUAL);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x180e);
+ OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_EQUAL);
OP2(SLJIT_SUB, TMP1, 0, TMP1, 0, SLJIT_IMM, 0x2000);
- OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x200A - 0x2000);
- OP_FLAGS(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_C_LESS_EQUAL);
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x202f - 0x2000);
- OP_FLAGS(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_C_EQUAL);
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x205f - 0x2000);
- OP_FLAGS(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_C_EQUAL);
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x3000 - 0x2000);
+ OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x200A - 0x2000);
+ OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_LESS_EQUAL);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x202f - 0x2000);
+ OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_EQUAL);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x205f - 0x2000);
+ OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_EQUAL);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x3000 - 0x2000);
#ifdef COMPILE_PCRE8
}
#endif
#endif /* SUPPORT_UTF || COMPILE_PCRE16 || COMPILE_PCRE32 */
-OP_FLAGS(SLJIT_OR | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_C_EQUAL);
+OP_FLAGS(SLJIT_OR | SLJIT_SET_Z, TMP2, 0, SLJIT_EQUAL);
sljit_emit_fast_return(compiler, RETURN_ADDR, 0);
}
@@ -3714,22 +5147,22 @@ DEFINE_COMPILER;
sljit_emit_fast_enter(compiler, RETURN_ADDR, 0);
OP2(SLJIT_SUB, TMP1, 0, TMP1, 0, SLJIT_IMM, 0x0a);
-OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x0d - 0x0a);
-OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_C_LESS_EQUAL);
-OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x85 - 0x0a);
+OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x0d - 0x0a);
+OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_LESS_EQUAL);
+OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x85 - 0x0a);
#if defined SUPPORT_UTF || defined COMPILE_PCRE16 || defined COMPILE_PCRE32
#ifdef COMPILE_PCRE8
if (common->utf)
{
#endif
- OP_FLAGS(SLJIT_OR | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_C_EQUAL);
+ OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_EQUAL);
OP2(SLJIT_OR, TMP1, 0, TMP1, 0, SLJIT_IMM, 0x1);
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x2029 - 0x0a);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x2029 - 0x0a);
#ifdef COMPILE_PCRE8
}
#endif
#endif /* SUPPORT_UTF || COMPILE_PCRE16 || COMPILE_PCRE32 */
-OP_FLAGS(SLJIT_OR | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_C_EQUAL);
+OP_FLAGS(SLJIT_OR | SLJIT_SET_Z, TMP2, 0, SLJIT_EQUAL);
sljit_emit_fast_return(compiler, RETURN_ADDR, 0);
}
@@ -3746,21 +5179,21 @@ struct sljit_label *label;
sljit_emit_fast_enter(compiler, RETURN_ADDR, 0);
OP2(SLJIT_SUB, STR_PTR, 0, STR_PTR, 0, TMP2, 0);
OP1(SLJIT_MOV, TMP3, 0, CHAR1, 0);
-OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), LOCALS0, CHAR2, 0);
+OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), LOCALS0, CHAR2, 0);
OP2(SLJIT_SUB, TMP1, 0, TMP1, 0, SLJIT_IMM, IN_UCHARS(1));
OP2(SLJIT_SUB, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
label = LABEL();
OP1(MOVU_UCHAR, CHAR1, 0, SLJIT_MEM1(TMP1), IN_UCHARS(1));
OP1(MOVU_UCHAR, CHAR2, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(1));
-jump = CMP(SLJIT_C_NOT_EQUAL, CHAR1, 0, CHAR2, 0);
-OP2(SLJIT_SUB | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_IMM, IN_UCHARS(1));
-JUMPTO(SLJIT_C_NOT_ZERO, label);
+jump = CMP(SLJIT_NOT_EQUAL, CHAR1, 0, CHAR2, 0);
+OP2(SLJIT_SUB | SLJIT_SET_Z, TMP2, 0, TMP2, 0, SLJIT_IMM, IN_UCHARS(1));
+JUMPTO(SLJIT_NOT_ZERO, label);
JUMPHERE(jump);
OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
OP1(SLJIT_MOV, CHAR1, 0, TMP3, 0);
-OP1(SLJIT_MOV, CHAR2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), LOCALS0);
+OP1(SLJIT_MOV, CHAR2, 0, SLJIT_MEM1(SLJIT_SP), LOCALS0);
sljit_emit_fast_return(compiler, RETURN_ADDR, 0);
}
@@ -3776,8 +5209,8 @@ sljit_emit_fast_enter(compiler, RETURN_ADDR, 0);
OP2(SLJIT_SUB, STR_PTR, 0, STR_PTR, 0, TMP2, 0);
OP1(SLJIT_MOV, TMP3, 0, LCC_TABLE, 0);
-OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), LOCALS0, CHAR1, 0);
-OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), LOCALS1, CHAR2, 0);
+OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), LOCALS0, CHAR1, 0);
+OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), LOCALS1, CHAR2, 0);
OP1(SLJIT_MOV, LCC_TABLE, 0, SLJIT_IMM, common->lcc);
OP2(SLJIT_SUB, TMP1, 0, TMP1, 0, SLJIT_IMM, IN_UCHARS(1));
OP2(SLJIT_SUB, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
@@ -3786,26 +5219,26 @@ label = LABEL();
OP1(MOVU_UCHAR, CHAR1, 0, SLJIT_MEM1(TMP1), IN_UCHARS(1));
OP1(MOVU_UCHAR, CHAR2, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(1));
#ifndef COMPILE_PCRE8
-jump = CMP(SLJIT_C_GREATER, CHAR1, 0, SLJIT_IMM, 255);
+jump = CMP(SLJIT_GREATER, CHAR1, 0, SLJIT_IMM, 255);
#endif
-OP1(SLJIT_MOV_UB, CHAR1, 0, SLJIT_MEM2(LCC_TABLE, CHAR1), 0);
+OP1(SLJIT_MOV_U8, CHAR1, 0, SLJIT_MEM2(LCC_TABLE, CHAR1), 0);
#ifndef COMPILE_PCRE8
JUMPHERE(jump);
-jump = CMP(SLJIT_C_GREATER, CHAR2, 0, SLJIT_IMM, 255);
+jump = CMP(SLJIT_GREATER, CHAR2, 0, SLJIT_IMM, 255);
#endif
-OP1(SLJIT_MOV_UB, CHAR2, 0, SLJIT_MEM2(LCC_TABLE, CHAR2), 0);
+OP1(SLJIT_MOV_U8, CHAR2, 0, SLJIT_MEM2(LCC_TABLE, CHAR2), 0);
#ifndef COMPILE_PCRE8
JUMPHERE(jump);
#endif
-jump = CMP(SLJIT_C_NOT_EQUAL, CHAR1, 0, CHAR2, 0);
-OP2(SLJIT_SUB | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_IMM, IN_UCHARS(1));
-JUMPTO(SLJIT_C_NOT_ZERO, label);
+jump = CMP(SLJIT_NOT_EQUAL, CHAR1, 0, CHAR2, 0);
+OP2(SLJIT_SUB | SLJIT_SET_Z, TMP2, 0, TMP2, 0, SLJIT_IMM, IN_UCHARS(1));
+JUMPTO(SLJIT_NOT_ZERO, label);
JUMPHERE(jump);
OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
OP1(SLJIT_MOV, LCC_TABLE, 0, TMP3, 0);
-OP1(SLJIT_MOV, CHAR1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), LOCALS0);
-OP1(SLJIT_MOV, CHAR2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), LOCALS1);
+OP1(SLJIT_MOV, CHAR1, 0, SLJIT_MEM1(SLJIT_SP), LOCALS0);
+OP1(SLJIT_MOV, CHAR2, 0, SLJIT_MEM1(SLJIT_SP), LOCALS1);
sljit_emit_fast_return(compiler, RETURN_ADDR, 0);
}
@@ -3818,11 +5251,11 @@ sljit_emit_fast_return(compiler, RETURN_ADDR, 0);
static const pcre_uchar * SLJIT_CALL do_utf_caselesscmp(pcre_uchar *src1, jit_arguments *args, pcre_uchar *end1)
{
/* This function would be ineffective to do in JIT level. */
-pcre_uint32 c1, c2;
+sljit_u32 c1, c2;
const pcre_uchar *src2 = args->uchar_ptr;
const pcre_uchar *end2 = args->end;
const ucd_record *ur;
-const pcre_uint32 *pp;
+const sljit_u32 *pp;
while (src1 < end1)
{
@@ -3847,7 +5280,7 @@ return src2;
#endif /* SUPPORT_UTF && SUPPORT_UCP */
static pcre_uchar *byte_sequence_compare(compiler_common *common, BOOL caseless, pcre_uchar *cc,
- compare_context* context, jump_list **backtracks)
+ compare_context *context, jump_list **backtracks)
{
DEFINE_COMPILER;
unsigned int othercasebit = 0;
@@ -3882,16 +5315,16 @@ if (context->sourcereg == -1)
#if defined COMPILE_PCRE8
#if defined SLJIT_UNALIGNED && SLJIT_UNALIGNED
if (context->length >= 4)
- OP1(SLJIT_MOV_SI, TMP1, 0, SLJIT_MEM1(STR_PTR), -context->length);
+ OP1(SLJIT_MOV_S32, TMP1, 0, SLJIT_MEM1(STR_PTR), -context->length);
else if (context->length >= 2)
- OP1(SLJIT_MOV_UH, TMP1, 0, SLJIT_MEM1(STR_PTR), -context->length);
+ OP1(SLJIT_MOV_U16, TMP1, 0, SLJIT_MEM1(STR_PTR), -context->length);
else
#endif
- OP1(SLJIT_MOV_UB, TMP1, 0, SLJIT_MEM1(STR_PTR), -context->length);
+ OP1(SLJIT_MOV_U8, TMP1, 0, SLJIT_MEM1(STR_PTR), -context->length);
#elif defined COMPILE_PCRE16
#if defined SLJIT_UNALIGNED && SLJIT_UNALIGNED
if (context->length >= 4)
- OP1(SLJIT_MOV_SI, TMP1, 0, SLJIT_MEM1(STR_PTR), -context->length);
+ OP1(SLJIT_MOV_S32, TMP1, 0, SLJIT_MEM1(STR_PTR), -context->length);
else
#endif
OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), -context->length);
@@ -3933,12 +5366,12 @@ do
#endif
{
if (context->length >= 4)
- OP1(SLJIT_MOV_SI, context->sourcereg, 0, SLJIT_MEM1(STR_PTR), -context->length);
+ OP1(SLJIT_MOV_S32, context->sourcereg, 0, SLJIT_MEM1(STR_PTR), -context->length);
else if (context->length >= 2)
- OP1(SLJIT_MOV_UH, context->sourcereg, 0, SLJIT_MEM1(STR_PTR), -context->length);
+ OP1(SLJIT_MOV_U16, context->sourcereg, 0, SLJIT_MEM1(STR_PTR), -context->length);
#if defined COMPILE_PCRE8
else if (context->length >= 1)
- OP1(SLJIT_MOV_UB, context->sourcereg, 0, SLJIT_MEM1(STR_PTR), -context->length);
+ OP1(SLJIT_MOV_U8, context->sourcereg, 0, SLJIT_MEM1(STR_PTR), -context->length);
#endif /* COMPILE_PCRE8 */
context->sourcereg = context->sourcereg == TMP1 ? TMP2 : TMP1;
@@ -3947,25 +5380,25 @@ do
case 4 / sizeof(pcre_uchar):
if (context->oc.asint != 0)
OP2(SLJIT_OR, context->sourcereg, 0, context->sourcereg, 0, SLJIT_IMM, context->oc.asint);
- add_jump(compiler, backtracks, CMP(SLJIT_C_NOT_EQUAL, context->sourcereg, 0, SLJIT_IMM, context->c.asint | context->oc.asint));
+ add_jump(compiler, backtracks, CMP(SLJIT_NOT_EQUAL, context->sourcereg, 0, SLJIT_IMM, context->c.asint | context->oc.asint));
break;
case 2 / sizeof(pcre_uchar):
if (context->oc.asushort != 0)
OP2(SLJIT_OR, context->sourcereg, 0, context->sourcereg, 0, SLJIT_IMM, context->oc.asushort);
- add_jump(compiler, backtracks, CMP(SLJIT_C_NOT_EQUAL, context->sourcereg, 0, SLJIT_IMM, context->c.asushort | context->oc.asushort));
+ add_jump(compiler, backtracks, CMP(SLJIT_NOT_EQUAL, context->sourcereg, 0, SLJIT_IMM, context->c.asushort | context->oc.asushort));
break;
#ifdef COMPILE_PCRE8
case 1:
if (context->oc.asbyte != 0)
OP2(SLJIT_OR, context->sourcereg, 0, context->sourcereg, 0, SLJIT_IMM, context->oc.asbyte);
- add_jump(compiler, backtracks, CMP(SLJIT_C_NOT_EQUAL, context->sourcereg, 0, SLJIT_IMM, context->c.asbyte | context->oc.asbyte));
+ add_jump(compiler, backtracks, CMP(SLJIT_NOT_EQUAL, context->sourcereg, 0, SLJIT_IMM, context->c.asbyte | context->oc.asbyte));
break;
#endif
default:
- SLJIT_ASSERT_STOP();
+ SLJIT_UNREACHABLE();
break;
}
context->ucharptr = 0;
@@ -3982,10 +5415,10 @@ do
if (othercasebit != 0 && othercasechar == cc)
{
OP2(SLJIT_OR, context->sourcereg, 0, context->sourcereg, 0, SLJIT_IMM, othercasebit);
- add_jump(compiler, backtracks, CMP(SLJIT_C_NOT_EQUAL, context->sourcereg, 0, SLJIT_IMM, *cc | othercasebit));
+ add_jump(compiler, backtracks, CMP(SLJIT_NOT_EQUAL, context->sourcereg, 0, SLJIT_IMM, *cc | othercasebit));
}
else
- add_jump(compiler, backtracks, CMP(SLJIT_C_NOT_EQUAL, context->sourcereg, 0, SLJIT_IMM, *cc));
+ add_jump(compiler, backtracks, CMP(SLJIT_NOT_EQUAL, context->sourcereg, 0, SLJIT_IMM, *cc));
#endif
@@ -4004,104 +5437,76 @@ return cc;
#define SET_TYPE_OFFSET(value) \
if ((value) != typeoffset) \
{ \
- if ((value) > typeoffset) \
- OP2(SLJIT_SUB, typereg, 0, typereg, 0, SLJIT_IMM, (value) - typeoffset); \
- else \
+ if ((value) < typeoffset) \
OP2(SLJIT_ADD, typereg, 0, typereg, 0, SLJIT_IMM, typeoffset - (value)); \
+ else \
+ OP2(SLJIT_SUB, typereg, 0, typereg, 0, SLJIT_IMM, (value) - typeoffset); \
} \
typeoffset = (value);
#define SET_CHAR_OFFSET(value) \
if ((value) != charoffset) \
{ \
- if ((value) > charoffset) \
- OP2(SLJIT_SUB, TMP1, 0, TMP1, 0, SLJIT_IMM, (value) - charoffset); \
+ if ((value) < charoffset) \
+ OP2(SLJIT_ADD, TMP1, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(charoffset - (value))); \
else \
- OP2(SLJIT_ADD, TMP1, 0, TMP1, 0, SLJIT_IMM, charoffset - (value)); \
+ OP2(SLJIT_SUB, TMP1, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)((value) - charoffset)); \
} \
charoffset = (value);
+static pcre_uchar *compile_char1_matchingpath(compiler_common *common, pcre_uchar type, pcre_uchar *cc, jump_list **backtracks, BOOL check_str_ptr);
+
static void compile_xclass_matchingpath(compiler_common *common, pcre_uchar *cc, jump_list **backtracks)
{
DEFINE_COMPILER;
jump_list *found = NULL;
-jump_list **list = (*cc & XCL_NOT) == 0 ? &found : backtracks;
-pcre_int32 c, charoffset;
-const pcre_uint32 *other_cases;
+jump_list **list = (cc[0] & XCL_NOT) == 0 ? &found : backtracks;
+sljit_uw c, charoffset, max = 256, min = READ_CHAR_MAX;
struct sljit_jump *jump = NULL;
pcre_uchar *ccbegin;
int compares, invertcmp, numberofcmps;
+#if defined SUPPORT_UTF && (defined COMPILE_PCRE8 || defined COMPILE_PCRE16)
+BOOL utf = common->utf;
+#endif
+
#ifdef SUPPORT_UCP
BOOL needstype = FALSE, needsscript = FALSE, needschar = FALSE;
BOOL charsaved = FALSE;
-int typereg = TMP1, scriptreg = TMP1;
-pcre_int32 typeoffset;
+int typereg = TMP1;
+const sljit_u32 *other_cases;
+sljit_uw typeoffset;
#endif
-/* Although SUPPORT_UTF must be defined, we are
- not necessary in utf mode even in 8 bit mode. */
-detect_partial_match(common, backtracks);
-read_char(common);
-
-if ((*cc++ & XCL_MAP) != 0)
+/* Scanning the necessary info. */
+cc++;
+ccbegin = cc;
+compares = 0;
+if (cc[-1] & XCL_MAP)
{
- OP1(SLJIT_MOV, TMP3, 0, TMP1, 0);
-#ifndef COMPILE_PCRE8
- jump = CMP(SLJIT_C_GREATER, TMP1, 0, SLJIT_IMM, 255);
-#elif defined SUPPORT_UTF
- if (common->utf)
- jump = CMP(SLJIT_C_GREATER, TMP1, 0, SLJIT_IMM, 255);
-#endif
-
- if (!check_class_ranges(common, (const pcre_uint8 *)cc, TRUE, list))
- {
- OP2(SLJIT_AND, TMP2, 0, TMP1, 0, SLJIT_IMM, 0x7);
- OP2(SLJIT_LSHR, TMP1, 0, TMP1, 0, SLJIT_IMM, 3);
- OP1(SLJIT_MOV_UB, TMP1, 0, SLJIT_MEM1(TMP1), (sljit_sw)cc);
- OP2(SLJIT_SHL, TMP2, 0, SLJIT_IMM, 1, TMP2, 0);
- OP2(SLJIT_AND | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, TMP2, 0);
- add_jump(compiler, list, JUMP(SLJIT_C_NOT_ZERO));
- }
-
-#ifndef COMPILE_PCRE8
- JUMPHERE(jump);
-#elif defined SUPPORT_UTF
- if (common->utf)
- JUMPHERE(jump);
-#endif
- OP1(SLJIT_MOV, TMP1, 0, TMP3, 0);
-#ifdef SUPPORT_UCP
- charsaved = TRUE;
-#endif
+ min = 0;
cc += 32 / sizeof(pcre_uchar);
}
-/* Scanning the necessary info. */
-ccbegin = cc;
-compares = 0;
while (*cc != XCL_END)
{
compares++;
if (*cc == XCL_SINGLE)
{
- cc += 2;
-#ifdef SUPPORT_UTF
- if (common->utf && HAS_EXTRALEN(cc[-1])) cc += GET_EXTRALEN(cc[-1]);
-#endif
+ cc ++;
+ GETCHARINCTEST(c, cc);
+ if (c > max) max = c;
+ if (c < min) min = c;
#ifdef SUPPORT_UCP
needschar = TRUE;
#endif
}
else if (*cc == XCL_RANGE)
{
- cc += 2;
-#ifdef SUPPORT_UTF
- if (common->utf && HAS_EXTRALEN(cc[-1])) cc += GET_EXTRALEN(cc[-1]);
-#endif
- cc++;
-#ifdef SUPPORT_UTF
- if (common->utf && HAS_EXTRALEN(cc[-1])) cc += GET_EXTRALEN(cc[-1]);
-#endif
+ cc ++;
+ GETCHARINCTEST(c, cc);
+ if (c < min) min = c;
+ GETCHARINCTEST(c, cc);
+ if (c > max) max = c;
#ifdef SUPPORT_UCP
needschar = TRUE;
#endif
@@ -4111,9 +5516,33 @@ while (*cc != XCL_END)
{
SLJIT_ASSERT(*cc == XCL_PROP || *cc == XCL_NOTPROP);
cc++;
+ if (*cc == PT_CLIST)
+ {
+ other_cases = PRIV(ucd_caseless_sets) + cc[1];
+ while (*other_cases != NOTACHAR)
+ {
+ if (*other_cases > max) max = *other_cases;
+ if (*other_cases < min) min = *other_cases;
+ other_cases++;
+ }
+ }
+ else
+ {
+ max = READ_CHAR_MAX;
+ min = 0;
+ }
+
switch(*cc)
{
case PT_ANY:
+ /* Any either accepts everything or ignored. */
+ if (cc[-1] == XCL_PROP)
+ {
+ compile_char1_matchingpath(common, OP_ALLANY, cc, backtracks, FALSE);
+ if (list == backtracks)
+ add_jump(compiler, backtracks, JUMP(SLJIT_JUMP));
+ return;
+ }
break;
case PT_LAMP:
@@ -4130,6 +5559,9 @@ while (*cc != XCL_END)
case PT_SPACE:
case PT_PXSPACE:
case PT_WORD:
+ case PT_PXGRAPH:
+ case PT_PXPRINT:
+ case PT_PXPUNCT:
needstype = TRUE;
needschar = TRUE;
break;
@@ -4140,56 +5572,163 @@ while (*cc != XCL_END)
break;
default:
- SLJIT_ASSERT_STOP();
+ SLJIT_UNREACHABLE();
break;
}
cc += 2;
}
#endif
}
+SLJIT_ASSERT(compares > 0);
+
+/* We are not necessary in utf mode even in 8 bit mode. */
+cc = ccbegin;
+read_char_range(common, min, max, (cc[-1] & XCL_NOT) != 0);
+
+if ((cc[-1] & XCL_HASPROP) == 0)
+ {
+ if ((cc[-1] & XCL_MAP) != 0)
+ {
+ jump = CMP(SLJIT_GREATER, TMP1, 0, SLJIT_IMM, 255);
+ if (!check_class_ranges(common, (const sljit_u8 *)cc, (((const sljit_u8 *)cc)[31] & 0x80) != 0, TRUE, &found))
+ {
+ OP2(SLJIT_AND, TMP2, 0, TMP1, 0, SLJIT_IMM, 0x7);
+ OP2(SLJIT_LSHR, TMP1, 0, TMP1, 0, SLJIT_IMM, 3);
+ OP1(SLJIT_MOV_U8, TMP1, 0, SLJIT_MEM1(TMP1), (sljit_sw)cc);
+ OP2(SLJIT_SHL, TMP2, 0, SLJIT_IMM, 1, TMP2, 0);
+ OP2(SLJIT_AND | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, TMP2, 0);
+ add_jump(compiler, &found, JUMP(SLJIT_NOT_ZERO));
+ }
+
+ add_jump(compiler, backtracks, JUMP(SLJIT_JUMP));
+ JUMPHERE(jump);
+
+ cc += 32 / sizeof(pcre_uchar);
+ }
+ else
+ {
+ OP2(SLJIT_SUB, TMP2, 0, TMP1, 0, SLJIT_IMM, min);
+ add_jump(compiler, (cc[-1] & XCL_NOT) == 0 ? backtracks : &found, CMP(SLJIT_GREATER, TMP2, 0, SLJIT_IMM, max - min));
+ }
+ }
+else if ((cc[-1] & XCL_MAP) != 0)
+ {
+ OP1(SLJIT_MOV, RETURN_ADDR, 0, TMP1, 0);
+#ifdef SUPPORT_UCP
+ charsaved = TRUE;
+#endif
+ if (!check_class_ranges(common, (const sljit_u8 *)cc, FALSE, TRUE, list))
+ {
+#ifdef COMPILE_PCRE8
+ jump = NULL;
+ if (common->utf)
+#endif
+ jump = CMP(SLJIT_GREATER, TMP1, 0, SLJIT_IMM, 255);
+
+ OP2(SLJIT_AND, TMP2, 0, TMP1, 0, SLJIT_IMM, 0x7);
+ OP2(SLJIT_LSHR, TMP1, 0, TMP1, 0, SLJIT_IMM, 3);
+ OP1(SLJIT_MOV_U8, TMP1, 0, SLJIT_MEM1(TMP1), (sljit_sw)cc);
+ OP2(SLJIT_SHL, TMP2, 0, SLJIT_IMM, 1, TMP2, 0);
+ OP2(SLJIT_AND | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, TMP2, 0);
+ add_jump(compiler, list, JUMP(SLJIT_NOT_ZERO));
+
+#ifdef COMPILE_PCRE8
+ if (common->utf)
+#endif
+ JUMPHERE(jump);
+ }
+
+ OP1(SLJIT_MOV, TMP1, 0, RETURN_ADDR, 0);
+ cc += 32 / sizeof(pcre_uchar);
+ }
#ifdef SUPPORT_UCP
-/* Simple register allocation. TMP1 is preferred if possible. */
if (needstype || needsscript)
{
if (needschar && !charsaved)
- OP1(SLJIT_MOV, TMP3, 0, TMP1, 0);
- add_jump(compiler, &common->getucd, JUMP(SLJIT_FAST_CALL));
- if (needschar)
+ OP1(SLJIT_MOV, RETURN_ADDR, 0, TMP1, 0);
+
+#ifdef COMPILE_PCRE32
+ if (!common->utf)
+ {
+ jump = CMP(SLJIT_LESS, TMP1, 0, SLJIT_IMM, 0x10ffff + 1);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_IMM, INVALID_UTF_CHAR);
+ JUMPHERE(jump);
+ }
+#endif
+
+ OP2(SLJIT_LSHR, TMP2, 0, TMP1, 0, SLJIT_IMM, UCD_BLOCK_SHIFT);
+ OP1(SLJIT_MOV_U8, TMP2, 0, SLJIT_MEM1(TMP2), (sljit_sw)PRIV(ucd_stage1));
+ OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, UCD_BLOCK_MASK);
+ OP2(SLJIT_SHL, TMP2, 0, TMP2, 0, SLJIT_IMM, UCD_BLOCK_SHIFT);
+ OP2(SLJIT_ADD, TMP1, 0, TMP1, 0, TMP2, 0);
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_IMM, (sljit_sw)PRIV(ucd_stage2));
+ OP1(SLJIT_MOV_U16, TMP2, 0, SLJIT_MEM2(TMP2, TMP1), 1);
+
+ /* Before anything else, we deal with scripts. */
+ if (needsscript)
{
- if (needstype)
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_IMM, (sljit_sw)PRIV(ucd_records) + SLJIT_OFFSETOF(ucd_record, script));
+ OP1(SLJIT_MOV_U8, TMP1, 0, SLJIT_MEM2(TMP1, TMP2), 3);
+
+ ccbegin = cc;
+
+ while (*cc != XCL_END)
{
- OP1(SLJIT_MOV, RETURN_ADDR, 0, TMP1, 0);
- typereg = RETURN_ADDR;
+ if (*cc == XCL_SINGLE)
+ {
+ cc ++;
+ GETCHARINCTEST(c, cc);
+ }
+ else if (*cc == XCL_RANGE)
+ {
+ cc ++;
+ GETCHARINCTEST(c, cc);
+ GETCHARINCTEST(c, cc);
+ }
+ else
+ {
+ SLJIT_ASSERT(*cc == XCL_PROP || *cc == XCL_NOTPROP);
+ cc++;
+ if (*cc == PT_SC)
+ {
+ compares--;
+ invertcmp = (compares == 0 && list != backtracks);
+ if (cc[-1] == XCL_NOTPROP)
+ invertcmp ^= 0x1;
+ jump = CMP(SLJIT_EQUAL ^ invertcmp, TMP1, 0, SLJIT_IMM, (int)cc[1]);
+ add_jump(compiler, compares > 0 ? list : backtracks, jump);
+ }
+ cc += 2;
+ }
}
- if (needsscript)
- scriptreg = TMP3;
- OP1(SLJIT_MOV, TMP1, 0, TMP3, 0);
+ cc = ccbegin;
}
- else if (needstype && needsscript)
- scriptreg = TMP3;
- /* In all other cases only one of them was specified, and that can goes to TMP1. */
- if (needsscript)
+ if (needschar)
{
- if (scriptreg == TMP1)
+ OP1(SLJIT_MOV, TMP1, 0, RETURN_ADDR, 0);
+ }
+
+ if (needstype)
+ {
+ if (!needschar)
{
- OP1(SLJIT_MOV, scriptreg, 0, SLJIT_IMM, (sljit_sw)PRIV(ucd_records) + SLJIT_OFFSETOF(ucd_record, script));
- OP1(SLJIT_MOV_UB, scriptreg, 0, SLJIT_MEM2(scriptreg, TMP2), 3);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_IMM, (sljit_sw)PRIV(ucd_records) + SLJIT_OFFSETOF(ucd_record, chartype));
+ OP1(SLJIT_MOV_U8, TMP1, 0, SLJIT_MEM2(TMP1, TMP2), 3);
}
else
{
OP2(SLJIT_SHL, TMP2, 0, TMP2, 0, SLJIT_IMM, 3);
- OP2(SLJIT_ADD, TMP2, 0, TMP2, 0, SLJIT_IMM, (sljit_sw)PRIV(ucd_records) + SLJIT_OFFSETOF(ucd_record, script));
- OP1(SLJIT_MOV_UB, scriptreg, 0, SLJIT_MEM1(TMP2), 0);
+ OP1(SLJIT_MOV_U8, RETURN_ADDR, 0, SLJIT_MEM1(TMP2), (sljit_sw)PRIV(ucd_records) + SLJIT_OFFSETOF(ucd_record, chartype));
+ typereg = RETURN_ADDR;
}
}
}
#endif
/* Generating code. */
-cc = ccbegin;
charoffset = 0;
numberofcmps = 0;
#ifdef SUPPORT_UCP
@@ -4205,148 +5744,123 @@ while (*cc != XCL_END)
if (*cc == XCL_SINGLE)
{
cc ++;
-#ifdef SUPPORT_UTF
- if (common->utf)
- {
- GETCHARINC(c, cc);
- }
- else
-#endif
- c = *cc++;
+ GETCHARINCTEST(c, cc);
if (numberofcmps < 3 && (*cc == XCL_SINGLE || *cc == XCL_RANGE))
{
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, c - charoffset);
- OP_FLAGS(numberofcmps == 0 ? SLJIT_MOV : SLJIT_OR, TMP2, 0, numberofcmps == 0 ? SLJIT_UNUSED : TMP2, 0, SLJIT_C_EQUAL);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(c - charoffset));
+ OP_FLAGS(numberofcmps == 0 ? SLJIT_MOV : SLJIT_OR, TMP2, 0, SLJIT_EQUAL);
numberofcmps++;
}
else if (numberofcmps > 0)
{
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, c - charoffset);
- OP_FLAGS(SLJIT_OR | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_C_EQUAL);
- jump = JUMP(SLJIT_C_NOT_ZERO ^ invertcmp);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(c - charoffset));
+ OP_FLAGS(SLJIT_OR | SLJIT_SET_Z, TMP2, 0, SLJIT_EQUAL);
+ jump = JUMP(SLJIT_NOT_ZERO ^ invertcmp);
numberofcmps = 0;
}
else
{
- jump = CMP(SLJIT_C_EQUAL ^ invertcmp, TMP1, 0, SLJIT_IMM, c - charoffset);
+ jump = CMP(SLJIT_EQUAL ^ invertcmp, TMP1, 0, SLJIT_IMM, (sljit_sw)(c - charoffset));
numberofcmps = 0;
}
}
else if (*cc == XCL_RANGE)
{
cc ++;
-#ifdef SUPPORT_UTF
- if (common->utf)
- {
- GETCHARINC(c, cc);
- }
- else
-#endif
- c = *cc++;
+ GETCHARINCTEST(c, cc);
SET_CHAR_OFFSET(c);
-#ifdef SUPPORT_UTF
- if (common->utf)
- {
- GETCHARINC(c, cc);
- }
- else
-#endif
- c = *cc++;
+ GETCHARINCTEST(c, cc);
+
if (numberofcmps < 3 && (*cc == XCL_SINGLE || *cc == XCL_RANGE))
{
- OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, c - charoffset);
- OP_FLAGS(numberofcmps == 0 ? SLJIT_MOV : SLJIT_OR, TMP2, 0, numberofcmps == 0 ? SLJIT_UNUSED : TMP2, 0, SLJIT_C_LESS_EQUAL);
+ OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(c - charoffset));
+ OP_FLAGS(numberofcmps == 0 ? SLJIT_MOV : SLJIT_OR, TMP2, 0, SLJIT_LESS_EQUAL);
numberofcmps++;
}
else if (numberofcmps > 0)
{
- OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, c - charoffset);
- OP_FLAGS(SLJIT_OR | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_C_LESS_EQUAL);
- jump = JUMP(SLJIT_C_NOT_ZERO ^ invertcmp);
+ OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(c - charoffset));
+ OP_FLAGS(SLJIT_OR | SLJIT_SET_Z, TMP2, 0, SLJIT_LESS_EQUAL);
+ jump = JUMP(SLJIT_NOT_ZERO ^ invertcmp);
numberofcmps = 0;
}
else
{
- jump = CMP(SLJIT_C_LESS_EQUAL ^ invertcmp, TMP1, 0, SLJIT_IMM, c - charoffset);
+ jump = CMP(SLJIT_LESS_EQUAL ^ invertcmp, TMP1, 0, SLJIT_IMM, (sljit_sw)(c - charoffset));
numberofcmps = 0;
}
}
#ifdef SUPPORT_UCP
else
{
+ SLJIT_ASSERT(*cc == XCL_PROP || *cc == XCL_NOTPROP);
if (*cc == XCL_NOTPROP)
invertcmp ^= 0x1;
cc++;
switch(*cc)
{
case PT_ANY:
- if (list != backtracks)
- {
- if ((cc[-1] == XCL_NOTPROP && compares > 0) || (cc[-1] == XCL_PROP && compares == 0))
- continue;
- }
- else if (cc[-1] == XCL_NOTPROP)
- continue;
- jump = JUMP(SLJIT_JUMP);
+ if (!invertcmp)
+ jump = JUMP(SLJIT_JUMP);
break;
case PT_LAMP:
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_Lu - typeoffset);
- OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_C_EQUAL);
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_Ll - typeoffset);
- OP_FLAGS(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_C_EQUAL);
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_Lt - typeoffset);
- OP_FLAGS(SLJIT_OR | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_C_EQUAL);
- jump = JUMP(SLJIT_C_NOT_ZERO ^ invertcmp);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_Lu - typeoffset);
+ OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_EQUAL);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_Ll - typeoffset);
+ OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_EQUAL);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_Lt - typeoffset);
+ OP_FLAGS(SLJIT_OR | SLJIT_SET_Z, TMP2, 0, SLJIT_EQUAL);
+ jump = JUMP(SLJIT_NOT_ZERO ^ invertcmp);
break;
case PT_GC:
c = PRIV(ucp_typerange)[(int)cc[1] * 2];
SET_TYPE_OFFSET(c);
- jump = CMP(SLJIT_C_LESS_EQUAL ^ invertcmp, typereg, 0, SLJIT_IMM, PRIV(ucp_typerange)[(int)cc[1] * 2 + 1] - c);
+ jump = CMP(SLJIT_LESS_EQUAL ^ invertcmp, typereg, 0, SLJIT_IMM, PRIV(ucp_typerange)[(int)cc[1] * 2 + 1] - c);
break;
case PT_PC:
- jump = CMP(SLJIT_C_EQUAL ^ invertcmp, typereg, 0, SLJIT_IMM, (int)cc[1] - typeoffset);
+ jump = CMP(SLJIT_EQUAL ^ invertcmp, typereg, 0, SLJIT_IMM, (int)cc[1] - typeoffset);
break;
case PT_SC:
- jump = CMP(SLJIT_C_EQUAL ^ invertcmp, scriptreg, 0, SLJIT_IMM, (int)cc[1]);
+ compares++;
+ /* Do nothing. */
break;
case PT_SPACE:
case PT_PXSPACE:
- if (*cc == PT_SPACE)
- {
- OP1(SLJIT_MOV, TMP2, 0, SLJIT_IMM, 0);
- jump = CMP(SLJIT_C_EQUAL, TMP1, 0, SLJIT_IMM, 11 - charoffset);
- }
SET_CHAR_OFFSET(9);
- OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 13 - 9);
- OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_C_LESS_EQUAL);
- if (*cc == PT_SPACE)
- JUMPHERE(jump);
+ OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0xd - 0x9);
+ OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_LESS_EQUAL);
+
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x85 - 0x9);
+ OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_EQUAL);
+
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x180e - 0x9);
+ OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_EQUAL);
SET_TYPE_OFFSET(ucp_Zl);
- OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_Zs - ucp_Zl);
- OP_FLAGS(SLJIT_OR | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_C_LESS_EQUAL);
- jump = JUMP(SLJIT_C_NOT_ZERO ^ invertcmp);
+ OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_Zs - ucp_Zl);
+ OP_FLAGS(SLJIT_OR | SLJIT_SET_Z, TMP2, 0, SLJIT_LESS_EQUAL);
+ jump = JUMP(SLJIT_NOT_ZERO ^ invertcmp);
break;
case PT_WORD:
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, CHAR_UNDERSCORE - charoffset);
- OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_C_EQUAL);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(CHAR_UNDERSCORE - charoffset));
+ OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_EQUAL);
/* Fall through. */
case PT_ALNUM:
SET_TYPE_OFFSET(ucp_Ll);
- OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_Lu - ucp_Ll);
- OP_FLAGS((*cc == PT_ALNUM) ? SLJIT_MOV : SLJIT_OR, TMP2, 0, (*cc == PT_ALNUM) ? SLJIT_UNUSED : TMP2, 0, SLJIT_C_LESS_EQUAL);
+ OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_Lu - ucp_Ll);
+ OP_FLAGS((*cc == PT_ALNUM) ? SLJIT_MOV : SLJIT_OR, TMP2, 0, SLJIT_LESS_EQUAL);
SET_TYPE_OFFSET(ucp_Nd);
- OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_No - ucp_Nd);
- OP_FLAGS(SLJIT_OR | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_C_LESS_EQUAL);
- jump = JUMP(SLJIT_C_NOT_ZERO ^ invertcmp);
+ OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_No - ucp_Nd);
+ OP_FLAGS(SLJIT_OR | SLJIT_SET_Z, TMP2, 0, SLJIT_LESS_EQUAL);
+ jump = JUMP(SLJIT_NOT_ZERO ^ invertcmp);
break;
case PT_CLIST:
@@ -4367,8 +5881,8 @@ while (*cc != XCL_END)
OP2(SLJIT_ADD, TMP2, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)charoffset);
OP2(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_IMM, other_cases[1] ^ other_cases[0]);
}
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP2, 0, SLJIT_IMM, other_cases[1]);
- OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_C_EQUAL);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP2, 0, SLJIT_IMM, other_cases[1]);
+ OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_EQUAL);
other_cases += 2;
}
else if (is_powerof2(other_cases[2] ^ other_cases[1]))
@@ -4380,43 +5894,108 @@ while (*cc != XCL_END)
OP2(SLJIT_ADD, TMP2, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)charoffset);
OP2(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_IMM, other_cases[1] ^ other_cases[0]);
}
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP2, 0, SLJIT_IMM, other_cases[2]);
- OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_C_EQUAL);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP2, 0, SLJIT_IMM, other_cases[2]);
+ OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_EQUAL);
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, other_cases[0] - charoffset);
- OP_FLAGS(SLJIT_OR | ((other_cases[3] == NOTACHAR) ? SLJIT_SET_E : 0), TMP2, 0, TMP2, 0, SLJIT_C_EQUAL);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(other_cases[0] - charoffset));
+ OP_FLAGS(SLJIT_OR | ((other_cases[3] == NOTACHAR) ? SLJIT_SET_Z : 0), TMP2, 0, SLJIT_EQUAL);
other_cases += 3;
}
else
{
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, *other_cases++ - charoffset);
- OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_C_EQUAL);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(*other_cases++ - charoffset));
+ OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_EQUAL);
}
while (*other_cases != NOTACHAR)
{
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, *other_cases++ - charoffset);
- OP_FLAGS(SLJIT_OR | ((*other_cases == NOTACHAR) ? SLJIT_SET_E : 0), TMP2, 0, TMP2, 0, SLJIT_C_EQUAL);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(*other_cases++ - charoffset));
+ OP_FLAGS(SLJIT_OR | ((*other_cases == NOTACHAR) ? SLJIT_SET_Z : 0), TMP2, 0, SLJIT_EQUAL);
}
- jump = JUMP(SLJIT_C_NOT_ZERO ^ invertcmp);
+ jump = JUMP(SLJIT_NOT_ZERO ^ invertcmp);
break;
case PT_UCNC:
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, CHAR_DOLLAR_SIGN - charoffset);
- OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_C_EQUAL);
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, CHAR_COMMERCIAL_AT - charoffset);
- OP_FLAGS(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_C_EQUAL);
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, CHAR_GRAVE_ACCENT - charoffset);
- OP_FLAGS(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_C_EQUAL);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(CHAR_DOLLAR_SIGN - charoffset));
+ OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_EQUAL);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(CHAR_COMMERCIAL_AT - charoffset));
+ OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_EQUAL);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(CHAR_GRAVE_ACCENT - charoffset));
+ OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_EQUAL);
SET_CHAR_OFFSET(0xa0);
- OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0xd7ff - charoffset);
- OP_FLAGS(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_C_LESS_EQUAL);
+ OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(0xd7ff - charoffset));
+ OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_LESS_EQUAL);
+ SET_CHAR_OFFSET(0);
+ OP2(SLJIT_SUB | SLJIT_SET_GREATER_EQUAL, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0xe000 - 0);
+ OP_FLAGS(SLJIT_OR | SLJIT_SET_Z, TMP2, 0, SLJIT_GREATER_EQUAL);
+ jump = JUMP(SLJIT_NOT_ZERO ^ invertcmp);
+ break;
+
+ case PT_PXGRAPH:
+ /* C and Z groups are the farthest two groups. */
+ SET_TYPE_OFFSET(ucp_Ll);
+ OP2(SLJIT_SUB | SLJIT_SET_GREATER, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_So - ucp_Ll);
+ OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_GREATER);
+
+ jump = CMP(SLJIT_NOT_EQUAL, typereg, 0, SLJIT_IMM, ucp_Cf - ucp_Ll);
+
+ /* In case of ucp_Cf, we overwrite the result. */
+ SET_CHAR_OFFSET(0x2066);
+ OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x2069 - 0x2066);
+ OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_LESS_EQUAL);
+
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x061c - 0x2066);
+ OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_EQUAL);
+
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x180e - 0x2066);
+ OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_EQUAL);
+
+ JUMPHERE(jump);
+ jump = CMP(SLJIT_ZERO ^ invertcmp, TMP2, 0, SLJIT_IMM, 0);
+ break;
+
+ case PT_PXPRINT:
+ /* C and Z groups are the farthest two groups. */
+ SET_TYPE_OFFSET(ucp_Ll);
+ OP2(SLJIT_SUB | SLJIT_SET_GREATER, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_So - ucp_Ll);
+ OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_GREATER);
+
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_Zs - ucp_Ll);
+ OP_FLAGS(SLJIT_AND, TMP2, 0, SLJIT_NOT_EQUAL);
+
+ jump = CMP(SLJIT_NOT_EQUAL, typereg, 0, SLJIT_IMM, ucp_Cf - ucp_Ll);
+
+ /* In case of ucp_Cf, we overwrite the result. */
+ SET_CHAR_OFFSET(0x2066);
+ OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x2069 - 0x2066);
+ OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_LESS_EQUAL);
+
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x061c - 0x2066);
+ OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_EQUAL);
+
+ JUMPHERE(jump);
+ jump = CMP(SLJIT_ZERO ^ invertcmp, TMP2, 0, SLJIT_IMM, 0);
+ break;
+
+ case PT_PXPUNCT:
+ SET_TYPE_OFFSET(ucp_Sc);
+ OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_So - ucp_Sc);
+ OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_LESS_EQUAL);
+
SET_CHAR_OFFSET(0);
- OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0xe000 - 0);
- OP_FLAGS(SLJIT_OR | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_C_GREATER_EQUAL);
- jump = JUMP(SLJIT_C_NOT_ZERO ^ invertcmp);
+ OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x7f);
+ OP_FLAGS(SLJIT_AND, TMP2, 0, SLJIT_LESS_EQUAL);
+
+ SET_TYPE_OFFSET(ucp_Pc);
+ OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_Ps - ucp_Pc);
+ OP_FLAGS(SLJIT_OR | SLJIT_SET_Z, TMP2, 0, SLJIT_LESS_EQUAL);
+ jump = JUMP(SLJIT_NOT_ZERO ^ invertcmp);
+ break;
+
+ default:
+ SLJIT_UNREACHABLE();
break;
}
cc += 2;
@@ -4436,90 +6015,303 @@ if (found != NULL)
#endif
-static pcre_uchar *compile_char1_matchingpath(compiler_common *common, pcre_uchar type, pcre_uchar *cc, jump_list **backtracks)
+static pcre_uchar *compile_simple_assertion_matchingpath(compiler_common *common, pcre_uchar type, pcre_uchar *cc, jump_list **backtracks)
{
DEFINE_COMPILER;
int length;
-unsigned int c, oc, bit;
-compare_context context;
struct sljit_jump *jump[4];
-jump_list *end_list;
#ifdef SUPPORT_UTF
struct sljit_label *label;
-#ifdef SUPPORT_UCP
-pcre_uchar propdata[5];
-#endif
-#endif
+#endif /* SUPPORT_UTF */
switch(type)
{
case OP_SOD:
OP1(SLJIT_MOV, TMP1, 0, ARGUMENTS, 0);
OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, begin));
- add_jump(compiler, backtracks, CMP(SLJIT_C_NOT_EQUAL, STR_PTR, 0, TMP1, 0));
+ add_jump(compiler, backtracks, CMP(SLJIT_NOT_EQUAL, STR_PTR, 0, TMP1, 0));
return cc;
case OP_SOM:
OP1(SLJIT_MOV, TMP1, 0, ARGUMENTS, 0);
OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, str));
- add_jump(compiler, backtracks, CMP(SLJIT_C_NOT_EQUAL, STR_PTR, 0, TMP1, 0));
+ add_jump(compiler, backtracks, CMP(SLJIT_NOT_EQUAL, STR_PTR, 0, TMP1, 0));
return cc;
case OP_NOT_WORD_BOUNDARY:
case OP_WORD_BOUNDARY:
add_jump(compiler, &common->wordboundary, JUMP(SLJIT_FAST_CALL));
- add_jump(compiler, backtracks, JUMP(type == OP_NOT_WORD_BOUNDARY ? SLJIT_C_NOT_ZERO : SLJIT_C_ZERO));
+ sljit_set_current_flags(compiler, SLJIT_SET_Z);
+ add_jump(compiler, backtracks, JUMP(type == OP_NOT_WORD_BOUNDARY ? SLJIT_NOT_ZERO : SLJIT_ZERO));
+ return cc;
+
+ case OP_EODN:
+ /* Requires rather complex checks. */
+ jump[0] = CMP(SLJIT_GREATER_EQUAL, STR_PTR, 0, STR_END, 0);
+ if (common->nltype == NLTYPE_FIXED && common->newline > 255)
+ {
+ OP2(SLJIT_ADD, TMP2, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(2));
+ OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(0));
+ if (common->mode == JIT_COMPILE)
+ add_jump(compiler, backtracks, CMP(SLJIT_NOT_EQUAL, TMP2, 0, STR_END, 0));
+ else
+ {
+ jump[1] = CMP(SLJIT_EQUAL, TMP2, 0, STR_END, 0);
+ OP2(SLJIT_SUB | SLJIT_SET_LESS, SLJIT_UNUSED, 0, TMP2, 0, STR_END, 0);
+ OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_LESS);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (common->newline >> 8) & 0xff);
+ OP_FLAGS(SLJIT_OR | SLJIT_SET_Z, TMP2, 0, SLJIT_NOT_EQUAL);
+ add_jump(compiler, backtracks, JUMP(SLJIT_NOT_EQUAL));
+ check_partial(common, TRUE);
+ add_jump(compiler, backtracks, JUMP(SLJIT_JUMP));
+ JUMPHERE(jump[1]);
+ }
+ OP1(MOV_UCHAR, TMP2, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(1));
+ add_jump(compiler, backtracks, CMP(SLJIT_NOT_EQUAL, TMP1, 0, SLJIT_IMM, (common->newline >> 8) & 0xff));
+ add_jump(compiler, backtracks, CMP(SLJIT_NOT_EQUAL, TMP2, 0, SLJIT_IMM, common->newline & 0xff));
+ }
+ else if (common->nltype == NLTYPE_FIXED)
+ {
+ OP2(SLJIT_ADD, TMP2, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
+ OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(0));
+ add_jump(compiler, backtracks, CMP(SLJIT_NOT_EQUAL, TMP2, 0, STR_END, 0));
+ add_jump(compiler, backtracks, CMP(SLJIT_NOT_EQUAL, TMP1, 0, SLJIT_IMM, common->newline));
+ }
+ else
+ {
+ OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(0));
+ jump[1] = CMP(SLJIT_NOT_EQUAL, TMP1, 0, SLJIT_IMM, CHAR_CR);
+ OP2(SLJIT_ADD, TMP2, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(2));
+ OP2(SLJIT_SUB | SLJIT_SET_Z | SLJIT_SET_GREATER, SLJIT_UNUSED, 0, TMP2, 0, STR_END, 0);
+ jump[2] = JUMP(SLJIT_GREATER);
+ add_jump(compiler, backtracks, JUMP(SLJIT_NOT_EQUAL) /* LESS */);
+ /* Equal. */
+ OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(1));
+ jump[3] = CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, CHAR_NL);
+ add_jump(compiler, backtracks, JUMP(SLJIT_JUMP));
+
+ JUMPHERE(jump[1]);
+ if (common->nltype == NLTYPE_ANYCRLF)
+ {
+ OP2(SLJIT_ADD, TMP2, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
+ add_jump(compiler, backtracks, CMP(SLJIT_LESS, TMP2, 0, STR_END, 0));
+ add_jump(compiler, backtracks, CMP(SLJIT_NOT_EQUAL, TMP1, 0, SLJIT_IMM, CHAR_NL));
+ }
+ else
+ {
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), LOCALS1, STR_PTR, 0);
+ read_char_range(common, common->nlmin, common->nlmax, TRUE);
+ add_jump(compiler, backtracks, CMP(SLJIT_NOT_EQUAL, STR_PTR, 0, STR_END, 0));
+ add_jump(compiler, &common->anynewline, JUMP(SLJIT_FAST_CALL));
+ sljit_set_current_flags(compiler, SLJIT_SET_Z);
+ add_jump(compiler, backtracks, JUMP(SLJIT_ZERO));
+ OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(SLJIT_SP), LOCALS1);
+ }
+ JUMPHERE(jump[2]);
+ JUMPHERE(jump[3]);
+ }
+ JUMPHERE(jump[0]);
+ check_partial(common, FALSE);
+ return cc;
+
+ case OP_EOD:
+ add_jump(compiler, backtracks, CMP(SLJIT_LESS, STR_PTR, 0, STR_END, 0));
+ check_partial(common, FALSE);
+ return cc;
+
+ case OP_DOLL:
+ OP1(SLJIT_MOV, TMP2, 0, ARGUMENTS, 0);
+ OP1(SLJIT_MOV_U8, TMP2, 0, SLJIT_MEM1(TMP2), SLJIT_OFFSETOF(jit_arguments, noteol));
+ add_jump(compiler, backtracks, CMP(SLJIT_NOT_EQUAL, TMP2, 0, SLJIT_IMM, 0));
+
+ if (!common->endonly)
+ compile_simple_assertion_matchingpath(common, OP_EODN, cc, backtracks);
+ else
+ {
+ add_jump(compiler, backtracks, CMP(SLJIT_LESS, STR_PTR, 0, STR_END, 0));
+ check_partial(common, FALSE);
+ }
return cc;
+ case OP_DOLLM:
+ jump[1] = CMP(SLJIT_LESS, STR_PTR, 0, STR_END, 0);
+ OP1(SLJIT_MOV, TMP2, 0, ARGUMENTS, 0);
+ OP1(SLJIT_MOV_U8, TMP2, 0, SLJIT_MEM1(TMP2), SLJIT_OFFSETOF(jit_arguments, noteol));
+ add_jump(compiler, backtracks, CMP(SLJIT_NOT_EQUAL, TMP2, 0, SLJIT_IMM, 0));
+ check_partial(common, FALSE);
+ jump[0] = JUMP(SLJIT_JUMP);
+ JUMPHERE(jump[1]);
+
+ if (common->nltype == NLTYPE_FIXED && common->newline > 255)
+ {
+ OP2(SLJIT_ADD, TMP2, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(2));
+ OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(0));
+ if (common->mode == JIT_COMPILE)
+ add_jump(compiler, backtracks, CMP(SLJIT_GREATER, TMP2, 0, STR_END, 0));
+ else
+ {
+ jump[1] = CMP(SLJIT_LESS_EQUAL, TMP2, 0, STR_END, 0);
+ /* STR_PTR = STR_END - IN_UCHARS(1) */
+ add_jump(compiler, backtracks, CMP(SLJIT_NOT_EQUAL, TMP1, 0, SLJIT_IMM, (common->newline >> 8) & 0xff));
+ check_partial(common, TRUE);
+ add_jump(compiler, backtracks, JUMP(SLJIT_JUMP));
+ JUMPHERE(jump[1]);
+ }
+
+ OP1(MOV_UCHAR, TMP2, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(1));
+ add_jump(compiler, backtracks, CMP(SLJIT_NOT_EQUAL, TMP1, 0, SLJIT_IMM, (common->newline >> 8) & 0xff));
+ add_jump(compiler, backtracks, CMP(SLJIT_NOT_EQUAL, TMP2, 0, SLJIT_IMM, common->newline & 0xff));
+ }
+ else
+ {
+ peek_char(common, common->nlmax);
+ check_newlinechar(common, common->nltype, backtracks, FALSE);
+ }
+ JUMPHERE(jump[0]);
+ return cc;
+
+ case OP_CIRC:
+ OP1(SLJIT_MOV, TMP2, 0, ARGUMENTS, 0);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(TMP2), SLJIT_OFFSETOF(jit_arguments, begin));
+ add_jump(compiler, backtracks, CMP(SLJIT_GREATER, STR_PTR, 0, TMP1, 0));
+ OP1(SLJIT_MOV_U8, TMP2, 0, SLJIT_MEM1(TMP2), SLJIT_OFFSETOF(jit_arguments, notbol));
+ add_jump(compiler, backtracks, CMP(SLJIT_NOT_EQUAL, TMP2, 0, SLJIT_IMM, 0));
+ return cc;
+
+ case OP_CIRCM:
+ OP1(SLJIT_MOV, TMP2, 0, ARGUMENTS, 0);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(TMP2), SLJIT_OFFSETOF(jit_arguments, begin));
+ jump[1] = CMP(SLJIT_GREATER, STR_PTR, 0, TMP1, 0);
+ OP1(SLJIT_MOV_U8, TMP2, 0, SLJIT_MEM1(TMP2), SLJIT_OFFSETOF(jit_arguments, notbol));
+ add_jump(compiler, backtracks, CMP(SLJIT_NOT_EQUAL, TMP2, 0, SLJIT_IMM, 0));
+ jump[0] = JUMP(SLJIT_JUMP);
+ JUMPHERE(jump[1]);
+
+ add_jump(compiler, backtracks, CMP(SLJIT_GREATER_EQUAL, STR_PTR, 0, STR_END, 0));
+ if (common->nltype == NLTYPE_FIXED && common->newline > 255)
+ {
+ OP2(SLJIT_SUB, TMP2, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(2));
+ add_jump(compiler, backtracks, CMP(SLJIT_LESS, TMP2, 0, TMP1, 0));
+ OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(-2));
+ OP1(MOV_UCHAR, TMP2, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(-1));
+ add_jump(compiler, backtracks, CMP(SLJIT_NOT_EQUAL, TMP1, 0, SLJIT_IMM, (common->newline >> 8) & 0xff));
+ add_jump(compiler, backtracks, CMP(SLJIT_NOT_EQUAL, TMP2, 0, SLJIT_IMM, common->newline & 0xff));
+ }
+ else
+ {
+ skip_char_back(common);
+ read_char_range(common, common->nlmin, common->nlmax, TRUE);
+ check_newlinechar(common, common->nltype, backtracks, FALSE);
+ }
+ JUMPHERE(jump[0]);
+ return cc;
+
+ case OP_REVERSE:
+ length = GET(cc, 0);
+ if (length == 0)
+ return cc + LINK_SIZE;
+ OP1(SLJIT_MOV, TMP1, 0, ARGUMENTS, 0);
+#ifdef SUPPORT_UTF
+ if (common->utf)
+ {
+ OP1(SLJIT_MOV, TMP3, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, begin));
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_IMM, length);
+ label = LABEL();
+ add_jump(compiler, backtracks, CMP(SLJIT_LESS_EQUAL, STR_PTR, 0, TMP3, 0));
+ skip_char_back(common);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, TMP2, 0, TMP2, 0, SLJIT_IMM, 1);
+ JUMPTO(SLJIT_NOT_ZERO, label);
+ }
+ else
+#endif
+ {
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, begin));
+ OP2(SLJIT_SUB, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(length));
+ add_jump(compiler, backtracks, CMP(SLJIT_LESS, STR_PTR, 0, TMP1, 0));
+ }
+ check_start_used_ptr(common);
+ return cc + LINK_SIZE;
+ }
+SLJIT_UNREACHABLE();
+return cc;
+}
+
+static pcre_uchar *compile_char1_matchingpath(compiler_common *common, pcre_uchar type, pcre_uchar *cc, jump_list **backtracks, BOOL check_str_ptr)
+{
+DEFINE_COMPILER;
+int length;
+unsigned int c, oc, bit;
+compare_context context;
+struct sljit_jump *jump[3];
+jump_list *end_list;
+#ifdef SUPPORT_UTF
+struct sljit_label *label;
+#ifdef SUPPORT_UCP
+pcre_uchar propdata[5];
+#endif
+#endif /* SUPPORT_UTF */
+
+switch(type)
+ {
case OP_NOT_DIGIT:
case OP_DIGIT:
/* Digits are usually 0-9, so it is worth to optimize them. */
- if (common->digits[0] == -2)
- get_ctype_ranges(common, ctype_digit, common->digits);
- detect_partial_match(common, backtracks);
- /* Flip the starting bit in the negative case. */
- if (type == OP_NOT_DIGIT)
- common->digits[1] ^= 1;
- if (!check_ranges(common, common->digits, backtracks, TRUE))
- {
- read_char8_type(common);
- OP2(SLJIT_AND | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, ctype_digit);
- add_jump(compiler, backtracks, JUMP(type == OP_DIGIT ? SLJIT_C_ZERO : SLJIT_C_NOT_ZERO));
- }
- if (type == OP_NOT_DIGIT)
- common->digits[1] ^= 1;
+ if (check_str_ptr)
+ detect_partial_match(common, backtracks);
+#if defined SUPPORT_UTF && defined COMPILE_PCRE8
+ if (common->utf && is_char7_bitset((const sljit_u8 *)common->ctypes - cbit_length + cbit_digit, FALSE))
+ read_char7_type(common, type == OP_NOT_DIGIT);
+ else
+#endif
+ read_char8_type(common, type == OP_NOT_DIGIT);
+ /* Flip the starting bit in the negative case. */
+ OP2(SLJIT_AND | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, ctype_digit);
+ add_jump(compiler, backtracks, JUMP(type == OP_DIGIT ? SLJIT_ZERO : SLJIT_NOT_ZERO));
return cc;
case OP_NOT_WHITESPACE:
case OP_WHITESPACE:
- detect_partial_match(common, backtracks);
- read_char8_type(common);
- OP2(SLJIT_AND | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, ctype_space);
- add_jump(compiler, backtracks, JUMP(type == OP_WHITESPACE ? SLJIT_C_ZERO : SLJIT_C_NOT_ZERO));
+ if (check_str_ptr)
+ detect_partial_match(common, backtracks);
+#if defined SUPPORT_UTF && defined COMPILE_PCRE8
+ if (common->utf && is_char7_bitset((const sljit_u8 *)common->ctypes - cbit_length + cbit_space, FALSE))
+ read_char7_type(common, type == OP_NOT_WHITESPACE);
+ else
+#endif
+ read_char8_type(common, type == OP_NOT_WHITESPACE);
+ OP2(SLJIT_AND | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, ctype_space);
+ add_jump(compiler, backtracks, JUMP(type == OP_WHITESPACE ? SLJIT_ZERO : SLJIT_NOT_ZERO));
return cc;
case OP_NOT_WORDCHAR:
case OP_WORDCHAR:
- detect_partial_match(common, backtracks);
- read_char8_type(common);
- OP2(SLJIT_AND | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, ctype_word);
- add_jump(compiler, backtracks, JUMP(type == OP_WORDCHAR ? SLJIT_C_ZERO : SLJIT_C_NOT_ZERO));
+ if (check_str_ptr)
+ detect_partial_match(common, backtracks);
+#if defined SUPPORT_UTF && defined COMPILE_PCRE8
+ if (common->utf && is_char7_bitset((const sljit_u8 *)common->ctypes - cbit_length + cbit_word, FALSE))
+ read_char7_type(common, type == OP_NOT_WORDCHAR);
+ else
+#endif
+ read_char8_type(common, type == OP_NOT_WORDCHAR);
+ OP2(SLJIT_AND | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, ctype_word);
+ add_jump(compiler, backtracks, JUMP(type == OP_WORDCHAR ? SLJIT_ZERO : SLJIT_NOT_ZERO));
return cc;
case OP_ANY:
- detect_partial_match(common, backtracks);
- read_char(common);
+ if (check_str_ptr)
+ detect_partial_match(common, backtracks);
+ read_char_range(common, common->nlmin, common->nlmax, TRUE);
if (common->nltype == NLTYPE_FIXED && common->newline > 255)
{
- jump[0] = CMP(SLJIT_C_NOT_EQUAL, TMP1, 0, SLJIT_IMM, (common->newline >> 8) & 0xff);
+ jump[0] = CMP(SLJIT_NOT_EQUAL, TMP1, 0, SLJIT_IMM, (common->newline >> 8) & 0xff);
end_list = NULL;
if (common->mode != JIT_PARTIAL_HARD_COMPILE)
- add_jump(compiler, &end_list, CMP(SLJIT_C_GREATER_EQUAL, STR_PTR, 0, STR_END, 0));
+ add_jump(compiler, &end_list, CMP(SLJIT_GREATER_EQUAL, STR_PTR, 0, STR_END, 0));
else
check_str_end(common, &end_list);
OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), 0);
- add_jump(compiler, backtracks, CMP(SLJIT_C_EQUAL, TMP1, 0, SLJIT_IMM, common->newline & 0xff));
+ add_jump(compiler, backtracks, CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, common->newline & 0xff));
set_jumps(end_list, LABEL());
JUMPHERE(jump[0]);
}
@@ -4528,7 +6320,8 @@ switch(type)
return cc;
case OP_ALLANY:
- detect_partial_match(common, backtracks);
+ if (check_str_ptr)
+ detect_partial_match(common, backtracks);
#ifdef SUPPORT_UTF
if (common->utf)
{
@@ -4536,14 +6329,14 @@ switch(type)
OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
#if defined COMPILE_PCRE8 || defined COMPILE_PCRE16
#if defined COMPILE_PCRE8
- jump[0] = CMP(SLJIT_C_LESS, TMP1, 0, SLJIT_IMM, 0xc0);
- OP1(SLJIT_MOV_UB, TMP1, 0, SLJIT_MEM1(TMP1), (sljit_sw)PRIV(utf8_table4) - 0xc0);
+ jump[0] = CMP(SLJIT_LESS, TMP1, 0, SLJIT_IMM, 0xc0);
+ OP1(SLJIT_MOV_U8, TMP1, 0, SLJIT_MEM1(TMP1), (sljit_sw)PRIV(utf8_table4) - 0xc0);
OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, TMP1, 0);
#elif defined COMPILE_PCRE16
- jump[0] = CMP(SLJIT_C_LESS, TMP1, 0, SLJIT_IMM, 0xd800);
+ jump[0] = CMP(SLJIT_LESS, TMP1, 0, SLJIT_IMM, 0xd800);
OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, 0xfc00);
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0xd800);
- OP_FLAGS(SLJIT_MOV, TMP1, 0, SLJIT_UNUSED, 0, SLJIT_C_EQUAL);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0xd800);
+ OP_FLAGS(SLJIT_MOV, TMP1, 0, SLJIT_EQUAL);
OP2(SLJIT_SHL, TMP1, 0, TMP1, 0, SLJIT_IMM, 1);
OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, TMP1, 0);
#endif
@@ -4556,7 +6349,8 @@ switch(type)
return cc;
case OP_ANYBYTE:
- detect_partial_match(common, backtracks);
+ if (check_str_ptr)
+ detect_partial_match(common, backtracks);
OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
return cc;
@@ -4564,28 +6358,31 @@ switch(type)
#ifdef SUPPORT_UCP
case OP_NOTPROP:
case OP_PROP:
- propdata[0] = 0;
+ propdata[0] = XCL_HASPROP;
propdata[1] = type == OP_NOTPROP ? XCL_NOTPROP : XCL_PROP;
propdata[2] = cc[0];
propdata[3] = cc[1];
propdata[4] = XCL_END;
+ if (check_str_ptr)
+ detect_partial_match(common, backtracks);
compile_xclass_matchingpath(common, propdata, backtracks);
return cc + 2;
#endif
#endif
case OP_ANYNL:
- detect_partial_match(common, backtracks);
- read_char(common);
- jump[0] = CMP(SLJIT_C_NOT_EQUAL, TMP1, 0, SLJIT_IMM, CHAR_CR);
+ if (check_str_ptr)
+ detect_partial_match(common, backtracks);
+ read_char_range(common, common->bsr_nlmin, common->bsr_nlmax, FALSE);
+ jump[0] = CMP(SLJIT_NOT_EQUAL, TMP1, 0, SLJIT_IMM, CHAR_CR);
/* We don't need to handle soft partial matching case. */
end_list = NULL;
if (common->mode != JIT_PARTIAL_HARD_COMPILE)
- add_jump(compiler, &end_list, CMP(SLJIT_C_GREATER_EQUAL, STR_PTR, 0, STR_END, 0));
+ add_jump(compiler, &end_list, CMP(SLJIT_GREATER_EQUAL, STR_PTR, 0, STR_END, 0));
else
check_str_end(common, &end_list);
OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), 0);
- jump[1] = CMP(SLJIT_C_NOT_EQUAL, TMP1, 0, SLJIT_IMM, CHAR_NL);
+ jump[1] = CMP(SLJIT_NOT_EQUAL, TMP1, 0, SLJIT_IMM, CHAR_NL);
OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
jump[2] = JUMP(SLJIT_JUMP);
JUMPHERE(jump[0]);
@@ -4597,52 +6394,57 @@ switch(type)
case OP_NOT_HSPACE:
case OP_HSPACE:
- detect_partial_match(common, backtracks);
- read_char(common);
+ if (check_str_ptr)
+ detect_partial_match(common, backtracks);
+ read_char_range(common, 0x9, 0x3000, type == OP_NOT_HSPACE);
add_jump(compiler, &common->hspace, JUMP(SLJIT_FAST_CALL));
- add_jump(compiler, backtracks, JUMP(type == OP_NOT_HSPACE ? SLJIT_C_NOT_ZERO : SLJIT_C_ZERO));
+ sljit_set_current_flags(compiler, SLJIT_SET_Z);
+ add_jump(compiler, backtracks, JUMP(type == OP_NOT_HSPACE ? SLJIT_NOT_ZERO : SLJIT_ZERO));
return cc;
case OP_NOT_VSPACE:
case OP_VSPACE:
- detect_partial_match(common, backtracks);
- read_char(common);
+ if (check_str_ptr)
+ detect_partial_match(common, backtracks);
+ read_char_range(common, 0xa, 0x2029, type == OP_NOT_VSPACE);
add_jump(compiler, &common->vspace, JUMP(SLJIT_FAST_CALL));
- add_jump(compiler, backtracks, JUMP(type == OP_NOT_VSPACE ? SLJIT_C_NOT_ZERO : SLJIT_C_ZERO));
+ sljit_set_current_flags(compiler, SLJIT_SET_Z);
+ add_jump(compiler, backtracks, JUMP(type == OP_NOT_VSPACE ? SLJIT_NOT_ZERO : SLJIT_ZERO));
return cc;
#ifdef SUPPORT_UCP
case OP_EXTUNI:
- detect_partial_match(common, backtracks);
+ if (check_str_ptr)
+ detect_partial_match(common, backtracks);
read_char(common);
add_jump(compiler, &common->getucd, JUMP(SLJIT_FAST_CALL));
OP1(SLJIT_MOV, TMP1, 0, SLJIT_IMM, (sljit_sw)PRIV(ucd_records) + SLJIT_OFFSETOF(ucd_record, gbprop));
/* Optimize register allocation: use a real register. */
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), LOCALS0, STACK_TOP, 0);
- OP1(SLJIT_MOV_UB, STACK_TOP, 0, SLJIT_MEM2(TMP1, TMP2), 3);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), LOCALS0, STACK_TOP, 0);
+ OP1(SLJIT_MOV_U8, STACK_TOP, 0, SLJIT_MEM2(TMP1, TMP2), 3);
label = LABEL();
- jump[0] = CMP(SLJIT_C_GREATER_EQUAL, STR_PTR, 0, STR_END, 0);
+ jump[0] = CMP(SLJIT_GREATER_EQUAL, STR_PTR, 0, STR_END, 0);
OP1(SLJIT_MOV, TMP3, 0, STR_PTR, 0);
read_char(common);
add_jump(compiler, &common->getucd, JUMP(SLJIT_FAST_CALL));
OP1(SLJIT_MOV, TMP1, 0, SLJIT_IMM, (sljit_sw)PRIV(ucd_records) + SLJIT_OFFSETOF(ucd_record, gbprop));
- OP1(SLJIT_MOV_UB, TMP2, 0, SLJIT_MEM2(TMP1, TMP2), 3);
+ OP1(SLJIT_MOV_U8, TMP2, 0, SLJIT_MEM2(TMP1, TMP2), 3);
OP2(SLJIT_SHL, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, 2);
- OP1(SLJIT_MOV_UI, TMP1, 0, SLJIT_MEM1(STACK_TOP), (sljit_sw)PRIV(ucp_gbtable));
+ OP1(SLJIT_MOV_U32, TMP1, 0, SLJIT_MEM1(STACK_TOP), (sljit_sw)PRIV(ucp_gbtable));
OP1(SLJIT_MOV, STACK_TOP, 0, TMP2, 0);
OP2(SLJIT_SHL, TMP2, 0, SLJIT_IMM, 1, TMP2, 0);
- OP2(SLJIT_AND | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, TMP2, 0);
- JUMPTO(SLJIT_C_NOT_ZERO, label);
+ OP2(SLJIT_AND | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, TMP2, 0);
+ JUMPTO(SLJIT_NOT_ZERO, label);
OP1(SLJIT_MOV, STR_PTR, 0, TMP3, 0);
JUMPHERE(jump[0]);
- OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), LOCALS0);
+ OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), LOCALS0);
if (common->mode == JIT_PARTIAL_HARD_COMPILE)
{
- jump[0] = CMP(SLJIT_C_LESS, STR_PTR, 0, STR_END, 0);
+ jump[0] = CMP(SLJIT_LESS, STR_PTR, 0, STR_END, 0);
/* Since we successfully read a char above, partial matching must occure. */
check_partial(common, TRUE);
JUMPHERE(jump[0]);
@@ -4650,176 +6452,17 @@ switch(type)
return cc;
#endif
- case OP_EODN:
- /* Requires rather complex checks. */
- jump[0] = CMP(SLJIT_C_GREATER_EQUAL, STR_PTR, 0, STR_END, 0);
- if (common->nltype == NLTYPE_FIXED && common->newline > 255)
- {
- OP2(SLJIT_ADD, TMP2, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(2));
- OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(0));
- if (common->mode == JIT_COMPILE)
- add_jump(compiler, backtracks, CMP(SLJIT_C_NOT_EQUAL, TMP2, 0, STR_END, 0));
- else
- {
- jump[1] = CMP(SLJIT_C_EQUAL, TMP2, 0, STR_END, 0);
- OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, TMP2, 0, STR_END, 0);
- OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_C_LESS);
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (common->newline >> 8) & 0xff);
- OP_FLAGS(SLJIT_OR | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_C_NOT_EQUAL);
- add_jump(compiler, backtracks, JUMP(SLJIT_C_NOT_EQUAL));
- check_partial(common, TRUE);
- add_jump(compiler, backtracks, JUMP(SLJIT_JUMP));
- JUMPHERE(jump[1]);
- }
- OP1(MOV_UCHAR, TMP2, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(1));
- add_jump(compiler, backtracks, CMP(SLJIT_C_NOT_EQUAL, TMP1, 0, SLJIT_IMM, (common->newline >> 8) & 0xff));
- add_jump(compiler, backtracks, CMP(SLJIT_C_NOT_EQUAL, TMP2, 0, SLJIT_IMM, common->newline & 0xff));
- }
- else if (common->nltype == NLTYPE_FIXED)
- {
- OP2(SLJIT_ADD, TMP2, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
- OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(0));
- add_jump(compiler, backtracks, CMP(SLJIT_C_NOT_EQUAL, TMP2, 0, STR_END, 0));
- add_jump(compiler, backtracks, CMP(SLJIT_C_NOT_EQUAL, TMP1, 0, SLJIT_IMM, common->newline));
- }
- else
- {
- OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(0));
- jump[1] = CMP(SLJIT_C_NOT_EQUAL, TMP1, 0, SLJIT_IMM, CHAR_CR);
- OP2(SLJIT_ADD, TMP2, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(2));
- OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, TMP2, 0, STR_END, 0);
- jump[2] = JUMP(SLJIT_C_GREATER);
- add_jump(compiler, backtracks, JUMP(SLJIT_C_LESS));
- /* Equal. */
- OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(1));
- jump[3] = CMP(SLJIT_C_EQUAL, TMP1, 0, SLJIT_IMM, CHAR_NL);
- add_jump(compiler, backtracks, JUMP(SLJIT_JUMP));
-
- JUMPHERE(jump[1]);
- if (common->nltype == NLTYPE_ANYCRLF)
- {
- OP2(SLJIT_ADD, TMP2, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
- add_jump(compiler, backtracks, CMP(SLJIT_C_LESS, TMP2, 0, STR_END, 0));
- add_jump(compiler, backtracks, CMP(SLJIT_C_NOT_EQUAL, TMP1, 0, SLJIT_IMM, CHAR_NL));
- }
- else
- {
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), LOCALS1, STR_PTR, 0);
- read_char(common);
- add_jump(compiler, backtracks, CMP(SLJIT_C_NOT_EQUAL, STR_PTR, 0, STR_END, 0));
- add_jump(compiler, &common->anynewline, JUMP(SLJIT_FAST_CALL));
- add_jump(compiler, backtracks, JUMP(SLJIT_C_ZERO));
- OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), LOCALS1);
- }
- JUMPHERE(jump[2]);
- JUMPHERE(jump[3]);
- }
- JUMPHERE(jump[0]);
- check_partial(common, FALSE);
- return cc;
-
- case OP_EOD:
- add_jump(compiler, backtracks, CMP(SLJIT_C_LESS, STR_PTR, 0, STR_END, 0));
- check_partial(common, FALSE);
- return cc;
-
- case OP_CIRC:
- OP1(SLJIT_MOV, TMP2, 0, ARGUMENTS, 0);
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(TMP2), SLJIT_OFFSETOF(jit_arguments, begin));
- add_jump(compiler, backtracks, CMP(SLJIT_C_GREATER, STR_PTR, 0, TMP1, 0));
- OP1(SLJIT_MOV_UB, TMP2, 0, SLJIT_MEM1(TMP2), SLJIT_OFFSETOF(jit_arguments, notbol));
- add_jump(compiler, backtracks, CMP(SLJIT_C_NOT_EQUAL, TMP2, 0, SLJIT_IMM, 0));
- return cc;
-
- case OP_CIRCM:
- OP1(SLJIT_MOV, TMP2, 0, ARGUMENTS, 0);
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(TMP2), SLJIT_OFFSETOF(jit_arguments, begin));
- jump[1] = CMP(SLJIT_C_GREATER, STR_PTR, 0, TMP1, 0);
- OP1(SLJIT_MOV_UB, TMP2, 0, SLJIT_MEM1(TMP2), SLJIT_OFFSETOF(jit_arguments, notbol));
- add_jump(compiler, backtracks, CMP(SLJIT_C_NOT_EQUAL, TMP2, 0, SLJIT_IMM, 0));
- jump[0] = JUMP(SLJIT_JUMP);
- JUMPHERE(jump[1]);
-
- add_jump(compiler, backtracks, CMP(SLJIT_C_GREATER_EQUAL, STR_PTR, 0, STR_END, 0));
- if (common->nltype == NLTYPE_FIXED && common->newline > 255)
- {
- OP2(SLJIT_SUB, TMP2, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(2));
- add_jump(compiler, backtracks, CMP(SLJIT_C_LESS, TMP2, 0, TMP1, 0));
- OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(-2));
- OP1(MOV_UCHAR, TMP2, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(-1));
- add_jump(compiler, backtracks, CMP(SLJIT_C_NOT_EQUAL, TMP1, 0, SLJIT_IMM, (common->newline >> 8) & 0xff));
- add_jump(compiler, backtracks, CMP(SLJIT_C_NOT_EQUAL, TMP2, 0, SLJIT_IMM, common->newline & 0xff));
- }
- else
- {
- skip_char_back(common);
- read_char(common);
- check_newlinechar(common, common->nltype, backtracks, FALSE);
- }
- JUMPHERE(jump[0]);
- return cc;
-
- case OP_DOLL:
- OP1(SLJIT_MOV, TMP2, 0, ARGUMENTS, 0);
- OP1(SLJIT_MOV_UB, TMP2, 0, SLJIT_MEM1(TMP2), SLJIT_OFFSETOF(jit_arguments, noteol));
- add_jump(compiler, backtracks, CMP(SLJIT_C_NOT_EQUAL, TMP2, 0, SLJIT_IMM, 0));
-
- if (!common->endonly)
- compile_char1_matchingpath(common, OP_EODN, cc, backtracks);
- else
- {
- add_jump(compiler, backtracks, CMP(SLJIT_C_LESS, STR_PTR, 0, STR_END, 0));
- check_partial(common, FALSE);
- }
- return cc;
-
- case OP_DOLLM:
- jump[1] = CMP(SLJIT_C_LESS, STR_PTR, 0, STR_END, 0);
- OP1(SLJIT_MOV, TMP2, 0, ARGUMENTS, 0);
- OP1(SLJIT_MOV_UB, TMP2, 0, SLJIT_MEM1(TMP2), SLJIT_OFFSETOF(jit_arguments, noteol));
- add_jump(compiler, backtracks, CMP(SLJIT_C_NOT_EQUAL, TMP2, 0, SLJIT_IMM, 0));
- check_partial(common, FALSE);
- jump[0] = JUMP(SLJIT_JUMP);
- JUMPHERE(jump[1]);
-
- if (common->nltype == NLTYPE_FIXED && common->newline > 255)
- {
- OP2(SLJIT_ADD, TMP2, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(2));
- OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(0));
- if (common->mode == JIT_COMPILE)
- add_jump(compiler, backtracks, CMP(SLJIT_C_GREATER, TMP2, 0, STR_END, 0));
- else
- {
- jump[1] = CMP(SLJIT_C_LESS_EQUAL, TMP2, 0, STR_END, 0);
- /* STR_PTR = STR_END - IN_UCHARS(1) */
- add_jump(compiler, backtracks, CMP(SLJIT_C_NOT_EQUAL, TMP1, 0, SLJIT_IMM, (common->newline >> 8) & 0xff));
- check_partial(common, TRUE);
- add_jump(compiler, backtracks, JUMP(SLJIT_JUMP));
- JUMPHERE(jump[1]);
- }
-
- OP1(MOV_UCHAR, TMP2, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(1));
- add_jump(compiler, backtracks, CMP(SLJIT_C_NOT_EQUAL, TMP1, 0, SLJIT_IMM, (common->newline >> 8) & 0xff));
- add_jump(compiler, backtracks, CMP(SLJIT_C_NOT_EQUAL, TMP2, 0, SLJIT_IMM, common->newline & 0xff));
- }
- else
- {
- peek_char(common);
- check_newlinechar(common, common->nltype, backtracks, FALSE);
- }
- JUMPHERE(jump[0]);
- return cc;
-
case OP_CHAR:
case OP_CHARI:
length = 1;
#ifdef SUPPORT_UTF
if (common->utf && HAS_EXTRALEN(*cc)) length += GET_EXTRALEN(*cc);
#endif
- if (common->mode == JIT_COMPILE && (type == OP_CHAR || !char_has_othercase(common, cc) || char_get_othercase_bit(common, cc) != 0))
+ if (common->mode == JIT_COMPILE && check_str_ptr
+ && (type == OP_CHAR || !char_has_othercase(common, cc) || char_get_othercase_bit(common, cc) != 0))
{
OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(length));
- add_jump(compiler, backtracks, CMP(SLJIT_C_GREATER, STR_PTR, 0, STR_END, 0));
+ add_jump(compiler, backtracks, CMP(SLJIT_GREATER, STR_PTR, 0, STR_END, 0));
context.length = IN_UCHARS(length);
context.sourcereg = -1;
@@ -4828,8 +6471,9 @@ switch(type)
#endif
return byte_sequence_compare(common, type == OP_CHARI, cc, &context, backtracks);
}
- detect_partial_match(common, backtracks);
- read_char(common);
+
+ if (check_str_ptr)
+ detect_partial_match(common, backtracks);
#ifdef SUPPORT_UTF
if (common->utf)
{
@@ -4838,29 +6482,31 @@ switch(type)
else
#endif
c = *cc;
+
if (type == OP_CHAR || !char_has_othercase(common, cc))
{
- add_jump(compiler, backtracks, CMP(SLJIT_C_NOT_EQUAL, TMP1, 0, SLJIT_IMM, c));
+ read_char_range(common, c, c, FALSE);
+ add_jump(compiler, backtracks, CMP(SLJIT_NOT_EQUAL, TMP1, 0, SLJIT_IMM, c));
return cc + length;
}
oc = char_othercase(common, c);
+ read_char_range(common, c < oc ? c : oc, c > oc ? c : oc, FALSE);
bit = c ^ oc;
if (is_powerof2(bit))
{
OP2(SLJIT_OR, TMP1, 0, TMP1, 0, SLJIT_IMM, bit);
- add_jump(compiler, backtracks, CMP(SLJIT_C_NOT_EQUAL, TMP1, 0, SLJIT_IMM, c | bit));
+ add_jump(compiler, backtracks, CMP(SLJIT_NOT_EQUAL, TMP1, 0, SLJIT_IMM, c | bit));
return cc + length;
}
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, c);
- OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_C_EQUAL);
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, oc);
- OP_FLAGS(SLJIT_OR | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_C_EQUAL);
- add_jump(compiler, backtracks, JUMP(SLJIT_C_ZERO));
+ jump[0] = CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, c);
+ add_jump(compiler, backtracks, CMP(SLJIT_NOT_EQUAL, TMP1, 0, SLJIT_IMM, oc));
+ JUMPHERE(jump[0]);
return cc + length;
case OP_NOT:
case OP_NOTI:
- detect_partial_match(common, backtracks);
+ if (check_str_ptr)
+ detect_partial_match(common, backtracks);
length = 1;
#ifdef SUPPORT_UTF
if (common->utf)
@@ -4869,18 +6515,18 @@ switch(type)
c = *cc;
if (c < 128)
{
- OP1(SLJIT_MOV_UB, TMP1, 0, SLJIT_MEM1(STR_PTR), 0);
+ OP1(SLJIT_MOV_U8, TMP1, 0, SLJIT_MEM1(STR_PTR), 0);
if (type == OP_NOT || !char_has_othercase(common, cc))
- add_jump(compiler, backtracks, CMP(SLJIT_C_EQUAL, TMP1, 0, SLJIT_IMM, c));
+ add_jump(compiler, backtracks, CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, c));
else
{
/* Since UTF8 code page is fixed, we know that c is in [a-z] or [A-Z] range. */
OP2(SLJIT_OR, TMP2, 0, TMP1, 0, SLJIT_IMM, 0x20);
- add_jump(compiler, backtracks, CMP(SLJIT_C_EQUAL, TMP2, 0, SLJIT_IMM, c | 0x20));
+ add_jump(compiler, backtracks, CMP(SLJIT_EQUAL, TMP2, 0, SLJIT_IMM, c | 0x20));
}
/* Skip the variable-length character. */
OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
- jump[0] = CMP(SLJIT_C_LESS, TMP1, 0, SLJIT_IMM, 0xc0);
+ jump[0] = CMP(SLJIT_LESS, TMP1, 0, SLJIT_IMM, 0xc0);
OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(TMP1), (sljit_sw)PRIV(utf8_table4) - 0xc0);
OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, TMP1, 0);
JUMPHERE(jump[0]);
@@ -4890,103 +6536,92 @@ switch(type)
#endif /* COMPILE_PCRE8 */
{
GETCHARLEN(c, cc, length);
- read_char(common);
}
}
else
#endif /* SUPPORT_UTF */
- {
- read_char(common);
c = *cc;
- }
if (type == OP_NOT || !char_has_othercase(common, cc))
- add_jump(compiler, backtracks, CMP(SLJIT_C_EQUAL, TMP1, 0, SLJIT_IMM, c));
+ {
+ read_char_range(common, c, c, TRUE);
+ add_jump(compiler, backtracks, CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, c));
+ }
else
{
oc = char_othercase(common, c);
+ read_char_range(common, c < oc ? c : oc, c > oc ? c : oc, TRUE);
bit = c ^ oc;
if (is_powerof2(bit))
{
OP2(SLJIT_OR, TMP1, 0, TMP1, 0, SLJIT_IMM, bit);
- add_jump(compiler, backtracks, CMP(SLJIT_C_EQUAL, TMP1, 0, SLJIT_IMM, c | bit));
+ add_jump(compiler, backtracks, CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, c | bit));
}
else
{
- add_jump(compiler, backtracks, CMP(SLJIT_C_EQUAL, TMP1, 0, SLJIT_IMM, c));
- add_jump(compiler, backtracks, CMP(SLJIT_C_EQUAL, TMP1, 0, SLJIT_IMM, oc));
+ add_jump(compiler, backtracks, CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, c));
+ add_jump(compiler, backtracks, CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, oc));
}
}
return cc + length;
case OP_CLASS:
case OP_NCLASS:
- detect_partial_match(common, backtracks);
- read_char(common);
- if (check_class_ranges(common, (const pcre_uint8 *)cc, type == OP_NCLASS, backtracks))
+ if (check_str_ptr)
+ detect_partial_match(common, backtracks);
+
+#if defined SUPPORT_UTF && defined COMPILE_PCRE8
+ bit = (common->utf && is_char7_bitset((const sljit_u8 *)cc, type == OP_NCLASS)) ? 127 : 255;
+ read_char_range(common, 0, bit, type == OP_NCLASS);
+#else
+ read_char_range(common, 0, 255, type == OP_NCLASS);
+#endif
+
+ if (check_class_ranges(common, (const sljit_u8 *)cc, type == OP_NCLASS, FALSE, backtracks))
return cc + 32 / sizeof(pcre_uchar);
-#if defined SUPPORT_UTF || !defined COMPILE_PCRE8
+#if defined SUPPORT_UTF && defined COMPILE_PCRE8
jump[0] = NULL;
-#ifdef COMPILE_PCRE8
- /* This check only affects 8 bit mode. In other modes, we
- always need to compare the value with 255. */
if (common->utf)
-#endif /* COMPILE_PCRE8 */
{
- jump[0] = CMP(SLJIT_C_GREATER, TMP1, 0, SLJIT_IMM, 255);
+ jump[0] = CMP(SLJIT_GREATER, TMP1, 0, SLJIT_IMM, bit);
if (type == OP_CLASS)
{
add_jump(compiler, backtracks, jump[0]);
jump[0] = NULL;
}
}
-#endif /* SUPPORT_UTF || !COMPILE_PCRE8 */
+#elif !defined COMPILE_PCRE8
+ jump[0] = CMP(SLJIT_GREATER, TMP1, 0, SLJIT_IMM, 255);
+ if (type == OP_CLASS)
+ {
+ add_jump(compiler, backtracks, jump[0]);
+ jump[0] = NULL;
+ }
+#endif /* SUPPORT_UTF && COMPILE_PCRE8 */
+
OP2(SLJIT_AND, TMP2, 0, TMP1, 0, SLJIT_IMM, 0x7);
OP2(SLJIT_LSHR, TMP1, 0, TMP1, 0, SLJIT_IMM, 3);
- OP1(SLJIT_MOV_UB, TMP1, 0, SLJIT_MEM1(TMP1), (sljit_sw)cc);
+ OP1(SLJIT_MOV_U8, TMP1, 0, SLJIT_MEM1(TMP1), (sljit_sw)cc);
OP2(SLJIT_SHL, TMP2, 0, SLJIT_IMM, 1, TMP2, 0);
- OP2(SLJIT_AND | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, TMP2, 0);
- add_jump(compiler, backtracks, JUMP(SLJIT_C_ZERO));
+ OP2(SLJIT_AND | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, TMP2, 0);
+ add_jump(compiler, backtracks, JUMP(SLJIT_ZERO));
+
#if defined SUPPORT_UTF || !defined COMPILE_PCRE8
if (jump[0] != NULL)
JUMPHERE(jump[0]);
-#endif /* SUPPORT_UTF || !COMPILE_PCRE8 */
+#endif
return cc + 32 / sizeof(pcre_uchar);
#if defined SUPPORT_UTF || defined COMPILE_PCRE16 || defined COMPILE_PCRE32
case OP_XCLASS:
+ if (check_str_ptr)
+ detect_partial_match(common, backtracks);
compile_xclass_matchingpath(common, cc + LINK_SIZE, backtracks);
return cc + GET(cc, 0) - 1;
#endif
-
- case OP_REVERSE:
- length = GET(cc, 0);
- if (length == 0)
- return cc + LINK_SIZE;
- OP1(SLJIT_MOV, TMP1, 0, ARGUMENTS, 0);
-#ifdef SUPPORT_UTF
- if (common->utf)
- {
- OP1(SLJIT_MOV, TMP3, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, begin));
- OP1(SLJIT_MOV, TMP2, 0, SLJIT_IMM, length);
- label = LABEL();
- add_jump(compiler, backtracks, CMP(SLJIT_C_LESS_EQUAL, STR_PTR, 0, TMP3, 0));
- skip_char_back(common);
- OP2(SLJIT_SUB | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_IMM, 1);
- JUMPTO(SLJIT_C_NOT_ZERO, label);
- }
- else
-#endif
- {
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, begin));
- OP2(SLJIT_SUB, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(length));
- add_jump(compiler, backtracks, CMP(SLJIT_C_LESS, STR_PTR, 0, TMP1, 0));
- }
- check_start_used_ptr(common);
- return cc + LINK_SIZE;
}
-SLJIT_ASSERT_STOP();
+SLJIT_UNREACHABLE();
return cc;
}
@@ -5042,7 +6677,7 @@ if (context.length > 0)
{
/* We have a fixed-length byte sequence. */
OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, context.length);
- add_jump(compiler, backtracks, CMP(SLJIT_C_GREATER, STR_PTR, 0, STR_END, 0));
+ add_jump(compiler, backtracks, CMP(SLJIT_GREATER, STR_PTR, 0, STR_END, 0));
context.sourcereg = -1;
#if defined SLJIT_UNALIGNED && SLJIT_UNALIGNED
@@ -5053,29 +6688,7 @@ if (context.length > 0)
}
/* A non-fixed length character will be checked if length == 0. */
-return compile_char1_matchingpath(common, *cc, cc + 1, backtracks);
-}
-
-static struct sljit_jump *compile_ref_checks(compiler_common *common, pcre_uchar *cc, jump_list **backtracks)
-{
-DEFINE_COMPILER;
-int offset = GET2(cc, 1) << 1;
-
-OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(offset));
-if (!common->jscript_compat)
- {
- if (backtracks == NULL)
- {
- /* OVECTOR(1) contains the "string begin - 1" constant. */
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(1));
- OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_C_EQUAL);
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(offset + 1));
- OP_FLAGS(SLJIT_OR | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_C_EQUAL);
- return JUMP(SLJIT_C_NOT_ZERO);
- }
- add_jump(compiler, backtracks, CMP(SLJIT_C_EQUAL, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(1)));
- }
-return CMP(SLJIT_C_EQUAL, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(offset + 1));
+return compile_char1_matchingpath(common, *cc, cc + 1, backtracks, TRUE);
}
/* Forward definitions. */
@@ -5110,39 +6723,80 @@ static void compile_backtrackingpath(compiler_common *, struct backtrack_common
#define BACKTRACK_AS(type) ((type *)backtrack)
-static pcre_uchar *compile_ref_matchingpath(compiler_common *common, pcre_uchar *cc, jump_list **backtracks, BOOL withchecks, BOOL emptyfail)
+static void compile_dnref_search(compiler_common *common, pcre_uchar *cc, jump_list **backtracks)
{
+/* The OVECTOR offset goes to TMP2. */
DEFINE_COMPILER;
-int offset = GET2(cc, 1) << 1;
+int count = GET2(cc, 1 + IMM2_SIZE);
+pcre_uchar *slot = common->name_table + GET2(cc, 1) * common->name_entry_size;
+unsigned int offset;
+jump_list *found = NULL;
+
+SLJIT_ASSERT(*cc == OP_DNREF || *cc == OP_DNREFI);
+
+OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(1));
+
+count--;
+while (count-- > 0)
+ {
+ offset = GET2(slot, 0) << 1;
+ GET_LOCAL_BASE(TMP2, 0, OVECTOR(offset));
+ add_jump(compiler, &found, CMP(SLJIT_NOT_EQUAL, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset), TMP1, 0));
+ slot += common->name_entry_size;
+ }
+
+offset = GET2(slot, 0) << 1;
+GET_LOCAL_BASE(TMP2, 0, OVECTOR(offset));
+if (backtracks != NULL && !common->jscript_compat)
+ add_jump(compiler, backtracks, CMP(SLJIT_EQUAL, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset), TMP1, 0));
+
+set_jumps(found, LABEL());
+}
+
+static void compile_ref_matchingpath(compiler_common *common, pcre_uchar *cc, jump_list **backtracks, BOOL withchecks, BOOL emptyfail)
+{
+DEFINE_COMPILER;
+BOOL ref = (*cc == OP_REF || *cc == OP_REFI);
+int offset = 0;
struct sljit_jump *jump = NULL;
struct sljit_jump *partial;
struct sljit_jump *nopartial;
-OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(offset));
-/* OVECTOR(1) contains the "string begin - 1" constant. */
-if (withchecks && !common->jscript_compat)
- add_jump(compiler, backtracks, CMP(SLJIT_C_EQUAL, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(1)));
+if (ref)
+ {
+ offset = GET2(cc, 1) << 1;
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset));
+ /* OVECTOR(1) contains the "string begin - 1" constant. */
+ if (withchecks && !common->jscript_compat)
+ add_jump(compiler, backtracks, CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(1)));
+ }
+else
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(TMP2), 0);
#if defined SUPPORT_UTF && defined SUPPORT_UCP
if (common->utf && *cc == OP_REFI)
{
- SLJIT_ASSERT(TMP1 == SLJIT_SCRATCH_REG1 && STACK_TOP == SLJIT_SCRATCH_REG2 && TMP2 == SLJIT_SCRATCH_REG3);
- OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(offset + 1));
+ SLJIT_ASSERT(TMP1 == SLJIT_R0 && STACK_TOP == SLJIT_R1 && TMP2 == SLJIT_R2);
+ if (ref)
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset + 1));
+ else
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(TMP2), sizeof(sljit_sw));
+
if (withchecks)
- jump = CMP(SLJIT_C_EQUAL, TMP1, 0, TMP2, 0);
+ jump = CMP(SLJIT_EQUAL, TMP1, 0, TMP2, 0);
/* Needed to save important temporary registers. */
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), LOCALS0, STACK_TOP, 0);
- OP1(SLJIT_MOV, SLJIT_SCRATCH_REG2, 0, ARGUMENTS, 0);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SCRATCH_REG2), SLJIT_OFFSETOF(jit_arguments, uchar_ptr), STR_PTR, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), LOCALS0, STACK_TOP, 0);
+ OP1(SLJIT_MOV, SLJIT_R1, 0, ARGUMENTS, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_R1), SLJIT_OFFSETOF(jit_arguments, uchar_ptr), STR_PTR, 0);
sljit_emit_ijump(compiler, SLJIT_CALL3, SLJIT_IMM, SLJIT_FUNC_OFFSET(do_utf_caselesscmp));
- OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), LOCALS0);
+ OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), LOCALS0);
if (common->mode == JIT_COMPILE)
- add_jump(compiler, backtracks, CMP(SLJIT_C_LESS_EQUAL, SLJIT_RETURN_REG, 0, SLJIT_IMM, 1));
+ add_jump(compiler, backtracks, CMP(SLJIT_LESS_EQUAL, SLJIT_RETURN_REG, 0, SLJIT_IMM, 1));
else
{
- add_jump(compiler, backtracks, CMP(SLJIT_C_EQUAL, SLJIT_RETURN_REG, 0, SLJIT_IMM, 0));
- nopartial = CMP(SLJIT_C_NOT_EQUAL, SLJIT_RETURN_REG, 0, SLJIT_IMM, 1);
+ add_jump(compiler, backtracks, CMP(SLJIT_EQUAL, SLJIT_RETURN_REG, 0, SLJIT_IMM, 0));
+ nopartial = CMP(SLJIT_NOT_EQUAL, SLJIT_RETURN_REG, 0, SLJIT_IMM, 1);
check_partial(common, FALSE);
add_jump(compiler, backtracks, JUMP(SLJIT_JUMP));
JUMPHERE(nopartial);
@@ -5152,17 +6806,21 @@ if (common->utf && *cc == OP_REFI)
else
#endif /* SUPPORT_UTF && SUPPORT_UCP */
{
- OP2(SLJIT_SUB | SLJIT_SET_E, TMP2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(offset + 1), TMP1, 0);
+ if (ref)
+ OP2(SLJIT_SUB | SLJIT_SET_Z, TMP2, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset + 1), TMP1, 0);
+ else
+ OP2(SLJIT_SUB | SLJIT_SET_Z, TMP2, 0, SLJIT_MEM1(TMP2), sizeof(sljit_sw), TMP1, 0);
+
if (withchecks)
- jump = JUMP(SLJIT_C_ZERO);
+ jump = JUMP(SLJIT_ZERO);
OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, TMP2, 0);
- partial = CMP(SLJIT_C_GREATER, STR_PTR, 0, STR_END, 0);
+ partial = CMP(SLJIT_GREATER, STR_PTR, 0, STR_END, 0);
if (common->mode == JIT_COMPILE)
add_jump(compiler, backtracks, partial);
add_jump(compiler, *cc == OP_REF ? &common->casefulcmp : &common->caselesscmp, JUMP(SLJIT_FAST_CALL));
- add_jump(compiler, backtracks, CMP(SLJIT_C_NOT_EQUAL, TMP2, 0, SLJIT_IMM, 0));
+ add_jump(compiler, backtracks, CMP(SLJIT_NOT_EQUAL, TMP2, 0, SLJIT_IMM, 0));
if (common->mode != JIT_COMPILE)
{
@@ -5171,10 +6829,10 @@ else
/* TMP2 -= STR_END - STR_PTR */
OP2(SLJIT_SUB, TMP2, 0, TMP2, 0, STR_PTR, 0);
OP2(SLJIT_ADD, TMP2, 0, TMP2, 0, STR_END, 0);
- partial = CMP(SLJIT_C_EQUAL, TMP2, 0, SLJIT_IMM, 0);
+ partial = CMP(SLJIT_EQUAL, TMP2, 0, SLJIT_IMM, 0);
OP1(SLJIT_MOV, STR_PTR, 0, STR_END, 0);
add_jump(compiler, *cc == OP_REF ? &common->casefulcmp : &common->caselesscmp, JUMP(SLJIT_FAST_CALL));
- add_jump(compiler, backtracks, CMP(SLJIT_C_NOT_EQUAL, TMP2, 0, SLJIT_IMM, 0));
+ add_jump(compiler, backtracks, CMP(SLJIT_NOT_EQUAL, TMP2, 0, SLJIT_IMM, 0));
JUMPHERE(partial);
check_partial(common, FALSE);
add_jump(compiler, backtracks, JUMP(SLJIT_JUMP));
@@ -5189,14 +6847,15 @@ if (jump != NULL)
else
JUMPHERE(jump);
}
-return cc + 1 + IMM2_SIZE;
}
static SLJIT_INLINE pcre_uchar *compile_ref_iterator_matchingpath(compiler_common *common, pcre_uchar *cc, backtrack_common *parent)
{
DEFINE_COMPILER;
+BOOL ref = (*cc == OP_REF || *cc == OP_REFI);
backtrack_common *backtrack;
pcre_uchar type;
+int offset = 0;
struct sljit_label *label;
struct sljit_jump *zerolength;
struct sljit_jump *jump = NULL;
@@ -5204,9 +6863,15 @@ pcre_uchar *ccbegin = cc;
int min = 0, max = 0;
BOOL minimize;
-PUSH_BACKTRACK(sizeof(iterator_backtrack), cc, NULL);
+PUSH_BACKTRACK(sizeof(ref_iterator_backtrack), cc, NULL);
+if (ref)
+ offset = GET2(cc, 1) << 1;
+else
+ cc += IMM2_SIZE;
type = cc[1 + IMM2_SIZE];
+
+SLJIT_COMPILE_ASSERT((OP_CRSTAR & 0x1) == 0, crstar_opcode_must_be_even);
minimize = (type & 0x1) != 0;
switch(type)
{
@@ -5235,7 +6900,7 @@ switch(type)
cc += 1 + IMM2_SIZE + 1 + 2 * IMM2_SIZE;
break;
default:
- SLJIT_ASSERT_STOP();
+ SLJIT_UNREACHABLE();
break;
}
@@ -5244,37 +6909,64 @@ if (!minimize)
if (min == 0)
{
allocate_stack(common, 2);
+ if (ref)
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset));
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), STR_PTR, 0);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(1), SLJIT_IMM, 0);
/* Temporary release of STR_PTR. */
- OP2(SLJIT_SUB, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, sizeof(sljit_sw));
- zerolength = compile_ref_checks(common, ccbegin, NULL);
- /* Restore if not zero length. */
OP2(SLJIT_ADD, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, sizeof(sljit_sw));
+ /* Handles both invalid and empty cases. Since the minimum repeat,
+ is zero the invalid case is basically the same as an empty case. */
+ if (ref)
+ zerolength = CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset + 1));
+ else
+ {
+ compile_dnref_search(common, ccbegin, NULL);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(TMP2), 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), POSSESSIVE1, TMP2, 0);
+ zerolength = CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_MEM1(TMP2), sizeof(sljit_sw));
+ }
+ /* Restore if not zero length. */
+ OP2(SLJIT_SUB, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, sizeof(sljit_sw));
}
else
{
allocate_stack(common, 1);
+ if (ref)
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset));
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), SLJIT_IMM, 0);
- zerolength = compile_ref_checks(common, ccbegin, &backtrack->topbacktracks);
+ if (ref)
+ {
+ add_jump(compiler, &backtrack->topbacktracks, CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(1)));
+ zerolength = CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset + 1));
+ }
+ else
+ {
+ compile_dnref_search(common, ccbegin, &backtrack->topbacktracks);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(TMP2), 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), POSSESSIVE1, TMP2, 0);
+ zerolength = CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_MEM1(TMP2), sizeof(sljit_sw));
+ }
}
if (min > 1 || max > 1)
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), POSSESSIVE0, SLJIT_IMM, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), POSSESSIVE0, SLJIT_IMM, 0);
label = LABEL();
+ if (!ref)
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), POSSESSIVE1);
compile_ref_matchingpath(common, ccbegin, &backtrack->topbacktracks, FALSE, FALSE);
if (min > 1 || max > 1)
{
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), POSSESSIVE0);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), POSSESSIVE0);
OP2(SLJIT_ADD, TMP1, 0, TMP1, 0, SLJIT_IMM, 1);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), POSSESSIVE0, TMP1, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), POSSESSIVE0, TMP1, 0);
if (min > 1)
- CMPTO(SLJIT_C_LESS, TMP1, 0, SLJIT_IMM, min, label);
+ CMPTO(SLJIT_LESS, TMP1, 0, SLJIT_IMM, min, label);
if (max > 1)
{
- jump = CMP(SLJIT_C_GREATER_EQUAL, TMP1, 0, SLJIT_IMM, max);
+ jump = CMP(SLJIT_GREATER_EQUAL, TMP1, 0, SLJIT_IMM, max);
allocate_stack(common, 1);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), STR_PTR, 0);
JUMPTO(SLJIT_JUMP, label);
@@ -5291,30 +6983,58 @@ if (!minimize)
}
JUMPHERE(zerolength);
- BACKTRACK_AS(iterator_backtrack)->matchingpath = LABEL();
+ BACKTRACK_AS(ref_iterator_backtrack)->matchingpath = LABEL();
count_match(common);
return cc;
}
-allocate_stack(common, 2);
+allocate_stack(common, ref ? 2 : 3);
+if (ref)
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset));
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), SLJIT_IMM, 0);
if (type != OP_CRMINSTAR)
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(1), SLJIT_IMM, 0);
if (min == 0)
{
- zerolength = compile_ref_checks(common, ccbegin, NULL);
+ /* Handles both invalid and empty cases. Since the minimum repeat,
+ is zero the invalid case is basically the same as an empty case. */
+ if (ref)
+ zerolength = CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset + 1));
+ else
+ {
+ compile_dnref_search(common, ccbegin, NULL);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(TMP2), 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(2), TMP2, 0);
+ zerolength = CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_MEM1(TMP2), sizeof(sljit_sw));
+ }
+ /* Length is non-zero, we can match real repeats. */
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), STR_PTR, 0);
jump = JUMP(SLJIT_JUMP);
}
else
- zerolength = compile_ref_checks(common, ccbegin, &backtrack->topbacktracks);
+ {
+ if (ref)
+ {
+ add_jump(compiler, &backtrack->topbacktracks, CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(1)));
+ zerolength = CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset + 1));
+ }
+ else
+ {
+ compile_dnref_search(common, ccbegin, &backtrack->topbacktracks);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(TMP2), 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(2), TMP2, 0);
+ zerolength = CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_MEM1(TMP2), sizeof(sljit_sw));
+ }
+ }
-BACKTRACK_AS(iterator_backtrack)->matchingpath = LABEL();
+BACKTRACK_AS(ref_iterator_backtrack)->matchingpath = LABEL();
if (max > 0)
- add_jump(compiler, &backtrack->topbacktracks, CMP(SLJIT_C_GREATER_EQUAL, SLJIT_MEM1(STACK_TOP), STACK(1), SLJIT_IMM, max));
+ add_jump(compiler, &backtrack->topbacktracks, CMP(SLJIT_GREATER_EQUAL, SLJIT_MEM1(STACK_TOP), STACK(1), SLJIT_IMM, max));
+if (!ref)
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(STACK_TOP), STACK(2));
compile_ref_matchingpath(common, ccbegin, &backtrack->topbacktracks, TRUE, TRUE);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), STR_PTR, 0);
@@ -5323,7 +7043,7 @@ if (min > 1)
OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), STACK(1));
OP2(SLJIT_ADD, TMP1, 0, TMP1, 0, SLJIT_IMM, 1);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(1), TMP1, 0);
- CMPTO(SLJIT_C_LESS, TMP1, 0, SLJIT_IMM, min, BACKTRACK_AS(iterator_backtrack)->matchingpath);
+ CMPTO(SLJIT_LESS, TMP1, 0, SLJIT_IMM, min, BACKTRACK_AS(ref_iterator_backtrack)->matchingpath);
}
else if (max > 0)
OP2(SLJIT_ADD, SLJIT_MEM1(STACK_TOP), STACK(1), SLJIT_MEM1(STACK_TOP), STACK(1), SLJIT_IMM, 1);
@@ -5383,15 +7103,15 @@ if (entry == NULL)
if (common->has_set_som && common->mark_ptr != 0)
{
- OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(0));
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(0));
allocate_stack(common, 2);
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->mark_ptr);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), common->mark_ptr);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), TMP2, 0);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(1), TMP1, 0);
}
else if (common->has_set_som || common->mark_ptr != 0)
{
- OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->has_set_som ? (int)(OVECTOR(0)) : common->mark_ptr);
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), common->has_set_som ? (int)(OVECTOR(0)) : common->mark_ptr);
allocate_stack(common, 1);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), TMP2, 0);
}
@@ -5401,11 +7121,11 @@ if (entry->entry == NULL)
else
JUMPTO(SLJIT_FAST_CALL, entry->entry);
/* Leave if the match is failed. */
-add_jump(compiler, &backtrack->topbacktracks, CMP(SLJIT_C_EQUAL, TMP1, 0, SLJIT_IMM, 0));
+add_jump(compiler, &backtrack->topbacktracks, CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, 0));
return cc + 1 + LINK_SIZE;
}
-static int SLJIT_CALL do_callout(struct jit_arguments* arguments, PUBL(callout_block) *callout_block, pcre_uchar **jit_ovector)
+static int SLJIT_CALL do_callout(struct jit_arguments *arguments, PUBL(callout_block) *callout_block, pcre_uchar **jit_ovector)
{
const pcre_uchar *begin = arguments->begin;
int *offset_vector = arguments->offsets;
@@ -5454,7 +7174,7 @@ return (*PUBL(callout))(callout_block);
(((int)sizeof(PUBL(callout_block)) + 7) & ~7)
#define CALLOUT_ARG_OFFSET(arg) \
- (-CALLOUT_ARG_SIZE + SLJIT_OFFSETOF(PUBL(callout_block), arg))
+ SLJIT_OFFSETOF(PUBL(callout_block), arg)
static SLJIT_INLINE pcre_uchar *compile_callout_matchingpath(compiler_common *common, pcre_uchar *cc, backtrack_common *parent)
{
@@ -5465,45 +7185,72 @@ PUSH_BACKTRACK(sizeof(backtrack_common), cc, NULL);
allocate_stack(common, CALLOUT_ARG_SIZE / sizeof(sljit_sw));
-OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->capture_last_ptr);
-OP1(SLJIT_MOV, TMP1, 0, ARGUMENTS, 0);
SLJIT_ASSERT(common->capture_last_ptr != 0);
-OP1(SLJIT_MOV_SI, SLJIT_MEM1(STACK_TOP), CALLOUT_ARG_OFFSET(callout_number), SLJIT_IMM, cc[1]);
-OP1(SLJIT_MOV_SI, SLJIT_MEM1(STACK_TOP), CALLOUT_ARG_OFFSET(capture_last), TMP2, 0);
+OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), common->capture_last_ptr);
+OP1(SLJIT_MOV, TMP1, 0, ARGUMENTS, 0);
+OP1(SLJIT_MOV_S32, SLJIT_MEM1(STACK_TOP), CALLOUT_ARG_OFFSET(callout_number), SLJIT_IMM, cc[1]);
+OP1(SLJIT_MOV_S32, SLJIT_MEM1(STACK_TOP), CALLOUT_ARG_OFFSET(capture_last), TMP2, 0);
/* These pointer sized fields temporarly stores internal variables. */
-OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(0));
+OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(0));
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), CALLOUT_ARG_OFFSET(offset_vector), STR_PTR, 0);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), CALLOUT_ARG_OFFSET(subject), TMP2, 0);
if (common->mark_ptr != 0)
OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, mark_ptr));
-OP1(SLJIT_MOV_SI, SLJIT_MEM1(STACK_TOP), CALLOUT_ARG_OFFSET(pattern_position), SLJIT_IMM, GET(cc, 2));
-OP1(SLJIT_MOV_SI, SLJIT_MEM1(STACK_TOP), CALLOUT_ARG_OFFSET(next_item_length), SLJIT_IMM, GET(cc, 2 + LINK_SIZE));
+OP1(SLJIT_MOV_S32, SLJIT_MEM1(STACK_TOP), CALLOUT_ARG_OFFSET(pattern_position), SLJIT_IMM, GET(cc, 2));
+OP1(SLJIT_MOV_S32, SLJIT_MEM1(STACK_TOP), CALLOUT_ARG_OFFSET(next_item_length), SLJIT_IMM, GET(cc, 2 + LINK_SIZE));
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), CALLOUT_ARG_OFFSET(mark), (common->mark_ptr != 0) ? TMP2 : SLJIT_IMM, 0);
/* Needed to save important temporary registers. */
-OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), LOCALS0, STACK_TOP, 0);
-OP2(SLJIT_SUB, SLJIT_SCRATCH_REG2, 0, STACK_TOP, 0, SLJIT_IMM, CALLOUT_ARG_SIZE);
-GET_LOCAL_BASE(SLJIT_SCRATCH_REG3, 0, OVECTOR_START);
+OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), LOCALS0, STACK_TOP, 0);
+/* SLJIT_R0 = arguments */
+OP1(SLJIT_MOV, SLJIT_R1, 0, STACK_TOP, 0);
+GET_LOCAL_BASE(SLJIT_R2, 0, OVECTOR_START);
sljit_emit_ijump(compiler, SLJIT_CALL3, SLJIT_IMM, SLJIT_FUNC_OFFSET(do_callout));
-OP1(SLJIT_MOV_SI, SLJIT_RETURN_REG, 0, SLJIT_RETURN_REG, 0);
-OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), LOCALS0);
+OP1(SLJIT_MOV_S32, SLJIT_RETURN_REG, 0, SLJIT_RETURN_REG, 0);
+OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), LOCALS0);
free_stack(common, CALLOUT_ARG_SIZE / sizeof(sljit_sw));
/* Check return value. */
-OP2(SLJIT_SUB | SLJIT_SET_S, SLJIT_UNUSED, 0, SLJIT_RETURN_REG, 0, SLJIT_IMM, 0);
-add_jump(compiler, &backtrack->topbacktracks, JUMP(SLJIT_C_SIG_GREATER));
+OP2(SLJIT_SUB | SLJIT_SET_Z | SLJIT_SET_SIG_GREATER, SLJIT_UNUSED, 0, SLJIT_RETURN_REG, 0, SLJIT_IMM, 0);
+add_jump(compiler, &backtrack->topbacktracks, JUMP(SLJIT_SIG_GREATER));
if (common->forced_quit_label == NULL)
- add_jump(compiler, &common->forced_quit, JUMP(SLJIT_C_SIG_LESS));
+ add_jump(compiler, &common->forced_quit, JUMP(SLJIT_NOT_EQUAL) /* SIG_LESS */);
else
- JUMPTO(SLJIT_C_SIG_LESS, common->forced_quit_label);
+ JUMPTO(SLJIT_NOT_EQUAL /* SIG_LESS */, common->forced_quit_label);
return cc + 2 + 2 * LINK_SIZE;
}
#undef CALLOUT_ARG_SIZE
#undef CALLOUT_ARG_OFFSET
+static SLJIT_INLINE BOOL assert_needs_str_ptr_saving(pcre_uchar *cc)
+{
+while (TRUE)
+ {
+ switch (*cc)
+ {
+ case OP_NOT_WORD_BOUNDARY:
+ case OP_WORD_BOUNDARY:
+ case OP_CIRC:
+ case OP_CIRCM:
+ case OP_DOLL:
+ case OP_DOLLM:
+ case OP_CALLOUT:
+ case OP_ALT:
+ cc += PRIV(OP_lengths)[*cc];
+ break;
+
+ case OP_KET:
+ return FALSE;
+
+ default:
+ return TRUE;
+ }
+ }
+}
+
static pcre_uchar *compile_assert_matchingpath(compiler_common *common, pcre_uchar *cc, assert_backtrack *backtrack, BOOL conditional)
{
DEFINE_COMPILER;
@@ -5555,21 +7302,34 @@ if (bra == OP_BRAMINZERO)
/* This is a braminzero backtrack path. */
OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), STACK(0));
free_stack(common, 1);
- brajump = CMP(SLJIT_C_EQUAL, STR_PTR, 0, SLJIT_IMM, 0);
+ brajump = CMP(SLJIT_EQUAL, STR_PTR, 0, SLJIT_IMM, 0);
}
if (framesize < 0)
{
- extrasize = needs_control_head ? 2 : 1;
+ extrasize = 1;
+ if (bra == OP_BRA && !assert_needs_str_ptr_saving(ccbegin + 1 + LINK_SIZE))
+ extrasize = 0;
+
+ if (needs_control_head)
+ extrasize++;
+
if (framesize == no_frame)
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr, STACK_TOP, 0);
- allocate_stack(common, extrasize);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), private_data_ptr, STACK_TOP, 0);
+
+ if (extrasize > 0)
+ allocate_stack(common, extrasize);
+
if (needs_control_head)
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->control_head_ptr);
- OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), STR_PTR, 0);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr);
+
+ if (extrasize > 0)
+ OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), STR_PTR, 0);
+
if (needs_control_head)
{
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->control_head_ptr, SLJIT_IMM, 0);
+ SLJIT_ASSERT(extrasize == 2);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr, SLJIT_IMM, 0);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(1), TMP1, 0);
}
}
@@ -5577,20 +7337,23 @@ else
{
extrasize = needs_control_head ? 3 : 2;
allocate_stack(common, framesize + extrasize);
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr);
- OP2(SLJIT_SUB, TMP2, 0, STACK_TOP, 0, SLJIT_IMM, (framesize + extrasize) * sizeof(sljit_sw));
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr, TMP2, 0);
+
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr);
+ OP2(SLJIT_ADD, TMP2, 0, STACK_TOP, 0, SLJIT_IMM, (framesize + extrasize) * sizeof(sljit_sw));
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), private_data_ptr, TMP2, 0);
if (needs_control_head)
- OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->control_head_ptr);
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), STR_PTR, 0);
+
if (needs_control_head)
{
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(2), TMP1, 0);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(1), TMP2, 0);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->control_head_ptr, SLJIT_IMM, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr, SLJIT_IMM, 0);
}
else
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(1), TMP1, 0);
+
init_frame(common, ccbegin, NULL, framesize + extrasize - 1, extrasize, FALSE);
}
@@ -5614,7 +7377,7 @@ while (1)
altbacktrack.top = NULL;
altbacktrack.topbacktracks = NULL;
- if (*ccbegin == OP_ALT)
+ if (*ccbegin == OP_ALT && extrasize > 0)
OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), STACK(0));
altbacktrack.cc = ccbegin;
@@ -5642,26 +7405,27 @@ while (1)
if (framesize < 0)
{
if (framesize == no_frame)
- OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr);
- else
+ OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr);
+ else if (extrasize > 0)
free_stack(common, extrasize);
+
if (needs_control_head)
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->control_head_ptr, SLJIT_MEM1(STACK_TOP), 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr, SLJIT_MEM1(STACK_TOP), STACK(-1));
}
else
{
if ((opcode != OP_ASSERT_NOT && opcode != OP_ASSERTBACK_NOT) || conditional)
{
/* We don't need to keep the STR_PTR, only the previous private_data_ptr. */
- OP2(SLJIT_ADD, STACK_TOP, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr, SLJIT_IMM, (framesize + 1) * sizeof(sljit_sw));
+ OP2(SLJIT_SUB, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr, SLJIT_IMM, (framesize + 1) * sizeof(sljit_sw));
if (needs_control_head)
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->control_head_ptr, SLJIT_MEM1(STACK_TOP), 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr, SLJIT_MEM1(STACK_TOP), STACK(-1));
}
else
{
- OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr);
+ OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr);
if (needs_control_head)
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->control_head_ptr, SLJIT_MEM1(STACK_TOP), (framesize + 1) * sizeof(sljit_sw));
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr, SLJIT_MEM1(STACK_TOP), STACK(-framesize - 2));
add_jump(compiler, &common->revertframes, JUMP(SLJIT_FAST_CALL));
}
}
@@ -5670,24 +7434,27 @@ while (1)
{
/* We know that STR_PTR was stored on the top of the stack. */
if (conditional)
- OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), needs_control_head ? sizeof(sljit_sw) : 0);
+ {
+ if (extrasize > 0)
+ OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), needs_control_head ? STACK(-2) : STACK(-1));
+ }
else if (bra == OP_BRAZERO)
{
if (framesize < 0)
- OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), (extrasize - 1) * sizeof(sljit_sw));
+ OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), STACK(-extrasize));
else
{
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), framesize * sizeof(sljit_sw));
- OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), (framesize + extrasize - 1) * sizeof(sljit_sw));
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr, TMP1, 0);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), STACK(-framesize - 1));
+ OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), STACK(-framesize - extrasize));
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), private_data_ptr, TMP1, 0);
}
- OP2(SLJIT_ADD, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, sizeof(sljit_sw));
+ OP2(SLJIT_SUB, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, sizeof(sljit_sw));
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), SLJIT_IMM, 0);
}
else if (framesize >= 0)
{
/* For OP_BRA and OP_BRAMINZERO. */
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr, SLJIT_MEM1(STACK_TOP), framesize * sizeof(sljit_sw));
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), private_data_ptr, SLJIT_MEM1(STACK_TOP), STACK(-framesize - 1));
}
}
add_jump(compiler, found, JUMP(SLJIT_JUMP));
@@ -5731,23 +7498,23 @@ if (common->positive_assert_quit != NULL)
set_jumps(common->positive_assert_quit, LABEL());
SLJIT_ASSERT(framesize != no_stack);
if (framesize < 0)
- OP2(SLJIT_ADD, STACK_TOP, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr, SLJIT_IMM, extrasize * sizeof(sljit_sw));
+ OP2(SLJIT_SUB, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr, SLJIT_IMM, extrasize * sizeof(sljit_sw));
else
{
- OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr);
+ OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr);
add_jump(compiler, &common->revertframes, JUMP(SLJIT_FAST_CALL));
- OP2(SLJIT_ADD, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, (framesize + extrasize) * sizeof(sljit_sw));
+ OP2(SLJIT_SUB, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, (framesize + extrasize) * sizeof(sljit_sw));
}
JUMPHERE(jump);
}
if (needs_control_head)
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->control_head_ptr, SLJIT_MEM1(STACK_TOP), STACK(1));
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr, SLJIT_MEM1(STACK_TOP), STACK(1));
if (opcode == OP_ASSERT || opcode == OP_ASSERTBACK)
{
/* Assert is failed. */
- if (conditional || bra == OP_BRAZERO)
+ if ((conditional && extrasize > 0) || bra == OP_BRAZERO)
OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), STACK(0));
if (framesize < 0)
@@ -5759,7 +7526,7 @@ if (opcode == OP_ASSERT || opcode == OP_ASSERTBACK)
free_stack(common, 1);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), SLJIT_IMM, 0);
}
- else
+ else if (extrasize > 0)
free_stack(common, extrasize);
}
else
@@ -5773,7 +7540,7 @@ if (opcode == OP_ASSERT || opcode == OP_ASSERTBACK)
}
else
free_stack(common, framesize + extrasize);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr, TMP1, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), private_data_ptr, TMP1, 0);
}
jump = JUMP(SLJIT_JUMP);
if (bra != OP_BRAZERO)
@@ -5784,17 +7551,19 @@ if (opcode == OP_ASSERT || opcode == OP_ASSERTBACK)
if (framesize < 0)
{
/* We know that STR_PTR was stored on the top of the stack. */
- OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), (extrasize - 1) * sizeof(sljit_sw));
+ if (extrasize > 0)
+ OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), STACK(-extrasize));
+
/* Keep the STR_PTR on the top of the stack. */
if (bra == OP_BRAZERO)
{
- OP2(SLJIT_ADD, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, sizeof(sljit_sw));
+ OP2(SLJIT_SUB, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, sizeof(sljit_sw));
if (extrasize == 2)
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), STR_PTR, 0);
}
else if (bra == OP_BRAMINZERO)
{
- OP2(SLJIT_ADD, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, sizeof(sljit_sw));
+ OP2(SLJIT_SUB, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, sizeof(sljit_sw));
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), SLJIT_IMM, 0);
}
}
@@ -5803,13 +7572,13 @@ if (opcode == OP_ASSERT || opcode == OP_ASSERTBACK)
if (bra == OP_BRA)
{
/* We don't need to keep the STR_PTR, only the previous private_data_ptr. */
- OP2(SLJIT_ADD, STACK_TOP, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr, SLJIT_IMM, (framesize + 1) * sizeof(sljit_sw));
- OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), (extrasize - 2) * sizeof(sljit_sw));
+ OP2(SLJIT_SUB, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr, SLJIT_IMM, (framesize + 1) * sizeof(sljit_sw));
+ OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), STACK(-extrasize + 1));
}
else
{
/* We don't need to keep the STR_PTR, only the previous private_data_ptr. */
- OP2(SLJIT_ADD, STACK_TOP, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr, SLJIT_IMM, (framesize + 2) * sizeof(sljit_sw));
+ OP2(SLJIT_SUB, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr, SLJIT_IMM, (framesize + 2) * sizeof(sljit_sw));
if (extrasize == 2)
{
OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), STACK(0));
@@ -5835,9 +7604,9 @@ if (opcode == OP_ASSERT || opcode == OP_ASSERTBACK)
JUMPHERE(brajump);
if (framesize >= 0)
{
- OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr);
+ OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr);
add_jump(compiler, &common->revertframes, JUMP(SLJIT_FAST_CALL));
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr, SLJIT_MEM1(STACK_TOP), framesize * sizeof(sljit_sw));
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), private_data_ptr, SLJIT_MEM1(STACK_TOP), STACK(-framesize - 1));
}
set_jumps(backtrack->common.topbacktracks, LABEL());
}
@@ -5847,14 +7616,16 @@ else
/* AssertNot is successful. */
if (framesize < 0)
{
- OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), STACK(0));
+ if (extrasize > 0)
+ OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), STACK(0));
+
if (bra != OP_BRA)
{
if (extrasize == 2)
free_stack(common, 1);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), SLJIT_IMM, 0);
}
- else
+ else if (extrasize > 0)
free_stack(common, extrasize);
}
else
@@ -5869,7 +7640,7 @@ else
}
else
free_stack(common, framesize + extrasize);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr, TMP1, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), private_data_ptr, TMP1, 0);
}
if (bra == OP_BRAZERO)
@@ -5902,116 +7673,6 @@ common->accept = save_accept;
return cc + 1 + LINK_SIZE;
}
-static sljit_sw SLJIT_CALL do_searchovector(sljit_uw refno, sljit_sw* locals, pcre_uchar *name_table)
-{
-int condition = FALSE;
-pcre_uchar *slotA = name_table;
-pcre_uchar *slotB;
-sljit_sw name_count = locals[LOCALS0 / sizeof(sljit_sw)];
-sljit_sw name_entry_size = locals[LOCALS1 / sizeof(sljit_sw)];
-sljit_sw no_capture;
-int i;
-
-locals += refno & 0xff;
-refno >>= 8;
-no_capture = locals[1];
-
-for (i = 0; i < name_count; i++)
- {
- if (GET2(slotA, 0) == refno) break;
- slotA += name_entry_size;
- }
-
-if (i < name_count)
- {
- /* Found a name for the number - there can be only one; duplicate names
- for different numbers are allowed, but not vice versa. First scan down
- for duplicates. */
-
- slotB = slotA;
- while (slotB > name_table)
- {
- slotB -= name_entry_size;
- if (STRCMP_UC_UC(slotA + IMM2_SIZE, slotB + IMM2_SIZE) == 0)
- {
- condition = locals[GET2(slotB, 0) << 1] != no_capture;
- if (condition) break;
- }
- else break;
- }
-
- /* Scan up for duplicates */
- if (!condition)
- {
- slotB = slotA;
- for (i++; i < name_count; i++)
- {
- slotB += name_entry_size;
- if (STRCMP_UC_UC(slotA + IMM2_SIZE, slotB + IMM2_SIZE) == 0)
- {
- condition = locals[GET2(slotB, 0) << 1] != no_capture;
- if (condition) break;
- }
- else break;
- }
- }
- }
-return condition;
-}
-
-static sljit_sw SLJIT_CALL do_searchgroups(sljit_uw recno, sljit_uw* locals, pcre_uchar *name_table)
-{
-int condition = FALSE;
-pcre_uchar *slotA = name_table;
-pcre_uchar *slotB;
-sljit_uw name_count = locals[LOCALS0 / sizeof(sljit_sw)];
-sljit_uw name_entry_size = locals[LOCALS1 / sizeof(sljit_sw)];
-sljit_uw group_num = locals[POSSESSIVE0 / sizeof(sljit_sw)];
-sljit_uw i;
-
-for (i = 0; i < name_count; i++)
- {
- if (GET2(slotA, 0) == recno) break;
- slotA += name_entry_size;
- }
-
-if (i < name_count)
- {
- /* Found a name for the number - there can be only one; duplicate
- names for different numbers are allowed, but not vice versa. First
- scan down for duplicates. */
-
- slotB = slotA;
- while (slotB > name_table)
- {
- slotB -= name_entry_size;
- if (STRCMP_UC_UC(slotA + IMM2_SIZE, slotB + IMM2_SIZE) == 0)
- {
- condition = GET2(slotB, 0) == group_num;
- if (condition) break;
- }
- else break;
- }
-
- /* Scan up for duplicates */
- if (!condition)
- {
- slotB = slotA;
- for (i++; i < name_count; i++)
- {
- slotB += name_entry_size;
- if (STRCMP_UC_UC(slotA + IMM2_SIZE, slotB + IMM2_SIZE) == 0)
- {
- condition = GET2(slotB, 0) == group_num;
- if (condition) break;
- }
- else break;
- }
- }
- }
-return condition;
-}
-
static SLJIT_INLINE void match_once_common(compiler_common *common, pcre_uchar ket, int framesize, int private_data_ptr, BOOL has_alternatives, BOOL needs_control_head)
{
DEFINE_COMPILER;
@@ -6020,33 +7681,35 @@ int stacksize;
if (framesize < 0)
{
if (framesize == no_frame)
- OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr);
+ OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr);
else
{
stacksize = needs_control_head ? 1 : 0;
if (ket != OP_KET || has_alternatives)
stacksize++;
- free_stack(common, stacksize);
+
+ if (stacksize > 0)
+ free_stack(common, stacksize);
}
if (needs_control_head)
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), (ket != OP_KET || has_alternatives) ? sizeof(sljit_sw) : 0);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), (ket != OP_KET || has_alternatives) ? STACK(-2) : STACK(-1));
/* TMP2 which is set here used by OP_KETRMAX below. */
if (ket == OP_KETRMAX)
- OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(STACK_TOP), 0);
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(STACK_TOP), STACK(-1));
else if (ket == OP_KETRMIN)
{
/* Move the STR_PTR to the private_data_ptr. */
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr, SLJIT_MEM1(STACK_TOP), 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), private_data_ptr, SLJIT_MEM1(STACK_TOP), STACK(-1));
}
}
else
{
stacksize = (ket != OP_KET || has_alternatives) ? 2 : 1;
- OP2(SLJIT_ADD, STACK_TOP, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr, SLJIT_IMM, (framesize + stacksize) * sizeof(sljit_sw));
+ OP2(SLJIT_SUB, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr, SLJIT_IMM, (framesize + stacksize) * sizeof(sljit_sw));
if (needs_control_head)
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), 0);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), STACK(-1));
if (ket == OP_KETRMAX)
{
@@ -6055,7 +7718,7 @@ else
}
}
if (needs_control_head)
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->control_head_ptr, TMP1, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr, TMP1, 0);
}
static SLJIT_INLINE int match_capture_common(compiler_common *common, int stacksize, int offset, int private_data_ptr)
@@ -6064,20 +7727,20 @@ DEFINE_COMPILER;
if (common->capture_last_ptr != 0)
{
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->capture_last_ptr);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->capture_last_ptr, SLJIT_IMM, offset >> 1);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), common->capture_last_ptr);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->capture_last_ptr, SLJIT_IMM, offset >> 1);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(stacksize), TMP1, 0);
stacksize++;
}
if (common->optimized_cbracket[offset >> 1] == 0)
{
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(offset));
- OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(offset + 1));
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset));
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset + 1));
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(stacksize), TMP1, 0);
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(stacksize + 1), TMP2, 0);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(offset + 1), STR_PTR, 0);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(offset), TMP1, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset + 1), STR_PTR, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset), TMP1, 0);
stacksize += 2;
}
return stacksize;
@@ -6144,11 +7807,12 @@ backtrack_common *backtrack;
pcre_uchar opcode;
int private_data_ptr = 0;
int offset = 0;
-int stacksize;
+int i, stacksize;
int repeat_ptr = 0, repeat_length = 0;
int repeat_type = 0, repeat_count = 0;
pcre_uchar *ccbegin;
pcre_uchar *matchingpath;
+pcre_uchar *slot;
pcre_uchar bra = OP_BRA;
pcre_uchar ket;
assert_backtrack *assert;
@@ -6198,20 +7862,8 @@ SLJIT_ASSERT(!((bra == OP_BRAZERO && ket == OP_KETRMIN) || (bra == OP_BRAMINZERO
cc += GET(cc, 1);
has_alternatives = *cc == OP_ALT;
-if (SLJIT_UNLIKELY(opcode == OP_COND) || SLJIT_UNLIKELY(opcode == OP_SCOND))
- {
- has_alternatives = (*matchingpath == OP_RREF) ? FALSE : TRUE;
- if (*matchingpath == OP_NRREF)
- {
- stacksize = GET2(matchingpath, 1);
- if (common->currententry == NULL || stacksize == RREF_ANY)
- has_alternatives = FALSE;
- else if (common->currententry->start == 0)
- has_alternatives = stacksize != 0;
- else
- has_alternatives = stacksize != (int)GET2(common->start, common->currententry->start + 1 + LINK_SIZE);
- }
- }
+if (SLJIT_UNLIKELY(opcode == OP_COND || opcode == OP_SCOND))
+ has_alternatives = (*matchingpath == OP_RREF || *matchingpath == OP_DNRREF || *matchingpath == OP_FAIL) ? FALSE : TRUE;
if (SLJIT_UNLIKELY(opcode == OP_COND) && (*cc == OP_KETRMAX || *cc == OP_KETRMIN))
opcode = OP_SCOND;
@@ -6272,13 +7924,13 @@ if (bra == OP_BRAMINZERO)
if (ket != OP_KETRMIN)
{
free_stack(common, 1);
- braminzero = CMP(SLJIT_C_EQUAL, STR_PTR, 0, SLJIT_IMM, 0);
+ braminzero = CMP(SLJIT_EQUAL, STR_PTR, 0, SLJIT_IMM, 0);
}
else
{
if (opcode == OP_ONCE || opcode >= OP_SBRA)
{
- jump = CMP(SLJIT_C_NOT_EQUAL, STR_PTR, 0, SLJIT_IMM, 0);
+ jump = CMP(SLJIT_NOT_EQUAL, STR_PTR, 0, SLJIT_IMM, 0);
OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), STACK(1));
/* Nothing stored during the first run. */
skip = JUMP(SLJIT_JUMP);
@@ -6287,19 +7939,19 @@ if (bra == OP_BRAMINZERO)
if (opcode != OP_ONCE || BACKTRACK_AS(bracket_backtrack)->u.framesize < 0)
{
/* When we come from outside, private_data_ptr contains the previous STR_PTR. */
- braminzero = CMP(SLJIT_C_EQUAL, STR_PTR, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr);
+ braminzero = CMP(SLJIT_EQUAL, STR_PTR, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr);
}
else
{
/* Except when the whole stack frame must be saved. */
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr);
- braminzero = CMP(SLJIT_C_EQUAL, STR_PTR, 0, SLJIT_MEM1(TMP1), (BACKTRACK_AS(bracket_backtrack)->u.framesize + 1) * sizeof(sljit_sw));
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr);
+ braminzero = CMP(SLJIT_EQUAL, STR_PTR, 0, SLJIT_MEM1(TMP1), STACK(-BACKTRACK_AS(bracket_backtrack)->u.framesize - 2));
}
JUMPHERE(skip);
}
else
{
- jump = CMP(SLJIT_C_NOT_EQUAL, STR_PTR, 0, SLJIT_IMM, 0);
+ jump = CMP(SLJIT_NOT_EQUAL, STR_PTR, 0, SLJIT_IMM, 0);
OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), STACK(1));
JUMPHERE(jump);
}
@@ -6308,7 +7960,7 @@ if (bra == OP_BRAMINZERO)
if (repeat_type != 0)
{
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), repeat_ptr, SLJIT_IMM, repeat_count);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), repeat_ptr, SLJIT_IMM, repeat_count);
if (repeat_type == OP_EXACT)
rmax_label = LABEL();
}
@@ -6329,7 +7981,7 @@ if (opcode == OP_ONCE)
stacksize = 0;
if (needs_control_head)
{
- OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->control_head_ptr);
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr);
stacksize++;
}
@@ -6340,12 +7992,12 @@ if (opcode == OP_ONCE)
{
stacksize += 2;
if (!needs_control_head)
- OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr);
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr);
}
else
{
if (BACKTRACK_AS(bracket_backtrack)->u.framesize == no_frame)
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr, STACK_TOP, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), private_data_ptr, STACK_TOP, 0);
if (ket == OP_KETRMAX || has_alternatives)
stacksize++;
}
@@ -6363,10 +8015,10 @@ if (opcode == OP_ONCE)
if (ket == OP_KETRMIN)
{
if (needs_control_head)
- OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr);
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(stacksize), STR_PTR, 0);
if (BACKTRACK_AS(bracket_backtrack)->u.framesize == no_frame)
- OP2(SLJIT_SUB, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr, STACK_TOP, 0, SLJIT_IMM, needs_control_head ? (2 * sizeof(sljit_sw)) : sizeof(sljit_sw));
+ OP2(SLJIT_ADD, SLJIT_MEM1(SLJIT_SP), private_data_ptr, STACK_TOP, 0, SLJIT_IMM, needs_control_head ? (2 * sizeof(sljit_sw)) : sizeof(sljit_sw));
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(stacksize + 1), TMP2, 0);
}
else if (ket == OP_KETRMAX || has_alternatives)
@@ -6383,20 +8035,20 @@ if (opcode == OP_ONCE)
if (needs_control_head)
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), TMP2, 0);
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr);
- OP2(SLJIT_SUB, TMP2, 0, STACK_TOP, 0, SLJIT_IMM, stacksize * sizeof(sljit_sw));
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr);
+ OP2(SLJIT_ADD, TMP2, 0, STACK_TOP, 0, SLJIT_IMM, stacksize * sizeof(sljit_sw));
stacksize = needs_control_head ? 1 : 0;
if (ket != OP_KET || has_alternatives)
{
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(stacksize), STR_PTR, 0);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr, TMP2, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), private_data_ptr, TMP2, 0);
stacksize++;
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(stacksize), TMP1, 0);
}
else
{
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr, TMP2, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), private_data_ptr, TMP2, 0);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(stacksize), TMP1, 0);
}
init_frame(common, ccbegin, NULL, BACKTRACK_AS(bracket_backtrack)->u.framesize + stacksize, stacksize + 1, FALSE);
@@ -6409,26 +8061,26 @@ else if (opcode == OP_CBRA || opcode == OP_SCBRA)
{
SLJIT_ASSERT(private_data_ptr == OVECTOR(offset));
allocate_stack(common, 2);
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr);
- OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr + sizeof(sljit_sw));
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr, STR_PTR, 0);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr);
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr + sizeof(sljit_sw));
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), private_data_ptr, STR_PTR, 0);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), TMP1, 0);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(1), TMP2, 0);
}
else
{
- OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr);
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr);
allocate_stack(common, 1);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr, STR_PTR, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), private_data_ptr, STR_PTR, 0);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), TMP2, 0);
}
}
else if (opcode == OP_SBRA || opcode == OP_SCOND)
{
/* Saving the previous value. */
- OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr);
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr);
allocate_stack(common, 1);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr, STR_PTR, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), private_data_ptr, STR_PTR, 0);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), TMP2, 0);
}
else if (has_alternatives)
@@ -6445,50 +8097,78 @@ if (opcode == OP_COND || opcode == OP_SCOND)
{
SLJIT_ASSERT(has_alternatives);
add_jump(compiler, &(BACKTRACK_AS(bracket_backtrack)->u.condfailed),
- CMP(SLJIT_C_EQUAL, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(GET2(matchingpath, 1) << 1), SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(1)));
+ CMP(SLJIT_EQUAL, SLJIT_MEM1(SLJIT_SP), OVECTOR(GET2(matchingpath, 1) << 1), SLJIT_MEM1(SLJIT_SP), OVECTOR(1)));
matchingpath += 1 + IMM2_SIZE;
}
- else if (*matchingpath == OP_NCREF)
+ else if (*matchingpath == OP_DNCREF)
{
SLJIT_ASSERT(has_alternatives);
- stacksize = GET2(matchingpath, 1);
- jump = CMP(SLJIT_C_NOT_EQUAL, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(stacksize << 1), SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(1));
-
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), POSSESSIVE1, STACK_TOP, 0);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), LOCALS0, SLJIT_IMM, common->name_count);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), LOCALS1, SLJIT_IMM, common->name_entry_size);
- OP1(SLJIT_MOV, SLJIT_SCRATCH_REG1, 0, SLJIT_IMM, (stacksize << 8) | (common->ovector_start / sizeof(sljit_sw)));
- GET_LOCAL_BASE(SLJIT_SCRATCH_REG2, 0, 0);
- OP1(SLJIT_MOV, SLJIT_SCRATCH_REG3, 0, SLJIT_IMM, common->name_table);
- sljit_emit_ijump(compiler, SLJIT_CALL3, SLJIT_IMM, SLJIT_FUNC_OFFSET(do_searchovector));
- OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), POSSESSIVE1);
- add_jump(compiler, &(BACKTRACK_AS(bracket_backtrack)->u.condfailed), CMP(SLJIT_C_EQUAL, SLJIT_SCRATCH_REG1, 0, SLJIT_IMM, 0));
- JUMPHERE(jump);
- matchingpath += 1 + IMM2_SIZE;
+ i = GET2(matchingpath, 1 + IMM2_SIZE);
+ slot = common->name_table + GET2(matchingpath, 1) * common->name_entry_size;
+ OP1(SLJIT_MOV, TMP3, 0, STR_PTR, 0);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(1));
+ OP2(SLJIT_SUB | SLJIT_SET_Z, TMP2, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(GET2(slot, 0) << 1), TMP1, 0);
+ slot += common->name_entry_size;
+ i--;
+ while (i-- > 0)
+ {
+ OP2(SLJIT_SUB, STR_PTR, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(GET2(slot, 0) << 1), TMP1, 0);
+ OP2(SLJIT_OR | SLJIT_SET_Z, TMP2, 0, TMP2, 0, STR_PTR, 0);
+ slot += common->name_entry_size;
+ }
+ OP1(SLJIT_MOV, STR_PTR, 0, TMP3, 0);
+ add_jump(compiler, &(BACKTRACK_AS(bracket_backtrack)->u.condfailed), JUMP(SLJIT_ZERO));
+ matchingpath += 1 + 2 * IMM2_SIZE;
}
- else if (*matchingpath == OP_RREF || *matchingpath == OP_NRREF)
+ else if (*matchingpath == OP_RREF || *matchingpath == OP_DNRREF || *matchingpath == OP_FAIL)
{
/* Never has other case. */
BACKTRACK_AS(bracket_backtrack)->u.condfailed = NULL;
+ SLJIT_ASSERT(!has_alternatives);
- stacksize = GET2(matchingpath, 1);
- if (common->currententry == NULL)
+ if (*matchingpath == OP_FAIL)
stacksize = 0;
- else if (stacksize == RREF_ANY)
- stacksize = 1;
- else if (common->currententry->start == 0)
- stacksize = stacksize == 0;
- else
- stacksize = stacksize == (int)GET2(common->start, common->currententry->start + 1 + LINK_SIZE);
-
- if (*matchingpath == OP_RREF || stacksize || common->currententry == NULL)
+ else if (*matchingpath == OP_RREF)
{
- SLJIT_ASSERT(!has_alternatives);
+ stacksize = GET2(matchingpath, 1);
+ if (common->currententry == NULL)
+ stacksize = 0;
+ else if (stacksize == RREF_ANY)
+ stacksize = 1;
+ else if (common->currententry->start == 0)
+ stacksize = stacksize == 0;
+ else
+ stacksize = stacksize == (int)GET2(common->start, common->currententry->start + 1 + LINK_SIZE);
+
if (stacksize != 0)
matchingpath += 1 + IMM2_SIZE;
+ }
+ else
+ {
+ if (common->currententry == NULL || common->currententry->start == 0)
+ stacksize = 0;
else
{
+ stacksize = GET2(matchingpath, 1 + IMM2_SIZE);
+ slot = common->name_table + GET2(matchingpath, 1) * common->name_entry_size;
+ i = (int)GET2(common->start, common->currententry->start + 1 + LINK_SIZE);
+ while (stacksize > 0)
+ {
+ if ((int)GET2(slot, 0) == i)
+ break;
+ slot += common->name_entry_size;
+ stacksize--;
+ }
+ }
+
+ if (stacksize != 0)
+ matchingpath += 1 + 2 * IMM2_SIZE;
+ }
+
+ /* The stacksize == 0 is a common "else" case. */
+ if (stacksize == 0)
+ {
if (*cc == OP_ALT)
{
matchingpath = cc + 1 + LINK_SIZE;
@@ -6497,24 +8177,6 @@ if (opcode == OP_COND || opcode == OP_SCOND)
else
matchingpath = cc;
}
- }
- else
- {
- SLJIT_ASSERT(has_alternatives);
-
- stacksize = GET2(matchingpath, 1);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), POSSESSIVE1, STACK_TOP, 0);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), LOCALS0, SLJIT_IMM, common->name_count);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), LOCALS1, SLJIT_IMM, common->name_entry_size);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), POSSESSIVE0, SLJIT_IMM, GET2(common->start, common->currententry->start + 1 + LINK_SIZE));
- OP1(SLJIT_MOV, SLJIT_SCRATCH_REG1, 0, SLJIT_IMM, stacksize);
- GET_LOCAL_BASE(SLJIT_SCRATCH_REG2, 0, 0);
- OP1(SLJIT_MOV, SLJIT_SCRATCH_REG3, 0, SLJIT_IMM, common->name_table);
- sljit_emit_ijump(compiler, SLJIT_CALL3, SLJIT_IMM, SLJIT_FUNC_OFFSET(do_searchgroups));
- OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), POSSESSIVE1);
- add_jump(compiler, &(BACKTRACK_AS(bracket_backtrack)->u.condfailed), CMP(SLJIT_C_EQUAL, SLJIT_SCRATCH_REG1, 0, SLJIT_IMM, 0));
- matchingpath += 1 + IMM2_SIZE;
- }
}
else
{
@@ -6541,7 +8203,7 @@ stacksize = 0;
if (repeat_type == OP_MINUPTO)
{
/* We need to preserve the counter. TMP2 will be used below. */
- OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), repeat_ptr);
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), repeat_ptr);
stacksize++;
}
if (ket != OP_KET || bra != OP_BRA)
@@ -6591,7 +8253,7 @@ if (has_alternatives)
if (offset != 0 && common->optimized_cbracket[offset >> 1] != 0)
{
SLJIT_ASSERT(private_data_ptr == OVECTOR(offset + 0));
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(offset + 1), STR_PTR, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset + 1), STR_PTR, 0);
}
if (ket == OP_KETRMAX)
@@ -6600,8 +8262,8 @@ if (ket == OP_KETRMAX)
{
if (has_alternatives)
BACKTRACK_AS(bracket_backtrack)->alternative_matchingpath = LABEL();
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_MEM1(SLJIT_LOCALS_REG), repeat_ptr, SLJIT_MEM1(SLJIT_LOCALS_REG), repeat_ptr, SLJIT_IMM, 1);
- JUMPTO(SLJIT_C_NOT_ZERO, rmax_label);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_MEM1(SLJIT_SP), repeat_ptr, SLJIT_MEM1(SLJIT_SP), repeat_ptr, SLJIT_IMM, 1);
+ JUMPTO(SLJIT_NOT_ZERO, rmax_label);
/* Drop STR_PTR for greedy plus quantifier. */
if (opcode != OP_ONCE)
free_stack(common, 1);
@@ -6613,14 +8275,14 @@ if (ket == OP_KETRMAX)
/* Checking zero-length iteration. */
if (opcode != OP_ONCE)
{
- CMPTO(SLJIT_C_NOT_EQUAL, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr, STR_PTR, 0, rmax_label);
+ CMPTO(SLJIT_NOT_EQUAL, SLJIT_MEM1(SLJIT_SP), private_data_ptr, STR_PTR, 0, rmax_label);
/* Drop STR_PTR for greedy plus quantifier. */
if (bra != OP_BRAZERO)
free_stack(common, 1);
}
else
/* TMP2 must contain the starting STR_PTR. */
- CMPTO(SLJIT_C_NOT_EQUAL, TMP2, 0, STR_PTR, 0, rmax_label);
+ CMPTO(SLJIT_NOT_EQUAL, TMP2, 0, STR_PTR, 0, rmax_label);
}
else
JUMPTO(SLJIT_JUMP, rmax_label);
@@ -6629,13 +8291,14 @@ if (ket == OP_KETRMAX)
if (repeat_type == OP_EXACT)
{
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_MEM1(SLJIT_LOCALS_REG), repeat_ptr, SLJIT_MEM1(SLJIT_LOCALS_REG), repeat_ptr, SLJIT_IMM, 1);
- JUMPTO(SLJIT_C_NOT_ZERO, rmax_label);
+ count_match(common);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_MEM1(SLJIT_SP), repeat_ptr, SLJIT_MEM1(SLJIT_SP), repeat_ptr, SLJIT_IMM, 1);
+ JUMPTO(SLJIT_NOT_ZERO, rmax_label);
}
else if (repeat_type == OP_UPTO)
{
/* We need to preserve the counter. */
- OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), repeat_ptr);
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), repeat_ptr);
allocate_stack(common, 1);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), TMP2, 0);
}
@@ -6655,7 +8318,7 @@ if (bra == OP_BRAMINZERO)
framesize is < 0, OP_ONCE will do the release itself. */
if (opcode == OP_ONCE && BACKTRACK_AS(bracket_backtrack)->u.framesize >= 0)
{
- OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr);
+ OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr);
add_jump(compiler, &common->revertframes, JUMP(SLJIT_FAST_CALL));
}
else if (ket == OP_KETRMIN && opcode != OP_ONCE)
@@ -6672,9 +8335,13 @@ while (*cc == OP_ALT)
cc += GET(cc, 1);
cc += 1 + LINK_SIZE;
-/* Temporarily encoding the needs_control_head in framesize. */
if (opcode == OP_ONCE)
+ {
+ /* We temporarily encode the needs_control_head in the lowest bit.
+ Note: on the target architectures of SLJIT the ((x << 1) >> 1) returns
+ the same value for small signed numbers (including negative numbers). */
BACKTRACK_AS(bracket_backtrack)->u.framesize = (BACKTRACK_AS(bracket_backtrack)->u.framesize << 1) | (needs_control_head ? 1 : 0);
+ }
return cc + repeat_length;
}
@@ -6725,7 +8392,7 @@ switch(opcode)
break;
default:
- SLJIT_ASSERT_STOP();
+ SLJIT_UNREACHABLE();
break;
}
@@ -6750,20 +8417,20 @@ if (framesize < 0)
BACKTRACK_AS(bracketpos_backtrack)->stacksize = stacksize;
allocate_stack(common, stacksize);
if (framesize == no_frame)
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr, STACK_TOP, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), private_data_ptr, STACK_TOP, 0);
stack = 0;
if (offset != 0)
{
stack = 2;
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(offset));
- OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(offset + 1));
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset));
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset + 1));
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), TMP1, 0);
if (common->capture_last_ptr != 0)
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->capture_last_ptr);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), common->capture_last_ptr);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(1), TMP2, 0);
if (needs_control_head)
- OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->control_head_ptr);
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr);
if (common->capture_last_ptr != 0)
{
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(2), TMP1, 0);
@@ -6773,7 +8440,7 @@ if (framesize < 0)
else
{
if (needs_control_head)
- OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->control_head_ptr);
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), STR_PTR, 0);
stack = 1;
}
@@ -6800,10 +8467,10 @@ else
BACKTRACK_AS(bracketpos_backtrack)->stacksize = stacksize;
allocate_stack(common, stacksize);
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr);
if (needs_control_head)
- OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->control_head_ptr);
- OP2(SLJIT_SUB, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr, STACK_TOP, 0, SLJIT_IMM, -STACK(stacksize - 1));
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr);
+ OP2(SLJIT_ADD, SLJIT_MEM1(SLJIT_SP), private_data_ptr, STACK_TOP, 0, SLJIT_IMM, stacksize * sizeof(sljit_sw));
stack = 0;
if (!zero)
@@ -6827,7 +8494,7 @@ else
}
if (offset != 0)
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), cbraprivptr, STR_PTR, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), cbraprivptr, STR_PTR, 0);
loop = LABEL();
while (*cc != OP_KETRPOS)
@@ -6843,16 +8510,16 @@ while (*cc != OP_KETRPOS)
if (framesize < 0)
{
if (framesize == no_frame)
- OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr);
+ OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr);
if (offset != 0)
{
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), cbraprivptr);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(offset + 1), STR_PTR, 0);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), cbraprivptr, STR_PTR, 0);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), cbraprivptr);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset + 1), STR_PTR, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), cbraprivptr, STR_PTR, 0);
if (common->capture_last_ptr != 0)
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->capture_last_ptr, SLJIT_IMM, offset >> 1);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(offset), TMP1, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->capture_last_ptr, SLJIT_IMM, offset >> 1);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset), TMP1, 0);
}
else
{
@@ -6861,8 +8528,12 @@ while (*cc != OP_KETRPOS)
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), STR_PTR, 0);
}
+ /* Even if the match is empty, we need to reset the control head. */
+ if (needs_control_head)
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr, SLJIT_MEM1(STACK_TOP), STACK(stack));
+
if (opcode == OP_SBRAPOS || opcode == OP_SCBRAPOS)
- add_jump(compiler, &emptymatch, CMP(SLJIT_C_EQUAL, TMP1, 0, STR_PTR, 0));
+ add_jump(compiler, &emptymatch, CMP(SLJIT_EQUAL, TMP1, 0, STR_PTR, 0));
if (!zero)
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(stacksize - 1), SLJIT_IMM, 0);
@@ -6871,25 +8542,29 @@ while (*cc != OP_KETRPOS)
{
if (offset != 0)
{
- OP2(SLJIT_ADD, STACK_TOP, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr, SLJIT_IMM, stacksize * sizeof(sljit_sw));
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), cbraprivptr);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(offset + 1), STR_PTR, 0);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), cbraprivptr, STR_PTR, 0);
+ OP2(SLJIT_SUB, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr, SLJIT_IMM, stacksize * sizeof(sljit_sw));
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), cbraprivptr);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset + 1), STR_PTR, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), cbraprivptr, STR_PTR, 0);
if (common->capture_last_ptr != 0)
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->capture_last_ptr, SLJIT_IMM, offset >> 1);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(offset), TMP1, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->capture_last_ptr, SLJIT_IMM, offset >> 1);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset), TMP1, 0);
}
else
{
- OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr);
- OP2(SLJIT_ADD, STACK_TOP, 0, TMP2, 0, SLJIT_IMM, stacksize * sizeof(sljit_sw));
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr);
+ OP2(SLJIT_SUB, STACK_TOP, 0, TMP2, 0, SLJIT_IMM, stacksize * sizeof(sljit_sw));
if (opcode == OP_SBRAPOS)
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(TMP2), (framesize + 1) * sizeof(sljit_sw));
- OP1(SLJIT_MOV, SLJIT_MEM1(TMP2), (framesize + 1) * sizeof(sljit_sw), STR_PTR, 0);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(TMP2), STACK(-framesize - 2));
+ OP1(SLJIT_MOV, SLJIT_MEM1(TMP2), STACK(-framesize - 2), STR_PTR, 0);
}
+ /* Even if the match is empty, we need to reset the control head. */
+ if (needs_control_head)
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr, SLJIT_MEM1(STACK_TOP), STACK(stack));
+
if (opcode == OP_SBRAPOS || opcode == OP_SCBRAPOS)
- add_jump(compiler, &emptymatch, CMP(SLJIT_C_EQUAL, TMP1, 0, STR_PTR, 0));
+ add_jump(compiler, &emptymatch, CMP(SLJIT_EQUAL, TMP1, 0, STR_PTR, 0));
if (!zero)
{
@@ -6900,9 +8575,6 @@ while (*cc != OP_KETRPOS)
}
}
- if (needs_control_head)
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->control_head_ptr, SLJIT_MEM1(STACK_TOP), STACK(stack));
-
JUMPTO(SLJIT_JUMP, loop);
flush_stubs(common);
@@ -6914,7 +8586,7 @@ while (*cc != OP_KETRPOS)
if (framesize < 0)
{
if (offset != 0)
- OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), cbraprivptr);
+ OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(SLJIT_SP), cbraprivptr);
else
OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), STACK(0));
}
@@ -6924,13 +8596,13 @@ while (*cc != OP_KETRPOS)
{
/* Last alternative. */
if (*cc == OP_KETRPOS)
- OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr);
- OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), cbraprivptr);
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr);
+ OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(SLJIT_SP), cbraprivptr);
}
else
{
- OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr);
- OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(TMP2), (framesize + 1) * sizeof(sljit_sw));
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr);
+ OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(TMP2), STACK(-framesize - 2));
}
}
@@ -6945,9 +8617,9 @@ backtrack->topbacktracks = NULL;
if (!zero)
{
if (framesize < 0)
- add_jump(compiler, &backtrack->topbacktracks, CMP(SLJIT_C_NOT_EQUAL, SLJIT_MEM1(STACK_TOP), STACK(stacksize - 1), SLJIT_IMM, 0));
+ add_jump(compiler, &backtrack->topbacktracks, CMP(SLJIT_NOT_EQUAL, SLJIT_MEM1(STACK_TOP), STACK(stacksize - 1), SLJIT_IMM, 0));
else /* TMP2 is set to [private_data_ptr] above. */
- add_jump(compiler, &backtrack->topbacktracks, CMP(SLJIT_C_NOT_EQUAL, SLJIT_MEM1(TMP2), (stacksize - 1) * sizeof(sljit_sw), SLJIT_IMM, 0));
+ add_jump(compiler, &backtrack->topbacktracks, CMP(SLJIT_NOT_EQUAL, SLJIT_MEM1(TMP2), STACK(-stacksize), SLJIT_IMM, 0));
}
/* None of them matched. */
@@ -6956,11 +8628,13 @@ count_match(common);
return cc + 1 + LINK_SIZE;
}
-static SLJIT_INLINE pcre_uchar *get_iterator_parameters(compiler_common *common, pcre_uchar *cc, pcre_uchar *opcode, pcre_uchar *type, int *arg1, int *arg2, pcre_uchar **end)
+static SLJIT_INLINE pcre_uchar *get_iterator_parameters(compiler_common *common, pcre_uchar *cc, pcre_uchar *opcode, pcre_uchar *type, sljit_u32 *max, sljit_u32 *exact, pcre_uchar **end)
{
int class_len;
*opcode = *cc;
+*exact = 0;
+
if (*opcode >= OP_STAR && *opcode <= OP_POSUPTO)
{
cc++;
@@ -6988,63 +8662,114 @@ else if (*opcode >= OP_TYPESTAR && *opcode <= OP_TYPEPOSUPTO)
{
cc++;
*opcode -= OP_TYPESTAR - OP_STAR;
- *type = 0;
+ *type = OP_END;
}
else
{
- SLJIT_ASSERT(*opcode >= OP_CLASS || *opcode <= OP_XCLASS);
+ SLJIT_ASSERT(*opcode == OP_CLASS || *opcode == OP_NCLASS || *opcode == OP_XCLASS);
*type = *opcode;
cc++;
class_len = (*type < OP_XCLASS) ? (int)(1 + (32 / sizeof(pcre_uchar))) : GET(cc, 0);
*opcode = cc[class_len - 1];
+
if (*opcode >= OP_CRSTAR && *opcode <= OP_CRMINQUERY)
{
*opcode -= OP_CRSTAR - OP_STAR;
- if (end != NULL)
- *end = cc + class_len;
+ *end = cc + class_len;
+
+ if (*opcode == OP_PLUS || *opcode == OP_MINPLUS)
+ {
+ *exact = 1;
+ *opcode -= OP_PLUS - OP_STAR;
+ }
}
- else
+ else if (*opcode >= OP_CRPOSSTAR && *opcode <= OP_CRPOSQUERY)
{
- SLJIT_ASSERT(*opcode == OP_CRRANGE || *opcode == OP_CRMINRANGE);
- *arg1 = GET2(cc, (class_len + IMM2_SIZE));
- *arg2 = GET2(cc, class_len);
+ *opcode -= OP_CRPOSSTAR - OP_POSSTAR;
+ *end = cc + class_len;
- if (*arg2 == 0)
+ if (*opcode == OP_POSPLUS)
{
- SLJIT_ASSERT(*arg1 != 0);
- *opcode = (*opcode == OP_CRRANGE) ? OP_UPTO : OP_MINUPTO;
+ *exact = 1;
+ *opcode = OP_POSSTAR;
}
- if (*arg1 == *arg2)
- *opcode = OP_EXACT;
+ }
+ else
+ {
+ SLJIT_ASSERT(*opcode == OP_CRRANGE || *opcode == OP_CRMINRANGE || *opcode == OP_CRPOSRANGE);
+ *max = GET2(cc, (class_len + IMM2_SIZE));
+ *exact = GET2(cc, class_len);
- if (end != NULL)
- *end = cc + class_len + 2 * IMM2_SIZE;
+ if (*max == 0)
+ {
+ if (*opcode == OP_CRPOSRANGE)
+ *opcode = OP_POSSTAR;
+ else
+ *opcode -= OP_CRRANGE - OP_STAR;
+ }
+ else
+ {
+ *max -= *exact;
+ if (*max == 0)
+ *opcode = OP_EXACT;
+ else if (*max == 1)
+ {
+ if (*opcode == OP_CRPOSRANGE)
+ *opcode = OP_POSQUERY;
+ else
+ *opcode -= OP_CRRANGE - OP_QUERY;
+ }
+ else
+ {
+ if (*opcode == OP_CRPOSRANGE)
+ *opcode = OP_POSUPTO;
+ else
+ *opcode -= OP_CRRANGE - OP_UPTO;
+ }
+ }
+ *end = cc + class_len + 2 * IMM2_SIZE;
}
return cc;
}
-if (*opcode == OP_UPTO || *opcode == OP_MINUPTO || *opcode == OP_EXACT || *opcode == OP_POSUPTO)
+switch(*opcode)
{
- *arg1 = GET2(cc, 0);
+ case OP_EXACT:
+ *exact = GET2(cc, 0);
+ cc += IMM2_SIZE;
+ break;
+
+ case OP_PLUS:
+ case OP_MINPLUS:
+ *exact = 1;
+ *opcode -= OP_PLUS - OP_STAR;
+ break;
+
+ case OP_POSPLUS:
+ *exact = 1;
+ *opcode = OP_POSSTAR;
+ break;
+
+ case OP_UPTO:
+ case OP_MINUPTO:
+ case OP_POSUPTO:
+ *max = GET2(cc, 0);
cc += IMM2_SIZE;
+ break;
}
-if (*type == 0)
+if (*type == OP_END)
{
*type = *cc;
- if (end != NULL)
- *end = next_opcode(common, cc);
+ *end = next_opcode(common, cc);
cc++;
return cc;
}
-if (end != NULL)
- {
- *end = cc + 1;
+*end = cc + 1;
#ifdef SUPPORT_UTF
- if (common->utf && HAS_EXTRALEN(*cc)) *end += GET_EXTRALEN(*cc);
+if (common->utf && HAS_EXTRALEN(*cc)) *end += GET_EXTRALEN(*cc);
#endif
- }
return cc;
}
@@ -7054,95 +8779,110 @@ DEFINE_COMPILER;
backtrack_common *backtrack;
pcre_uchar opcode;
pcre_uchar type;
-int arg1 = -1, arg2 = -1;
-pcre_uchar* end;
-jump_list *nomatch = NULL;
+sljit_u32 max = 0, exact;
+BOOL fast_fail;
+sljit_s32 fast_str_ptr;
+BOOL charpos_enabled;
+pcre_uchar charpos_char;
+unsigned int charpos_othercasebit;
+pcre_uchar *end;
+jump_list *no_match = NULL;
+jump_list *no_char1_match = NULL;
struct sljit_jump *jump = NULL;
struct sljit_label *label;
int private_data_ptr = PRIVATE_DATA(cc);
-int base = (private_data_ptr == 0) ? SLJIT_MEM1(STACK_TOP) : SLJIT_MEM1(SLJIT_LOCALS_REG);
+int base = (private_data_ptr == 0) ? SLJIT_MEM1(STACK_TOP) : SLJIT_MEM1(SLJIT_SP);
int offset0 = (private_data_ptr == 0) ? STACK(0) : private_data_ptr;
int offset1 = (private_data_ptr == 0) ? STACK(1) : private_data_ptr + (int)sizeof(sljit_sw);
int tmp_base, tmp_offset;
-PUSH_BACKTRACK(sizeof(iterator_backtrack), cc, NULL);
+PUSH_BACKTRACK(sizeof(char_iterator_backtrack), cc, NULL);
-cc = get_iterator_parameters(common, cc, &opcode, &type, &arg1, &arg2, &end);
+fast_str_ptr = PRIVATE_DATA(cc + 1);
+fast_fail = TRUE;
-switch(type)
+SLJIT_ASSERT(common->fast_forward_bc_ptr == NULL || fast_str_ptr == 0 || cc == common->fast_forward_bc_ptr);
+
+if (cc == common->fast_forward_bc_ptr)
+ fast_fail = FALSE;
+else if (common->fast_fail_start_ptr == 0)
+ fast_str_ptr = 0;
+
+SLJIT_ASSERT(common->fast_forward_bc_ptr != NULL || fast_str_ptr == 0
+ || (fast_str_ptr >= common->fast_fail_start_ptr && fast_str_ptr <= common->fast_fail_end_ptr));
+
+cc = get_iterator_parameters(common, cc, &opcode, &type, &max, &exact, &end);
+
+if (type != OP_EXTUNI)
{
- case OP_NOT_DIGIT:
- case OP_DIGIT:
- case OP_NOT_WHITESPACE:
- case OP_WHITESPACE:
- case OP_NOT_WORDCHAR:
- case OP_WORDCHAR:
- case OP_ANY:
- case OP_ALLANY:
- case OP_ANYBYTE:
- case OP_ANYNL:
- case OP_NOT_HSPACE:
- case OP_HSPACE:
- case OP_NOT_VSPACE:
- case OP_VSPACE:
- case OP_CHAR:
- case OP_CHARI:
- case OP_NOT:
- case OP_NOTI:
- case OP_CLASS:
- case OP_NCLASS:
tmp_base = TMP3;
tmp_offset = 0;
- break;
+ }
+else
+ {
+ tmp_base = SLJIT_MEM1(SLJIT_SP);
+ tmp_offset = POSSESSIVE0;
+ }
- default:
- SLJIT_ASSERT_STOP();
- /* Fall through. */
+if (fast_fail && fast_str_ptr != 0)
+ add_jump(compiler, &backtrack->topbacktracks, CMP(SLJIT_LESS_EQUAL, STR_PTR, 0, SLJIT_MEM1(SLJIT_SP), fast_str_ptr));
- case OP_EXTUNI:
- case OP_XCLASS:
- case OP_NOTPROP:
- case OP_PROP:
- tmp_base = SLJIT_MEM1(SLJIT_LOCALS_REG);
- tmp_offset = POSSESSIVE0;
- break;
+/* Handle fixed part first. */
+if (exact > 1)
+ {
+ SLJIT_ASSERT(fast_str_ptr == 0);
+ if (common->mode == JIT_COMPILE
+#ifdef SUPPORT_UTF
+ && !common->utf
+#endif
+ )
+ {
+ OP2(SLJIT_ADD, TMP1, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(exact));
+ add_jump(compiler, &backtrack->topbacktracks, CMP(SLJIT_GREATER, TMP1, 0, STR_END, 0));
+ OP1(SLJIT_MOV, tmp_base, tmp_offset, SLJIT_IMM, exact);
+ label = LABEL();
+ compile_char1_matchingpath(common, type, cc, &backtrack->topbacktracks, FALSE);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, tmp_base, tmp_offset, tmp_base, tmp_offset, SLJIT_IMM, 1);
+ JUMPTO(SLJIT_NOT_ZERO, label);
+ }
+ else
+ {
+ OP1(SLJIT_MOV, tmp_base, tmp_offset, SLJIT_IMM, exact);
+ label = LABEL();
+ compile_char1_matchingpath(common, type, cc, &backtrack->topbacktracks, TRUE);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, tmp_base, tmp_offset, tmp_base, tmp_offset, SLJIT_IMM, 1);
+ JUMPTO(SLJIT_NOT_ZERO, label);
+ }
}
+else if (exact == 1)
+ compile_char1_matchingpath(common, type, cc, &backtrack->topbacktracks, TRUE);
switch(opcode)
{
case OP_STAR:
- case OP_PLUS:
case OP_UPTO:
- case OP_CRRANGE:
+ SLJIT_ASSERT(fast_str_ptr == 0 || opcode == OP_STAR);
+
if (type == OP_ANYNL || type == OP_EXTUNI)
{
SLJIT_ASSERT(private_data_ptr == 0);
- if (opcode == OP_STAR || opcode == OP_UPTO)
- {
- allocate_stack(common, 2);
- OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), STR_PTR, 0);
- OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(1), SLJIT_IMM, 0);
- }
- else
- {
- allocate_stack(common, 1);
- OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), SLJIT_IMM, 0);
- }
+ SLJIT_ASSERT(fast_str_ptr == 0);
+
+ allocate_stack(common, 2);
+ OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), STR_PTR, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(1), SLJIT_IMM, 0);
- if (opcode == OP_UPTO || opcode == OP_CRRANGE)
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), POSSESSIVE0, SLJIT_IMM, 0);
+ if (opcode == OP_UPTO)
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), POSSESSIVE0, SLJIT_IMM, max);
label = LABEL();
- compile_char1_matchingpath(common, type, cc, &backtrack->topbacktracks);
- if (opcode == OP_UPTO || opcode == OP_CRRANGE)
+ compile_char1_matchingpath(common, type, cc, &BACKTRACK_AS(char_iterator_backtrack)->u.backtracks, TRUE);
+ if (opcode == OP_UPTO)
{
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), POSSESSIVE0);
- OP2(SLJIT_ADD, TMP1, 0, TMP1, 0, SLJIT_IMM, 1);
- if (opcode == OP_CRRANGE && arg2 > 0)
- CMPTO(SLJIT_C_LESS, TMP1, 0, SLJIT_IMM, arg2, label);
- if (opcode == OP_UPTO || (opcode == OP_CRRANGE && arg1 > 0))
- jump = CMP(SLJIT_C_GREATER_EQUAL, TMP1, 0, SLJIT_IMM, arg1);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), POSSESSIVE0, TMP1, 0);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), POSSESSIVE0);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, TMP1, 0, TMP1, 0, SLJIT_IMM, 1);
+ jump = JUMP(SLJIT_ZERO);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), POSSESSIVE0, TMP1, 0);
}
/* We cannot use TMP3 because of this allocate_stack. */
@@ -7154,111 +8894,273 @@ switch(opcode)
}
else
{
- if (opcode == OP_PLUS)
- compile_char1_matchingpath(common, type, cc, &backtrack->topbacktracks);
- if (private_data_ptr == 0)
- allocate_stack(common, 2);
- OP1(SLJIT_MOV, base, offset0, STR_PTR, 0);
- if (opcode <= OP_PLUS)
+ charpos_enabled = FALSE;
+ charpos_char = 0;
+ charpos_othercasebit = 0;
+
+ if ((type != OP_CHAR && type != OP_CHARI) && (*end == OP_CHAR || *end == OP_CHARI))
+ {
+ charpos_enabled = TRUE;
+#ifdef SUPPORT_UTF
+ charpos_enabled = !common->utf || !HAS_EXTRALEN(end[1]);
+#endif
+ if (charpos_enabled && *end == OP_CHARI && char_has_othercase(common, end + 1))
+ {
+ charpos_othercasebit = char_get_othercase_bit(common, end + 1);
+ if (charpos_othercasebit == 0)
+ charpos_enabled = FALSE;
+ }
+
+ if (charpos_enabled)
+ {
+ charpos_char = end[1];
+ /* Consumpe the OP_CHAR opcode. */
+ end += 2;
+#if defined COMPILE_PCRE8
+ SLJIT_ASSERT((charpos_othercasebit >> 8) == 0);
+#elif defined COMPILE_PCRE16 || defined COMPILE_PCRE32
+ SLJIT_ASSERT((charpos_othercasebit >> 9) == 0);
+ if ((charpos_othercasebit & 0x100) != 0)
+ charpos_othercasebit = (charpos_othercasebit & 0xff) << 8;
+#endif
+ if (charpos_othercasebit != 0)
+ charpos_char |= charpos_othercasebit;
+
+ BACKTRACK_AS(char_iterator_backtrack)->u.charpos.enabled = TRUE;
+ BACKTRACK_AS(char_iterator_backtrack)->u.charpos.chr = charpos_char;
+ BACKTRACK_AS(char_iterator_backtrack)->u.charpos.othercasebit = charpos_othercasebit;
+ }
+ }
+
+ if (charpos_enabled)
+ {
+ if (opcode == OP_UPTO)
+ OP1(SLJIT_MOV, tmp_base, tmp_offset, SLJIT_IMM, max + 1);
+
+ /* Search the first instance of charpos_char. */
+ jump = JUMP(SLJIT_JUMP);
+ label = LABEL();
+ if (opcode == OP_UPTO)
+ {
+ OP2(SLJIT_SUB | SLJIT_SET_Z, tmp_base, tmp_offset, tmp_base, tmp_offset, SLJIT_IMM, 1);
+ add_jump(compiler, &backtrack->topbacktracks, JUMP(SLJIT_ZERO));
+ }
+ compile_char1_matchingpath(common, type, cc, &backtrack->topbacktracks, FALSE);
+ if (fast_str_ptr != 0)
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), fast_str_ptr, STR_PTR, 0);
+ JUMPHERE(jump);
+
+ detect_partial_match(common, &backtrack->topbacktracks);
+ OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(0));
+ if (charpos_othercasebit != 0)
+ OP2(SLJIT_OR, TMP1, 0, TMP1, 0, SLJIT_IMM, charpos_othercasebit);
+ CMPTO(SLJIT_NOT_EQUAL, TMP1, 0, SLJIT_IMM, charpos_char, label);
+
+ if (private_data_ptr == 0)
+ allocate_stack(common, 2);
+ OP1(SLJIT_MOV, base, offset0, STR_PTR, 0);
OP1(SLJIT_MOV, base, offset1, STR_PTR, 0);
- else
- OP1(SLJIT_MOV, base, offset1, SLJIT_IMM, 1);
- label = LABEL();
- compile_char1_matchingpath(common, type, cc, &nomatch);
- OP1(SLJIT_MOV, base, offset0, STR_PTR, 0);
- if (opcode <= OP_PLUS)
- JUMPTO(SLJIT_JUMP, label);
- else if (opcode == OP_CRRANGE && arg1 == 0)
+ if (opcode == OP_UPTO)
+ {
+ OP2(SLJIT_SUB | SLJIT_SET_Z, tmp_base, tmp_offset, tmp_base, tmp_offset, SLJIT_IMM, 1);
+ add_jump(compiler, &no_match, JUMP(SLJIT_ZERO));
+ }
+
+ /* Search the last instance of charpos_char. */
+ label = LABEL();
+ compile_char1_matchingpath(common, type, cc, &no_match, FALSE);
+ if (fast_str_ptr != 0)
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), fast_str_ptr, STR_PTR, 0);
+ detect_partial_match(common, &no_match);
+ OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(0));
+ if (charpos_othercasebit != 0)
+ OP2(SLJIT_OR, TMP1, 0, TMP1, 0, SLJIT_IMM, charpos_othercasebit);
+ if (opcode == OP_STAR)
+ {
+ CMPTO(SLJIT_NOT_EQUAL, TMP1, 0, SLJIT_IMM, charpos_char, label);
+ OP1(SLJIT_MOV, base, offset0, STR_PTR, 0);
+ }
+ else
+ {
+ jump = CMP(SLJIT_NOT_EQUAL, TMP1, 0, SLJIT_IMM, charpos_char);
+ OP1(SLJIT_MOV, base, offset0, STR_PTR, 0);
+ JUMPHERE(jump);
+ }
+
+ if (opcode == OP_UPTO)
+ {
+ OP2(SLJIT_SUB | SLJIT_SET_Z, tmp_base, tmp_offset, tmp_base, tmp_offset, SLJIT_IMM, 1);
+ JUMPTO(SLJIT_NOT_ZERO, label);
+ }
+ else
+ JUMPTO(SLJIT_JUMP, label);
+
+ set_jumps(no_match, LABEL());
+ OP1(SLJIT_MOV, STR_PTR, 0, base, offset0);
+ OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
+ OP1(SLJIT_MOV, base, offset0, STR_PTR, 0);
+ }
+#if defined SUPPORT_UTF && !defined COMPILE_PCRE32
+ else if (common->utf)
{
- OP2(SLJIT_ADD, base, offset1, base, offset1, SLJIT_IMM, 1);
- JUMPTO(SLJIT_JUMP, label);
+ if (private_data_ptr == 0)
+ allocate_stack(common, 2);
+
+ OP1(SLJIT_MOV, base, offset0, STR_PTR, 0);
+ OP1(SLJIT_MOV, base, offset1, STR_PTR, 0);
+
+ if (opcode == OP_UPTO)
+ OP1(SLJIT_MOV, tmp_base, tmp_offset, SLJIT_IMM, max);
+
+ label = LABEL();
+ compile_char1_matchingpath(common, type, cc, &no_match, TRUE);
+ OP1(SLJIT_MOV, base, offset0, STR_PTR, 0);
+
+ if (opcode == OP_UPTO)
+ {
+ OP2(SLJIT_SUB | SLJIT_SET_Z, tmp_base, tmp_offset, tmp_base, tmp_offset, SLJIT_IMM, 1);
+ JUMPTO(SLJIT_NOT_ZERO, label);
+ }
+ else
+ JUMPTO(SLJIT_JUMP, label);
+
+ set_jumps(no_match, LABEL());
+ OP1(SLJIT_MOV, STR_PTR, 0, base, offset0);
+ if (fast_str_ptr != 0)
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), fast_str_ptr, STR_PTR, 0);
}
+#endif
else
{
- OP1(SLJIT_MOV, TMP1, 0, base, offset1);
- OP2(SLJIT_ADD, TMP1, 0, TMP1, 0, SLJIT_IMM, 1);
- OP1(SLJIT_MOV, base, offset1, TMP1, 0);
- CMPTO(SLJIT_C_LESS, TMP1, 0, SLJIT_IMM, arg1 + 1, label);
+ if (private_data_ptr == 0)
+ allocate_stack(common, 2);
+
+ OP1(SLJIT_MOV, base, offset1, STR_PTR, 0);
+ if (opcode == OP_UPTO)
+ OP1(SLJIT_MOV, tmp_base, tmp_offset, SLJIT_IMM, max);
+
+ label = LABEL();
+ detect_partial_match(common, &no_match);
+ compile_char1_matchingpath(common, type, cc, &no_char1_match, FALSE);
+ if (opcode == OP_UPTO)
+ {
+ OP2(SLJIT_SUB | SLJIT_SET_Z, tmp_base, tmp_offset, tmp_base, tmp_offset, SLJIT_IMM, 1);
+ JUMPTO(SLJIT_NOT_ZERO, label);
+ OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
+ }
+ else
+ JUMPTO(SLJIT_JUMP, label);
+
+ set_jumps(no_char1_match, LABEL());
+ OP2(SLJIT_SUB, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
+ set_jumps(no_match, LABEL());
+ OP1(SLJIT_MOV, base, offset0, STR_PTR, 0);
+ if (fast_str_ptr != 0)
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), fast_str_ptr, STR_PTR, 0);
}
- set_jumps(nomatch, LABEL());
- if (opcode == OP_CRRANGE)
- add_jump(compiler, &backtrack->topbacktracks, CMP(SLJIT_C_LESS, base, offset1, SLJIT_IMM, arg2 + 1));
- OP1(SLJIT_MOV, STR_PTR, 0, base, offset0);
}
- BACKTRACK_AS(iterator_backtrack)->matchingpath = LABEL();
+ BACKTRACK_AS(char_iterator_backtrack)->matchingpath = LABEL();
break;
case OP_MINSTAR:
- case OP_MINPLUS:
- if (opcode == OP_MINPLUS)
- compile_char1_matchingpath(common, type, cc, &backtrack->topbacktracks);
if (private_data_ptr == 0)
allocate_stack(common, 1);
OP1(SLJIT_MOV, base, offset0, STR_PTR, 0);
- BACKTRACK_AS(iterator_backtrack)->matchingpath = LABEL();
+ BACKTRACK_AS(char_iterator_backtrack)->matchingpath = LABEL();
+ if (fast_str_ptr != 0)
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), fast_str_ptr, STR_PTR, 0);
break;
case OP_MINUPTO:
- case OP_CRMINRANGE:
+ SLJIT_ASSERT(fast_str_ptr == 0);
if (private_data_ptr == 0)
allocate_stack(common, 2);
OP1(SLJIT_MOV, base, offset0, STR_PTR, 0);
- OP1(SLJIT_MOV, base, offset1, SLJIT_IMM, 1);
- if (opcode == OP_CRMINRANGE)
- add_jump(compiler, &backtrack->topbacktracks, JUMP(SLJIT_JUMP));
- BACKTRACK_AS(iterator_backtrack)->matchingpath = LABEL();
+ OP1(SLJIT_MOV, base, offset1, SLJIT_IMM, max + 1);
+ BACKTRACK_AS(char_iterator_backtrack)->matchingpath = LABEL();
break;
case OP_QUERY:
case OP_MINQUERY:
+ SLJIT_ASSERT(fast_str_ptr == 0);
if (private_data_ptr == 0)
allocate_stack(common, 1);
OP1(SLJIT_MOV, base, offset0, STR_PTR, 0);
if (opcode == OP_QUERY)
- compile_char1_matchingpath(common, type, cc, &backtrack->topbacktracks);
- BACKTRACK_AS(iterator_backtrack)->matchingpath = LABEL();
+ compile_char1_matchingpath(common, type, cc, &BACKTRACK_AS(char_iterator_backtrack)->u.backtracks, TRUE);
+ BACKTRACK_AS(char_iterator_backtrack)->matchingpath = LABEL();
break;
case OP_EXACT:
- OP1(SLJIT_MOV, tmp_base, tmp_offset, SLJIT_IMM, arg1);
- label = LABEL();
- compile_char1_matchingpath(common, type, cc, &backtrack->topbacktracks);
- OP2(SLJIT_SUB | SLJIT_SET_E, tmp_base, tmp_offset, tmp_base, tmp_offset, SLJIT_IMM, 1);
- JUMPTO(SLJIT_C_NOT_ZERO, label);
break;
case OP_POSSTAR:
- case OP_POSPLUS:
- case OP_POSUPTO:
- if (opcode == OP_POSPLUS)
- compile_char1_matchingpath(common, type, cc, &backtrack->topbacktracks);
- if (opcode == OP_POSUPTO)
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), POSSESSIVE1, SLJIT_IMM, arg1);
- OP1(SLJIT_MOV, tmp_base, tmp_offset, STR_PTR, 0);
- label = LABEL();
- compile_char1_matchingpath(common, type, cc, &nomatch);
- OP1(SLJIT_MOV, tmp_base, tmp_offset, STR_PTR, 0);
- if (opcode != OP_POSUPTO)
+#if defined SUPPORT_UTF && !defined COMPILE_PCRE32
+ if (common->utf)
+ {
+ OP1(SLJIT_MOV, tmp_base, tmp_offset, STR_PTR, 0);
+ label = LABEL();
+ compile_char1_matchingpath(common, type, cc, &no_match, TRUE);
+ OP1(SLJIT_MOV, tmp_base, tmp_offset, STR_PTR, 0);
JUMPTO(SLJIT_JUMP, label);
- else
+ set_jumps(no_match, LABEL());
+ OP1(SLJIT_MOV, STR_PTR, 0, tmp_base, tmp_offset);
+ if (fast_str_ptr != 0)
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), fast_str_ptr, STR_PTR, 0);
+ break;
+ }
+#endif
+ label = LABEL();
+ detect_partial_match(common, &no_match);
+ compile_char1_matchingpath(common, type, cc, &no_char1_match, FALSE);
+ JUMPTO(SLJIT_JUMP, label);
+ set_jumps(no_char1_match, LABEL());
+ OP2(SLJIT_SUB, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
+ set_jumps(no_match, LABEL());
+ if (fast_str_ptr != 0)
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), fast_str_ptr, STR_PTR, 0);
+ break;
+
+ case OP_POSUPTO:
+ SLJIT_ASSERT(fast_str_ptr == 0);
+#if defined SUPPORT_UTF && !defined COMPILE_PCRE32
+ if (common->utf)
{
- OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_MEM1(SLJIT_LOCALS_REG), POSSESSIVE1, SLJIT_MEM1(SLJIT_LOCALS_REG), POSSESSIVE1, SLJIT_IMM, 1);
- JUMPTO(SLJIT_C_NOT_ZERO, label);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), POSSESSIVE1, STR_PTR, 0);
+ OP1(SLJIT_MOV, tmp_base, tmp_offset, SLJIT_IMM, max);
+ label = LABEL();
+ compile_char1_matchingpath(common, type, cc, &no_match, TRUE);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), POSSESSIVE1, STR_PTR, 0);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, tmp_base, tmp_offset, tmp_base, tmp_offset, SLJIT_IMM, 1);
+ JUMPTO(SLJIT_NOT_ZERO, label);
+ set_jumps(no_match, LABEL());
+ OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(SLJIT_SP), POSSESSIVE1);
+ break;
}
- set_jumps(nomatch, LABEL());
- OP1(SLJIT_MOV, STR_PTR, 0, tmp_base, tmp_offset);
+#endif
+ OP1(SLJIT_MOV, tmp_base, tmp_offset, SLJIT_IMM, max);
+ label = LABEL();
+ detect_partial_match(common, &no_match);
+ compile_char1_matchingpath(common, type, cc, &no_char1_match, FALSE);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, tmp_base, tmp_offset, tmp_base, tmp_offset, SLJIT_IMM, 1);
+ JUMPTO(SLJIT_NOT_ZERO, label);
+ OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
+ set_jumps(no_char1_match, LABEL());
+ OP2(SLJIT_SUB, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
+ set_jumps(no_match, LABEL());
break;
case OP_POSQUERY:
+ SLJIT_ASSERT(fast_str_ptr == 0);
OP1(SLJIT_MOV, tmp_base, tmp_offset, STR_PTR, 0);
- compile_char1_matchingpath(common, type, cc, &nomatch);
+ compile_char1_matchingpath(common, type, cc, &no_match, TRUE);
OP1(SLJIT_MOV, tmp_base, tmp_offset, STR_PTR, 0);
- set_jumps(nomatch, LABEL());
+ set_jumps(no_match, LABEL());
OP1(SLJIT_MOV, STR_PTR, 0, tmp_base, tmp_offset);
break;
default:
- SLJIT_ASSERT_STOP();
+ SLJIT_UNREACHABLE();
break;
}
@@ -7279,7 +9181,7 @@ if (*cc == OP_FAIL)
return cc + 1;
}
-if (*cc == OP_ASSERT_ACCEPT || common->currententry != NULL)
+if (*cc == OP_ASSERT_ACCEPT || common->currententry != NULL || !common->might_be_empty)
{
/* No need to check notempty conditions. */
if (common->accept_label == NULL)
@@ -7290,22 +9192,22 @@ if (*cc == OP_ASSERT_ACCEPT || common->currententry != NULL)
}
if (common->accept_label == NULL)
- add_jump(compiler, &common->accept, CMP(SLJIT_C_NOT_EQUAL, STR_PTR, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(0)));
+ add_jump(compiler, &common->accept, CMP(SLJIT_NOT_EQUAL, STR_PTR, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(0)));
else
- CMPTO(SLJIT_C_NOT_EQUAL, STR_PTR, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(0), common->accept_label);
+ CMPTO(SLJIT_NOT_EQUAL, STR_PTR, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(0), common->accept_label);
OP1(SLJIT_MOV, TMP1, 0, ARGUMENTS, 0);
-OP1(SLJIT_MOV_UB, TMP2, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, notempty));
-add_jump(compiler, &backtrack->topbacktracks, CMP(SLJIT_C_NOT_EQUAL, TMP2, 0, SLJIT_IMM, 0));
-OP1(SLJIT_MOV_UB, TMP2, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, notempty_atstart));
+OP1(SLJIT_MOV_U8, TMP2, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, notempty));
+add_jump(compiler, &backtrack->topbacktracks, CMP(SLJIT_NOT_EQUAL, TMP2, 0, SLJIT_IMM, 0));
+OP1(SLJIT_MOV_U8, TMP2, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, notempty_atstart));
if (common->accept_label == NULL)
- add_jump(compiler, &common->accept, CMP(SLJIT_C_EQUAL, TMP2, 0, SLJIT_IMM, 0));
+ add_jump(compiler, &common->accept, CMP(SLJIT_EQUAL, TMP2, 0, SLJIT_IMM, 0));
else
- CMPTO(SLJIT_C_EQUAL, TMP2, 0, SLJIT_IMM, 0, common->accept_label);
+ CMPTO(SLJIT_EQUAL, TMP2, 0, SLJIT_IMM, 0, common->accept_label);
OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, str));
if (common->accept_label == NULL)
- add_jump(compiler, &common->accept, CMP(SLJIT_C_NOT_EQUAL, TMP2, 0, STR_PTR, 0));
+ add_jump(compiler, &common->accept, CMP(SLJIT_NOT_EQUAL, TMP2, 0, STR_PTR, 0));
else
- CMPTO(SLJIT_C_NOT_EQUAL, TMP2, 0, STR_PTR, 0, common->accept_label);
+ CMPTO(SLJIT_NOT_EQUAL, TMP2, 0, STR_PTR, 0, common->accept_label);
add_jump(compiler, &backtrack->topbacktracks, JUMP(SLJIT_JUMP));
return cc + 1;
}
@@ -7321,11 +9223,11 @@ if (common->currententry != NULL)
return cc + 1 + IMM2_SIZE;
if (!optimized_cbracket)
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR_PRIV(offset));
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR_PRIV(offset));
offset <<= 1;
-OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(offset + 1), STR_PTR, 0);
+OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset + 1), STR_PTR, 0);
if (!optimized_cbracket)
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(offset), TMP1, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset), TMP1, 0);
return cc + 1 + IMM2_SIZE;
}
@@ -7352,7 +9254,7 @@ if (opcode == OP_PRUNE_ARG || opcode == OP_THEN_ARG)
{
OP1(SLJIT_MOV, TMP1, 0, ARGUMENTS, 0);
OP1(SLJIT_MOV, TMP2, 0, SLJIT_IMM, (sljit_sw)(cc + 2));
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->mark_ptr, TMP2, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->mark_ptr, TMP2, 0);
OP1(SLJIT_MOV, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, mark_ptr), TMP2, 0);
}
@@ -7377,12 +9279,12 @@ BACKTRACK_AS(then_trap_backtrack)->framesize = get_framesize(common, cc, ccend,
size = BACKTRACK_AS(then_trap_backtrack)->framesize;
size = 3 + (size < 0 ? 0 : size);
-OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->control_head_ptr);
+OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr);
allocate_stack(common, size);
if (size > 3)
- OP2(SLJIT_SUB, SLJIT_MEM1(SLJIT_LOCALS_REG), common->control_head_ptr, STACK_TOP, 0, SLJIT_IMM, (size - 3) * sizeof(sljit_sw));
+ OP2(SLJIT_ADD, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr, STACK_TOP, 0, SLJIT_IMM, (size - 3) * sizeof(sljit_sw));
else
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->control_head_ptr, STACK_TOP, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr, STACK_TOP, 0);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(size - 1), SLJIT_IMM, BACKTRACK_AS(then_trap_backtrack)->start);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(size - 2), SLJIT_IMM, type_then_trap);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(size - 3), TMP2, 0);
@@ -7418,6 +9320,16 @@ while (cc < ccend)
case OP_SOM:
case OP_NOT_WORD_BOUNDARY:
case OP_WORD_BOUNDARY:
+ case OP_EODN:
+ case OP_EOD:
+ case OP_DOLL:
+ case OP_DOLLM:
+ case OP_CIRC:
+ case OP_CIRCM:
+ case OP_REVERSE:
+ cc = compile_simple_assertion_matchingpath(common, *cc, cc + 1, parent->top != NULL ? &parent->top->nextbacktracks : &parent->topbacktracks);
+ break;
+
case OP_NOT_DIGIT:
case OP_DIGIT:
case OP_NOT_WHITESPACE:
@@ -7435,23 +9347,16 @@ while (cc < ccend)
case OP_NOT_VSPACE:
case OP_VSPACE:
case OP_EXTUNI:
- case OP_EODN:
- case OP_EOD:
- case OP_CIRC:
- case OP_CIRCM:
- case OP_DOLL:
- case OP_DOLLM:
case OP_NOT:
case OP_NOTI:
- case OP_REVERSE:
- cc = compile_char1_matchingpath(common, *cc, cc + 1, parent->top != NULL ? &parent->top->nextbacktracks : &parent->topbacktracks);
+ cc = compile_char1_matchingpath(common, *cc, cc + 1, parent->top != NULL ? &parent->top->nextbacktracks : &parent->topbacktracks, TRUE);
break;
case OP_SET_SOM:
PUSH_BACKTRACK_NOVALUE(sizeof(backtrack_common), cc);
- OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(0));
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(0));
allocate_stack(common, 1);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(0), STR_PTR, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), OVECTOR(0), STR_PTR, 0);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), TMP2, 0);
cc++;
break;
@@ -7461,7 +9366,7 @@ while (cc < ccend)
if (common->mode == JIT_COMPILE)
cc = compile_charn_matchingpath(common, cc, ccend, parent->top != NULL ? &parent->top->nextbacktracks : &parent->topbacktracks);
else
- cc = compile_char1_matchingpath(common, *cc, cc + 1, parent->top != NULL ? &parent->top->nextbacktracks : &parent->topbacktracks);
+ cc = compile_char1_matchingpath(common, *cc, cc + 1, parent->top != NULL ? &parent->top->nextbacktracks : &parent->topbacktracks, TRUE);
break;
case OP_STAR:
@@ -7534,27 +9439,42 @@ while (cc < ccend)
case OP_CLASS:
case OP_NCLASS:
- if (cc[1 + (32 / sizeof(pcre_uchar))] >= OP_CRSTAR && cc[1 + (32 / sizeof(pcre_uchar))] <= OP_CRMINRANGE)
+ if (cc[1 + (32 / sizeof(pcre_uchar))] >= OP_CRSTAR && cc[1 + (32 / sizeof(pcre_uchar))] <= OP_CRPOSRANGE)
cc = compile_iterator_matchingpath(common, cc, parent);
else
- cc = compile_char1_matchingpath(common, *cc, cc + 1, parent->top != NULL ? &parent->top->nextbacktracks : &parent->topbacktracks);
+ cc = compile_char1_matchingpath(common, *cc, cc + 1, parent->top != NULL ? &parent->top->nextbacktracks : &parent->topbacktracks, TRUE);
break;
#if defined SUPPORT_UTF || defined COMPILE_PCRE16 || defined COMPILE_PCRE32
case OP_XCLASS:
- if (*(cc + GET(cc, 1)) >= OP_CRSTAR && *(cc + GET(cc, 1)) <= OP_CRMINRANGE)
+ if (*(cc + GET(cc, 1)) >= OP_CRSTAR && *(cc + GET(cc, 1)) <= OP_CRPOSRANGE)
cc = compile_iterator_matchingpath(common, cc, parent);
else
- cc = compile_char1_matchingpath(common, *cc, cc + 1, parent->top != NULL ? &parent->top->nextbacktracks : &parent->topbacktracks);
+ cc = compile_char1_matchingpath(common, *cc, cc + 1, parent->top != NULL ? &parent->top->nextbacktracks : &parent->topbacktracks, TRUE);
break;
#endif
case OP_REF:
case OP_REFI:
- if (cc[1 + IMM2_SIZE] >= OP_CRSTAR && cc[1 + IMM2_SIZE] <= OP_CRMINRANGE)
+ if (cc[1 + IMM2_SIZE] >= OP_CRSTAR && cc[1 + IMM2_SIZE] <= OP_CRPOSRANGE)
cc = compile_ref_iterator_matchingpath(common, cc, parent);
else
- cc = compile_ref_matchingpath(common, cc, parent->top != NULL ? &parent->top->nextbacktracks : &parent->topbacktracks, TRUE, FALSE);
+ {
+ compile_ref_matchingpath(common, cc, parent->top != NULL ? &parent->top->nextbacktracks : &parent->topbacktracks, TRUE, FALSE);
+ cc += 1 + IMM2_SIZE;
+ }
+ break;
+
+ case OP_DNREF:
+ case OP_DNREFI:
+ if (cc[1 + 2 * IMM2_SIZE] >= OP_CRSTAR && cc[1 + 2 * IMM2_SIZE] <= OP_CRPOSRANGE)
+ cc = compile_ref_iterator_matchingpath(common, cc, parent);
+ else
+ {
+ compile_dnref_search(common, cc, parent->top != NULL ? &parent->top->nextbacktracks : &parent->topbacktracks);
+ compile_ref_matchingpath(common, cc, parent->top != NULL ? &parent->top->nextbacktracks : &parent->topbacktracks, TRUE, FALSE);
+ cc += 1 + 2 * IMM2_SIZE;
+ }
break;
case OP_RECURSE:
@@ -7588,8 +9508,7 @@ while (cc < ccend)
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(1), STR_PTR, 0);
}
BACKTRACK_AS(braminzero_backtrack)->matchingpath = LABEL();
- if (cc[1] > OP_ASSERTBACK_NOT)
- count_match(common);
+ count_match(common);
break;
case OP_ONCE:
@@ -7624,17 +9543,17 @@ while (cc < ccend)
case OP_MARK:
PUSH_BACKTRACK_NOVALUE(sizeof(backtrack_common), cc);
SLJIT_ASSERT(common->mark_ptr != 0);
- OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->mark_ptr);
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), common->mark_ptr);
allocate_stack(common, common->has_skip_arg ? 5 : 1);
OP1(SLJIT_MOV, TMP1, 0, ARGUMENTS, 0);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(common->has_skip_arg ? 4 : 0), TMP2, 0);
OP1(SLJIT_MOV, TMP2, 0, SLJIT_IMM, (sljit_sw)(cc + 2));
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->mark_ptr, TMP2, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->mark_ptr, TMP2, 0);
OP1(SLJIT_MOV, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, mark_ptr), TMP2, 0);
if (common->has_skip_arg)
{
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->control_head_ptr);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->control_head_ptr, STACK_TOP, 0);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr, STACK_TOP, 0);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(1), SLJIT_IMM, type_mark);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(2), SLJIT_IMM, (sljit_sw)(cc + 2));
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(3), STR_PTR, 0);
@@ -7668,7 +9587,7 @@ while (cc < ccend)
break;
default:
- SLJIT_ASSERT_STOP();
+ SLJIT_UNREACHABLE();
return;
}
if (cc == NULL)
@@ -7707,95 +9626,82 @@ DEFINE_COMPILER;
pcre_uchar *cc = current->cc;
pcre_uchar opcode;
pcre_uchar type;
-int arg1 = -1, arg2 = -1;
+sljit_u32 max = 0, exact;
struct sljit_label *label = NULL;
struct sljit_jump *jump = NULL;
jump_list *jumplist = NULL;
+pcre_uchar *end;
int private_data_ptr = PRIVATE_DATA(cc);
-int base = (private_data_ptr == 0) ? SLJIT_MEM1(STACK_TOP) : SLJIT_MEM1(SLJIT_LOCALS_REG);
+int base = (private_data_ptr == 0) ? SLJIT_MEM1(STACK_TOP) : SLJIT_MEM1(SLJIT_SP);
int offset0 = (private_data_ptr == 0) ? STACK(0) : private_data_ptr;
int offset1 = (private_data_ptr == 0) ? STACK(1) : private_data_ptr + (int)sizeof(sljit_sw);
-cc = get_iterator_parameters(common, cc, &opcode, &type, &arg1, &arg2, NULL);
+cc = get_iterator_parameters(common, cc, &opcode, &type, &max, &exact, &end);
switch(opcode)
{
case OP_STAR:
- case OP_PLUS:
case OP_UPTO:
- case OP_CRRANGE:
if (type == OP_ANYNL || type == OP_EXTUNI)
{
SLJIT_ASSERT(private_data_ptr == 0);
- set_jumps(current->topbacktracks, LABEL());
+ set_jumps(CURRENT_AS(char_iterator_backtrack)->u.backtracks, LABEL());
OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), STACK(0));
free_stack(common, 1);
- CMPTO(SLJIT_C_NOT_EQUAL, STR_PTR, 0, SLJIT_IMM, 0, CURRENT_AS(iterator_backtrack)->matchingpath);
+ CMPTO(SLJIT_NOT_EQUAL, STR_PTR, 0, SLJIT_IMM, 0, CURRENT_AS(char_iterator_backtrack)->matchingpath);
}
else
{
- if (opcode == OP_UPTO)
- arg2 = 0;
- if (opcode <= OP_PLUS)
+ if (CURRENT_AS(char_iterator_backtrack)->u.charpos.enabled)
{
OP1(SLJIT_MOV, STR_PTR, 0, base, offset0);
- jump = CMP(SLJIT_C_LESS_EQUAL, STR_PTR, 0, base, offset1);
+ OP1(SLJIT_MOV, TMP2, 0, base, offset1);
+ OP2(SLJIT_SUB, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1));
+
+ jump = CMP(SLJIT_LESS_EQUAL, STR_PTR, 0, TMP2, 0);
+ label = LABEL();
+ OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(-1));
+ OP1(SLJIT_MOV, base, offset0, STR_PTR, 0);
+ if (CURRENT_AS(char_iterator_backtrack)->u.charpos.othercasebit != 0)
+ OP2(SLJIT_OR, TMP1, 0, TMP1, 0, SLJIT_IMM, CURRENT_AS(char_iterator_backtrack)->u.charpos.othercasebit);
+ CMPTO(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, CURRENT_AS(char_iterator_backtrack)->u.charpos.chr, CURRENT_AS(char_iterator_backtrack)->matchingpath);
+ skip_char_back(common);
+ CMPTO(SLJIT_GREATER, STR_PTR, 0, TMP2, 0, label);
}
else
{
- OP1(SLJIT_MOV, TMP1, 0, base, offset1);
OP1(SLJIT_MOV, STR_PTR, 0, base, offset0);
- jump = CMP(SLJIT_C_LESS_EQUAL, TMP1, 0, SLJIT_IMM, arg2 + 1);
- OP2(SLJIT_SUB, base, offset1, TMP1, 0, SLJIT_IMM, 1);
+ jump = CMP(SLJIT_LESS_EQUAL, STR_PTR, 0, base, offset1);
+ skip_char_back(common);
+ OP1(SLJIT_MOV, base, offset0, STR_PTR, 0);
+ JUMPTO(SLJIT_JUMP, CURRENT_AS(char_iterator_backtrack)->matchingpath);
}
- skip_char_back(common);
- OP1(SLJIT_MOV, base, offset0, STR_PTR, 0);
- JUMPTO(SLJIT_JUMP, CURRENT_AS(iterator_backtrack)->matchingpath);
- if (opcode == OP_CRRANGE)
- set_jumps(current->topbacktracks, LABEL());
JUMPHERE(jump);
if (private_data_ptr == 0)
free_stack(common, 2);
- if (opcode == OP_PLUS)
- set_jumps(current->topbacktracks, LABEL());
}
break;
case OP_MINSTAR:
- case OP_MINPLUS:
OP1(SLJIT_MOV, STR_PTR, 0, base, offset0);
- compile_char1_matchingpath(common, type, cc, &jumplist);
+ compile_char1_matchingpath(common, type, cc, &jumplist, TRUE);
OP1(SLJIT_MOV, base, offset0, STR_PTR, 0);
- JUMPTO(SLJIT_JUMP, CURRENT_AS(iterator_backtrack)->matchingpath);
+ JUMPTO(SLJIT_JUMP, CURRENT_AS(char_iterator_backtrack)->matchingpath);
set_jumps(jumplist, LABEL());
if (private_data_ptr == 0)
free_stack(common, 1);
- if (opcode == OP_MINPLUS)
- set_jumps(current->topbacktracks, LABEL());
break;
case OP_MINUPTO:
- case OP_CRMINRANGE:
- if (opcode == OP_CRMINRANGE)
- {
- label = LABEL();
- set_jumps(current->topbacktracks, label);
- }
+ OP1(SLJIT_MOV, TMP1, 0, base, offset1);
OP1(SLJIT_MOV, STR_PTR, 0, base, offset0);
- compile_char1_matchingpath(common, type, cc, &jumplist);
+ OP2(SLJIT_SUB | SLJIT_SET_Z, TMP1, 0, TMP1, 0, SLJIT_IMM, 1);
+ add_jump(compiler, &jumplist, JUMP(SLJIT_ZERO));
- OP1(SLJIT_MOV, TMP1, 0, base, offset1);
- OP1(SLJIT_MOV, base, offset0, STR_PTR, 0);
- OP2(SLJIT_ADD, TMP1, 0, TMP1, 0, SLJIT_IMM, 1);
OP1(SLJIT_MOV, base, offset1, TMP1, 0);
-
- if (opcode == OP_CRMINRANGE)
- CMPTO(SLJIT_C_LESS, TMP1, 0, SLJIT_IMM, arg2 + 1, label);
-
- if (opcode == OP_CRMINRANGE && arg1 == 0)
- JUMPTO(SLJIT_JUMP, CURRENT_AS(iterator_backtrack)->matchingpath);
- else
- CMPTO(SLJIT_C_LESS, TMP1, 0, SLJIT_IMM, arg1 + 2, CURRENT_AS(iterator_backtrack)->matchingpath);
+ compile_char1_matchingpath(common, type, cc, &jumplist, TRUE);
+ OP1(SLJIT_MOV, base, offset0, STR_PTR, 0);
+ JUMPTO(SLJIT_JUMP, CURRENT_AS(char_iterator_backtrack)->matchingpath);
set_jumps(jumplist, LABEL());
if (private_data_ptr == 0)
@@ -7805,12 +9711,12 @@ switch(opcode)
case OP_QUERY:
OP1(SLJIT_MOV, STR_PTR, 0, base, offset0);
OP1(SLJIT_MOV, base, offset0, SLJIT_IMM, 0);
- CMPTO(SLJIT_C_NOT_EQUAL, STR_PTR, 0, SLJIT_IMM, 0, CURRENT_AS(iterator_backtrack)->matchingpath);
+ CMPTO(SLJIT_NOT_EQUAL, STR_PTR, 0, SLJIT_IMM, 0, CURRENT_AS(char_iterator_backtrack)->matchingpath);
jump = JUMP(SLJIT_JUMP);
- set_jumps(current->topbacktracks, LABEL());
+ set_jumps(CURRENT_AS(char_iterator_backtrack)->u.backtracks, LABEL());
OP1(SLJIT_MOV, STR_PTR, 0, base, offset0);
OP1(SLJIT_MOV, base, offset0, SLJIT_IMM, 0);
- JUMPTO(SLJIT_JUMP, CURRENT_AS(iterator_backtrack)->matchingpath);
+ JUMPTO(SLJIT_JUMP, CURRENT_AS(char_iterator_backtrack)->matchingpath);
JUMPHERE(jump);
if (private_data_ptr == 0)
free_stack(common, 1);
@@ -7819,9 +9725,9 @@ switch(opcode)
case OP_MINQUERY:
OP1(SLJIT_MOV, STR_PTR, 0, base, offset0);
OP1(SLJIT_MOV, base, offset0, SLJIT_IMM, 0);
- jump = CMP(SLJIT_C_EQUAL, STR_PTR, 0, SLJIT_IMM, 0);
- compile_char1_matchingpath(common, type, cc, &jumplist);
- JUMPTO(SLJIT_JUMP, CURRENT_AS(iterator_backtrack)->matchingpath);
+ jump = CMP(SLJIT_EQUAL, STR_PTR, 0, SLJIT_IMM, 0);
+ compile_char1_matchingpath(common, type, cc, &jumplist, TRUE);
+ JUMPTO(SLJIT_JUMP, CURRENT_AS(char_iterator_backtrack)->matchingpath);
set_jumps(jumplist, LABEL());
JUMPHERE(jump);
if (private_data_ptr == 0)
@@ -7829,41 +9735,42 @@ switch(opcode)
break;
case OP_EXACT:
- case OP_POSPLUS:
- set_jumps(current->topbacktracks, LABEL());
- break;
-
case OP_POSSTAR:
case OP_POSQUERY:
case OP_POSUPTO:
break;
default:
- SLJIT_ASSERT_STOP();
+ SLJIT_UNREACHABLE();
break;
}
+
+set_jumps(current->topbacktracks, LABEL());
}
static SLJIT_INLINE void compile_ref_iterator_backtrackingpath(compiler_common *common, struct backtrack_common *current)
{
DEFINE_COMPILER;
pcre_uchar *cc = current->cc;
+BOOL ref = (*cc == OP_REF || *cc == OP_REFI);
pcre_uchar type;
-type = cc[1 + IMM2_SIZE];
+type = cc[ref ? 1 + IMM2_SIZE : 1 + 2 * IMM2_SIZE];
+
if ((type & 0x1) == 0)
{
+ /* Maximize case. */
set_jumps(current->topbacktracks, LABEL());
OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), STACK(0));
free_stack(common, 1);
- CMPTO(SLJIT_C_NOT_EQUAL, STR_PTR, 0, SLJIT_IMM, 0, CURRENT_AS(iterator_backtrack)->matchingpath);
+ CMPTO(SLJIT_NOT_EQUAL, STR_PTR, 0, SLJIT_IMM, 0, CURRENT_AS(ref_iterator_backtrack)->matchingpath);
return;
}
OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), STACK(0));
-CMPTO(SLJIT_C_NOT_EQUAL, STR_PTR, 0, SLJIT_IMM, 0, CURRENT_AS(iterator_backtrack)->matchingpath);
+CMPTO(SLJIT_NOT_EQUAL, STR_PTR, 0, SLJIT_IMM, 0, CURRENT_AS(ref_iterator_backtrack)->matchingpath);
set_jumps(current->topbacktracks, LABEL());
-free_stack(common, 2);
+free_stack(common, ref ? 2 : 3);
}
static SLJIT_INLINE void compile_recurse_backtrackingpath(compiler_common *common, struct backtrack_common *current)
@@ -7881,14 +9788,14 @@ if (common->has_set_som && common->mark_ptr != 0)
OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(STACK_TOP), STACK(0));
OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), STACK(1));
free_stack(common, 2);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(0), TMP2, 0);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->mark_ptr, TMP1, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), OVECTOR(0), TMP2, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->mark_ptr, TMP1, 0);
}
else if (common->has_set_som || common->mark_ptr != 0)
{
OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(STACK_TOP), STACK(0));
free_stack(common, 1);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->has_set_som ? (int)(OVECTOR(0)) : common->mark_ptr, TMP2, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->has_set_som ? (int)(OVECTOR(0)) : common->mark_ptr, TMP2, 0);
}
}
@@ -7919,7 +9826,7 @@ if (CURRENT_AS(assert_backtrack)->framesize < 0)
if (bra == OP_BRAZERO)
{
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), SLJIT_IMM, 0);
- CMPTO(SLJIT_C_NOT_EQUAL, STR_PTR, 0, SLJIT_IMM, 0, CURRENT_AS(assert_backtrack)->matchingpath);
+ CMPTO(SLJIT_NOT_EQUAL, STR_PTR, 0, SLJIT_IMM, 0, CURRENT_AS(assert_backtrack)->matchingpath);
free_stack(common, 1);
}
return;
@@ -7930,19 +9837,19 @@ if (bra == OP_BRAZERO)
if (*cc == OP_ASSERT_NOT || *cc == OP_ASSERTBACK_NOT)
{
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), SLJIT_IMM, 0);
- CMPTO(SLJIT_C_NOT_EQUAL, STR_PTR, 0, SLJIT_IMM, 0, CURRENT_AS(assert_backtrack)->matchingpath);
+ CMPTO(SLJIT_NOT_EQUAL, STR_PTR, 0, SLJIT_IMM, 0, CURRENT_AS(assert_backtrack)->matchingpath);
free_stack(common, 1);
return;
}
free_stack(common, 1);
- brajump = CMP(SLJIT_C_EQUAL, STR_PTR, 0, SLJIT_IMM, 0);
+ brajump = CMP(SLJIT_EQUAL, STR_PTR, 0, SLJIT_IMM, 0);
}
if (*cc == OP_ASSERT || *cc == OP_ASSERTBACK)
{
- OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), CURRENT_AS(assert_backtrack)->private_data_ptr);
+ OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), CURRENT_AS(assert_backtrack)->private_data_ptr);
add_jump(compiler, &common->revertframes, JUMP(SLJIT_FAST_CALL));
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), CURRENT_AS(assert_backtrack)->private_data_ptr, SLJIT_MEM1(STACK_TOP), CURRENT_AS(assert_backtrack)->framesize * sizeof(sljit_sw));
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), CURRENT_AS(assert_backtrack)->private_data_ptr, SLJIT_MEM1(STACK_TOP), STACK(-CURRENT_AS(assert_backtrack)->framesize - 1));
set_jumps(current->topbacktracks, LABEL());
}
@@ -7952,7 +9859,7 @@ else
if (bra == OP_BRAZERO)
{
/* We know there is enough place on the stack. */
- OP2(SLJIT_ADD, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, sizeof(sljit_sw));
+ OP2(SLJIT_SUB, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, sizeof(sljit_sw));
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), SLJIT_IMM, 0);
JUMPTO(SLJIT_JUMP, CURRENT_AS(assert_backtrack)->matchingpath);
JUMPHERE(brajump);
@@ -7962,21 +9869,22 @@ if (bra == OP_BRAZERO)
static void compile_bracket_backtrackingpath(compiler_common *common, struct backtrack_common *current)
{
DEFINE_COMPILER;
-int opcode, stacksize, count;
+int opcode, stacksize, alt_count, alt_max;
int offset = 0;
int private_data_ptr = CURRENT_AS(bracket_backtrack)->private_data_ptr;
int repeat_ptr = 0, repeat_type = 0, repeat_count = 0;
pcre_uchar *cc = current->cc;
pcre_uchar *ccbegin;
pcre_uchar *ccprev;
-jump_list *jumplist = NULL;
-jump_list *jumplistitem = NULL;
pcre_uchar bra = OP_BRA;
pcre_uchar ket;
assert_backtrack *assert;
+sljit_uw *next_update_addr = NULL;
BOOL has_alternatives;
BOOL needs_control_head = FALSE;
struct sljit_jump *brazero = NULL;
+struct sljit_jump *alt1 = NULL;
+struct sljit_jump *alt2 = NULL;
struct sljit_jump *once = NULL;
struct sljit_jump *cond = NULL;
struct sljit_label *rmin_label = NULL;
@@ -8014,6 +9922,8 @@ if (SLJIT_UNLIKELY(opcode == OP_COND) && (*cc == OP_KETRMAX || *cc == OP_KETRMIN
if (SLJIT_UNLIKELY(opcode == OP_ONCE_NC))
opcode = OP_ONCE;
+alt_max = has_alternatives ? no_alternatives(ccbegin) : 0;
+
/* Decoding the needs_control_head in framesize. */
if (opcode == OP_ONCE)
{
@@ -8027,9 +9937,9 @@ if (ket != OP_KET && repeat_type != 0)
OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), STACK(0));
free_stack(common, 1);
if (repeat_type == OP_UPTO)
- OP2(SLJIT_ADD, SLJIT_MEM1(SLJIT_LOCALS_REG), repeat_ptr, TMP1, 0, SLJIT_IMM, 1);
+ OP2(SLJIT_ADD, SLJIT_MEM1(SLJIT_SP), repeat_ptr, TMP1, 0, SLJIT_IMM, 1);
else
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), repeat_ptr, TMP1, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), repeat_ptr, TMP1, 0);
}
if (ket == OP_KETRMAX)
@@ -8038,7 +9948,7 @@ if (ket == OP_KETRMAX)
{
OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), STACK(0));
free_stack(common, 1);
- brazero = CMP(SLJIT_C_EQUAL, TMP1, 0, SLJIT_IMM, 0);
+ brazero = CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, 0);
}
}
else if (ket == OP_KETRMIN)
@@ -8049,7 +9959,7 @@ else if (ket == OP_KETRMIN)
if (repeat_type != 0)
{
/* TMP1 was set a few lines above. */
- CMPTO(SLJIT_C_NOT_EQUAL, TMP1, 0, SLJIT_IMM, 0, CURRENT_AS(bracket_backtrack)->recursive_matchingpath);
+ CMPTO(SLJIT_NOT_EQUAL, TMP1, 0, SLJIT_IMM, 0, CURRENT_AS(bracket_backtrack)->recursive_matchingpath);
/* Drop STR_PTR for non-greedy plus quantifier. */
if (opcode != OP_ONCE)
free_stack(common, 1);
@@ -8058,11 +9968,11 @@ else if (ket == OP_KETRMIN)
{
/* Checking zero-length iteration. */
if (opcode != OP_ONCE || CURRENT_AS(bracket_backtrack)->u.framesize < 0)
- CMPTO(SLJIT_C_NOT_EQUAL, STR_PTR, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr, CURRENT_AS(bracket_backtrack)->recursive_matchingpath);
+ CMPTO(SLJIT_NOT_EQUAL, STR_PTR, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr, CURRENT_AS(bracket_backtrack)->recursive_matchingpath);
else
{
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr);
- CMPTO(SLJIT_C_NOT_EQUAL, STR_PTR, 0, SLJIT_MEM1(TMP1), (CURRENT_AS(bracket_backtrack)->u.framesize + 1) * sizeof(sljit_sw), CURRENT_AS(bracket_backtrack)->recursive_matchingpath);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr);
+ CMPTO(SLJIT_NOT_EQUAL, STR_PTR, 0, SLJIT_MEM1(TMP1), STACK(-CURRENT_AS(bracket_backtrack)->u.framesize - 2), CURRENT_AS(bracket_backtrack)->recursive_matchingpath);
}
/* Drop STR_PTR for non-greedy plus quantifier. */
if (opcode != OP_ONCE)
@@ -8073,17 +9983,17 @@ else if (ket == OP_KETRMIN)
}
rmin_label = LABEL();
if (repeat_type != 0)
- OP2(SLJIT_ADD, SLJIT_MEM1(SLJIT_LOCALS_REG), repeat_ptr, SLJIT_MEM1(SLJIT_LOCALS_REG), repeat_ptr, SLJIT_IMM, 1);
+ OP2(SLJIT_ADD, SLJIT_MEM1(SLJIT_SP), repeat_ptr, SLJIT_MEM1(SLJIT_SP), repeat_ptr, SLJIT_IMM, 1);
}
else if (bra == OP_BRAZERO)
{
OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), STACK(0));
free_stack(common, 1);
- brazero = CMP(SLJIT_C_NOT_EQUAL, TMP1, 0, SLJIT_IMM, 0);
+ brazero = CMP(SLJIT_NOT_EQUAL, TMP1, 0, SLJIT_IMM, 0);
}
else if (repeat_type == OP_EXACT)
{
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), repeat_ptr, SLJIT_IMM, 1);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), repeat_ptr, SLJIT_IMM, 1);
exact_label = LABEL();
}
@@ -8094,19 +10004,19 @@ if (offset != 0)
SLJIT_ASSERT(common->optimized_cbracket[offset >> 1] == 0);
OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), STACK(0));
OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(STACK_TOP), STACK(1));
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->capture_last_ptr, TMP1, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->capture_last_ptr, TMP1, 0);
OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), STACK(2));
free_stack(common, 3);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(offset), TMP2, 0);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(offset + 1), TMP1, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset), TMP2, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset + 1), TMP1, 0);
}
else if (common->optimized_cbracket[offset >> 1] == 0)
{
OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), STACK(0));
OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(STACK_TOP), STACK(1));
free_stack(common, 2);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(offset), TMP1, 0);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(offset + 1), TMP2, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset), TMP1, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset + 1), TMP2, 0);
}
}
@@ -8114,7 +10024,7 @@ if (SLJIT_UNLIKELY(opcode == OP_ONCE))
{
if (CURRENT_AS(bracket_backtrack)->u.framesize >= 0)
{
- OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr);
+ OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr);
add_jump(compiler, &common->revertframes, JUMP(SLJIT_FAST_CALL));
}
once = JUMP(SLJIT_JUMP);
@@ -8127,44 +10037,30 @@ else if (SLJIT_UNLIKELY(opcode == OP_COND) || SLJIT_UNLIKELY(opcode == OP_SCOND)
OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), STACK(0));
free_stack(common, 1);
- jumplistitem = sljit_alloc_memory(compiler, sizeof(jump_list));
- if (SLJIT_UNLIKELY(!jumplistitem))
- return;
- jumplist = jumplistitem;
- jumplistitem->next = NULL;
- jumplistitem->jump = CMP(SLJIT_C_EQUAL, TMP1, 0, SLJIT_IMM, 1);
+ alt_max = 2;
+ alt1 = CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, sizeof(sljit_uw));
}
}
-else if (*cc == OP_ALT)
+else if (has_alternatives)
{
- /* Build a jump list. Get the last successfully matched branch index. */
OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), STACK(0));
free_stack(common, 1);
- count = 1;
- do
- {
- /* Append as the last item. */
- if (jumplist != NULL)
- {
- jumplistitem->next = sljit_alloc_memory(compiler, sizeof(jump_list));
- jumplistitem = jumplistitem->next;
- }
- else
- {
- jumplistitem = sljit_alloc_memory(compiler, sizeof(jump_list));
- jumplist = jumplistitem;
- }
- if (SLJIT_UNLIKELY(!jumplistitem))
+ if (alt_max > 4)
+ {
+ /* Table jump if alt_max is greater than 4. */
+ next_update_addr = allocate_read_only_data(common, alt_max * sizeof(sljit_uw));
+ if (SLJIT_UNLIKELY(next_update_addr == NULL))
return;
-
- jumplistitem->next = NULL;
- jumplistitem->jump = CMP(SLJIT_C_EQUAL, TMP1, 0, SLJIT_IMM, count++);
- cc += GET(cc, 1);
+ sljit_emit_ijump(compiler, SLJIT_JUMP, SLJIT_MEM1(TMP1), (sljit_sw)next_update_addr);
+ add_label_addr(common, next_update_addr++);
+ }
+ else
+ {
+ if (alt_max == 4)
+ alt2 = CMP(SLJIT_GREATER_EQUAL, TMP1, 0, SLJIT_IMM, 2 * sizeof(sljit_uw));
+ alt1 = CMP(SLJIT_GREATER_EQUAL, TMP1, 0, SLJIT_IMM, sizeof(sljit_uw));
}
- while (*cc == OP_ALT);
-
- cc = ccbegin + GET(ccbegin, 1);
}
COMPILE_BACKTRACKINGPATH(current->top);
@@ -8180,9 +10076,9 @@ if (SLJIT_UNLIKELY(opcode == OP_COND) || SLJIT_UNLIKELY(opcode == OP_SCOND))
assert = CURRENT_AS(bracket_backtrack)->u.assert;
if (assert->framesize >= 0 && (ccbegin[1 + LINK_SIZE] == OP_ASSERT || ccbegin[1 + LINK_SIZE] == OP_ASSERTBACK))
{
- OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), assert->private_data_ptr);
+ OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), assert->private_data_ptr);
add_jump(compiler, &common->revertframes, JUMP(SLJIT_FAST_CALL));
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), assert->private_data_ptr, SLJIT_MEM1(STACK_TOP), assert->framesize * sizeof(sljit_sw));
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), assert->private_data_ptr, SLJIT_MEM1(STACK_TOP), STACK(-assert->framesize - 1));
}
cond = JUMP(SLJIT_JUMP);
set_jumps(CURRENT_AS(bracket_backtrack)->u.assert->condfailed, LABEL());
@@ -8199,7 +10095,7 @@ if (SLJIT_UNLIKELY(opcode == OP_COND) || SLJIT_UNLIKELY(opcode == OP_SCOND))
if (has_alternatives)
{
- count = 1;
+ alt_count = sizeof(sljit_uw);
do
{
current->top = NULL;
@@ -8215,7 +10111,7 @@ if (has_alternatives)
if (opcode != OP_ONCE)
{
if (private_data_ptr != 0)
- OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr);
+ OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr);
else
OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), STACK(0));
}
@@ -8236,7 +10132,7 @@ if (has_alternatives)
if (repeat_type == OP_MINUPTO)
{
/* We need to preserve the counter. TMP2 will be used below. */
- OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), repeat_ptr);
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), repeat_ptr);
stacksize++;
}
if (ket != OP_KET || bra != OP_BRA)
@@ -8275,22 +10171,37 @@ if (has_alternatives)
stacksize = match_capture_common(common, stacksize, offset, private_data_ptr);
if (opcode != OP_ONCE)
- OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(stacksize), SLJIT_IMM, count++);
+ OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(stacksize), SLJIT_IMM, alt_count);
if (offset != 0 && ket == OP_KETRMAX && common->optimized_cbracket[offset >> 1] != 0)
{
/* If ket is not OP_KETRMAX, this code path is executed after the jump to alternative_matchingpath. */
SLJIT_ASSERT(private_data_ptr == OVECTOR(offset + 0));
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(offset + 1), STR_PTR, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset + 1), STR_PTR, 0);
}
JUMPTO(SLJIT_JUMP, CURRENT_AS(bracket_backtrack)->alternative_matchingpath);
if (opcode != OP_ONCE)
{
- SLJIT_ASSERT(jumplist);
- JUMPHERE(jumplist->jump);
- jumplist = jumplist->next;
+ if (alt_max > 4)
+ add_label_addr(common, next_update_addr++);
+ else
+ {
+ if (alt_count != 2 * sizeof(sljit_uw))
+ {
+ JUMPHERE(alt1);
+ if (alt_max == 3 && alt_count == sizeof(sljit_uw))
+ alt2 = CMP(SLJIT_GREATER_EQUAL, TMP1, 0, SLJIT_IMM, 2 * sizeof(sljit_uw));
+ }
+ else
+ {
+ JUMPHERE(alt2);
+ if (alt_max == 4)
+ alt1 = CMP(SLJIT_GREATER_EQUAL, TMP1, 0, SLJIT_IMM, 3 * sizeof(sljit_uw));
+ }
+ }
+ alt_count += sizeof(sljit_uw);
}
COMPILE_BACKTRACKINGPATH(current->top);
@@ -8299,7 +10210,6 @@ if (has_alternatives)
SLJIT_ASSERT(!current->nextbacktracks);
}
while (*cc == OP_ALT);
- SLJIT_ASSERT(!jumplist);
if (cond != NULL)
{
@@ -8307,9 +10217,9 @@ if (has_alternatives)
assert = CURRENT_AS(bracket_backtrack)->u.assert;
if ((ccbegin[1 + LINK_SIZE] == OP_ASSERT_NOT || ccbegin[1 + LINK_SIZE] == OP_ASSERTBACK_NOT) && assert->framesize >= 0)
{
- OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), assert->private_data_ptr);
+ OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), assert->private_data_ptr);
add_jump(compiler, &common->revertframes, JUMP(SLJIT_FAST_CALL));
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), assert->private_data_ptr, SLJIT_MEM1(STACK_TOP), assert->framesize * sizeof(sljit_sw));
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), assert->private_data_ptr, SLJIT_MEM1(STACK_TOP), STACK(-assert->framesize - 1));
}
JUMPHERE(cond);
}
@@ -8327,19 +10237,19 @@ if (offset != 0)
OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), STACK(0));
OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(STACK_TOP), STACK(1));
free_stack(common, 2);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(offset), TMP1, 0);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(offset + 1), TMP2, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset), TMP1, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset + 1), TMP2, 0);
}
else
{
OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), STACK(0));
free_stack(common, 1);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr, TMP1, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), private_data_ptr, TMP1, 0);
}
}
else if (opcode == OP_SBRA || opcode == OP_SCOND)
{
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr, SLJIT_MEM1(STACK_TOP), STACK(0));
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), private_data_ptr, SLJIT_MEM1(STACK_TOP), STACK(0));
free_stack(common, 1);
}
else if (opcode == OP_ONCE)
@@ -8357,26 +10267,28 @@ else if (opcode == OP_ONCE)
/* The STR_PTR must be released. */
stacksize++;
}
- free_stack(common, stacksize);
+
+ if (stacksize > 0)
+ free_stack(common, stacksize);
JUMPHERE(once);
/* Restore previous private_data_ptr */
if (CURRENT_AS(bracket_backtrack)->u.framesize >= 0)
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr, SLJIT_MEM1(STACK_TOP), CURRENT_AS(bracket_backtrack)->u.framesize * sizeof(sljit_sw));
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), private_data_ptr, SLJIT_MEM1(STACK_TOP), STACK(-CURRENT_AS(bracket_backtrack)->u.framesize - 1));
else if (ket == OP_KETRMIN)
{
OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), STACK(1));
/* See the comment below. */
free_stack(common, 2);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), private_data_ptr, TMP1, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), private_data_ptr, TMP1, 0);
}
}
if (repeat_type == OP_EXACT)
{
- OP2(SLJIT_ADD, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), repeat_ptr, SLJIT_IMM, 1);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), repeat_ptr, TMP1, 0);
- CMPTO(SLJIT_C_LESS_EQUAL, TMP1, 0, SLJIT_IMM, repeat_count, exact_label);
+ OP2(SLJIT_ADD, TMP1, 0, SLJIT_MEM1(SLJIT_SP), repeat_ptr, SLJIT_IMM, 1);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), repeat_ptr, TMP1, 0);
+ CMPTO(SLJIT_LESS_EQUAL, TMP1, 0, SLJIT_IMM, repeat_count, exact_label);
}
else if (ket == OP_KETRMAX)
{
@@ -8384,7 +10296,7 @@ else if (ket == OP_KETRMAX)
if (bra != OP_BRAZERO)
free_stack(common, 1);
- CMPTO(SLJIT_C_NOT_EQUAL, STR_PTR, 0, SLJIT_IMM, 0, CURRENT_AS(bracket_backtrack)->recursive_matchingpath);
+ CMPTO(SLJIT_NOT_EQUAL, STR_PTR, 0, SLJIT_IMM, 0, CURRENT_AS(bracket_backtrack)->recursive_matchingpath);
if (bra == OP_BRAZERO)
{
OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), STACK(1));
@@ -8402,7 +10314,7 @@ else if (ket == OP_KETRMIN)
affect badly the free_stack(2) above. */
if (opcode != OP_ONCE)
free_stack(common, 1);
- CMPTO(SLJIT_C_NOT_EQUAL, TMP1, 0, SLJIT_IMM, 0, rmin_label);
+ CMPTO(SLJIT_NOT_EQUAL, TMP1, 0, SLJIT_IMM, 0, rmin_label);
if (opcode == OP_ONCE)
free_stack(common, bra == OP_BRAMINZERO ? 2 : 1);
else if (bra == OP_BRAMINZERO)
@@ -8429,19 +10341,19 @@ if (CURRENT_AS(bracketpos_backtrack)->framesize < 0)
offset = (GET2(current->cc, 1 + LINK_SIZE)) << 1;
OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), STACK(0));
OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(STACK_TOP), STACK(1));
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(offset), TMP1, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset), TMP1, 0);
if (common->capture_last_ptr != 0)
OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), STACK(2));
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(offset + 1), TMP2, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset + 1), TMP2, 0);
if (common->capture_last_ptr != 0)
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->capture_last_ptr, TMP1, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->capture_last_ptr, TMP1, 0);
}
set_jumps(current->topbacktracks, LABEL());
free_stack(common, CURRENT_AS(bracketpos_backtrack)->stacksize);
return;
}
-OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), CURRENT_AS(bracketpos_backtrack)->private_data_ptr);
+OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), CURRENT_AS(bracketpos_backtrack)->private_data_ptr);
add_jump(compiler, &common->revertframes, JUMP(SLJIT_FAST_CALL));
if (current->topbacktracks)
@@ -8452,7 +10364,7 @@ if (current->topbacktracks)
free_stack(common, CURRENT_AS(bracketpos_backtrack)->stacksize);
JUMPHERE(jump);
}
-OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), CURRENT_AS(bracketpos_backtrack)->private_data_ptr, SLJIT_MEM1(STACK_TOP), CURRENT_AS(bracketpos_backtrack)->framesize * sizeof(sljit_sw));
+OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), CURRENT_AS(bracketpos_backtrack)->private_data_ptr, SLJIT_MEM1(STACK_TOP), STACK(-CURRENT_AS(bracketpos_backtrack)->framesize - 1));
}
static SLJIT_INLINE void compile_braminzero_backtrackingpath(compiler_common *common, struct backtrack_common *current)
@@ -8492,16 +10404,16 @@ if (opcode == OP_THEN || opcode == OP_THEN_ARG)
{
SLJIT_ASSERT(common->control_head_ptr != 0);
- OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->control_head_ptr);
+ OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr);
OP1(SLJIT_MOV, TMP1, 0, SLJIT_IMM, type_then_trap);
OP1(SLJIT_MOV, TMP2, 0, SLJIT_IMM, common->then_trap->start);
jump = JUMP(SLJIT_JUMP);
loop = LABEL();
- OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(STACK_TOP), -(int)sizeof(sljit_sw));
+ OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(STACK_TOP), STACK(0));
JUMPHERE(jump);
- CMPTO(SLJIT_C_NOT_EQUAL, SLJIT_MEM1(STACK_TOP), -(int)(2 * sizeof(sljit_sw)), TMP1, 0, loop);
- CMPTO(SLJIT_C_NOT_EQUAL, SLJIT_MEM1(STACK_TOP), -(int)(3 * sizeof(sljit_sw)), TMP2, 0, loop);
+ CMPTO(SLJIT_NOT_EQUAL, SLJIT_MEM1(STACK_TOP), STACK(1), TMP1, 0, loop);
+ CMPTO(SLJIT_NOT_EQUAL, SLJIT_MEM1(STACK_TOP), STACK(2), TMP2, 0, loop);
add_jump(compiler, &common->then_trap->quit, JUMP(SLJIT_JUMP));
return;
}
@@ -8524,14 +10436,14 @@ if (common->local_exit)
if (opcode == OP_SKIP_ARG)
{
SLJIT_ASSERT(common->control_head_ptr != 0);
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->control_head_ptr);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), LOCALS0, STACK_TOP, 0);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), LOCALS0, STACK_TOP, 0);
OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_IMM, (sljit_sw)(current->cc + 2));
sljit_emit_ijump(compiler, SLJIT_CALL2, SLJIT_IMM, SLJIT_FUNC_OFFSET(do_search_mark));
- OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), LOCALS0);
+ OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), LOCALS0);
OP1(SLJIT_MOV, STR_PTR, 0, TMP1, 0);
- add_jump(compiler, &common->reset_match, CMP(SLJIT_C_NOT_EQUAL, STR_PTR, 0, SLJIT_IMM, -1));
+ add_jump(compiler, &common->reset_match, CMP(SLJIT_NOT_EQUAL, STR_PTR, 0, SLJIT_IMM, -1));
return;
}
@@ -8569,7 +10481,7 @@ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), STACK(0));
free_stack(common, 3);
JUMPHERE(jump);
-OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->control_head_ptr, TMP1, 0);
+OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr, TMP1, 0);
}
static void compile_backtrackingpath(compiler_common *common, struct backtrack_common *current)
@@ -8586,7 +10498,7 @@ while (current)
case OP_SET_SOM:
OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), STACK(0));
free_stack(common, 1);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(0), TMP1, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), OVECTOR(0), TMP1, 0);
break;
case OP_STAR:
@@ -8664,6 +10576,8 @@ while (current)
case OP_REF:
case OP_REFI:
+ case OP_DNREF:
+ case OP_DNREFI:
compile_ref_iterator_backtrackingpath(common, current);
break;
@@ -8713,9 +10627,9 @@ while (current)
if (common->has_skip_arg)
OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(STACK_TOP), STACK(0));
free_stack(common, common->has_skip_arg ? 5 : 1);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->mark_ptr, TMP1, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->mark_ptr, TMP1, 0);
if (common->has_skip_arg)
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->control_head_ptr, TMP2, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr, TMP2, 0);
break;
case OP_THEN:
@@ -8749,7 +10663,7 @@ while (current)
break;
default:
- SLJIT_ASSERT_STOP();
+ SLJIT_UNREACHABLE();
break;
}
current = current->prev;
@@ -8762,7 +10676,7 @@ static SLJIT_INLINE void compile_recurse(compiler_common *common)
DEFINE_COMPILER;
pcre_uchar *cc = common->start + common->currententry->start;
pcre_uchar *ccbegin = cc + 1 + LINK_SIZE + (*cc == OP_BRA ? 0 : IMM2_SIZE);
-pcre_uchar *ccend = bracketend(cc);
+pcre_uchar *ccend = bracketend(cc) - (1 + LINK_SIZE);
BOOL needs_control_head;
int framesize = get_framesize(common, cc, NULL, TRUE, &needs_control_head);
int private_data_size = get_private_data_copy_length(common, ccbegin, ccend, needs_control_head);
@@ -8785,12 +10699,13 @@ common->currententry->entry = LABEL();
set_jumps(common->currententry->calls, common->currententry->entry);
sljit_emit_fast_enter(compiler, TMP2, 0);
+count_match(common);
allocate_stack(common, private_data_size + framesize + alternativesize);
OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(private_data_size + framesize + alternativesize - 1), TMP2, 0);
-copy_private_data(common, ccbegin, ccend, TRUE, private_data_size + framesize + alternativesize, framesize + alternativesize, needs_control_head);
+copy_private_data(common, ccbegin, ccend, TRUE, framesize + alternativesize, private_data_size + framesize + alternativesize, needs_control_head);
if (needs_control_head)
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->control_head_ptr, SLJIT_IMM, 0);
-OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->recursive_head_ptr, STACK_TOP, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr, SLJIT_IMM, 0);
+OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->recursive_head_ptr, STACK_TOP, 0);
if (needs_frame)
init_frame(common, cc, NULL, framesize + alternativesize - 1, alternativesize, TRUE);
@@ -8837,12 +10752,12 @@ jump = JUMP(SLJIT_JUMP);
if (common->quit != NULL)
{
set_jumps(common->quit, LABEL());
- OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->recursive_head_ptr);
+ OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), common->recursive_head_ptr);
if (needs_frame)
{
- OP2(SLJIT_SUB, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, (framesize + alternativesize) * sizeof(sljit_sw));
- add_jump(compiler, &common->revertframes, JUMP(SLJIT_FAST_CALL));
OP2(SLJIT_ADD, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, (framesize + alternativesize) * sizeof(sljit_sw));
+ add_jump(compiler, &common->revertframes, JUMP(SLJIT_FAST_CALL));
+ OP2(SLJIT_SUB, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, (framesize + alternativesize) * sizeof(sljit_sw));
}
OP1(SLJIT_MOV, TMP3, 0, SLJIT_IMM, 0);
common->quit = NULL;
@@ -8850,35 +10765,35 @@ if (common->quit != NULL)
}
set_jumps(common->accept, LABEL());
-OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->recursive_head_ptr);
+OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), common->recursive_head_ptr);
if (needs_frame)
{
- OP2(SLJIT_SUB, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, (framesize + alternativesize) * sizeof(sljit_sw));
- add_jump(compiler, &common->revertframes, JUMP(SLJIT_FAST_CALL));
OP2(SLJIT_ADD, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, (framesize + alternativesize) * sizeof(sljit_sw));
+ add_jump(compiler, &common->revertframes, JUMP(SLJIT_FAST_CALL));
+ OP2(SLJIT_SUB, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, (framesize + alternativesize) * sizeof(sljit_sw));
}
OP1(SLJIT_MOV, TMP3, 0, SLJIT_IMM, 1);
JUMPHERE(jump);
if (common->quit != NULL)
set_jumps(common->quit, LABEL());
-copy_private_data(common, ccbegin, ccend, FALSE, private_data_size + framesize + alternativesize, framesize + alternativesize, needs_control_head);
+copy_private_data(common, ccbegin, ccend, FALSE, framesize + alternativesize, private_data_size + framesize + alternativesize, needs_control_head);
free_stack(common, private_data_size + framesize + alternativesize);
if (needs_control_head)
{
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), 2 * sizeof(sljit_sw));
- OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(STACK_TOP), sizeof(sljit_sw));
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->recursive_head_ptr, TMP1, 0);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), STACK(-3));
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(STACK_TOP), STACK(-2));
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->recursive_head_ptr, TMP1, 0);
OP1(SLJIT_MOV, TMP1, 0, TMP3, 0);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->control_head_ptr, TMP2, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr, TMP2, 0);
}
else
{
- OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(STACK_TOP), sizeof(sljit_sw));
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(STACK_TOP), STACK(-2));
OP1(SLJIT_MOV, TMP1, 0, TMP3, 0);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->recursive_head_ptr, TMP2, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->recursive_head_ptr, TMP2, 0);
}
-sljit_emit_fast_return(compiler, SLJIT_MEM1(STACK_TOP), 0);
+sljit_emit_fast_return(compiler, SLJIT_MEM1(STACK_TOP), STACK(-1));
}
#undef COMPILE_BACKTRACKINGPATH
@@ -8891,23 +10806,25 @@ struct sljit_compiler *compiler;
backtrack_common rootbacktrack;
compiler_common common_data;
compiler_common *common = &common_data;
-const pcre_uint8 *tables = re->tables;
+const sljit_u8 *tables = re->tables;
pcre_study_data *study;
int private_data_size;
pcre_uchar *ccend;
executable_functions *functions;
void *executable_func;
sljit_uw executable_size;
+sljit_uw total_length;
+label_addr_list *label_addr;
struct sljit_label *mainloop_label = NULL;
struct sljit_label *continue_match_label;
-struct sljit_label *empty_match_found_label;
-struct sljit_label *empty_match_backtrack_label;
+struct sljit_label *empty_match_found_label = NULL;
+struct sljit_label *empty_match_backtrack_label = NULL;
struct sljit_label *reset_match_label;
+struct sljit_label *quit_label;
struct sljit_jump *jump;
struct sljit_jump *minlength_check_failed = NULL;
struct sljit_jump *reqbyte_notfound = NULL;
-struct sljit_jump *empty_match;
-struct sljit_label *quit_label;
+struct sljit_jump *empty_match = NULL;
SLJIT_ASSERT((extra->flags & PCRE_EXTRA_STUDY_DATA) != 0);
study = extra->study_data;
@@ -8920,9 +10837,11 @@ memset(common, 0, sizeof(compiler_common));
rootbacktrack.cc = (pcre_uchar *)re + re->name_table_offset + re->name_count * re->name_entry_size;
common->start = rootbacktrack.cc;
+common->read_only_data_head = NULL;
common->fcc = tables + fcc_offset;
common->lcc = (sljit_sw)(tables + lcc_offset);
common->mode = mode;
+common->might_be_empty = study->minlength == 0;
common->nltype = NLTYPE_FIXED;
switch(re->options & PCRE_NEWLINE_BITS)
{
@@ -8943,6 +10862,8 @@ switch(re->options & PCRE_NEWLINE_BITS)
case PCRE_NEWLINE_ANYCRLF: common->newline = (CHAR_CR << 8) | CHAR_NL; common->nltype = NLTYPE_ANYCRLF; break;
default: return;
}
+common->nlmax = READ_CHAR_MAX;
+common->nlmin = 0;
if ((re->options & PCRE_BSR_ANYCRLF) != 0)
common->bsr_nltype = NLTYPE_ANYCRLF;
else if ((re->options & PCRE_BSR_UNICODE) != 0)
@@ -8955,10 +10876,11 @@ else
common->bsr_nltype = NLTYPE_ANY;
#endif
}
+common->bsr_nlmax = READ_CHAR_MAX;
+common->bsr_nlmin = 0;
common->endonly = (re->options & PCRE_DOLLAR_ENDONLY) != 0;
common->ctypes = (sljit_sw)(tables + ctypes_offset);
-common->digits[0] = -2;
-common->name_table = (sljit_sw)((pcre_uchar *)re + re->name_table_offset);
+common->name_table = ((pcre_uchar *)re) + re->name_table_offset;
common->name_count = re->name_count;
common->name_entry_size = re->name_entry_size;
common->jscript_compat = (re->options & PCRE_JAVASCRIPT_COMPAT) != 0;
@@ -8968,12 +10890,35 @@ common->utf = (re->options & PCRE_UTF8) != 0;
#ifdef SUPPORT_UCP
common->use_ucp = (re->options & PCRE_UCP) != 0;
#endif
+if (common->utf)
+ {
+ if (common->nltype == NLTYPE_ANY)
+ common->nlmax = 0x2029;
+ else if (common->nltype == NLTYPE_ANYCRLF)
+ common->nlmax = (CHAR_CR > CHAR_NL) ? CHAR_CR : CHAR_NL;
+ else
+ {
+ /* We only care about the first newline character. */
+ common->nlmax = common->newline & 0xff;
+ }
+
+ if (common->nltype == NLTYPE_FIXED)
+ common->nlmin = common->newline & 0xff;
+ else
+ common->nlmin = (CHAR_CR < CHAR_NL) ? CHAR_CR : CHAR_NL;
+
+ if (common->bsr_nltype == NLTYPE_ANY)
+ common->bsr_nlmax = 0x2029;
+ else
+ common->bsr_nlmax = (CHAR_CR > CHAR_NL) ? CHAR_CR : CHAR_NL;
+ common->bsr_nlmin = (CHAR_CR < CHAR_NL) ? CHAR_CR : CHAR_NL;
+ }
#endif /* SUPPORT_UTF */
-ccend = bracketend(rootbacktrack.cc);
+ccend = bracketend(common->start);
/* Calculate the local space size on the stack. */
common->ovector_start = LIMIT_MATCH + sizeof(sljit_sw);
-common->optimized_cbracket = (pcre_uint8 *)SLJIT_MALLOC(re->top_bracket + 1);
+common->optimized_cbracket = (sljit_u8 *)SLJIT_MALLOC(re->top_bracket + 1, compiler->allocator_data);
if (!common->optimized_cbracket)
return;
#if defined DEBUG_FORCE_UNOPTIMIZED_CBRAS && DEBUG_FORCE_UNOPTIMIZED_CBRAS == 1
@@ -8982,14 +10927,14 @@ memset(common->optimized_cbracket, 0, re->top_bracket + 1);
memset(common->optimized_cbracket, 1, re->top_bracket + 1);
#endif
-SLJIT_ASSERT(*rootbacktrack.cc == OP_BRA && ccend[-(1 + LINK_SIZE)] == OP_KET);
+SLJIT_ASSERT(*common->start == OP_BRA && ccend[-(1 + LINK_SIZE)] == OP_KET);
#if defined DEBUG_FORCE_UNOPTIMIZED_CBRAS && DEBUG_FORCE_UNOPTIMIZED_CBRAS == 2
common->capture_last_ptr = common->ovector_start;
common->ovector_start += sizeof(sljit_sw);
#endif
-if (!check_opcode_types(common, rootbacktrack.cc, ccend))
+if (!check_opcode_types(common, common->start, ccend))
{
- SLJIT_FREE(common->optimized_cbracket);
+ SLJIT_FREE(common->optimized_cbracket, compiler->allocator_data);
return;
}
@@ -9008,15 +10953,10 @@ if (mode != JIT_COMPILE)
common->hit_start = common->ovector_start;
common->ovector_start += 2 * sizeof(sljit_sw);
}
- else
- {
- SLJIT_ASSERT(mode == JIT_PARTIAL_HARD_COMPILE);
- common->needs_start_ptr = TRUE;
- }
}
if ((re->options & PCRE_FIRSTLINE) != 0)
{
- common->first_line_end = common->ovector_start;
+ common->match_end_ptr = common->ovector_start;
common->ovector_start += sizeof(sljit_sw);
}
#if defined DEBUG_FORCE_CONTROL_HEAD && DEBUG_FORCE_CONTROL_HEAD
@@ -9027,14 +10967,12 @@ if (common->control_head_ptr != 0)
common->control_head_ptr = common->ovector_start;
common->ovector_start += sizeof(sljit_sw);
}
-if (common->needs_start_ptr && common->has_set_som)
+if (common->has_set_som)
{
/* Saving the real start pointer is necessary. */
common->start_ptr = common->ovector_start;
common->ovector_start += sizeof(sljit_sw);
}
-else
- common->needs_start_ptr = FALSE;
/* Aligning ovector to even number of sljit words. */
if ((common->ovector_start & sizeof(sljit_sw)) != 0)
@@ -9050,88 +10988,93 @@ if (common->capture_last_ptr != 0)
SLJIT_ASSERT(!(common->req_char_ptr != 0 && common->start_used_ptr != 0));
common->cbra_ptr = OVECTOR_START + (re->top_bracket + 1) * 2 * sizeof(sljit_sw);
-common->private_data_ptrs = (int *)SLJIT_MALLOC((ccend - rootbacktrack.cc) * sizeof(sljit_si));
+total_length = ccend - common->start;
+common->private_data_ptrs = (sljit_s32 *)SLJIT_MALLOC(total_length * (sizeof(sljit_s32) + (common->has_then ? 1 : 0)), compiler->allocator_data);
if (!common->private_data_ptrs)
{
- SLJIT_FREE(common->optimized_cbracket);
+ SLJIT_FREE(common->optimized_cbracket, compiler->allocator_data);
return;
}
-memset(common->private_data_ptrs, 0, (ccend - rootbacktrack.cc) * sizeof(int));
+memset(common->private_data_ptrs, 0, total_length * sizeof(sljit_s32));
private_data_size = common->cbra_ptr + (re->top_bracket + 1) * sizeof(sljit_sw);
set_private_data_ptrs(common, &private_data_size, ccend);
+if ((re->options & PCRE_ANCHORED) == 0 && (re->options & PCRE_NO_START_OPTIMIZE) == 0)
+ {
+ if (!detect_fast_forward_skip(common, &private_data_size) && !common->has_skip_in_assert_back)
+ detect_fast_fail(common, common->start, &private_data_size, 4);
+ }
+
+SLJIT_ASSERT(common->fast_fail_start_ptr <= common->fast_fail_end_ptr);
+
if (private_data_size > SLJIT_MAX_LOCAL_SIZE)
{
- SLJIT_FREE(common->private_data_ptrs);
- SLJIT_FREE(common->optimized_cbracket);
+ SLJIT_FREE(common->private_data_ptrs, compiler->allocator_data);
+ SLJIT_FREE(common->optimized_cbracket, compiler->allocator_data);
return;
}
if (common->has_then)
{
- common->then_offsets = (pcre_uint8 *)SLJIT_MALLOC(ccend - rootbacktrack.cc);
- if (!common->then_offsets)
- {
- SLJIT_FREE(common->optimized_cbracket);
- SLJIT_FREE(common->private_data_ptrs);
- return;
- }
- memset(common->then_offsets, 0, ccend - rootbacktrack.cc);
- set_then_offsets(common, rootbacktrack.cc, NULL);
+ common->then_offsets = (sljit_u8 *)(common->private_data_ptrs + total_length);
+ memset(common->then_offsets, 0, total_length);
+ set_then_offsets(common, common->start, NULL);
}
-compiler = sljit_create_compiler();
+compiler = sljit_create_compiler(NULL);
if (!compiler)
{
- SLJIT_FREE(common->optimized_cbracket);
- SLJIT_FREE(common->private_data_ptrs);
- if (common->has_then)
- SLJIT_FREE(common->then_offsets);
+ SLJIT_FREE(common->optimized_cbracket, compiler->allocator_data);
+ SLJIT_FREE(common->private_data_ptrs, compiler->allocator_data);
return;
}
common->compiler = compiler;
/* Main pcre_jit_exec entry. */
-sljit_emit_enter(compiler, 1, 5, 5, private_data_size);
+sljit_emit_enter(compiler, 0, 1, 5, 5, 0, 0, private_data_size);
/* Register init. */
reset_ovector(common, (re->top_bracket + 1) * 2);
if (common->req_char_ptr != 0)
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->req_char_ptr, SLJIT_SCRATCH_REG1, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->req_char_ptr, SLJIT_R0, 0);
-OP1(SLJIT_MOV, ARGUMENTS, 0, SLJIT_SAVED_REG1, 0);
-OP1(SLJIT_MOV, TMP1, 0, SLJIT_SAVED_REG1, 0);
+OP1(SLJIT_MOV, ARGUMENTS, 0, SLJIT_S0, 0);
+OP1(SLJIT_MOV, TMP1, 0, SLJIT_S0, 0);
OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, str));
OP1(SLJIT_MOV, STR_END, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, end));
OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, stack));
-OP1(SLJIT_MOV_UI, TMP1, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, limit_match));
+OP1(SLJIT_MOV_U32, TMP1, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, limit_match));
OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(TMP2), SLJIT_OFFSETOF(struct sljit_stack, base));
OP1(SLJIT_MOV, STACK_LIMIT, 0, SLJIT_MEM1(TMP2), SLJIT_OFFSETOF(struct sljit_stack, limit));
-OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), LIMIT_MATCH, TMP1, 0);
+OP2(SLJIT_ADD, TMP1, 0, TMP1, 0, SLJIT_IMM, 1);
+OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), LIMIT_MATCH, TMP1, 0);
+
+if (common->fast_fail_start_ptr < common->fast_fail_end_ptr)
+ reset_fast_fail(common);
if (mode == JIT_PARTIAL_SOFT_COMPILE)
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->hit_start, SLJIT_IMM, -1);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->hit_start, SLJIT_IMM, -1);
if (common->mark_ptr != 0)
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->mark_ptr, SLJIT_IMM, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->mark_ptr, SLJIT_IMM, 0);
if (common->control_head_ptr != 0)
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->control_head_ptr, SLJIT_IMM, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr, SLJIT_IMM, 0);
/* Main part of the matching */
if ((re->options & PCRE_ANCHORED) == 0)
{
- mainloop_label = mainloop_entry(common, (re->flags & PCRE_HASCRORLF) != 0, (re->options & PCRE_FIRSTLINE) != 0);
+ mainloop_label = mainloop_entry(common, (re->flags & PCRE_HASCRORLF) != 0);
continue_match_label = LABEL();
/* Forward search if possible. */
if ((re->options & PCRE_NO_START_OPTIMIZE) == 0)
{
- if (mode == JIT_COMPILE && fast_forward_first_n_chars(common, (re->options & PCRE_FIRSTLINE) != 0))
- { /* Do nothing */ }
+ if (mode == JIT_COMPILE && fast_forward_first_n_chars(common))
+ ;
else if ((re->flags & PCRE_FIRSTSET) != 0)
- fast_forward_first_char(common, (pcre_uchar)re->first_char, (re->flags & PCRE_FCH_CASELESS) != 0, (re->options & PCRE_FIRSTLINE) != 0);
+ fast_forward_first_char(common, (pcre_uchar)re->first_char, (re->flags & PCRE_FCH_CASELESS) != 0);
else if ((re->flags & PCRE_STARTLINE) != 0)
- fast_forward_newline(common, (re->options & PCRE_FIRSTLINE) != 0);
- else if ((re->flags & PCRE_STARTLINE) == 0 && study != NULL && (study->flags & PCRE_STUDY_MAPPED) != 0)
- fast_forward_start_bits(common, (sljit_uw)study->start_bits, (re->options & PCRE_FIRSTLINE) != 0);
+ fast_forward_newline(common);
+ else if (study != NULL && (study->flags & PCRE_STUDY_MAPPED) != 0)
+ fast_forward_start_bits(common, study->start_bits);
}
}
else
@@ -9141,50 +11084,49 @@ if (mode == JIT_COMPILE && study->minlength > 0 && (re->options & PCRE_NO_START_
{
OP1(SLJIT_MOV, SLJIT_RETURN_REG, 0, SLJIT_IMM, PCRE_ERROR_NOMATCH);
OP2(SLJIT_ADD, TMP2, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(study->minlength));
- minlength_check_failed = CMP(SLJIT_C_GREATER, TMP2, 0, STR_END, 0);
+ minlength_check_failed = CMP(SLJIT_GREATER, TMP2, 0, STR_END, 0);
}
if (common->req_char_ptr != 0)
reqbyte_notfound = search_requested_char(common, (pcre_uchar)re->req_char, (re->flags & PCRE_RCH_CASELESS) != 0, (re->flags & PCRE_FIRSTSET) != 0);
/* Store the current STR_PTR in OVECTOR(0). */
-OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(0), STR_PTR, 0);
+OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), OVECTOR(0), STR_PTR, 0);
/* Copy the limit of allowed recursions. */
-OP1(SLJIT_MOV, COUNT_MATCH, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), LIMIT_MATCH);
+OP1(SLJIT_MOV, COUNT_MATCH, 0, SLJIT_MEM1(SLJIT_SP), LIMIT_MATCH);
if (common->capture_last_ptr != 0)
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->capture_last_ptr, SLJIT_IMM, -1);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->capture_last_ptr, SLJIT_IMM, -1);
+if (common->fast_forward_bc_ptr != NULL)
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), PRIVATE_DATA(common->fast_forward_bc_ptr + 1), STR_PTR, 0);
-if (common->needs_start_ptr)
- {
- SLJIT_ASSERT(common->start_ptr != OVECTOR(0));
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->start_ptr, STR_PTR, 0);
- }
-else
- SLJIT_ASSERT(common->start_ptr == OVECTOR(0));
+if (common->start_ptr != OVECTOR(0))
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->start_ptr, STR_PTR, 0);
/* Copy the beginning of the string. */
if (mode == JIT_PARTIAL_SOFT_COMPILE)
{
- jump = CMP(SLJIT_C_NOT_EQUAL, SLJIT_MEM1(SLJIT_LOCALS_REG), common->hit_start, SLJIT_IMM, -1);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->start_used_ptr, STR_PTR, 0);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->hit_start + sizeof(sljit_sw), STR_PTR, 0);
+ jump = CMP(SLJIT_NOT_EQUAL, SLJIT_MEM1(SLJIT_SP), common->hit_start, SLJIT_IMM, -1);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->start_used_ptr, STR_PTR, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->hit_start + sizeof(sljit_sw), STR_PTR, 0);
JUMPHERE(jump);
}
else if (mode == JIT_PARTIAL_HARD_COMPILE)
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->start_used_ptr, STR_PTR, 0);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->start_used_ptr, STR_PTR, 0);
-compile_matchingpath(common, rootbacktrack.cc, ccend, &rootbacktrack);
+compile_matchingpath(common, common->start, ccend, &rootbacktrack);
if (SLJIT_UNLIKELY(sljit_get_compiler_error(compiler)))
{
sljit_free_compiler(compiler);
- SLJIT_FREE(common->optimized_cbracket);
- SLJIT_FREE(common->private_data_ptrs);
- if (common->has_then)
- SLJIT_FREE(common->then_offsets);
+ SLJIT_FREE(common->optimized_cbracket, compiler->allocator_data);
+ SLJIT_FREE(common->private_data_ptrs, compiler->allocator_data);
+ free_read_only_data(common->read_only_data_head, compiler->allocator_data);
return;
}
-empty_match = CMP(SLJIT_C_EQUAL, STR_PTR, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), OVECTOR(0));
-empty_match_found_label = LABEL();
+if (common->might_be_empty)
+ {
+ empty_match = CMP(SLJIT_EQUAL, STR_PTR, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(0));
+ empty_match_found_label = LABEL();
+ }
common->accept_label = LABEL();
if (common->accept != NULL)
@@ -9208,15 +11150,15 @@ if (mode != JIT_COMPILE)
return_with_partial_match(common, common->quit_label);
}
-empty_match_backtrack_label = LABEL();
+if (common->might_be_empty)
+ empty_match_backtrack_label = LABEL();
compile_backtrackingpath(common, rootbacktrack.top);
if (SLJIT_UNLIKELY(sljit_get_compiler_error(compiler)))
{
sljit_free_compiler(compiler);
- SLJIT_FREE(common->optimized_cbracket);
- SLJIT_FREE(common->private_data_ptrs);
- if (common->has_then)
- SLJIT_FREE(common->then_offsets);
+ SLJIT_FREE(common->optimized_cbracket, compiler->allocator_data);
+ SLJIT_FREE(common->private_data_ptrs, compiler->allocator_data);
+ free_read_only_data(common->read_only_data_head, compiler->allocator_data);
return;
}
@@ -9226,28 +11168,33 @@ reset_match_label = LABEL();
if (mode == JIT_PARTIAL_SOFT_COMPILE)
{
/* Update hit_start only in the first time. */
- jump = CMP(SLJIT_C_NOT_EQUAL, SLJIT_MEM1(SLJIT_LOCALS_REG), common->hit_start, SLJIT_IMM, 0);
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->start_used_ptr);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->start_used_ptr, SLJIT_IMM, -1);
- OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), common->hit_start, TMP1, 0);
+ jump = CMP(SLJIT_NOT_EQUAL, SLJIT_MEM1(SLJIT_SP), common->hit_start, SLJIT_IMM, 0);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), common->start_used_ptr);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->start_used_ptr, SLJIT_IMM, -1);
+ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->hit_start, TMP1, 0);
JUMPHERE(jump);
}
/* Check we have remaining characters. */
if ((re->options & PCRE_ANCHORED) == 0 && (re->options & PCRE_FIRSTLINE) != 0)
{
- SLJIT_ASSERT(common->first_line_end != 0);
- OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->first_line_end);
+ SLJIT_ASSERT(common->match_end_ptr != 0);
+ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), common->match_end_ptr);
}
-OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), common->start_ptr);
+OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(SLJIT_SP),
+ (common->fast_forward_bc_ptr != NULL) ? (PRIVATE_DATA(common->fast_forward_bc_ptr + 1)) : common->start_ptr);
if ((re->options & PCRE_ANCHORED) == 0)
{
- if ((re->options & PCRE_FIRSTLINE) == 0)
- CMPTO(SLJIT_C_LESS, STR_PTR, 0, STR_END, 0, mainloop_label);
+ if (common->ff_newline_shortcut != NULL)
+ {
+ if ((re->options & PCRE_FIRSTLINE) == 0)
+ CMPTO(SLJIT_LESS, STR_PTR, 0, STR_END, 0, common->ff_newline_shortcut);
+ /* There cannot be more newlines here. */
+ }
else
- CMPTO(SLJIT_C_LESS, STR_PTR, 0, TMP1, 0, mainloop_label);
+ CMPTO(SLJIT_LESS, STR_PTR, 0, ((re->options & PCRE_FIRSTLINE) == 0) ? STR_END : TMP1, 0, mainloop_label);
}
/* No more remaining characters. */
@@ -9255,23 +11202,29 @@ if (reqbyte_notfound != NULL)
JUMPHERE(reqbyte_notfound);
if (mode == JIT_PARTIAL_SOFT_COMPILE)
- CMPTO(SLJIT_C_NOT_EQUAL, SLJIT_MEM1(SLJIT_LOCALS_REG), common->hit_start, SLJIT_IMM, -1, common->partialmatchlabel);
+ CMPTO(SLJIT_NOT_EQUAL, SLJIT_MEM1(SLJIT_SP), common->hit_start, SLJIT_IMM, -1, common->partialmatchlabel);
OP1(SLJIT_MOV, SLJIT_RETURN_REG, 0, SLJIT_IMM, PCRE_ERROR_NOMATCH);
JUMPTO(SLJIT_JUMP, common->quit_label);
flush_stubs(common);
-JUMPHERE(empty_match);
-OP1(SLJIT_MOV, TMP1, 0, ARGUMENTS, 0);
-OP1(SLJIT_MOV_UB, TMP2, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, notempty));
-CMPTO(SLJIT_C_NOT_EQUAL, TMP2, 0, SLJIT_IMM, 0, empty_match_backtrack_label);
-OP1(SLJIT_MOV_UB, TMP2, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, notempty_atstart));
-CMPTO(SLJIT_C_EQUAL, TMP2, 0, SLJIT_IMM, 0, empty_match_found_label);
-OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, str));
-CMPTO(SLJIT_C_NOT_EQUAL, TMP2, 0, STR_PTR, 0, empty_match_found_label);
-JUMPTO(SLJIT_JUMP, empty_match_backtrack_label);
+if (common->might_be_empty)
+ {
+ JUMPHERE(empty_match);
+ OP1(SLJIT_MOV, TMP1, 0, ARGUMENTS, 0);
+ OP1(SLJIT_MOV_U8, TMP2, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, notempty));
+ CMPTO(SLJIT_NOT_EQUAL, TMP2, 0, SLJIT_IMM, 0, empty_match_backtrack_label);
+ OP1(SLJIT_MOV_U8, TMP2, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, notempty_atstart));
+ CMPTO(SLJIT_EQUAL, TMP2, 0, SLJIT_IMM, 0, empty_match_found_label);
+ OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, str));
+ CMPTO(SLJIT_NOT_EQUAL, TMP2, 0, STR_PTR, 0, empty_match_found_label);
+ JUMPTO(SLJIT_JUMP, empty_match_backtrack_label);
+ }
+common->fast_forward_bc_ptr = NULL;
+common->fast_fail_start_ptr = 0;
+common->fast_fail_end_ptr = 0;
common->currententry = common->entries;
common->local_exit = TRUE;
quit_label = common->quit_label;
@@ -9282,10 +11235,9 @@ while (common->currententry != NULL)
if (SLJIT_UNLIKELY(sljit_get_compiler_error(compiler)))
{
sljit_free_compiler(compiler);
- SLJIT_FREE(common->optimized_cbracket);
- SLJIT_FREE(common->private_data_ptrs);
- if (common->has_then)
- SLJIT_FREE(common->then_offsets);
+ SLJIT_FREE(common->optimized_cbracket, compiler->allocator_data);
+ SLJIT_FREE(common->private_data_ptrs, compiler->allocator_data);
+ free_read_only_data(common->read_only_data_head, compiler->allocator_data);
return;
}
flush_stubs(common);
@@ -9298,21 +11250,21 @@ common->quit_label = quit_label;
/* This is a (really) rare case. */
set_jumps(common->stackalloc, LABEL());
/* RETURN_ADDR is not a saved register. */
-sljit_emit_fast_enter(compiler, SLJIT_MEM1(SLJIT_LOCALS_REG), LOCALS0);
-OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_LOCALS_REG), LOCALS1, TMP2, 0);
+sljit_emit_fast_enter(compiler, SLJIT_MEM1(SLJIT_SP), LOCALS0);
+OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), LOCALS1, TMP2, 0);
OP1(SLJIT_MOV, TMP1, 0, ARGUMENTS, 0);
OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, stack));
OP1(SLJIT_MOV, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(struct sljit_stack, top), STACK_TOP, 0);
-OP2(SLJIT_ADD, TMP2, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(struct sljit_stack, limit), SLJIT_IMM, STACK_GROWTH_RATE);
+OP2(SLJIT_SUB, TMP2, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(struct sljit_stack, limit), SLJIT_IMM, STACK_GROWTH_RATE);
sljit_emit_ijump(compiler, SLJIT_CALL2, SLJIT_IMM, SLJIT_FUNC_OFFSET(sljit_stack_resize));
-jump = CMP(SLJIT_C_NOT_EQUAL, SLJIT_RETURN_REG, 0, SLJIT_IMM, 0);
+jump = CMP(SLJIT_NOT_EQUAL, SLJIT_RETURN_REG, 0, SLJIT_IMM, 0);
OP1(SLJIT_MOV, TMP1, 0, ARGUMENTS, 0);
OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, stack));
OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(struct sljit_stack, top));
OP1(SLJIT_MOV, STACK_LIMIT, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(struct sljit_stack, limit));
-OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_LOCALS_REG), LOCALS1);
-sljit_emit_fast_return(compiler, SLJIT_MEM1(SLJIT_LOCALS_REG), LOCALS0);
+OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), LOCALS1);
+sljit_emit_fast_return(compiler, SLJIT_MEM1(SLJIT_SP), LOCALS0);
/* Allocation failed. */
JUMPHERE(jump);
@@ -9364,19 +11316,22 @@ if (common->reset_match != NULL)
{
set_jumps(common->reset_match, LABEL());
do_reset_match(common, (re->top_bracket + 1) * 2);
- CMPTO(SLJIT_C_GREATER, STR_PTR, 0, TMP1, 0, continue_match_label);
+ CMPTO(SLJIT_GREATER, STR_PTR, 0, TMP1, 0, continue_match_label);
OP1(SLJIT_MOV, STR_PTR, 0, TMP1, 0);
JUMPTO(SLJIT_JUMP, reset_match_label);
}
#ifdef SUPPORT_UTF
-#ifndef COMPILE_PCRE32
+#ifdef COMPILE_PCRE8
if (common->utfreadchar != NULL)
{
set_jumps(common->utfreadchar, LABEL());
do_utfreadchar(common);
}
-#endif /* !COMPILE_PCRE32 */
-#ifdef COMPILE_PCRE8
+if (common->utfreadchar16 != NULL)
+ {
+ set_jumps(common->utfreadchar16, LABEL());
+ do_utfreadchar16(common);
+ }
if (common->utfreadtype8 != NULL)
{
set_jumps(common->utfreadtype8, LABEL());
@@ -9392,16 +11347,23 @@ if (common->getucd != NULL)
}
#endif
-SLJIT_FREE(common->optimized_cbracket);
-SLJIT_FREE(common->private_data_ptrs);
-if (common->has_then)
- SLJIT_FREE(common->then_offsets);
+SLJIT_FREE(common->optimized_cbracket, compiler->allocator_data);
+SLJIT_FREE(common->private_data_ptrs, compiler->allocator_data);
executable_func = sljit_generate_code(compiler);
executable_size = sljit_get_generated_code_size(compiler);
+label_addr = common->label_addrs;
+while (label_addr != NULL)
+ {
+ *label_addr->update_addr = sljit_get_label_addr(label_addr->label);
+ label_addr = label_addr->next;
+ }
sljit_free_compiler(compiler);
if (executable_func == NULL)
+ {
+ free_read_only_data(common->read_only_data_head, compiler->allocator_data);
return;
+ }
/* Reuse the function descriptor if possible. */
if ((extra->flags & PCRE_EXTRA_EXECUTABLE_JIT) != 0 && extra->executable_jit != NULL)
@@ -9417,12 +11379,13 @@ else
* bit remains set, as the bit indicates that the pointer to the data
* is valid.)
*/
- functions = SLJIT_MALLOC(sizeof(executable_functions));
+ functions = SLJIT_MALLOC(sizeof(executable_functions), compiler->allocator_data);
if (functions == NULL)
{
/* This case is highly unlikely since we just recently
- freed a lot of memory. Although not impossible. */
+ freed a lot of memory. Not impossible though. */
sljit_free_code(executable_func);
+ free_read_only_data(common->read_only_data_head, compiler->allocator_data);
return;
}
memset(functions, 0, sizeof(executable_functions));
@@ -9433,22 +11396,23 @@ else
}
functions->executable_funcs[mode] = executable_func;
+functions->read_only_data_heads[mode] = common->read_only_data_head;
functions->executable_sizes[mode] = executable_size;
}
-static int jit_machine_stack_exec(jit_arguments *arguments, void* executable_func)
+static SLJIT_NOINLINE int jit_machine_stack_exec(jit_arguments *arguments, void *executable_func)
{
union {
- void* executable_func;
+ void *executable_func;
jit_function call_executable_func;
} convert_executable_func;
-pcre_uint8 local_space[MACHINE_STACK_SIZE];
+sljit_u8 local_space[MACHINE_STACK_SIZE];
struct sljit_stack local_stack;
-local_stack.top = (sljit_sw)&local_space;
-local_stack.base = local_stack.top;
-local_stack.limit = local_stack.base + MACHINE_STACK_SIZE;
-local_stack.max_limit = local_stack.limit;
+local_stack.max_limit = local_space;
+local_stack.limit = local_space;
+local_stack.base = local_space + MACHINE_STACK_SIZE;
+local_stack.top = local_space + MACHINE_STACK_SIZE;
arguments->stack = &local_stack;
convert_executable_func.executable_func = executable_func;
return convert_executable_func.call_executable_func(arguments);
@@ -9460,7 +11424,7 @@ PRIV(jit_exec)(const PUBL(extra) *extra_data, const pcre_uchar *subject,
{
executable_functions *functions = (executable_functions *)extra_data->executable_jit;
union {
- void* executable_func;
+ void *executable_func;
jit_function call_executable_func;
} convert_executable_func;
jit_arguments arguments;
@@ -9482,7 +11446,7 @@ arguments.begin = subject;
arguments.end = subject + length;
arguments.mark_ptr = NULL;
/* JIT decreases this value less frequently than the interpreter. */
-arguments.limit_match = ((extra_data->flags & PCRE_EXTRA_MATCH_LIMIT) == 0) ? MATCH_LIMIT : (pcre_uint32)(extra_data->match_limit);
+arguments.limit_match = ((extra_data->flags & PCRE_EXTRA_MATCH_LIMIT) == 0) ? MATCH_LIMIT : (sljit_u32)(extra_data->match_limit);
if (functions->limit_match != 0 && functions->limit_match < arguments.limit_match)
arguments.limit_match = functions->limit_match;
arguments.notbol = (options & PCRE_NOTBOL) != 0;
@@ -9554,7 +11518,7 @@ pcre32_jit_exec(const pcre32 *argument_re, const pcre32_extra *extra_data,
pcre_uchar *subject_ptr = (pcre_uchar *)subject;
executable_functions *functions = (executable_functions *)extra_data->executable_jit;
union {
- void* executable_func;
+ void *executable_func;
jit_function call_executable_func;
} convert_executable_func;
jit_arguments arguments;
@@ -9582,7 +11546,7 @@ arguments.begin = subject_ptr;
arguments.end = subject_ptr + length;
arguments.mark_ptr = NULL;
/* JIT decreases this value less frequently than the interpreter. */
-arguments.limit_match = ((extra_data->flags & PCRE_EXTRA_MATCH_LIMIT) == 0) ? MATCH_LIMIT : (pcre_uint32)(extra_data->match_limit);
+arguments.limit_match = ((extra_data->flags & PCRE_EXTRA_MATCH_LIMIT) == 0) ? MATCH_LIMIT : (sljit_u32)(extra_data->match_limit);
if (functions->limit_match != 0 && functions->limit_match < arguments.limit_match)
arguments.limit_match = functions->limit_match;
arguments.notbol = (options & PCRE_NOTBOL) != 0;
@@ -9626,8 +11590,9 @@ for (i = 0; i < JIT_NUMBER_OF_COMPILE_MODES; i++)
{
if (functions->executable_funcs[i] != NULL)
sljit_free_code(functions->executable_funcs[i]);
+ free_read_only_data(functions->read_only_data_heads[i], NULL);
}
-SLJIT_FREE(functions);
+SLJIT_FREE(functions, compiler->allocator_data);
}
int
@@ -9669,7 +11634,7 @@ if (startsize > maxsize)
startsize = maxsize;
startsize = (startsize + STACK_GROWTH_RATE - 1) & ~(STACK_GROWTH_RATE - 1);
maxsize = (maxsize + STACK_GROWTH_RATE - 1) & ~(STACK_GROWTH_RATE - 1);
-return (PUBL(jit_stack)*)sljit_allocate_stack(startsize, maxsize);
+return (PUBL(jit_stack)*)sljit_allocate_stack(startsize, maxsize, NULL);
}
#if defined COMPILE_PCRE8
@@ -9688,7 +11653,7 @@ PCRE_EXP_DECL void
pcre32_jit_stack_free(pcre32_jit_stack *stack)
#endif
{
-sljit_free_stack((struct sljit_stack *)stack);
+sljit_free_stack((struct sljit_stack *)stack, NULL);
}
#if defined COMPILE_PCRE8
@@ -9718,6 +11683,20 @@ if (extra != NULL &&
}
}
+#if defined COMPILE_PCRE8
+PCRE_EXP_DECL void
+pcre_jit_free_unused_memory(void)
+#elif defined COMPILE_PCRE16
+PCRE_EXP_DECL void
+pcre16_jit_free_unused_memory(void)
+#elif defined COMPILE_PCRE32
+PCRE_EXP_DECL void
+pcre32_jit_free_unused_memory(void)
+#endif
+{
+sljit_free_unused_memory_exec();
+}
+
#else /* SUPPORT_JIT */
/* These are dummy functions to avoid linking errors when JIT support is not
@@ -9784,6 +11763,19 @@ pcre32_assign_jit_stack(pcre32_extra *extra, pcre32_jit_callback callback, void
(void)userdata;
}
+#if defined COMPILE_PCRE8
+PCRE_EXP_DECL void
+pcre_jit_free_unused_memory(void)
+#elif defined COMPILE_PCRE16
+PCRE_EXP_DECL void
+pcre16_jit_free_unused_memory(void)
+#elif defined COMPILE_PCRE32
+PCRE_EXP_DECL void
+pcre32_jit_free_unused_memory(void)
+#endif
+{
+}
+
#endif
/* End of pcre_jit_compile.c */
diff --git a/erts/emulator/pcre/pcre_latin_1_table.c b/erts/emulator/pcre/pcre_latin_1_table.c
index 599540723b..aa29275a94 100644
--- a/erts/emulator/pcre/pcre_latin_1_table.c
+++ b/erts/emulator/pcre/pcre_latin_1_table.c
@@ -158,7 +158,7 @@ print, punct, and cntrl. Other classes are built from combinations. */
*/
0x80,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 0- 7 */
- 0x00,0x01,0x01,0x00,0x01,0x01,0x00,0x00, /* 8- 15 */
+ 0x00,0x01,0x01,0x01,0x01,0x01,0x00,0x00, /* 8- 15 */
0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 16- 23 */
0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 24- 31 */
0x01,0x00,0x00,0x00,0x80,0x00,0x00,0x00, /* - ' */
diff --git a/erts/emulator/pcre/pcre_maketables.c b/erts/emulator/pcre/pcre_maketables.c
index 9310d886fa..89204d1152 100644
--- a/erts/emulator/pcre/pcre_maketables.c
+++ b/erts/emulator/pcre/pcre_maketables.c
@@ -104,13 +104,17 @@ for (i = 0; i < 256; i++) *p++ = tolower(i);
for (i = 0; i < 256; i++) *p++ = islower(i)? toupper(i) : tolower(i);
/* Then the character class tables. Don't try to be clever and save effort on
-exclusive ones - in some locales things may be different. Note that the table
-for "space" includes everything "isspace" gives, including VT in the default
-locale. This makes it work for the POSIX class [:space:]. Note also that it is
-possible for a character to be alnum or alpha without being lower or upper,
-such as "male and female ordinals" (\xAA and \xBA) in the fr_FR locale (at
-least under Debian Linux's locales as of 12/2005). So we must test for alnum
-specially. */
+exclusive ones - in some locales things may be different.
+
+Note that the table for "space" includes everything "isspace" gives, including
+VT in the default locale. This makes it work for the POSIX class [:space:].
+From release 8.34 is is also correct for Perl space, because Perl added VT at
+release 5.18.
+
+Note also that it is possible for a character to be alnum or alpha without
+being lower or upper, such as "male and female ordinals" (\xAA and \xBA) in the
+fr_FR locale (at least under Debian Linux's locales as of 12/2005). So we must
+test for alnum specially. */
memset(p, 0, cbit_length);
for (i = 0; i < 256; i++)
@@ -129,14 +133,15 @@ for (i = 0; i < 256; i++)
}
p += cbit_length;
-/* Finally, the character type table. In this, we exclude VT from the white
-space chars, because Perl doesn't recognize it as such for \s and for comments
-within regexes. */
+/* Finally, the character type table. In this, we used to exclude VT from the
+white space chars, because Perl didn't recognize it as such for \s and for
+comments within regexes. However, Perl changed at release 5.18, so PCRE changed
+at release 8.34. */
for (i = 0; i < 256; i++)
{
int x = 0;
- if (i != CHAR_VT && isspace(i)) x += ctype_space;
+ if (isspace(i)) x += ctype_space;
if (isalpha(i)) x += ctype_letter;
if (isdigit(i)) x += ctype_digit;
if (isxdigit(i)) x += ctype_xdigit;
diff --git a/erts/emulator/pcre/pcre_string_utils.c b/erts/emulator/pcre/pcre_string_utils.c
index 274070469f..abce400dc5 100644
--- a/erts/emulator/pcre/pcre_string_utils.c
+++ b/erts/emulator/pcre/pcre_string_utils.c
@@ -6,7 +6,7 @@
and semantics are as close as possible to those of the Perl 5 language.
Written by Philip Hazel
- Copyright (c) 1997-2013 University of Cambridge
+ Copyright (c) 1997-2014 University of Cambridge
-----------------------------------------------------------------------------
Redistribution and use in source and binary forms, with or without
@@ -91,8 +91,8 @@ pcre_uchar c2;
while (*str1 != '\0' || *str2 != '\0')
{
- c1 = RAWUCHARINC(str1);
- c2 = RAWUCHARINC(str2);
+ c1 = UCHAR21INC(str1);
+ c2 = UCHAR21INC(str2);
if (c1 != c2)
return ((c1 > c2) << 1) - 1;
}
@@ -131,7 +131,7 @@ pcre_uchar c2;
while (*str1 != '\0' || *ustr2 != '\0')
{
- c1 = RAWUCHARINC(str1);
+ c1 = UCHAR21INC(str1);
c2 = (pcre_uchar)*ustr2++;
if (c1 != c2)
return ((c1 > c2) << 1) - 1;
diff --git a/erts/emulator/pcre/pcre_study.c b/erts/emulator/pcre/pcre_study.c
index 3d8961ffb0..91afa2e140 100644
--- a/erts/emulator/pcre/pcre_study.c
+++ b/erts/emulator/pcre/pcre_study.c
@@ -67,10 +67,12 @@ string of that length that matches. In UTF8 mode, the result is in characters
rather than bytes.
Arguments:
+ re compiled pattern block
code pointer to start of group (the bracket)
- startcode pointer to start of the whole pattern
+ startcode pointer to start of the whole pattern's code
options the compiling options
- int RECURSE depth
+ recurses chain of recurse_check to catch mutual recursion
+ countptr pointer to call count (to catch over complexity)
Returns: the minimum length
-1 if \C in UTF-8 mode or (*ACCEPT) was encountered
@@ -79,16 +81,20 @@ Returns: the minimum length
*/
static int
-find_minlength(const pcre_uchar *code, const pcre_uchar *startcode, int options,
- int recurse_depth)
+find_minlength(const REAL_PCRE *re, const pcre_uchar *code,
+ const pcre_uchar *startcode, int options, recurse_check *recurses,
+ int *countptr)
{
int length = -1;
/* PCRE_UTF16 has the same value as PCRE_UTF8. */
BOOL utf = (options & PCRE_UTF8) != 0;
BOOL had_recurse = FALSE;
+recurse_check this_recurse;
register int branchlength = 0;
register pcre_uchar *cc = (pcre_uchar *)code + 1 + LINK_SIZE;
+if ((*countptr)++ > 1000) return -1; /* too complex */
+
if (*code == OP_CBRA || *code == OP_SCBRA ||
*code == OP_CBRAPOS || *code == OP_SCBRAPOS) cc += IMM2_SIZE;
@@ -130,7 +136,7 @@ for (;;)
case OP_SBRAPOS:
case OP_ONCE:
case OP_ONCE_NC:
- d = find_minlength(cc, startcode, options, recurse_depth);
+ d = find_minlength(re, cc, startcode, options, recurses, countptr);
if (d < 0) return d;
branchlength += d;
do cc += GET(cc, 1); while (*cc == OP_ALT);
@@ -176,9 +182,9 @@ for (;;)
case OP_REVERSE:
case OP_CREF:
- case OP_NCREF:
+ case OP_DNCREF:
case OP_RREF:
- case OP_NRREF:
+ case OP_DNRREF:
case OP_DEF:
case OP_CALLOUT:
case OP_SOD:
@@ -342,6 +348,7 @@ for (;;)
{
case OP_CRPLUS:
case OP_CRMINPLUS:
+ case OP_CRPOSPLUS:
branchlength++;
/* Fall through */
@@ -349,11 +356,14 @@ for (;;)
case OP_CRMINSTAR:
case OP_CRQUERY:
case OP_CRMINQUERY:
+ case OP_CRPOSSTAR:
+ case OP_CRPOSQUERY:
cc++;
break;
case OP_CRRANGE:
case OP_CRMINRANGE:
+ case OP_CRPOSRANGE:
branchlength += GET2(cc,1);
cc += 1 + 2 * IMM2_SIZE;
break;
@@ -376,21 +386,80 @@ for (;;)
matches an empty string (by default it causes a matching failure), so in
that case we must set the minimum length to zero. */
- case OP_REF:
+ case OP_DNREF: /* Duplicate named pattern back reference */
+ case OP_DNREFI:
+ if ((options & PCRE_JAVASCRIPT_COMPAT) == 0)
+ {
+ int count = GET2(cc, 1+IMM2_SIZE);
+ pcre_uchar *slot = (pcre_uchar *)re +
+ re->name_table_offset + GET2(cc, 1) * re->name_entry_size;
+ d = INT_MAX;
+ while (count-- > 0)
+ {
+ ce = cs = (pcre_uchar *)PRIV(find_bracket)(startcode, utf, GET2(slot, 0));
+ if (cs == NULL) return -2;
+ do ce += GET(ce, 1); while (*ce == OP_ALT);
+ if (cc > cs && cc < ce) /* Simple recursion */
+ {
+ d = 0;
+ had_recurse = TRUE;
+ break;
+ }
+ else
+ {
+ recurse_check *r = recurses;
+ for (r = recurses; r != NULL; r = r->prev) if (r->group == cs) break;
+ if (r != NULL) /* Mutual recursion */
+ {
+ d = 0;
+ had_recurse = TRUE;
+ break;
+ }
+ else
+ {
+ int dd;
+ this_recurse.prev = recurses;
+ this_recurse.group = cs;
+ dd = find_minlength(re, cs, startcode, options, &this_recurse,
+ countptr);
+ if (dd < d) d = dd;
+ }
+ }
+ slot += re->name_entry_size;
+ }
+ }
+ else d = 0;
+ cc += 1 + 2*IMM2_SIZE;
+ goto REPEAT_BACK_REFERENCE;
+
+ case OP_REF: /* Single back reference */
case OP_REFI:
if ((options & PCRE_JAVASCRIPT_COMPAT) == 0)
{
ce = cs = (pcre_uchar *)PRIV(find_bracket)(startcode, utf, GET2(cc, 1));
if (cs == NULL) return -2;
do ce += GET(ce, 1); while (*ce == OP_ALT);
- if (cc > cs && cc < ce)
+ if (cc > cs && cc < ce) /* Simple recursion */
{
d = 0;
had_recurse = TRUE;
}
else
{
- d = find_minlength(cs, startcode, options, recurse_depth);
+ recurse_check *r = recurses;
+ for (r = recurses; r != NULL; r = r->prev) if (r->group == cs) break;
+ if (r != NULL) /* Mutual recursion */
+ {
+ d = 0;
+ had_recurse = TRUE;
+ }
+ else
+ {
+ this_recurse.prev = recurses;
+ this_recurse.group = cs;
+ d = find_minlength(re, cs, startcode, options, &this_recurse,
+ countptr);
+ }
}
}
else d = 0;
@@ -398,24 +467,29 @@ for (;;)
/* Handle repeated back references */
+ REPEAT_BACK_REFERENCE:
switch (*cc)
{
case OP_CRSTAR:
case OP_CRMINSTAR:
case OP_CRQUERY:
case OP_CRMINQUERY:
+ case OP_CRPOSSTAR:
+ case OP_CRPOSQUERY:
min = 0;
cc++;
break;
case OP_CRPLUS:
case OP_CRMINPLUS:
+ case OP_CRPOSPLUS:
min = 1;
cc++;
break;
case OP_CRRANGE:
case OP_CRMINRANGE:
+ case OP_CRPOSRANGE:
min = GET2(cc, 1);
cc += 1 + 2 * IMM2_SIZE;
break;
@@ -434,11 +508,21 @@ for (;;)
case OP_RECURSE:
cs = ce = (pcre_uchar *)startcode + GET(cc, 1);
do ce += GET(ce, 1); while (*ce == OP_ALT);
- if ((cc > cs && cc < ce) || recurse_depth > 10)
+ if (cc > cs && cc < ce) /* Simple recursion */
had_recurse = TRUE;
else
{
- branchlength += find_minlength(cs, startcode, options, recurse_depth + 1);
+ recurse_check *r = recurses;
+ for (r = recurses; r != NULL; r = r->prev) if (r->group == cs) break;
+ if (r != NULL) /* Mutual recursion */
+ had_recurse = TRUE;
+ else
+ {
+ this_recurse.prev = recurses;
+ this_recurse.group = cs;
+ branchlength += find_minlength(re, cs, startcode, options,
+ &this_recurse, countptr);
+ }
}
cc += 1 + LINK_SIZE;
break;
@@ -779,6 +863,10 @@ do
case OP_COND:
case OP_CREF:
case OP_DEF:
+ case OP_DNCREF:
+ case OP_DNREF:
+ case OP_DNREFI:
+ case OP_DNRREF:
case OP_DOLL:
case OP_DOLLM:
case OP_END:
@@ -787,7 +875,6 @@ do
case OP_EXTUNI:
case OP_FAIL:
case OP_MARK:
- case OP_NCREF:
case OP_NOT:
case OP_NOTEXACT:
case OP_NOTEXACTI:
@@ -819,8 +906,6 @@ do
case OP_NOTUPTOI:
case OP_NOT_HSPACE:
case OP_NOT_VSPACE:
- case OP_NRREF:
- case OP_PROP:
case OP_PRUNE:
case OP_PRUNE_ARG:
case OP_RECURSE:
@@ -836,11 +921,33 @@ do
case OP_SOM:
case OP_THEN:
case OP_THEN_ARG:
-#if defined SUPPORT_UTF || !defined COMPILE_PCRE8
- case OP_XCLASS:
-#endif
return SSB_FAIL;
+ /* A "real" property test implies no starting bits, but the fake property
+ PT_CLIST identifies a list of characters. These lists are short, as they
+ are used for characters with more than one "other case", so there is no
+ point in recognizing them for OP_NOTPROP. */
+
+ case OP_PROP:
+ if (tcode[1] != PT_CLIST) return SSB_FAIL;
+ {
+ const pcre_uint32 *p = PRIV(ucd_caseless_sets) + tcode[2];
+ while ((c = *p++) < NOTACHAR)
+ {
+#if defined SUPPORT_UTF && defined COMPILE_PCRE8
+ if (utf)
+ {
+ pcre_uchar buff[6];
+ (void)PRIV(ord2utf)(c, buff);
+ c = buff[0];
+ }
+#endif
+ if (c > 0xff) SET_BIT(0xff); else SET_BIT(c);
+ }
+ }
+ try_next = FALSE;
+ break;
+
/* We can ignore word boundary tests. */
case OP_WORD_BOUNDARY:
@@ -1066,24 +1173,17 @@ do
try_next = FALSE;
break;
- /* The cbit_space table has vertical tab as whitespace; we have to
- ensure it is set as not whitespace. Luckily, the code value is the same
- (0x0b) in ASCII and EBCDIC, so we can just adjust the appropriate bit. */
+ /* The cbit_space table has vertical tab as whitespace; we no longer
+ have to play fancy tricks because Perl added VT to its whitespace at
+ release 5.18. PCRE added it at release 8.34. */
case OP_NOT_WHITESPACE:
set_nottype_bits(start_bits, cbit_space, table_limit, cd);
- start_bits[1] |= 0x08;
try_next = FALSE;
break;
- /* The cbit_space table has vertical tab as whitespace; we have to not
- set it from the table. Luckily, the code value is the same (0x0b) in
- ASCII and EBCDIC, so we can just adjust the appropriate bit. */
-
case OP_WHITESPACE:
- c = start_bits[1]; /* Save in case it was already set */
set_type_bits(start_bits, cbit_space, table_limit, cd);
- start_bits[1] = (start_bits[1] & ~0x08) | c;
try_next = FALSE;
break;
@@ -1184,24 +1284,16 @@ do
set_type_bits(start_bits, cbit_digit, table_limit, cd);
break;
- /* The cbit_space table has vertical tab as whitespace; we have to
- ensure it gets set as not whitespace. Luckily, the code value is the
- same (0x0b) in ASCII and EBCDIC, so we can just adjust the appropriate
- bit. */
+ /* The cbit_space table has vertical tab as whitespace; we no longer
+ have to play fancy tricks because Perl added VT to its whitespace at
+ release 5.18. PCRE added it at release 8.34. */
case OP_NOT_WHITESPACE:
set_nottype_bits(start_bits, cbit_space, table_limit, cd);
- start_bits[1] |= 0x08;
break;
- /* The cbit_space table has vertical tab as whitespace; we have to
- avoid setting it. Luckily, the code value is the same (0x0b) in ASCII
- and EBCDIC, so we can just adjust the appropriate bit. */
-
case OP_WHITESPACE:
- c = start_bits[1]; /* Save in case it was already set */
set_type_bits(start_bits, cbit_space, table_limit, cd);
- start_bits[1] = (start_bits[1] & ~0x08) | c;
break;
case OP_NOT_WORDCHAR:
@@ -1222,6 +1314,16 @@ do
with a value >= 0xc4 is a potentially valid starter because it starts a
character with a value > 255. */
+#if defined SUPPORT_UTF || !defined COMPILE_PCRE8
+ case OP_XCLASS:
+ if ((tcode[1 + LINK_SIZE] & XCL_HASPROP) != 0)
+ return SSB_FAIL;
+ /* All bits are set. */
+ if ((tcode[1 + LINK_SIZE] & XCL_MAP) == 0 && (tcode[1 + LINK_SIZE] & XCL_NOT) != 0)
+ return SSB_FAIL;
+#endif
+ /* Fall through */
+
case OP_NCLASS:
#if defined SUPPORT_UTF && defined COMPILE_PCRE8
if (utf)
@@ -1238,8 +1340,21 @@ do
case OP_CLASS:
{
pcre_uint8 *map;
- tcode++;
- map = (pcre_uint8 *)tcode;
+#if defined SUPPORT_UTF || !defined COMPILE_PCRE8
+ map = NULL;
+ if (*tcode == OP_XCLASS)
+ {
+ if ((tcode[1 + LINK_SIZE] & XCL_MAP) != 0)
+ map = (pcre_uint8 *)(tcode + 1 + LINK_SIZE + 1);
+ tcode += GET(tcode, 1);
+ }
+ else
+#endif
+ {
+ tcode++;
+ map = (pcre_uint8 *)tcode;
+ tcode += 32 / sizeof(pcre_uchar);
+ }
/* In UTF-8 mode, the bits in a bit map correspond to character
values, not to byte values. However, the bit map we are constructing is
@@ -1247,42 +1362,49 @@ do
value is > 127. In fact, there are only two possible starting bytes for
characters in the range 128 - 255. */
-#if defined SUPPORT_UTF && defined COMPILE_PCRE8
- if (utf)
+#if defined SUPPORT_UTF || !defined COMPILE_PCRE8
+ if (map != NULL)
+#endif
{
- for (c = 0; c < 16; c++) start_bits[c] |= map[c];
- for (c = 128; c < 256; c++)
+#if defined SUPPORT_UTF && defined COMPILE_PCRE8
+ if (utf)
{
- if ((map[c/8] && (1 << (c&7))) != 0)
+ for (c = 0; c < 16; c++) start_bits[c] |= map[c];
+ for (c = 128; c < 256; c++)
{
- int d = (c >> 6) | 0xc0; /* Set bit for this starter */
- start_bits[d/8] |= (1 << (d&7)); /* and then skip on to the */
- c = (c & 0xc0) + 0x40 - 1; /* next relevant character. */
+ if ((map[c/8] & (1 << (c&7))) != 0)
+ {
+ int d = (c >> 6) | 0xc0; /* Set bit for this starter */
+ start_bits[d/8] |= (1 << (d&7)); /* and then skip on to the */
+ c = (c & 0xc0) + 0x40 - 1; /* next relevant character. */
+ }
}
}
- }
- else
+ else
#endif
- {
- /* In non-UTF-8 mode, the two bit maps are completely compatible. */
- for (c = 0; c < 32; c++) start_bits[c] |= map[c];
+ {
+ /* In non-UTF-8 mode, the two bit maps are completely compatible. */
+ for (c = 0; c < 32; c++) start_bits[c] |= map[c];
+ }
}
/* Advance past the bit map, and act on what follows. For a zero
minimum repeat, continue; otherwise stop processing. */
- tcode += 32 / sizeof(pcre_uchar);
switch (*tcode)
{
case OP_CRSTAR:
case OP_CRMINSTAR:
case OP_CRQUERY:
case OP_CRMINQUERY:
+ case OP_CRPOSSTAR:
+ case OP_CRPOSQUERY:
tcode++;
break;
case OP_CRRANGE:
case OP_CRMINRANGE:
+ case OP_CRPOSRANGE:
if (GET2(tcode, 1) == 0) tcode += 1 + 2 * IMM2_SIZE;
else try_next = FALSE;
break;
@@ -1343,6 +1465,7 @@ pcre32_study(const pcre32 *external_re, int options, const char **errorptr)
#endif
{
int min;
+int count = 0;
BOOL bits_set = FALSE;
pcre_uint8 start_bits[32];
PUBL(extra) *extra = NULL;
@@ -1352,6 +1475,7 @@ pcre_uchar *code;
compile_data compile_block;
const REAL_PCRE *re = (const REAL_PCRE *)external_re;
+
*errorptr = NULL;
if (re == NULL || re->magic_number != MAGIC_NUMBER)
@@ -1434,7 +1558,7 @@ if ((re->options & PCRE_ANCHORED) == 0 &&
/* Find the minimum length of subject string. */
-switch(min = find_minlength(code, code, re->options, 0))
+switch(min = find_minlength(re, code, code, re->options, NULL, &count))
{
case -2: *errorptr = "internal error: missing capturing bracket"; return NULL;
case -3: *errorptr = "internal error: opcode not recognized"; return NULL;
diff --git a/erts/emulator/pcre/pcre_tables.c b/erts/emulator/pcre/pcre_tables.c
index 7be23babe0..08e31f1460 100644
--- a/erts/emulator/pcre/pcre_tables.c
+++ b/erts/emulator/pcre/pcre_tables.c
@@ -6,7 +6,7 @@
and semantics are as close as possible to those of the Perl 5 language.
Written by Philip Hazel
- Copyright (c) 1997-2012 University of Cambridge
+ Copyright (c) 1997-2017 University of Cambridge
-----------------------------------------------------------------------------
Redistribution and use in source and binary forms, with or without
@@ -162,7 +162,7 @@ const pcre_uint32 PRIV(ucp_gbtable[]) = {
(1<<ucp_gbExtend)|(1<<ucp_gbSpacingMark), /* 5 SpacingMark */
(1<<ucp_gbExtend)|(1<<ucp_gbSpacingMark)|(1<<ucp_gbL)| /* 6 L */
- (1<<ucp_gbL)|(1<<ucp_gbV)|(1<<ucp_gbLV)|(1<<ucp_gbLVT),
+ (1<<ucp_gbV)|(1<<ucp_gbLV)|(1<<ucp_gbLVT),
(1<<ucp_gbExtend)|(1<<ucp_gbSpacingMark)|(1<<ucp_gbV)| /* 7 V */
(1<<ucp_gbT),
@@ -214,6 +214,7 @@ strings to make sure that UTF-8 support works on EBCDIC platforms. */
#define STRING_Avestan0 STR_A STR_v STR_e STR_s STR_t STR_a STR_n "\0"
#define STRING_Balinese0 STR_B STR_a STR_l STR_i STR_n STR_e STR_s STR_e "\0"
#define STRING_Bamum0 STR_B STR_a STR_m STR_u STR_m "\0"
+#define STRING_Bassa_Vah0 STR_B STR_a STR_s STR_s STR_a STR_UNDERSCORE STR_V STR_a STR_h "\0"
#define STRING_Batak0 STR_B STR_a STR_t STR_a STR_k "\0"
#define STRING_Bengali0 STR_B STR_e STR_n STR_g STR_a STR_l STR_i "\0"
#define STRING_Bopomofo0 STR_B STR_o STR_p STR_o STR_m STR_o STR_f STR_o "\0"
@@ -224,6 +225,7 @@ strings to make sure that UTF-8 support works on EBCDIC platforms. */
#define STRING_C0 STR_C "\0"
#define STRING_Canadian_Aboriginal0 STR_C STR_a STR_n STR_a STR_d STR_i STR_a STR_n STR_UNDERSCORE STR_A STR_b STR_o STR_r STR_i STR_g STR_i STR_n STR_a STR_l "\0"
#define STRING_Carian0 STR_C STR_a STR_r STR_i STR_a STR_n "\0"
+#define STRING_Caucasian_Albanian0 STR_C STR_a STR_u STR_c STR_a STR_s STR_i STR_a STR_n STR_UNDERSCORE STR_A STR_l STR_b STR_a STR_n STR_i STR_a STR_n "\0"
#define STRING_Cc0 STR_C STR_c "\0"
#define STRING_Cf0 STR_C STR_f "\0"
#define STRING_Chakma0 STR_C STR_h STR_a STR_k STR_m STR_a "\0"
@@ -239,11 +241,14 @@ strings to make sure that UTF-8 support works on EBCDIC platforms. */
#define STRING_Cyrillic0 STR_C STR_y STR_r STR_i STR_l STR_l STR_i STR_c "\0"
#define STRING_Deseret0 STR_D STR_e STR_s STR_e STR_r STR_e STR_t "\0"
#define STRING_Devanagari0 STR_D STR_e STR_v STR_a STR_n STR_a STR_g STR_a STR_r STR_i "\0"
+#define STRING_Duployan0 STR_D STR_u STR_p STR_l STR_o STR_y STR_a STR_n "\0"
#define STRING_Egyptian_Hieroglyphs0 STR_E STR_g STR_y STR_p STR_t STR_i STR_a STR_n STR_UNDERSCORE STR_H STR_i STR_e STR_r STR_o STR_g STR_l STR_y STR_p STR_h STR_s "\0"
+#define STRING_Elbasan0 STR_E STR_l STR_b STR_a STR_s STR_a STR_n "\0"
#define STRING_Ethiopic0 STR_E STR_t STR_h STR_i STR_o STR_p STR_i STR_c "\0"
#define STRING_Georgian0 STR_G STR_e STR_o STR_r STR_g STR_i STR_a STR_n "\0"
#define STRING_Glagolitic0 STR_G STR_l STR_a STR_g STR_o STR_l STR_i STR_t STR_i STR_c "\0"
#define STRING_Gothic0 STR_G STR_o STR_t STR_h STR_i STR_c "\0"
+#define STRING_Grantha0 STR_G STR_r STR_a STR_n STR_t STR_h STR_a "\0"
#define STRING_Greek0 STR_G STR_r STR_e STR_e STR_k "\0"
#define STRING_Gujarati0 STR_G STR_u STR_j STR_a STR_r STR_a STR_t STR_i "\0"
#define STRING_Gurmukhi0 STR_G STR_u STR_r STR_m STR_u STR_k STR_h STR_i "\0"
@@ -263,12 +268,15 @@ strings to make sure that UTF-8 support works on EBCDIC platforms. */
#define STRING_Kayah_Li0 STR_K STR_a STR_y STR_a STR_h STR_UNDERSCORE STR_L STR_i "\0"
#define STRING_Kharoshthi0 STR_K STR_h STR_a STR_r STR_o STR_s STR_h STR_t STR_h STR_i "\0"
#define STRING_Khmer0 STR_K STR_h STR_m STR_e STR_r "\0"
+#define STRING_Khojki0 STR_K STR_h STR_o STR_j STR_k STR_i "\0"
+#define STRING_Khudawadi0 STR_K STR_h STR_u STR_d STR_a STR_w STR_a STR_d STR_i "\0"
#define STRING_L0 STR_L "\0"
#define STRING_L_AMPERSAND0 STR_L STR_AMPERSAND "\0"
#define STRING_Lao0 STR_L STR_a STR_o "\0"
#define STRING_Latin0 STR_L STR_a STR_t STR_i STR_n "\0"
#define STRING_Lepcha0 STR_L STR_e STR_p STR_c STR_h STR_a "\0"
#define STRING_Limbu0 STR_L STR_i STR_m STR_b STR_u "\0"
+#define STRING_Linear_A0 STR_L STR_i STR_n STR_e STR_a STR_r STR_UNDERSCORE STR_A "\0"
#define STRING_Linear_B0 STR_L STR_i STR_n STR_e STR_a STR_r STR_UNDERSCORE STR_B "\0"
#define STRING_Lisu0 STR_L STR_i STR_s STR_u "\0"
#define STRING_Ll0 STR_L STR_l "\0"
@@ -279,18 +287,24 @@ strings to make sure that UTF-8 support works on EBCDIC platforms. */
#define STRING_Lycian0 STR_L STR_y STR_c STR_i STR_a STR_n "\0"
#define STRING_Lydian0 STR_L STR_y STR_d STR_i STR_a STR_n "\0"
#define STRING_M0 STR_M "\0"
+#define STRING_Mahajani0 STR_M STR_a STR_h STR_a STR_j STR_a STR_n STR_i "\0"
#define STRING_Malayalam0 STR_M STR_a STR_l STR_a STR_y STR_a STR_l STR_a STR_m "\0"
#define STRING_Mandaic0 STR_M STR_a STR_n STR_d STR_a STR_i STR_c "\0"
+#define STRING_Manichaean0 STR_M STR_a STR_n STR_i STR_c STR_h STR_a STR_e STR_a STR_n "\0"
#define STRING_Mc0 STR_M STR_c "\0"
#define STRING_Me0 STR_M STR_e "\0"
#define STRING_Meetei_Mayek0 STR_M STR_e STR_e STR_t STR_e STR_i STR_UNDERSCORE STR_M STR_a STR_y STR_e STR_k "\0"
+#define STRING_Mende_Kikakui0 STR_M STR_e STR_n STR_d STR_e STR_UNDERSCORE STR_K STR_i STR_k STR_a STR_k STR_u STR_i "\0"
#define STRING_Meroitic_Cursive0 STR_M STR_e STR_r STR_o STR_i STR_t STR_i STR_c STR_UNDERSCORE STR_C STR_u STR_r STR_s STR_i STR_v STR_e "\0"
#define STRING_Meroitic_Hieroglyphs0 STR_M STR_e STR_r STR_o STR_i STR_t STR_i STR_c STR_UNDERSCORE STR_H STR_i STR_e STR_r STR_o STR_g STR_l STR_y STR_p STR_h STR_s "\0"
#define STRING_Miao0 STR_M STR_i STR_a STR_o "\0"
#define STRING_Mn0 STR_M STR_n "\0"
+#define STRING_Modi0 STR_M STR_o STR_d STR_i "\0"
#define STRING_Mongolian0 STR_M STR_o STR_n STR_g STR_o STR_l STR_i STR_a STR_n "\0"
+#define STRING_Mro0 STR_M STR_r STR_o "\0"
#define STRING_Myanmar0 STR_M STR_y STR_a STR_n STR_m STR_a STR_r "\0"
#define STRING_N0 STR_N "\0"
+#define STRING_Nabataean0 STR_N STR_a STR_b STR_a STR_t STR_a STR_e STR_a STR_n "\0"
#define STRING_Nd0 STR_N STR_d "\0"
#define STRING_New_Tai_Lue0 STR_N STR_e STR_w STR_UNDERSCORE STR_T STR_a STR_i STR_UNDERSCORE STR_L STR_u STR_e "\0"
#define STRING_Nko0 STR_N STR_k STR_o "\0"
@@ -299,12 +313,17 @@ strings to make sure that UTF-8 support works on EBCDIC platforms. */
#define STRING_Ogham0 STR_O STR_g STR_h STR_a STR_m "\0"
#define STRING_Ol_Chiki0 STR_O STR_l STR_UNDERSCORE STR_C STR_h STR_i STR_k STR_i "\0"
#define STRING_Old_Italic0 STR_O STR_l STR_d STR_UNDERSCORE STR_I STR_t STR_a STR_l STR_i STR_c "\0"
+#define STRING_Old_North_Arabian0 STR_O STR_l STR_d STR_UNDERSCORE STR_N STR_o STR_r STR_t STR_h STR_UNDERSCORE STR_A STR_r STR_a STR_b STR_i STR_a STR_n "\0"
+#define STRING_Old_Permic0 STR_O STR_l STR_d STR_UNDERSCORE STR_P STR_e STR_r STR_m STR_i STR_c "\0"
#define STRING_Old_Persian0 STR_O STR_l STR_d STR_UNDERSCORE STR_P STR_e STR_r STR_s STR_i STR_a STR_n "\0"
#define STRING_Old_South_Arabian0 STR_O STR_l STR_d STR_UNDERSCORE STR_S STR_o STR_u STR_t STR_h STR_UNDERSCORE STR_A STR_r STR_a STR_b STR_i STR_a STR_n "\0"
#define STRING_Old_Turkic0 STR_O STR_l STR_d STR_UNDERSCORE STR_T STR_u STR_r STR_k STR_i STR_c "\0"
#define STRING_Oriya0 STR_O STR_r STR_i STR_y STR_a "\0"
#define STRING_Osmanya0 STR_O STR_s STR_m STR_a STR_n STR_y STR_a "\0"
#define STRING_P0 STR_P "\0"
+#define STRING_Pahawh_Hmong0 STR_P STR_a STR_h STR_a STR_w STR_h STR_UNDERSCORE STR_H STR_m STR_o STR_n STR_g "\0"
+#define STRING_Palmyrene0 STR_P STR_a STR_l STR_m STR_y STR_r STR_e STR_n STR_e "\0"
+#define STRING_Pau_Cin_Hau0 STR_P STR_a STR_u STR_UNDERSCORE STR_C STR_i STR_n STR_UNDERSCORE STR_H STR_a STR_u "\0"
#define STRING_Pc0 STR_P STR_c "\0"
#define STRING_Pd0 STR_P STR_d "\0"
#define STRING_Pe0 STR_P STR_e "\0"
@@ -314,6 +333,7 @@ strings to make sure that UTF-8 support works on EBCDIC platforms. */
#define STRING_Pi0 STR_P STR_i "\0"
#define STRING_Po0 STR_P STR_o "\0"
#define STRING_Ps0 STR_P STR_s "\0"
+#define STRING_Psalter_Pahlavi0 STR_P STR_s STR_a STR_l STR_t STR_e STR_r STR_UNDERSCORE STR_P STR_a STR_h STR_l STR_a STR_v STR_i "\0"
#define STRING_Rejang0 STR_R STR_e STR_j STR_a STR_n STR_g "\0"
#define STRING_Runic0 STR_R STR_u STR_n STR_i STR_c "\0"
#define STRING_S0 STR_S "\0"
@@ -322,6 +342,7 @@ strings to make sure that UTF-8 support works on EBCDIC platforms. */
#define STRING_Sc0 STR_S STR_c "\0"
#define STRING_Sharada0 STR_S STR_h STR_a STR_r STR_a STR_d STR_a "\0"
#define STRING_Shavian0 STR_S STR_h STR_a STR_v STR_i STR_a STR_n "\0"
+#define STRING_Siddham0 STR_S STR_i STR_d STR_d STR_h STR_a STR_m "\0"
#define STRING_Sinhala0 STR_S STR_i STR_n STR_h STR_a STR_l STR_a "\0"
#define STRING_Sk0 STR_S STR_k "\0"
#define STRING_Sm0 STR_S STR_m "\0"
@@ -342,8 +363,10 @@ strings to make sure that UTF-8 support works on EBCDIC platforms. */
#define STRING_Thai0 STR_T STR_h STR_a STR_i "\0"
#define STRING_Tibetan0 STR_T STR_i STR_b STR_e STR_t STR_a STR_n "\0"
#define STRING_Tifinagh0 STR_T STR_i STR_f STR_i STR_n STR_a STR_g STR_h "\0"
+#define STRING_Tirhuta0 STR_T STR_i STR_r STR_h STR_u STR_t STR_a "\0"
#define STRING_Ugaritic0 STR_U STR_g STR_a STR_r STR_i STR_t STR_i STR_c "\0"
#define STRING_Vai0 STR_V STR_a STR_i "\0"
+#define STRING_Warang_Citi0 STR_W STR_a STR_r STR_a STR_n STR_g STR_UNDERSCORE STR_C STR_i STR_t STR_i "\0"
#define STRING_Xan0 STR_X STR_a STR_n "\0"
#define STRING_Xps0 STR_X STR_p STR_s "\0"
#define STRING_Xsp0 STR_X STR_s STR_p "\0"
@@ -362,6 +385,7 @@ const char PRIV(utt_names)[] =
STRING_Avestan0
STRING_Balinese0
STRING_Bamum0
+ STRING_Bassa_Vah0
STRING_Batak0
STRING_Bengali0
STRING_Bopomofo0
@@ -372,6 +396,7 @@ const char PRIV(utt_names)[] =
STRING_C0
STRING_Canadian_Aboriginal0
STRING_Carian0
+ STRING_Caucasian_Albanian0
STRING_Cc0
STRING_Cf0
STRING_Chakma0
@@ -387,11 +412,14 @@ const char PRIV(utt_names)[] =
STRING_Cyrillic0
STRING_Deseret0
STRING_Devanagari0
+ STRING_Duployan0
STRING_Egyptian_Hieroglyphs0
+ STRING_Elbasan0
STRING_Ethiopic0
STRING_Georgian0
STRING_Glagolitic0
STRING_Gothic0
+ STRING_Grantha0
STRING_Greek0
STRING_Gujarati0
STRING_Gurmukhi0
@@ -411,12 +439,15 @@ const char PRIV(utt_names)[] =
STRING_Kayah_Li0
STRING_Kharoshthi0
STRING_Khmer0
+ STRING_Khojki0
+ STRING_Khudawadi0
STRING_L0
STRING_L_AMPERSAND0
STRING_Lao0
STRING_Latin0
STRING_Lepcha0
STRING_Limbu0
+ STRING_Linear_A0
STRING_Linear_B0
STRING_Lisu0
STRING_Ll0
@@ -427,18 +458,24 @@ const char PRIV(utt_names)[] =
STRING_Lycian0
STRING_Lydian0
STRING_M0
+ STRING_Mahajani0
STRING_Malayalam0
STRING_Mandaic0
+ STRING_Manichaean0
STRING_Mc0
STRING_Me0
STRING_Meetei_Mayek0
+ STRING_Mende_Kikakui0
STRING_Meroitic_Cursive0
STRING_Meroitic_Hieroglyphs0
STRING_Miao0
STRING_Mn0
+ STRING_Modi0
STRING_Mongolian0
+ STRING_Mro0
STRING_Myanmar0
STRING_N0
+ STRING_Nabataean0
STRING_Nd0
STRING_New_Tai_Lue0
STRING_Nko0
@@ -447,12 +484,17 @@ const char PRIV(utt_names)[] =
STRING_Ogham0
STRING_Ol_Chiki0
STRING_Old_Italic0
+ STRING_Old_North_Arabian0
+ STRING_Old_Permic0
STRING_Old_Persian0
STRING_Old_South_Arabian0
STRING_Old_Turkic0
STRING_Oriya0
STRING_Osmanya0
STRING_P0
+ STRING_Pahawh_Hmong0
+ STRING_Palmyrene0
+ STRING_Pau_Cin_Hau0
STRING_Pc0
STRING_Pd0
STRING_Pe0
@@ -462,6 +504,7 @@ const char PRIV(utt_names)[] =
STRING_Pi0
STRING_Po0
STRING_Ps0
+ STRING_Psalter_Pahlavi0
STRING_Rejang0
STRING_Runic0
STRING_S0
@@ -470,6 +513,7 @@ const char PRIV(utt_names)[] =
STRING_Sc0
STRING_Sharada0
STRING_Shavian0
+ STRING_Siddham0
STRING_Sinhala0
STRING_Sk0
STRING_Sm0
@@ -490,8 +534,10 @@ const char PRIV(utt_names)[] =
STRING_Thai0
STRING_Tibetan0
STRING_Tifinagh0
+ STRING_Tirhuta0
STRING_Ugaritic0
STRING_Vai0
+ STRING_Warang_Citi0
STRING_Xan0
STRING_Xps0
STRING_Xsp0
@@ -510,146 +556,169 @@ const ucp_type_table PRIV(utt)[] = {
{ 20, PT_SC, ucp_Avestan },
{ 28, PT_SC, ucp_Balinese },
{ 37, PT_SC, ucp_Bamum },
- { 43, PT_SC, ucp_Batak },
- { 49, PT_SC, ucp_Bengali },
- { 57, PT_SC, ucp_Bopomofo },
- { 66, PT_SC, ucp_Brahmi },
- { 73, PT_SC, ucp_Braille },
- { 81, PT_SC, ucp_Buginese },
- { 90, PT_SC, ucp_Buhid },
- { 96, PT_GC, ucp_C },
- { 98, PT_SC, ucp_Canadian_Aboriginal },
- { 118, PT_SC, ucp_Carian },
- { 125, PT_PC, ucp_Cc },
- { 128, PT_PC, ucp_Cf },
- { 131, PT_SC, ucp_Chakma },
- { 138, PT_SC, ucp_Cham },
- { 143, PT_SC, ucp_Cherokee },
- { 152, PT_PC, ucp_Cn },
- { 155, PT_PC, ucp_Co },
- { 158, PT_SC, ucp_Common },
- { 165, PT_SC, ucp_Coptic },
- { 172, PT_PC, ucp_Cs },
- { 175, PT_SC, ucp_Cuneiform },
- { 185, PT_SC, ucp_Cypriot },
- { 193, PT_SC, ucp_Cyrillic },
- { 202, PT_SC, ucp_Deseret },
- { 210, PT_SC, ucp_Devanagari },
- { 221, PT_SC, ucp_Egyptian_Hieroglyphs },
- { 242, PT_SC, ucp_Ethiopic },
- { 251, PT_SC, ucp_Georgian },
- { 260, PT_SC, ucp_Glagolitic },
- { 271, PT_SC, ucp_Gothic },
- { 278, PT_SC, ucp_Greek },
- { 284, PT_SC, ucp_Gujarati },
- { 293, PT_SC, ucp_Gurmukhi },
- { 302, PT_SC, ucp_Han },
- { 306, PT_SC, ucp_Hangul },
- { 313, PT_SC, ucp_Hanunoo },
- { 321, PT_SC, ucp_Hebrew },
- { 328, PT_SC, ucp_Hiragana },
- { 337, PT_SC, ucp_Imperial_Aramaic },
- { 354, PT_SC, ucp_Inherited },
- { 364, PT_SC, ucp_Inscriptional_Pahlavi },
- { 386, PT_SC, ucp_Inscriptional_Parthian },
- { 409, PT_SC, ucp_Javanese },
- { 418, PT_SC, ucp_Kaithi },
- { 425, PT_SC, ucp_Kannada },
- { 433, PT_SC, ucp_Katakana },
- { 442, PT_SC, ucp_Kayah_Li },
- { 451, PT_SC, ucp_Kharoshthi },
- { 462, PT_SC, ucp_Khmer },
- { 468, PT_GC, ucp_L },
- { 470, PT_LAMP, 0 },
- { 473, PT_SC, ucp_Lao },
- { 477, PT_SC, ucp_Latin },
- { 483, PT_SC, ucp_Lepcha },
- { 490, PT_SC, ucp_Limbu },
- { 496, PT_SC, ucp_Linear_B },
- { 505, PT_SC, ucp_Lisu },
- { 510, PT_PC, ucp_Ll },
- { 513, PT_PC, ucp_Lm },
- { 516, PT_PC, ucp_Lo },
- { 519, PT_PC, ucp_Lt },
- { 522, PT_PC, ucp_Lu },
- { 525, PT_SC, ucp_Lycian },
- { 532, PT_SC, ucp_Lydian },
- { 539, PT_GC, ucp_M },
- { 541, PT_SC, ucp_Malayalam },
- { 551, PT_SC, ucp_Mandaic },
- { 559, PT_PC, ucp_Mc },
- { 562, PT_PC, ucp_Me },
- { 565, PT_SC, ucp_Meetei_Mayek },
- { 578, PT_SC, ucp_Meroitic_Cursive },
- { 595, PT_SC, ucp_Meroitic_Hieroglyphs },
- { 616, PT_SC, ucp_Miao },
- { 621, PT_PC, ucp_Mn },
- { 624, PT_SC, ucp_Mongolian },
- { 634, PT_SC, ucp_Myanmar },
- { 642, PT_GC, ucp_N },
- { 644, PT_PC, ucp_Nd },
- { 647, PT_SC, ucp_New_Tai_Lue },
- { 659, PT_SC, ucp_Nko },
- { 663, PT_PC, ucp_Nl },
- { 666, PT_PC, ucp_No },
- { 669, PT_SC, ucp_Ogham },
- { 675, PT_SC, ucp_Ol_Chiki },
- { 684, PT_SC, ucp_Old_Italic },
- { 695, PT_SC, ucp_Old_Persian },
- { 707, PT_SC, ucp_Old_South_Arabian },
- { 725, PT_SC, ucp_Old_Turkic },
- { 736, PT_SC, ucp_Oriya },
- { 742, PT_SC, ucp_Osmanya },
- { 750, PT_GC, ucp_P },
- { 752, PT_PC, ucp_Pc },
- { 755, PT_PC, ucp_Pd },
- { 758, PT_PC, ucp_Pe },
- { 761, PT_PC, ucp_Pf },
- { 764, PT_SC, ucp_Phags_Pa },
- { 773, PT_SC, ucp_Phoenician },
- { 784, PT_PC, ucp_Pi },
- { 787, PT_PC, ucp_Po },
- { 790, PT_PC, ucp_Ps },
- { 793, PT_SC, ucp_Rejang },
- { 800, PT_SC, ucp_Runic },
- { 806, PT_GC, ucp_S },
- { 808, PT_SC, ucp_Samaritan },
- { 818, PT_SC, ucp_Saurashtra },
- { 829, PT_PC, ucp_Sc },
- { 832, PT_SC, ucp_Sharada },
- { 840, PT_SC, ucp_Shavian },
- { 848, PT_SC, ucp_Sinhala },
- { 856, PT_PC, ucp_Sk },
- { 859, PT_PC, ucp_Sm },
- { 862, PT_PC, ucp_So },
- { 865, PT_SC, ucp_Sora_Sompeng },
- { 878, PT_SC, ucp_Sundanese },
- { 888, PT_SC, ucp_Syloti_Nagri },
- { 901, PT_SC, ucp_Syriac },
- { 908, PT_SC, ucp_Tagalog },
- { 916, PT_SC, ucp_Tagbanwa },
- { 925, PT_SC, ucp_Tai_Le },
- { 932, PT_SC, ucp_Tai_Tham },
- { 941, PT_SC, ucp_Tai_Viet },
- { 950, PT_SC, ucp_Takri },
- { 956, PT_SC, ucp_Tamil },
- { 962, PT_SC, ucp_Telugu },
- { 969, PT_SC, ucp_Thaana },
- { 976, PT_SC, ucp_Thai },
- { 981, PT_SC, ucp_Tibetan },
- { 989, PT_SC, ucp_Tifinagh },
- { 998, PT_SC, ucp_Ugaritic },
- { 1007, PT_SC, ucp_Vai },
- { 1011, PT_ALNUM, 0 },
- { 1015, PT_PXSPACE, 0 },
- { 1019, PT_SPACE, 0 },
- { 1023, PT_UCNC, 0 },
- { 1027, PT_WORD, 0 },
- { 1031, PT_SC, ucp_Yi },
- { 1034, PT_GC, ucp_Z },
- { 1036, PT_PC, ucp_Zl },
- { 1039, PT_PC, ucp_Zp },
- { 1042, PT_PC, ucp_Zs }
+ { 43, PT_SC, ucp_Bassa_Vah },
+ { 53, PT_SC, ucp_Batak },
+ { 59, PT_SC, ucp_Bengali },
+ { 67, PT_SC, ucp_Bopomofo },
+ { 76, PT_SC, ucp_Brahmi },
+ { 83, PT_SC, ucp_Braille },
+ { 91, PT_SC, ucp_Buginese },
+ { 100, PT_SC, ucp_Buhid },
+ { 106, PT_GC, ucp_C },
+ { 108, PT_SC, ucp_Canadian_Aboriginal },
+ { 128, PT_SC, ucp_Carian },
+ { 135, PT_SC, ucp_Caucasian_Albanian },
+ { 154, PT_PC, ucp_Cc },
+ { 157, PT_PC, ucp_Cf },
+ { 160, PT_SC, ucp_Chakma },
+ { 167, PT_SC, ucp_Cham },
+ { 172, PT_SC, ucp_Cherokee },
+ { 181, PT_PC, ucp_Cn },
+ { 184, PT_PC, ucp_Co },
+ { 187, PT_SC, ucp_Common },
+ { 194, PT_SC, ucp_Coptic },
+ { 201, PT_PC, ucp_Cs },
+ { 204, PT_SC, ucp_Cuneiform },
+ { 214, PT_SC, ucp_Cypriot },
+ { 222, PT_SC, ucp_Cyrillic },
+ { 231, PT_SC, ucp_Deseret },
+ { 239, PT_SC, ucp_Devanagari },
+ { 250, PT_SC, ucp_Duployan },
+ { 259, PT_SC, ucp_Egyptian_Hieroglyphs },
+ { 280, PT_SC, ucp_Elbasan },
+ { 288, PT_SC, ucp_Ethiopic },
+ { 297, PT_SC, ucp_Georgian },
+ { 306, PT_SC, ucp_Glagolitic },
+ { 317, PT_SC, ucp_Gothic },
+ { 324, PT_SC, ucp_Grantha },
+ { 332, PT_SC, ucp_Greek },
+ { 338, PT_SC, ucp_Gujarati },
+ { 347, PT_SC, ucp_Gurmukhi },
+ { 356, PT_SC, ucp_Han },
+ { 360, PT_SC, ucp_Hangul },
+ { 367, PT_SC, ucp_Hanunoo },
+ { 375, PT_SC, ucp_Hebrew },
+ { 382, PT_SC, ucp_Hiragana },
+ { 391, PT_SC, ucp_Imperial_Aramaic },
+ { 408, PT_SC, ucp_Inherited },
+ { 418, PT_SC, ucp_Inscriptional_Pahlavi },
+ { 440, PT_SC, ucp_Inscriptional_Parthian },
+ { 463, PT_SC, ucp_Javanese },
+ { 472, PT_SC, ucp_Kaithi },
+ { 479, PT_SC, ucp_Kannada },
+ { 487, PT_SC, ucp_Katakana },
+ { 496, PT_SC, ucp_Kayah_Li },
+ { 505, PT_SC, ucp_Kharoshthi },
+ { 516, PT_SC, ucp_Khmer },
+ { 522, PT_SC, ucp_Khojki },
+ { 529, PT_SC, ucp_Khudawadi },
+ { 539, PT_GC, ucp_L },
+ { 541, PT_LAMP, 0 },
+ { 544, PT_SC, ucp_Lao },
+ { 548, PT_SC, ucp_Latin },
+ { 554, PT_SC, ucp_Lepcha },
+ { 561, PT_SC, ucp_Limbu },
+ { 567, PT_SC, ucp_Linear_A },
+ { 576, PT_SC, ucp_Linear_B },
+ { 585, PT_SC, ucp_Lisu },
+ { 590, PT_PC, ucp_Ll },
+ { 593, PT_PC, ucp_Lm },
+ { 596, PT_PC, ucp_Lo },
+ { 599, PT_PC, ucp_Lt },
+ { 602, PT_PC, ucp_Lu },
+ { 605, PT_SC, ucp_Lycian },
+ { 612, PT_SC, ucp_Lydian },
+ { 619, PT_GC, ucp_M },
+ { 621, PT_SC, ucp_Mahajani },
+ { 630, PT_SC, ucp_Malayalam },
+ { 640, PT_SC, ucp_Mandaic },
+ { 648, PT_SC, ucp_Manichaean },
+ { 659, PT_PC, ucp_Mc },
+ { 662, PT_PC, ucp_Me },
+ { 665, PT_SC, ucp_Meetei_Mayek },
+ { 678, PT_SC, ucp_Mende_Kikakui },
+ { 692, PT_SC, ucp_Meroitic_Cursive },
+ { 709, PT_SC, ucp_Meroitic_Hieroglyphs },
+ { 730, PT_SC, ucp_Miao },
+ { 735, PT_PC, ucp_Mn },
+ { 738, PT_SC, ucp_Modi },
+ { 743, PT_SC, ucp_Mongolian },
+ { 753, PT_SC, ucp_Mro },
+ { 757, PT_SC, ucp_Myanmar },
+ { 765, PT_GC, ucp_N },
+ { 767, PT_SC, ucp_Nabataean },
+ { 777, PT_PC, ucp_Nd },
+ { 780, PT_SC, ucp_New_Tai_Lue },
+ { 792, PT_SC, ucp_Nko },
+ { 796, PT_PC, ucp_Nl },
+ { 799, PT_PC, ucp_No },
+ { 802, PT_SC, ucp_Ogham },
+ { 808, PT_SC, ucp_Ol_Chiki },
+ { 817, PT_SC, ucp_Old_Italic },
+ { 828, PT_SC, ucp_Old_North_Arabian },
+ { 846, PT_SC, ucp_Old_Permic },
+ { 857, PT_SC, ucp_Old_Persian },
+ { 869, PT_SC, ucp_Old_South_Arabian },
+ { 887, PT_SC, ucp_Old_Turkic },
+ { 898, PT_SC, ucp_Oriya },
+ { 904, PT_SC, ucp_Osmanya },
+ { 912, PT_GC, ucp_P },
+ { 914, PT_SC, ucp_Pahawh_Hmong },
+ { 927, PT_SC, ucp_Palmyrene },
+ { 937, PT_SC, ucp_Pau_Cin_Hau },
+ { 949, PT_PC, ucp_Pc },
+ { 952, PT_PC, ucp_Pd },
+ { 955, PT_PC, ucp_Pe },
+ { 958, PT_PC, ucp_Pf },
+ { 961, PT_SC, ucp_Phags_Pa },
+ { 970, PT_SC, ucp_Phoenician },
+ { 981, PT_PC, ucp_Pi },
+ { 984, PT_PC, ucp_Po },
+ { 987, PT_PC, ucp_Ps },
+ { 990, PT_SC, ucp_Psalter_Pahlavi },
+ { 1006, PT_SC, ucp_Rejang },
+ { 1013, PT_SC, ucp_Runic },
+ { 1019, PT_GC, ucp_S },
+ { 1021, PT_SC, ucp_Samaritan },
+ { 1031, PT_SC, ucp_Saurashtra },
+ { 1042, PT_PC, ucp_Sc },
+ { 1045, PT_SC, ucp_Sharada },
+ { 1053, PT_SC, ucp_Shavian },
+ { 1061, PT_SC, ucp_Siddham },
+ { 1069, PT_SC, ucp_Sinhala },
+ { 1077, PT_PC, ucp_Sk },
+ { 1080, PT_PC, ucp_Sm },
+ { 1083, PT_PC, ucp_So },
+ { 1086, PT_SC, ucp_Sora_Sompeng },
+ { 1099, PT_SC, ucp_Sundanese },
+ { 1109, PT_SC, ucp_Syloti_Nagri },
+ { 1122, PT_SC, ucp_Syriac },
+ { 1129, PT_SC, ucp_Tagalog },
+ { 1137, PT_SC, ucp_Tagbanwa },
+ { 1146, PT_SC, ucp_Tai_Le },
+ { 1153, PT_SC, ucp_Tai_Tham },
+ { 1162, PT_SC, ucp_Tai_Viet },
+ { 1171, PT_SC, ucp_Takri },
+ { 1177, PT_SC, ucp_Tamil },
+ { 1183, PT_SC, ucp_Telugu },
+ { 1190, PT_SC, ucp_Thaana },
+ { 1197, PT_SC, ucp_Thai },
+ { 1202, PT_SC, ucp_Tibetan },
+ { 1210, PT_SC, ucp_Tifinagh },
+ { 1219, PT_SC, ucp_Tirhuta },
+ { 1227, PT_SC, ucp_Ugaritic },
+ { 1236, PT_SC, ucp_Vai },
+ { 1240, PT_SC, ucp_Warang_Citi },
+ { 1252, PT_ALNUM, 0 },
+ { 1256, PT_PXSPACE, 0 },
+ { 1260, PT_SPACE, 0 },
+ { 1264, PT_UCNC, 0 },
+ { 1268, PT_WORD, 0 },
+ { 1272, PT_SC, ucp_Yi },
+ { 1275, PT_GC, ucp_Z },
+ { 1277, PT_PC, ucp_Zl },
+ { 1280, PT_PC, ucp_Zp },
+ { 1283, PT_PC, ucp_Zs }
};
const int PRIV(utt_size) = sizeof(PRIV(utt)) / sizeof(ucp_type_table);
diff --git a/erts/emulator/pcre/pcre_ucd.c b/erts/emulator/pcre/pcre_ucd.c
index bdbc73c245..2dd4b05751 100644
--- a/erts/emulator/pcre/pcre_ucd.c
+++ b/erts/emulator/pcre/pcre_ucd.c
@@ -20,7 +20,7 @@ needed. */
/* Unicode character database. */
/* This file was autogenerated by the MultiStage2.py script. */
-/* Total size: 65696 bytes, block size: 128. */
+/* Total size: 72576 bytes, block size: 128. */
/* The tables herein are needed only when UCP support is built
into PCRE. This module should not be referenced otherwise, so
@@ -38,6 +38,20 @@ const pcre_uint16 PRIV(ucd_stage2)[] = {0};
const pcre_uint32 PRIV(ucd_caseless_sets)[] = {0};
#else
+/* If the 32-bit library is run in non-32-bit mode, character values
+greater than 0x10ffff may be encountered. For these we set up a
+special record. */
+
+#ifdef COMPILE_PCRE32
+const ucd_record PRIV(dummy_ucd_record)[] = {{
+ ucp_Common, /* script */
+ ucp_Cn, /* type unassigned */
+ ucp_gbOther, /* grapheme break property */
+ 0, /* case set */
+ 0, /* other case */
+ }};
+#endif
+
/* When recompiling tables with a new Unicode version, please check the
types in this structure definition from pcre_internal.h (the actual
field names will be different):
@@ -79,7 +93,7 @@ const pcre_uint32 PRIV(ucd_caseless_sets)[] = {
#ifndef PCRE_INCLUDED
-const ucd_record PRIV(ucd_records)[] = { /* 5024 bytes, record size 8 */
+const ucd_record PRIV(ucd_records)[] = { /* 5760 bytes, record size 8 */
{ 9, 0, 2, 0, 0, }, /* 0 */
{ 9, 0, 1, 0, 0, }, /* 1 */
{ 9, 0, 0, 0, 0, }, /* 2 */
@@ -166,548 +180,640 @@ const ucd_record PRIV(ucd_records)[] = { /* 5024 bytes, record size 8 */
{ 33, 5, 12, 0, -205, }, /* 83 */
{ 33, 5, 12, 0, -202, }, /* 84 */
{ 33, 5, 12, 0, -203, }, /* 85 */
- { 33, 5, 12, 0, -207, }, /* 86 */
- { 33, 5, 12, 0, 42280, }, /* 87 */
- { 33, 5, 12, 0, 42308, }, /* 88 */
- { 33, 5, 12, 0, -209, }, /* 89 */
- { 33, 5, 12, 0, -211, }, /* 90 */
- { 33, 5, 12, 0, 10743, }, /* 91 */
- { 33, 5, 12, 0, 10749, }, /* 92 */
- { 33, 5, 12, 0, -213, }, /* 93 */
- { 33, 5, 12, 0, -214, }, /* 94 */
- { 33, 5, 12, 0, 10727, }, /* 95 */
- { 33, 5, 12, 0, -218, }, /* 96 */
- { 33, 5, 12, 0, -69, }, /* 97 */
- { 33, 5, 12, 0, -217, }, /* 98 */
- { 33, 5, 12, 0, -71, }, /* 99 */
- { 33, 5, 12, 0, -219, }, /* 100 */
- { 33, 6, 12, 0, 0, }, /* 101 */
- { 9, 6, 12, 0, 0, }, /* 102 */
- { 3, 24, 12, 0, 0, }, /* 103 */
- { 27, 12, 3, 0, 0, }, /* 104 */
- { 27, 12, 3, 21, 116, }, /* 105 */
- { 19, 9, 12, 0, 1, }, /* 106 */
- { 19, 5, 12, 0, -1, }, /* 107 */
- { 19, 24, 12, 0, 0, }, /* 108 */
- { 9, 2, 12, 0, 0, }, /* 109 */
- { 19, 6, 12, 0, 0, }, /* 110 */
- { 19, 5, 12, 0, 130, }, /* 111 */
- { 19, 9, 12, 0, 38, }, /* 112 */
- { 19, 9, 12, 0, 37, }, /* 113 */
- { 19, 9, 12, 0, 64, }, /* 114 */
- { 19, 9, 12, 0, 63, }, /* 115 */
- { 19, 5, 12, 0, 0, }, /* 116 */
- { 19, 9, 12, 0, 32, }, /* 117 */
- { 19, 9, 12, 34, 32, }, /* 118 */
- { 19, 9, 12, 59, 32, }, /* 119 */
- { 19, 9, 12, 38, 32, }, /* 120 */
- { 19, 9, 12, 21, 32, }, /* 121 */
- { 19, 9, 12, 51, 32, }, /* 122 */
- { 19, 9, 12, 26, 32, }, /* 123 */
- { 19, 9, 12, 47, 32, }, /* 124 */
- { 19, 9, 12, 55, 32, }, /* 125 */
- { 19, 9, 12, 30, 32, }, /* 126 */
- { 19, 9, 12, 43, 32, }, /* 127 */
- { 19, 9, 12, 67, 32, }, /* 128 */
- { 19, 5, 12, 0, -38, }, /* 129 */
- { 19, 5, 12, 0, -37, }, /* 130 */
- { 19, 5, 12, 0, -32, }, /* 131 */
- { 19, 5, 12, 34, -32, }, /* 132 */
- { 19, 5, 12, 59, -32, }, /* 133 */
- { 19, 5, 12, 38, -32, }, /* 134 */
- { 19, 5, 12, 21, -116, }, /* 135 */
- { 19, 5, 12, 51, -32, }, /* 136 */
- { 19, 5, 12, 26, -775, }, /* 137 */
- { 19, 5, 12, 47, -32, }, /* 138 */
- { 19, 5, 12, 55, -32, }, /* 139 */
- { 19, 5, 12, 30, 1, }, /* 140 */
- { 19, 5, 12, 30, -32, }, /* 141 */
- { 19, 5, 12, 43, -32, }, /* 142 */
- { 19, 5, 12, 67, -32, }, /* 143 */
- { 19, 5, 12, 0, -64, }, /* 144 */
- { 19, 5, 12, 0, -63, }, /* 145 */
- { 19, 9, 12, 0, 8, }, /* 146 */
- { 19, 5, 12, 34, -30, }, /* 147 */
- { 19, 5, 12, 38, -25, }, /* 148 */
- { 19, 9, 12, 0, 0, }, /* 149 */
- { 19, 5, 12, 43, -15, }, /* 150 */
- { 19, 5, 12, 47, -22, }, /* 151 */
- { 19, 5, 12, 0, -8, }, /* 152 */
- { 10, 9, 12, 0, 1, }, /* 153 */
- { 10, 5, 12, 0, -1, }, /* 154 */
- { 19, 5, 12, 51, -54, }, /* 155 */
- { 19, 5, 12, 55, -48, }, /* 156 */
- { 19, 5, 12, 0, 7, }, /* 157 */
- { 19, 9, 12, 38, -60, }, /* 158 */
- { 19, 5, 12, 59, -64, }, /* 159 */
- { 19, 25, 12, 0, 0, }, /* 160 */
- { 19, 9, 12, 0, -7, }, /* 161 */
- { 19, 9, 12, 0, -130, }, /* 162 */
- { 12, 9, 12, 0, 80, }, /* 163 */
- { 12, 9, 12, 0, 32, }, /* 164 */
- { 12, 5, 12, 0, -32, }, /* 165 */
- { 12, 5, 12, 0, -80, }, /* 166 */
- { 12, 9, 12, 0, 1, }, /* 167 */
- { 12, 5, 12, 0, -1, }, /* 168 */
- { 12, 26, 12, 0, 0, }, /* 169 */
- { 12, 12, 3, 0, 0, }, /* 170 */
- { 12, 11, 3, 0, 0, }, /* 171 */
- { 12, 9, 12, 0, 15, }, /* 172 */
- { 12, 5, 12, 0, -15, }, /* 173 */
- { 1, 9, 12, 0, 48, }, /* 174 */
- { 1, 6, 12, 0, 0, }, /* 175 */
- { 1, 21, 12, 0, 0, }, /* 176 */
- { 1, 5, 12, 0, -48, }, /* 177 */
- { 1, 5, 12, 0, 0, }, /* 178 */
- { 1, 17, 12, 0, 0, }, /* 179 */
- { 1, 23, 12, 0, 0, }, /* 180 */
- { 25, 12, 3, 0, 0, }, /* 181 */
- { 25, 17, 12, 0, 0, }, /* 182 */
- { 25, 21, 12, 0, 0, }, /* 183 */
- { 25, 7, 12, 0, 0, }, /* 184 */
- { 0, 1, 2, 0, 0, }, /* 185 */
- { 0, 25, 12, 0, 0, }, /* 186 */
- { 0, 21, 12, 0, 0, }, /* 187 */
- { 0, 23, 12, 0, 0, }, /* 188 */
- { 0, 26, 12, 0, 0, }, /* 189 */
- { 0, 12, 3, 0, 0, }, /* 190 */
- { 0, 7, 12, 0, 0, }, /* 191 */
- { 0, 6, 12, 0, 0, }, /* 192 */
- { 0, 13, 12, 0, 0, }, /* 193 */
- { 49, 21, 12, 0, 0, }, /* 194 */
- { 49, 1, 2, 0, 0, }, /* 195 */
- { 49, 7, 12, 0, 0, }, /* 196 */
- { 49, 12, 3, 0, 0, }, /* 197 */
- { 55, 7, 12, 0, 0, }, /* 198 */
- { 55, 12, 3, 0, 0, }, /* 199 */
- { 63, 13, 12, 0, 0, }, /* 200 */
- { 63, 7, 12, 0, 0, }, /* 201 */
- { 63, 12, 3, 0, 0, }, /* 202 */
- { 63, 6, 12, 0, 0, }, /* 203 */
- { 63, 26, 12, 0, 0, }, /* 204 */
- { 63, 21, 12, 0, 0, }, /* 205 */
- { 89, 7, 12, 0, 0, }, /* 206 */
- { 89, 12, 3, 0, 0, }, /* 207 */
- { 89, 6, 12, 0, 0, }, /* 208 */
- { 89, 21, 12, 0, 0, }, /* 209 */
- { 94, 7, 12, 0, 0, }, /* 210 */
- { 94, 12, 3, 0, 0, }, /* 211 */
- { 94, 21, 12, 0, 0, }, /* 212 */
- { 14, 12, 3, 0, 0, }, /* 213 */
- { 14, 10, 5, 0, 0, }, /* 214 */
- { 14, 7, 12, 0, 0, }, /* 215 */
- { 14, 13, 12, 0, 0, }, /* 216 */
- { 14, 21, 12, 0, 0, }, /* 217 */
- { 14, 6, 12, 0, 0, }, /* 218 */
- { 2, 12, 3, 0, 0, }, /* 219 */
- { 2, 10, 5, 0, 0, }, /* 220 */
- { 2, 7, 12, 0, 0, }, /* 221 */
- { 2, 10, 3, 0, 0, }, /* 222 */
- { 2, 13, 12, 0, 0, }, /* 223 */
- { 2, 23, 12, 0, 0, }, /* 224 */
- { 2, 15, 12, 0, 0, }, /* 225 */
- { 2, 26, 12, 0, 0, }, /* 226 */
- { 21, 12, 3, 0, 0, }, /* 227 */
- { 21, 10, 5, 0, 0, }, /* 228 */
- { 21, 7, 12, 0, 0, }, /* 229 */
- { 21, 13, 12, 0, 0, }, /* 230 */
- { 20, 12, 3, 0, 0, }, /* 231 */
- { 20, 10, 5, 0, 0, }, /* 232 */
- { 20, 7, 12, 0, 0, }, /* 233 */
- { 20, 13, 12, 0, 0, }, /* 234 */
- { 20, 21, 12, 0, 0, }, /* 235 */
- { 20, 23, 12, 0, 0, }, /* 236 */
- { 43, 12, 3, 0, 0, }, /* 237 */
- { 43, 10, 5, 0, 0, }, /* 238 */
- { 43, 7, 12, 0, 0, }, /* 239 */
- { 43, 10, 3, 0, 0, }, /* 240 */
- { 43, 13, 12, 0, 0, }, /* 241 */
- { 43, 26, 12, 0, 0, }, /* 242 */
- { 43, 15, 12, 0, 0, }, /* 243 */
- { 53, 12, 3, 0, 0, }, /* 244 */
- { 53, 7, 12, 0, 0, }, /* 245 */
- { 53, 10, 3, 0, 0, }, /* 246 */
- { 53, 10, 5, 0, 0, }, /* 247 */
- { 53, 13, 12, 0, 0, }, /* 248 */
- { 53, 15, 12, 0, 0, }, /* 249 */
- { 53, 26, 12, 0, 0, }, /* 250 */
- { 53, 23, 12, 0, 0, }, /* 251 */
- { 54, 10, 5, 0, 0, }, /* 252 */
- { 54, 7, 12, 0, 0, }, /* 253 */
- { 54, 12, 3, 0, 0, }, /* 254 */
- { 54, 13, 12, 0, 0, }, /* 255 */
- { 54, 15, 12, 0, 0, }, /* 256 */
- { 54, 26, 12, 0, 0, }, /* 257 */
- { 28, 10, 5, 0, 0, }, /* 258 */
- { 28, 7, 12, 0, 0, }, /* 259 */
- { 28, 12, 3, 0, 0, }, /* 260 */
- { 28, 10, 3, 0, 0, }, /* 261 */
- { 28, 13, 12, 0, 0, }, /* 262 */
- { 36, 10, 5, 0, 0, }, /* 263 */
- { 36, 7, 12, 0, 0, }, /* 264 */
- { 36, 10, 3, 0, 0, }, /* 265 */
- { 36, 12, 3, 0, 0, }, /* 266 */
- { 36, 13, 12, 0, 0, }, /* 267 */
- { 36, 15, 12, 0, 0, }, /* 268 */
- { 36, 26, 12, 0, 0, }, /* 269 */
- { 47, 10, 5, 0, 0, }, /* 270 */
- { 47, 7, 12, 0, 0, }, /* 271 */
- { 47, 12, 3, 0, 0, }, /* 272 */
- { 47, 10, 3, 0, 0, }, /* 273 */
- { 47, 21, 12, 0, 0, }, /* 274 */
- { 56, 7, 12, 0, 0, }, /* 275 */
- { 56, 12, 3, 0, 0, }, /* 276 */
- { 56, 7, 5, 0, 0, }, /* 277 */
- { 56, 6, 12, 0, 0, }, /* 278 */
- { 56, 21, 12, 0, 0, }, /* 279 */
- { 56, 13, 12, 0, 0, }, /* 280 */
- { 32, 7, 12, 0, 0, }, /* 281 */
- { 32, 12, 3, 0, 0, }, /* 282 */
- { 32, 7, 5, 0, 0, }, /* 283 */
- { 32, 6, 12, 0, 0, }, /* 284 */
- { 32, 13, 12, 0, 0, }, /* 285 */
- { 57, 7, 12, 0, 0, }, /* 286 */
- { 57, 26, 12, 0, 0, }, /* 287 */
- { 57, 21, 12, 0, 0, }, /* 288 */
- { 57, 12, 3, 0, 0, }, /* 289 */
- { 57, 13, 12, 0, 0, }, /* 290 */
- { 57, 15, 12, 0, 0, }, /* 291 */
- { 57, 22, 12, 0, 0, }, /* 292 */
- { 57, 18, 12, 0, 0, }, /* 293 */
- { 57, 10, 5, 0, 0, }, /* 294 */
- { 38, 7, 12, 0, 0, }, /* 295 */
- { 38, 10, 12, 0, 0, }, /* 296 */
- { 38, 12, 3, 0, 0, }, /* 297 */
- { 38, 10, 5, 0, 0, }, /* 298 */
- { 38, 13, 12, 0, 0, }, /* 299 */
- { 38, 21, 12, 0, 0, }, /* 300 */
- { 38, 26, 12, 0, 0, }, /* 301 */
- { 16, 9, 12, 0, 7264, }, /* 302 */
- { 16, 7, 12, 0, 0, }, /* 303 */
- { 16, 6, 12, 0, 0, }, /* 304 */
- { 23, 7, 6, 0, 0, }, /* 305 */
- { 23, 7, 7, 0, 0, }, /* 306 */
- { 23, 7, 8, 0, 0, }, /* 307 */
- { 15, 7, 12, 0, 0, }, /* 308 */
- { 15, 12, 3, 0, 0, }, /* 309 */
- { 15, 21, 12, 0, 0, }, /* 310 */
- { 15, 15, 12, 0, 0, }, /* 311 */
- { 15, 26, 12, 0, 0, }, /* 312 */
- { 8, 7, 12, 0, 0, }, /* 313 */
- { 7, 17, 12, 0, 0, }, /* 314 */
- { 7, 7, 12, 0, 0, }, /* 315 */
- { 7, 21, 12, 0, 0, }, /* 316 */
- { 40, 29, 12, 0, 0, }, /* 317 */
- { 40, 7, 12, 0, 0, }, /* 318 */
- { 40, 22, 12, 0, 0, }, /* 319 */
- { 40, 18, 12, 0, 0, }, /* 320 */
- { 45, 7, 12, 0, 0, }, /* 321 */
- { 45, 14, 12, 0, 0, }, /* 322 */
- { 50, 7, 12, 0, 0, }, /* 323 */
- { 50, 12, 3, 0, 0, }, /* 324 */
- { 24, 7, 12, 0, 0, }, /* 325 */
- { 24, 12, 3, 0, 0, }, /* 326 */
- { 6, 7, 12, 0, 0, }, /* 327 */
- { 6, 12, 3, 0, 0, }, /* 328 */
- { 51, 7, 12, 0, 0, }, /* 329 */
- { 51, 12, 3, 0, 0, }, /* 330 */
- { 31, 7, 12, 0, 0, }, /* 331 */
- { 31, 12, 3, 0, 0, }, /* 332 */
- { 31, 10, 5, 0, 0, }, /* 333 */
- { 31, 21, 12, 0, 0, }, /* 334 */
- { 31, 6, 12, 0, 0, }, /* 335 */
- { 31, 23, 12, 0, 0, }, /* 336 */
- { 31, 13, 12, 0, 0, }, /* 337 */
- { 31, 15, 12, 0, 0, }, /* 338 */
- { 37, 21, 12, 0, 0, }, /* 339 */
- { 37, 17, 12, 0, 0, }, /* 340 */
- { 37, 12, 3, 0, 0, }, /* 341 */
- { 37, 29, 12, 0, 0, }, /* 342 */
- { 37, 13, 12, 0, 0, }, /* 343 */
- { 37, 7, 12, 0, 0, }, /* 344 */
- { 37, 6, 12, 0, 0, }, /* 345 */
- { 34, 7, 12, 0, 0, }, /* 346 */
- { 34, 12, 3, 0, 0, }, /* 347 */
- { 34, 10, 5, 0, 0, }, /* 348 */
- { 34, 26, 12, 0, 0, }, /* 349 */
- { 34, 21, 12, 0, 0, }, /* 350 */
- { 34, 13, 12, 0, 0, }, /* 351 */
- { 52, 7, 12, 0, 0, }, /* 352 */
- { 39, 7, 12, 0, 0, }, /* 353 */
- { 39, 10, 12, 0, 0, }, /* 354 */
- { 39, 10, 5, 0, 0, }, /* 355 */
- { 39, 13, 12, 0, 0, }, /* 356 */
- { 39, 15, 12, 0, 0, }, /* 357 */
- { 39, 26, 12, 0, 0, }, /* 358 */
- { 31, 26, 12, 0, 0, }, /* 359 */
- { 5, 7, 12, 0, 0, }, /* 360 */
- { 5, 12, 3, 0, 0, }, /* 361 */
- { 5, 10, 5, 0, 0, }, /* 362 */
- { 5, 21, 12, 0, 0, }, /* 363 */
- { 90, 7, 12, 0, 0, }, /* 364 */
- { 90, 10, 5, 0, 0, }, /* 365 */
- { 90, 12, 3, 0, 0, }, /* 366 */
- { 90, 10, 12, 0, 0, }, /* 367 */
- { 90, 13, 12, 0, 0, }, /* 368 */
- { 90, 21, 12, 0, 0, }, /* 369 */
- { 90, 6, 12, 0, 0, }, /* 370 */
- { 61, 12, 3, 0, 0, }, /* 371 */
- { 61, 10, 5, 0, 0, }, /* 372 */
- { 61, 7, 12, 0, 0, }, /* 373 */
- { 61, 13, 12, 0, 0, }, /* 374 */
- { 61, 21, 12, 0, 0, }, /* 375 */
- { 61, 26, 12, 0, 0, }, /* 376 */
- { 75, 12, 3, 0, 0, }, /* 377 */
- { 75, 10, 5, 0, 0, }, /* 378 */
- { 75, 7, 12, 0, 0, }, /* 379 */
- { 75, 13, 12, 0, 0, }, /* 380 */
- { 92, 7, 12, 0, 0, }, /* 381 */
- { 92, 12, 3, 0, 0, }, /* 382 */
- { 92, 10, 5, 0, 0, }, /* 383 */
- { 92, 21, 12, 0, 0, }, /* 384 */
- { 69, 7, 12, 0, 0, }, /* 385 */
- { 69, 10, 5, 0, 0, }, /* 386 */
- { 69, 12, 3, 0, 0, }, /* 387 */
- { 69, 21, 12, 0, 0, }, /* 388 */
- { 69, 13, 12, 0, 0, }, /* 389 */
- { 72, 13, 12, 0, 0, }, /* 390 */
- { 72, 7, 12, 0, 0, }, /* 391 */
- { 72, 6, 12, 0, 0, }, /* 392 */
- { 72, 21, 12, 0, 0, }, /* 393 */
- { 75, 21, 12, 0, 0, }, /* 394 */
- { 9, 10, 5, 0, 0, }, /* 395 */
- { 9, 7, 12, 0, 0, }, /* 396 */
- { 12, 5, 12, 0, 0, }, /* 397 */
- { 12, 6, 12, 0, 0, }, /* 398 */
- { 33, 5, 12, 0, 35332, }, /* 399 */
- { 33, 5, 12, 0, 3814, }, /* 400 */
- { 33, 9, 12, 63, 1, }, /* 401 */
- { 33, 5, 12, 63, -1, }, /* 402 */
- { 33, 5, 12, 63, -58, }, /* 403 */
- { 33, 9, 12, 0, -7615, }, /* 404 */
- { 19, 5, 12, 0, 8, }, /* 405 */
- { 19, 9, 12, 0, -8, }, /* 406 */
- { 19, 5, 12, 0, 74, }, /* 407 */
- { 19, 5, 12, 0, 86, }, /* 408 */
- { 19, 5, 12, 0, 100, }, /* 409 */
- { 19, 5, 12, 0, 128, }, /* 410 */
- { 19, 5, 12, 0, 112, }, /* 411 */
- { 19, 5, 12, 0, 126, }, /* 412 */
- { 19, 8, 12, 0, -8, }, /* 413 */
- { 19, 5, 12, 0, 9, }, /* 414 */
- { 19, 9, 12, 0, -74, }, /* 415 */
- { 19, 8, 12, 0, -9, }, /* 416 */
- { 19, 5, 12, 21, -7173, }, /* 417 */
- { 19, 9, 12, 0, -86, }, /* 418 */
- { 19, 9, 12, 0, -100, }, /* 419 */
- { 19, 9, 12, 0, -112, }, /* 420 */
- { 19, 9, 12, 0, -128, }, /* 421 */
- { 19, 9, 12, 0, -126, }, /* 422 */
- { 27, 1, 3, 0, 0, }, /* 423 */
- { 9, 27, 2, 0, 0, }, /* 424 */
- { 9, 28, 2, 0, 0, }, /* 425 */
- { 9, 2, 2, 0, 0, }, /* 426 */
- { 27, 11, 3, 0, 0, }, /* 427 */
- { 9, 9, 12, 0, 0, }, /* 428 */
- { 9, 5, 12, 0, 0, }, /* 429 */
- { 19, 9, 12, 67, -7517, }, /* 430 */
- { 33, 9, 12, 71, -8383, }, /* 431 */
- { 33, 9, 12, 75, -8262, }, /* 432 */
- { 33, 9, 12, 0, 28, }, /* 433 */
- { 33, 5, 12, 0, -28, }, /* 434 */
- { 33, 14, 12, 0, 16, }, /* 435 */
- { 33, 14, 12, 0, -16, }, /* 436 */
- { 33, 14, 12, 0, 0, }, /* 437 */
- { 9, 26, 12, 0, 26, }, /* 438 */
- { 9, 26, 12, 0, -26, }, /* 439 */
- { 4, 26, 12, 0, 0, }, /* 440 */
- { 17, 9, 12, 0, 48, }, /* 441 */
- { 17, 5, 12, 0, -48, }, /* 442 */
- { 33, 9, 12, 0, -10743, }, /* 443 */
- { 33, 9, 12, 0, -3814, }, /* 444 */
- { 33, 9, 12, 0, -10727, }, /* 445 */
- { 33, 5, 12, 0, -10795, }, /* 446 */
- { 33, 5, 12, 0, -10792, }, /* 447 */
- { 33, 9, 12, 0, -10780, }, /* 448 */
- { 33, 9, 12, 0, -10749, }, /* 449 */
- { 33, 9, 12, 0, -10783, }, /* 450 */
- { 33, 9, 12, 0, -10782, }, /* 451 */
- { 33, 9, 12, 0, -10815, }, /* 452 */
- { 10, 5, 12, 0, 0, }, /* 453 */
- { 10, 26, 12, 0, 0, }, /* 454 */
- { 10, 12, 3, 0, 0, }, /* 455 */
- { 10, 21, 12, 0, 0, }, /* 456 */
- { 10, 15, 12, 0, 0, }, /* 457 */
- { 16, 5, 12, 0, -7264, }, /* 458 */
- { 58, 7, 12, 0, 0, }, /* 459 */
- { 58, 6, 12, 0, 0, }, /* 460 */
- { 58, 21, 12, 0, 0, }, /* 461 */
- { 58, 12, 3, 0, 0, }, /* 462 */
- { 22, 26, 12, 0, 0, }, /* 463 */
- { 22, 6, 12, 0, 0, }, /* 464 */
- { 22, 14, 12, 0, 0, }, /* 465 */
- { 23, 10, 3, 0, 0, }, /* 466 */
- { 26, 7, 12, 0, 0, }, /* 467 */
- { 26, 6, 12, 0, 0, }, /* 468 */
- { 29, 7, 12, 0, 0, }, /* 469 */
- { 29, 6, 12, 0, 0, }, /* 470 */
- { 3, 7, 12, 0, 0, }, /* 471 */
- { 23, 7, 12, 0, 0, }, /* 472 */
- { 23, 26, 12, 0, 0, }, /* 473 */
- { 29, 26, 12, 0, 0, }, /* 474 */
- { 22, 7, 12, 0, 0, }, /* 475 */
- { 60, 7, 12, 0, 0, }, /* 476 */
- { 60, 6, 12, 0, 0, }, /* 477 */
- { 60, 26, 12, 0, 0, }, /* 478 */
- { 85, 7, 12, 0, 0, }, /* 479 */
- { 85, 6, 12, 0, 0, }, /* 480 */
- { 85, 21, 12, 0, 0, }, /* 481 */
- { 76, 7, 12, 0, 0, }, /* 482 */
- { 76, 6, 12, 0, 0, }, /* 483 */
- { 76, 21, 12, 0, 0, }, /* 484 */
- { 76, 13, 12, 0, 0, }, /* 485 */
- { 12, 7, 12, 0, 0, }, /* 486 */
- { 12, 21, 12, 0, 0, }, /* 487 */
- { 78, 7, 12, 0, 0, }, /* 488 */
- { 78, 14, 12, 0, 0, }, /* 489 */
- { 78, 12, 3, 0, 0, }, /* 490 */
- { 78, 21, 12, 0, 0, }, /* 491 */
- { 33, 9, 12, 0, -35332, }, /* 492 */
- { 33, 9, 12, 0, -42280, }, /* 493 */
- { 33, 9, 12, 0, -42308, }, /* 494 */
- { 48, 7, 12, 0, 0, }, /* 495 */
- { 48, 12, 3, 0, 0, }, /* 496 */
- { 48, 10, 5, 0, 0, }, /* 497 */
- { 48, 26, 12, 0, 0, }, /* 498 */
- { 64, 7, 12, 0, 0, }, /* 499 */
- { 64, 21, 12, 0, 0, }, /* 500 */
- { 74, 10, 5, 0, 0, }, /* 501 */
- { 74, 7, 12, 0, 0, }, /* 502 */
- { 74, 12, 3, 0, 0, }, /* 503 */
- { 74, 21, 12, 0, 0, }, /* 504 */
- { 74, 13, 12, 0, 0, }, /* 505 */
- { 68, 13, 12, 0, 0, }, /* 506 */
- { 68, 7, 12, 0, 0, }, /* 507 */
- { 68, 12, 3, 0, 0, }, /* 508 */
- { 68, 21, 12, 0, 0, }, /* 509 */
- { 73, 7, 12, 0, 0, }, /* 510 */
- { 73, 12, 3, 0, 0, }, /* 511 */
- { 73, 10, 5, 0, 0, }, /* 512 */
- { 73, 21, 12, 0, 0, }, /* 513 */
- { 83, 12, 3, 0, 0, }, /* 514 */
- { 83, 10, 5, 0, 0, }, /* 515 */
- { 83, 7, 12, 0, 0, }, /* 516 */
- { 83, 21, 12, 0, 0, }, /* 517 */
- { 83, 6, 12, 0, 0, }, /* 518 */
- { 83, 13, 12, 0, 0, }, /* 519 */
- { 67, 7, 12, 0, 0, }, /* 520 */
- { 67, 12, 3, 0, 0, }, /* 521 */
- { 67, 10, 5, 0, 0, }, /* 522 */
- { 67, 13, 12, 0, 0, }, /* 523 */
- { 67, 21, 12, 0, 0, }, /* 524 */
- { 38, 6, 12, 0, 0, }, /* 525 */
- { 91, 7, 12, 0, 0, }, /* 526 */
- { 91, 12, 3, 0, 0, }, /* 527 */
- { 91, 6, 12, 0, 0, }, /* 528 */
- { 91, 21, 12, 0, 0, }, /* 529 */
- { 86, 7, 12, 0, 0, }, /* 530 */
- { 86, 10, 5, 0, 0, }, /* 531 */
- { 86, 12, 3, 0, 0, }, /* 532 */
- { 86, 21, 12, 0, 0, }, /* 533 */
- { 86, 6, 12, 0, 0, }, /* 534 */
- { 86, 13, 12, 0, 0, }, /* 535 */
- { 23, 7, 9, 0, 0, }, /* 536 */
- { 23, 7, 10, 0, 0, }, /* 537 */
- { 9, 4, 2, 0, 0, }, /* 538 */
- { 9, 3, 12, 0, 0, }, /* 539 */
- { 25, 25, 12, 0, 0, }, /* 540 */
- { 0, 24, 12, 0, 0, }, /* 541 */
- { 9, 6, 3, 0, 0, }, /* 542 */
- { 35, 7, 12, 0, 0, }, /* 543 */
- { 19, 14, 12, 0, 0, }, /* 544 */
- { 19, 15, 12, 0, 0, }, /* 545 */
- { 19, 26, 12, 0, 0, }, /* 546 */
- { 70, 7, 12, 0, 0, }, /* 547 */
- { 66, 7, 12, 0, 0, }, /* 548 */
- { 41, 7, 12, 0, 0, }, /* 549 */
- { 41, 15, 12, 0, 0, }, /* 550 */
- { 18, 7, 12, 0, 0, }, /* 551 */
- { 18, 14, 12, 0, 0, }, /* 552 */
- { 59, 7, 12, 0, 0, }, /* 553 */
- { 59, 21, 12, 0, 0, }, /* 554 */
- { 42, 7, 12, 0, 0, }, /* 555 */
- { 42, 21, 12, 0, 0, }, /* 556 */
- { 42, 14, 12, 0, 0, }, /* 557 */
- { 13, 9, 12, 0, 40, }, /* 558 */
- { 13, 5, 12, 0, -40, }, /* 559 */
- { 46, 7, 12, 0, 0, }, /* 560 */
- { 44, 7, 12, 0, 0, }, /* 561 */
- { 44, 13, 12, 0, 0, }, /* 562 */
- { 11, 7, 12, 0, 0, }, /* 563 */
- { 80, 7, 12, 0, 0, }, /* 564 */
- { 80, 21, 12, 0, 0, }, /* 565 */
- { 80, 15, 12, 0, 0, }, /* 566 */
- { 65, 7, 12, 0, 0, }, /* 567 */
- { 65, 15, 12, 0, 0, }, /* 568 */
- { 65, 21, 12, 0, 0, }, /* 569 */
- { 71, 7, 12, 0, 0, }, /* 570 */
- { 71, 21, 12, 0, 0, }, /* 571 */
- { 97, 7, 12, 0, 0, }, /* 572 */
- { 96, 7, 12, 0, 0, }, /* 573 */
- { 30, 7, 12, 0, 0, }, /* 574 */
- { 30, 12, 3, 0, 0, }, /* 575 */
- { 30, 15, 12, 0, 0, }, /* 576 */
- { 30, 21, 12, 0, 0, }, /* 577 */
- { 87, 7, 12, 0, 0, }, /* 578 */
- { 87, 15, 12, 0, 0, }, /* 579 */
- { 87, 21, 12, 0, 0, }, /* 580 */
- { 77, 7, 12, 0, 0, }, /* 581 */
- { 77, 21, 12, 0, 0, }, /* 582 */
- { 82, 7, 12, 0, 0, }, /* 583 */
- { 82, 15, 12, 0, 0, }, /* 584 */
- { 81, 7, 12, 0, 0, }, /* 585 */
- { 81, 15, 12, 0, 0, }, /* 586 */
- { 88, 7, 12, 0, 0, }, /* 587 */
- { 0, 15, 12, 0, 0, }, /* 588 */
- { 93, 10, 5, 0, 0, }, /* 589 */
- { 93, 12, 3, 0, 0, }, /* 590 */
- { 93, 7, 12, 0, 0, }, /* 591 */
- { 93, 21, 12, 0, 0, }, /* 592 */
- { 93, 15, 12, 0, 0, }, /* 593 */
- { 93, 13, 12, 0, 0, }, /* 594 */
- { 84, 12, 3, 0, 0, }, /* 595 */
- { 84, 10, 5, 0, 0, }, /* 596 */
- { 84, 7, 12, 0, 0, }, /* 597 */
- { 84, 21, 12, 0, 0, }, /* 598 */
- { 84, 1, 2, 0, 0, }, /* 599 */
- { 100, 7, 12, 0, 0, }, /* 600 */
- { 100, 13, 12, 0, 0, }, /* 601 */
- { 95, 12, 3, 0, 0, }, /* 602 */
- { 95, 7, 12, 0, 0, }, /* 603 */
- { 95, 10, 5, 0, 0, }, /* 604 */
- { 95, 13, 12, 0, 0, }, /* 605 */
- { 95, 21, 12, 0, 0, }, /* 606 */
- { 99, 12, 3, 0, 0, }, /* 607 */
- { 99, 10, 5, 0, 0, }, /* 608 */
- { 99, 7, 12, 0, 0, }, /* 609 */
- { 99, 21, 12, 0, 0, }, /* 610 */
- { 99, 13, 12, 0, 0, }, /* 611 */
- { 101, 7, 12, 0, 0, }, /* 612 */
- { 101, 12, 3, 0, 0, }, /* 613 */
- { 101, 10, 5, 0, 0, }, /* 614 */
- { 101, 13, 12, 0, 0, }, /* 615 */
- { 62, 7, 12, 0, 0, }, /* 616 */
- { 62, 14, 12, 0, 0, }, /* 617 */
- { 62, 21, 12, 0, 0, }, /* 618 */
- { 79, 7, 12, 0, 0, }, /* 619 */
- { 98, 7, 12, 0, 0, }, /* 620 */
- { 98, 10, 5, 0, 0, }, /* 621 */
- { 98, 12, 3, 0, 0, }, /* 622 */
- { 98, 6, 12, 0, 0, }, /* 623 */
- { 9, 10, 3, 0, 0, }, /* 624 */
- { 19, 12, 3, 0, 0, }, /* 625 */
- { 9, 26, 11, 0, 0, }, /* 626 */
- { 26, 26, 12, 0, 0, }, /* 627 */
+ { 33, 5, 12, 0, 42319, }, /* 86 */
+ { 33, 5, 12, 0, 42315, }, /* 87 */
+ { 33, 5, 12, 0, -207, }, /* 88 */
+ { 33, 5, 12, 0, 42280, }, /* 89 */
+ { 33, 5, 12, 0, 42308, }, /* 90 */
+ { 33, 5, 12, 0, -209, }, /* 91 */
+ { 33, 5, 12, 0, -211, }, /* 92 */
+ { 33, 5, 12, 0, 10743, }, /* 93 */
+ { 33, 5, 12, 0, 42305, }, /* 94 */
+ { 33, 5, 12, 0, 10749, }, /* 95 */
+ { 33, 5, 12, 0, -213, }, /* 96 */
+ { 33, 5, 12, 0, -214, }, /* 97 */
+ { 33, 5, 12, 0, 10727, }, /* 98 */
+ { 33, 5, 12, 0, -218, }, /* 99 */
+ { 33, 5, 12, 0, 42282, }, /* 100 */
+ { 33, 5, 12, 0, -69, }, /* 101 */
+ { 33, 5, 12, 0, -217, }, /* 102 */
+ { 33, 5, 12, 0, -71, }, /* 103 */
+ { 33, 5, 12, 0, -219, }, /* 104 */
+ { 33, 5, 12, 0, 42258, }, /* 105 */
+ { 33, 6, 12, 0, 0, }, /* 106 */
+ { 9, 6, 12, 0, 0, }, /* 107 */
+ { 3, 24, 12, 0, 0, }, /* 108 */
+ { 27, 12, 3, 0, 0, }, /* 109 */
+ { 27, 12, 3, 21, 116, }, /* 110 */
+ { 19, 9, 12, 0, 1, }, /* 111 */
+ { 19, 5, 12, 0, -1, }, /* 112 */
+ { 19, 24, 12, 0, 0, }, /* 113 */
+ { 9, 2, 12, 0, 0, }, /* 114 */
+ { 19, 6, 12, 0, 0, }, /* 115 */
+ { 19, 5, 12, 0, 130, }, /* 116 */
+ { 19, 9, 12, 0, 116, }, /* 117 */
+ { 19, 9, 12, 0, 38, }, /* 118 */
+ { 19, 9, 12, 0, 37, }, /* 119 */
+ { 19, 9, 12, 0, 64, }, /* 120 */
+ { 19, 9, 12, 0, 63, }, /* 121 */
+ { 19, 5, 12, 0, 0, }, /* 122 */
+ { 19, 9, 12, 0, 32, }, /* 123 */
+ { 19, 9, 12, 34, 32, }, /* 124 */
+ { 19, 9, 12, 59, 32, }, /* 125 */
+ { 19, 9, 12, 38, 32, }, /* 126 */
+ { 19, 9, 12, 21, 32, }, /* 127 */
+ { 19, 9, 12, 51, 32, }, /* 128 */
+ { 19, 9, 12, 26, 32, }, /* 129 */
+ { 19, 9, 12, 47, 32, }, /* 130 */
+ { 19, 9, 12, 55, 32, }, /* 131 */
+ { 19, 9, 12, 30, 32, }, /* 132 */
+ { 19, 9, 12, 43, 32, }, /* 133 */
+ { 19, 9, 12, 67, 32, }, /* 134 */
+ { 19, 5, 12, 0, -38, }, /* 135 */
+ { 19, 5, 12, 0, -37, }, /* 136 */
+ { 19, 5, 12, 0, -32, }, /* 137 */
+ { 19, 5, 12, 34, -32, }, /* 138 */
+ { 19, 5, 12, 59, -32, }, /* 139 */
+ { 19, 5, 12, 38, -32, }, /* 140 */
+ { 19, 5, 12, 21, -116, }, /* 141 */
+ { 19, 5, 12, 51, -32, }, /* 142 */
+ { 19, 5, 12, 26, -775, }, /* 143 */
+ { 19, 5, 12, 47, -32, }, /* 144 */
+ { 19, 5, 12, 55, -32, }, /* 145 */
+ { 19, 5, 12, 30, 1, }, /* 146 */
+ { 19, 5, 12, 30, -32, }, /* 147 */
+ { 19, 5, 12, 43, -32, }, /* 148 */
+ { 19, 5, 12, 67, -32, }, /* 149 */
+ { 19, 5, 12, 0, -64, }, /* 150 */
+ { 19, 5, 12, 0, -63, }, /* 151 */
+ { 19, 9, 12, 0, 8, }, /* 152 */
+ { 19, 5, 12, 34, -30, }, /* 153 */
+ { 19, 5, 12, 38, -25, }, /* 154 */
+ { 19, 9, 12, 0, 0, }, /* 155 */
+ { 19, 5, 12, 43, -15, }, /* 156 */
+ { 19, 5, 12, 47, -22, }, /* 157 */
+ { 19, 5, 12, 0, -8, }, /* 158 */
+ { 10, 9, 12, 0, 1, }, /* 159 */
+ { 10, 5, 12, 0, -1, }, /* 160 */
+ { 19, 5, 12, 51, -54, }, /* 161 */
+ { 19, 5, 12, 55, -48, }, /* 162 */
+ { 19, 5, 12, 0, 7, }, /* 163 */
+ { 19, 5, 12, 0, -116, }, /* 164 */
+ { 19, 9, 12, 38, -60, }, /* 165 */
+ { 19, 5, 12, 59, -64, }, /* 166 */
+ { 19, 25, 12, 0, 0, }, /* 167 */
+ { 19, 9, 12, 0, -7, }, /* 168 */
+ { 19, 9, 12, 0, -130, }, /* 169 */
+ { 12, 9, 12, 0, 80, }, /* 170 */
+ { 12, 9, 12, 0, 32, }, /* 171 */
+ { 12, 5, 12, 0, -32, }, /* 172 */
+ { 12, 5, 12, 0, -80, }, /* 173 */
+ { 12, 9, 12, 0, 1, }, /* 174 */
+ { 12, 5, 12, 0, -1, }, /* 175 */
+ { 12, 26, 12, 0, 0, }, /* 176 */
+ { 12, 12, 3, 0, 0, }, /* 177 */
+ { 12, 11, 3, 0, 0, }, /* 178 */
+ { 12, 9, 12, 0, 15, }, /* 179 */
+ { 12, 5, 12, 0, -15, }, /* 180 */
+ { 1, 9, 12, 0, 48, }, /* 181 */
+ { 1, 6, 12, 0, 0, }, /* 182 */
+ { 1, 21, 12, 0, 0, }, /* 183 */
+ { 1, 5, 12, 0, -48, }, /* 184 */
+ { 1, 5, 12, 0, 0, }, /* 185 */
+ { 1, 17, 12, 0, 0, }, /* 186 */
+ { 1, 26, 12, 0, 0, }, /* 187 */
+ { 1, 23, 12, 0, 0, }, /* 188 */
+ { 25, 12, 3, 0, 0, }, /* 189 */
+ { 25, 17, 12, 0, 0, }, /* 190 */
+ { 25, 21, 12, 0, 0, }, /* 191 */
+ { 25, 7, 12, 0, 0, }, /* 192 */
+ { 0, 1, 2, 0, 0, }, /* 193 */
+ { 0, 25, 12, 0, 0, }, /* 194 */
+ { 0, 21, 12, 0, 0, }, /* 195 */
+ { 0, 23, 12, 0, 0, }, /* 196 */
+ { 0, 26, 12, 0, 0, }, /* 197 */
+ { 0, 12, 3, 0, 0, }, /* 198 */
+ { 0, 7, 12, 0, 0, }, /* 199 */
+ { 0, 6, 12, 0, 0, }, /* 200 */
+ { 0, 13, 12, 0, 0, }, /* 201 */
+ { 49, 21, 12, 0, 0, }, /* 202 */
+ { 49, 1, 2, 0, 0, }, /* 203 */
+ { 49, 7, 12, 0, 0, }, /* 204 */
+ { 49, 12, 3, 0, 0, }, /* 205 */
+ { 55, 7, 12, 0, 0, }, /* 206 */
+ { 55, 12, 3, 0, 0, }, /* 207 */
+ { 63, 13, 12, 0, 0, }, /* 208 */
+ { 63, 7, 12, 0, 0, }, /* 209 */
+ { 63, 12, 3, 0, 0, }, /* 210 */
+ { 63, 6, 12, 0, 0, }, /* 211 */
+ { 63, 26, 12, 0, 0, }, /* 212 */
+ { 63, 21, 12, 0, 0, }, /* 213 */
+ { 89, 7, 12, 0, 0, }, /* 214 */
+ { 89, 12, 3, 0, 0, }, /* 215 */
+ { 89, 6, 12, 0, 0, }, /* 216 */
+ { 89, 21, 12, 0, 0, }, /* 217 */
+ { 94, 7, 12, 0, 0, }, /* 218 */
+ { 94, 12, 3, 0, 0, }, /* 219 */
+ { 94, 21, 12, 0, 0, }, /* 220 */
+ { 14, 12, 3, 0, 0, }, /* 221 */
+ { 14, 10, 5, 0, 0, }, /* 222 */
+ { 14, 7, 12, 0, 0, }, /* 223 */
+ { 14, 13, 12, 0, 0, }, /* 224 */
+ { 14, 21, 12, 0, 0, }, /* 225 */
+ { 14, 6, 12, 0, 0, }, /* 226 */
+ { 2, 7, 12, 0, 0, }, /* 227 */
+ { 2, 12, 3, 0, 0, }, /* 228 */
+ { 2, 10, 5, 0, 0, }, /* 229 */
+ { 2, 10, 3, 0, 0, }, /* 230 */
+ { 2, 13, 12, 0, 0, }, /* 231 */
+ { 2, 23, 12, 0, 0, }, /* 232 */
+ { 2, 15, 12, 0, 0, }, /* 233 */
+ { 2, 26, 12, 0, 0, }, /* 234 */
+ { 21, 12, 3, 0, 0, }, /* 235 */
+ { 21, 10, 5, 0, 0, }, /* 236 */
+ { 21, 7, 12, 0, 0, }, /* 237 */
+ { 21, 13, 12, 0, 0, }, /* 238 */
+ { 20, 12, 3, 0, 0, }, /* 239 */
+ { 20, 10, 5, 0, 0, }, /* 240 */
+ { 20, 7, 12, 0, 0, }, /* 241 */
+ { 20, 13, 12, 0, 0, }, /* 242 */
+ { 20, 21, 12, 0, 0, }, /* 243 */
+ { 20, 23, 12, 0, 0, }, /* 244 */
+ { 43, 12, 3, 0, 0, }, /* 245 */
+ { 43, 10, 5, 0, 0, }, /* 246 */
+ { 43, 7, 12, 0, 0, }, /* 247 */
+ { 43, 10, 3, 0, 0, }, /* 248 */
+ { 43, 13, 12, 0, 0, }, /* 249 */
+ { 43, 26, 12, 0, 0, }, /* 250 */
+ { 43, 15, 12, 0, 0, }, /* 251 */
+ { 53, 12, 3, 0, 0, }, /* 252 */
+ { 53, 7, 12, 0, 0, }, /* 253 */
+ { 53, 10, 3, 0, 0, }, /* 254 */
+ { 53, 10, 5, 0, 0, }, /* 255 */
+ { 53, 13, 12, 0, 0, }, /* 256 */
+ { 53, 15, 12, 0, 0, }, /* 257 */
+ { 53, 26, 12, 0, 0, }, /* 258 */
+ { 53, 23, 12, 0, 0, }, /* 259 */
+ { 54, 12, 3, 0, 0, }, /* 260 */
+ { 54, 10, 5, 0, 0, }, /* 261 */
+ { 54, 7, 12, 0, 0, }, /* 262 */
+ { 54, 13, 12, 0, 0, }, /* 263 */
+ { 54, 15, 12, 0, 0, }, /* 264 */
+ { 54, 26, 12, 0, 0, }, /* 265 */
+ { 28, 12, 3, 0, 0, }, /* 266 */
+ { 28, 10, 5, 0, 0, }, /* 267 */
+ { 28, 7, 12, 0, 0, }, /* 268 */
+ { 28, 10, 3, 0, 0, }, /* 269 */
+ { 28, 13, 12, 0, 0, }, /* 270 */
+ { 36, 12, 3, 0, 0, }, /* 271 */
+ { 36, 10, 5, 0, 0, }, /* 272 */
+ { 36, 7, 12, 0, 0, }, /* 273 */
+ { 36, 10, 3, 0, 0, }, /* 274 */
+ { 36, 13, 12, 0, 0, }, /* 275 */
+ { 36, 15, 12, 0, 0, }, /* 276 */
+ { 36, 26, 12, 0, 0, }, /* 277 */
+ { 47, 10, 5, 0, 0, }, /* 278 */
+ { 47, 7, 12, 0, 0, }, /* 279 */
+ { 47, 12, 3, 0, 0, }, /* 280 */
+ { 47, 10, 3, 0, 0, }, /* 281 */
+ { 47, 13, 12, 0, 0, }, /* 282 */
+ { 47, 21, 12, 0, 0, }, /* 283 */
+ { 56, 7, 12, 0, 0, }, /* 284 */
+ { 56, 12, 3, 0, 0, }, /* 285 */
+ { 56, 7, 5, 0, 0, }, /* 286 */
+ { 56, 6, 12, 0, 0, }, /* 287 */
+ { 56, 21, 12, 0, 0, }, /* 288 */
+ { 56, 13, 12, 0, 0, }, /* 289 */
+ { 32, 7, 12, 0, 0, }, /* 290 */
+ { 32, 12, 3, 0, 0, }, /* 291 */
+ { 32, 7, 5, 0, 0, }, /* 292 */
+ { 32, 6, 12, 0, 0, }, /* 293 */
+ { 32, 13, 12, 0, 0, }, /* 294 */
+ { 57, 7, 12, 0, 0, }, /* 295 */
+ { 57, 26, 12, 0, 0, }, /* 296 */
+ { 57, 21, 12, 0, 0, }, /* 297 */
+ { 57, 12, 3, 0, 0, }, /* 298 */
+ { 57, 13, 12, 0, 0, }, /* 299 */
+ { 57, 15, 12, 0, 0, }, /* 300 */
+ { 57, 22, 12, 0, 0, }, /* 301 */
+ { 57, 18, 12, 0, 0, }, /* 302 */
+ { 57, 10, 5, 0, 0, }, /* 303 */
+ { 38, 7, 12, 0, 0, }, /* 304 */
+ { 38, 10, 12, 0, 0, }, /* 305 */
+ { 38, 12, 3, 0, 0, }, /* 306 */
+ { 38, 10, 5, 0, 0, }, /* 307 */
+ { 38, 13, 12, 0, 0, }, /* 308 */
+ { 38, 21, 12, 0, 0, }, /* 309 */
+ { 38, 26, 12, 0, 0, }, /* 310 */
+ { 16, 9, 12, 0, 7264, }, /* 311 */
+ { 16, 7, 12, 0, 0, }, /* 312 */
+ { 16, 6, 12, 0, 0, }, /* 313 */
+ { 23, 7, 6, 0, 0, }, /* 314 */
+ { 23, 7, 7, 0, 0, }, /* 315 */
+ { 23, 7, 8, 0, 0, }, /* 316 */
+ { 15, 7, 12, 0, 0, }, /* 317 */
+ { 15, 12, 3, 0, 0, }, /* 318 */
+ { 15, 21, 12, 0, 0, }, /* 319 */
+ { 15, 15, 12, 0, 0, }, /* 320 */
+ { 15, 26, 12, 0, 0, }, /* 321 */
+ { 8, 7, 12, 0, 0, }, /* 322 */
+ { 7, 17, 12, 0, 0, }, /* 323 */
+ { 7, 7, 12, 0, 0, }, /* 324 */
+ { 7, 21, 12, 0, 0, }, /* 325 */
+ { 40, 29, 12, 0, 0, }, /* 326 */
+ { 40, 7, 12, 0, 0, }, /* 327 */
+ { 40, 22, 12, 0, 0, }, /* 328 */
+ { 40, 18, 12, 0, 0, }, /* 329 */
+ { 45, 7, 12, 0, 0, }, /* 330 */
+ { 45, 14, 12, 0, 0, }, /* 331 */
+ { 50, 7, 12, 0, 0, }, /* 332 */
+ { 50, 12, 3, 0, 0, }, /* 333 */
+ { 24, 7, 12, 0, 0, }, /* 334 */
+ { 24, 12, 3, 0, 0, }, /* 335 */
+ { 6, 7, 12, 0, 0, }, /* 336 */
+ { 6, 12, 3, 0, 0, }, /* 337 */
+ { 51, 7, 12, 0, 0, }, /* 338 */
+ { 51, 12, 3, 0, 0, }, /* 339 */
+ { 31, 7, 12, 0, 0, }, /* 340 */
+ { 31, 12, 3, 0, 0, }, /* 341 */
+ { 31, 10, 5, 0, 0, }, /* 342 */
+ { 31, 21, 12, 0, 0, }, /* 343 */
+ { 31, 6, 12, 0, 0, }, /* 344 */
+ { 31, 23, 12, 0, 0, }, /* 345 */
+ { 31, 13, 12, 0, 0, }, /* 346 */
+ { 31, 15, 12, 0, 0, }, /* 347 */
+ { 37, 21, 12, 0, 0, }, /* 348 */
+ { 37, 17, 12, 0, 0, }, /* 349 */
+ { 37, 12, 3, 0, 0, }, /* 350 */
+ { 37, 1, 2, 0, 0, }, /* 351 */
+ { 37, 13, 12, 0, 0, }, /* 352 */
+ { 37, 7, 12, 0, 0, }, /* 353 */
+ { 37, 6, 12, 0, 0, }, /* 354 */
+ { 34, 7, 12, 0, 0, }, /* 355 */
+ { 34, 12, 3, 0, 0, }, /* 356 */
+ { 34, 10, 5, 0, 0, }, /* 357 */
+ { 34, 26, 12, 0, 0, }, /* 358 */
+ { 34, 21, 12, 0, 0, }, /* 359 */
+ { 34, 13, 12, 0, 0, }, /* 360 */
+ { 52, 7, 12, 0, 0, }, /* 361 */
+ { 39, 7, 12, 0, 0, }, /* 362 */
+ { 39, 10, 12, 0, 0, }, /* 363 */
+ { 39, 10, 5, 0, 0, }, /* 364 */
+ { 39, 13, 12, 0, 0, }, /* 365 */
+ { 39, 15, 12, 0, 0, }, /* 366 */
+ { 39, 26, 12, 0, 0, }, /* 367 */
+ { 31, 26, 12, 0, 0, }, /* 368 */
+ { 5, 7, 12, 0, 0, }, /* 369 */
+ { 5, 12, 3, 0, 0, }, /* 370 */
+ { 5, 10, 5, 0, 0, }, /* 371 */
+ { 5, 21, 12, 0, 0, }, /* 372 */
+ { 90, 7, 12, 0, 0, }, /* 373 */
+ { 90, 10, 5, 0, 0, }, /* 374 */
+ { 90, 12, 3, 0, 0, }, /* 375 */
+ { 90, 10, 12, 0, 0, }, /* 376 */
+ { 90, 13, 12, 0, 0, }, /* 377 */
+ { 90, 21, 12, 0, 0, }, /* 378 */
+ { 90, 6, 12, 0, 0, }, /* 379 */
+ { 27, 11, 3, 0, 0, }, /* 380 */
+ { 61, 12, 3, 0, 0, }, /* 381 */
+ { 61, 10, 5, 0, 0, }, /* 382 */
+ { 61, 7, 12, 0, 0, }, /* 383 */
+ { 61, 13, 12, 0, 0, }, /* 384 */
+ { 61, 21, 12, 0, 0, }, /* 385 */
+ { 61, 26, 12, 0, 0, }, /* 386 */
+ { 75, 12, 3, 0, 0, }, /* 387 */
+ { 75, 10, 5, 0, 0, }, /* 388 */
+ { 75, 7, 12, 0, 0, }, /* 389 */
+ { 75, 13, 12, 0, 0, }, /* 390 */
+ { 92, 7, 12, 0, 0, }, /* 391 */
+ { 92, 12, 3, 0, 0, }, /* 392 */
+ { 92, 10, 5, 0, 0, }, /* 393 */
+ { 92, 21, 12, 0, 0, }, /* 394 */
+ { 69, 7, 12, 0, 0, }, /* 395 */
+ { 69, 10, 5, 0, 0, }, /* 396 */
+ { 69, 12, 3, 0, 0, }, /* 397 */
+ { 69, 21, 12, 0, 0, }, /* 398 */
+ { 69, 13, 12, 0, 0, }, /* 399 */
+ { 72, 13, 12, 0, 0, }, /* 400 */
+ { 72, 7, 12, 0, 0, }, /* 401 */
+ { 72, 6, 12, 0, 0, }, /* 402 */
+ { 72, 21, 12, 0, 0, }, /* 403 */
+ { 75, 21, 12, 0, 0, }, /* 404 */
+ { 9, 10, 5, 0, 0, }, /* 405 */
+ { 9, 7, 12, 0, 0, }, /* 406 */
+ { 12, 5, 12, 0, 0, }, /* 407 */
+ { 12, 6, 12, 0, 0, }, /* 408 */
+ { 33, 5, 12, 0, 35332, }, /* 409 */
+ { 33, 5, 12, 0, 3814, }, /* 410 */
+ { 33, 9, 12, 63, 1, }, /* 411 */
+ { 33, 5, 12, 63, -1, }, /* 412 */
+ { 33, 5, 12, 63, -58, }, /* 413 */
+ { 33, 9, 12, 0, -7615, }, /* 414 */
+ { 19, 5, 12, 0, 8, }, /* 415 */
+ { 19, 9, 12, 0, -8, }, /* 416 */
+ { 19, 5, 12, 0, 74, }, /* 417 */
+ { 19, 5, 12, 0, 86, }, /* 418 */
+ { 19, 5, 12, 0, 100, }, /* 419 */
+ { 19, 5, 12, 0, 128, }, /* 420 */
+ { 19, 5, 12, 0, 112, }, /* 421 */
+ { 19, 5, 12, 0, 126, }, /* 422 */
+ { 19, 8, 12, 0, -8, }, /* 423 */
+ { 19, 5, 12, 0, 9, }, /* 424 */
+ { 19, 9, 12, 0, -74, }, /* 425 */
+ { 19, 8, 12, 0, -9, }, /* 426 */
+ { 19, 5, 12, 21, -7173, }, /* 427 */
+ { 19, 9, 12, 0, -86, }, /* 428 */
+ { 19, 9, 12, 0, -100, }, /* 429 */
+ { 19, 9, 12, 0, -112, }, /* 430 */
+ { 19, 9, 12, 0, -128, }, /* 431 */
+ { 19, 9, 12, 0, -126, }, /* 432 */
+ { 27, 1, 3, 0, 0, }, /* 433 */
+ { 9, 27, 2, 0, 0, }, /* 434 */
+ { 9, 28, 2, 0, 0, }, /* 435 */
+ { 9, 2, 2, 0, 0, }, /* 436 */
+ { 9, 9, 12, 0, 0, }, /* 437 */
+ { 9, 5, 12, 0, 0, }, /* 438 */
+ { 19, 9, 12, 67, -7517, }, /* 439 */
+ { 33, 9, 12, 71, -8383, }, /* 440 */
+ { 33, 9, 12, 75, -8262, }, /* 441 */
+ { 33, 9, 12, 0, 28, }, /* 442 */
+ { 33, 5, 12, 0, -28, }, /* 443 */
+ { 33, 14, 12, 0, 16, }, /* 444 */
+ { 33, 14, 12, 0, -16, }, /* 445 */
+ { 33, 14, 12, 0, 0, }, /* 446 */
+ { 9, 26, 12, 0, 26, }, /* 447 */
+ { 9, 26, 12, 0, -26, }, /* 448 */
+ { 4, 26, 12, 0, 0, }, /* 449 */
+ { 17, 9, 12, 0, 48, }, /* 450 */
+ { 17, 5, 12, 0, -48, }, /* 451 */
+ { 33, 9, 12, 0, -10743, }, /* 452 */
+ { 33, 9, 12, 0, -3814, }, /* 453 */
+ { 33, 9, 12, 0, -10727, }, /* 454 */
+ { 33, 5, 12, 0, -10795, }, /* 455 */
+ { 33, 5, 12, 0, -10792, }, /* 456 */
+ { 33, 9, 12, 0, -10780, }, /* 457 */
+ { 33, 9, 12, 0, -10749, }, /* 458 */
+ { 33, 9, 12, 0, -10783, }, /* 459 */
+ { 33, 9, 12, 0, -10782, }, /* 460 */
+ { 33, 9, 12, 0, -10815, }, /* 461 */
+ { 10, 5, 12, 0, 0, }, /* 462 */
+ { 10, 26, 12, 0, 0, }, /* 463 */
+ { 10, 12, 3, 0, 0, }, /* 464 */
+ { 10, 21, 12, 0, 0, }, /* 465 */
+ { 10, 15, 12, 0, 0, }, /* 466 */
+ { 16, 5, 12, 0, -7264, }, /* 467 */
+ { 58, 7, 12, 0, 0, }, /* 468 */
+ { 58, 6, 12, 0, 0, }, /* 469 */
+ { 58, 21, 12, 0, 0, }, /* 470 */
+ { 58, 12, 3, 0, 0, }, /* 471 */
+ { 22, 26, 12, 0, 0, }, /* 472 */
+ { 22, 6, 12, 0, 0, }, /* 473 */
+ { 22, 14, 12, 0, 0, }, /* 474 */
+ { 23, 10, 3, 0, 0, }, /* 475 */
+ { 26, 7, 12, 0, 0, }, /* 476 */
+ { 26, 6, 12, 0, 0, }, /* 477 */
+ { 29, 7, 12, 0, 0, }, /* 478 */
+ { 29, 6, 12, 0, 0, }, /* 479 */
+ { 3, 7, 12, 0, 0, }, /* 480 */
+ { 23, 7, 12, 0, 0, }, /* 481 */
+ { 23, 26, 12, 0, 0, }, /* 482 */
+ { 29, 26, 12, 0, 0, }, /* 483 */
+ { 22, 7, 12, 0, 0, }, /* 484 */
+ { 60, 7, 12, 0, 0, }, /* 485 */
+ { 60, 6, 12, 0, 0, }, /* 486 */
+ { 60, 26, 12, 0, 0, }, /* 487 */
+ { 85, 7, 12, 0, 0, }, /* 488 */
+ { 85, 6, 12, 0, 0, }, /* 489 */
+ { 85, 21, 12, 0, 0, }, /* 490 */
+ { 76, 7, 12, 0, 0, }, /* 491 */
+ { 76, 6, 12, 0, 0, }, /* 492 */
+ { 76, 21, 12, 0, 0, }, /* 493 */
+ { 76, 13, 12, 0, 0, }, /* 494 */
+ { 12, 7, 12, 0, 0, }, /* 495 */
+ { 12, 21, 12, 0, 0, }, /* 496 */
+ { 78, 7, 12, 0, 0, }, /* 497 */
+ { 78, 14, 12, 0, 0, }, /* 498 */
+ { 78, 12, 3, 0, 0, }, /* 499 */
+ { 78, 21, 12, 0, 0, }, /* 500 */
+ { 33, 9, 12, 0, -35332, }, /* 501 */
+ { 33, 9, 12, 0, -42280, }, /* 502 */
+ { 33, 9, 12, 0, -42308, }, /* 503 */
+ { 33, 9, 12, 0, -42319, }, /* 504 */
+ { 33, 9, 12, 0, -42315, }, /* 505 */
+ { 33, 9, 12, 0, -42305, }, /* 506 */
+ { 33, 9, 12, 0, -42258, }, /* 507 */
+ { 33, 9, 12, 0, -42282, }, /* 508 */
+ { 48, 7, 12, 0, 0, }, /* 509 */
+ { 48, 12, 3, 0, 0, }, /* 510 */
+ { 48, 10, 5, 0, 0, }, /* 511 */
+ { 48, 26, 12, 0, 0, }, /* 512 */
+ { 64, 7, 12, 0, 0, }, /* 513 */
+ { 64, 21, 12, 0, 0, }, /* 514 */
+ { 74, 10, 5, 0, 0, }, /* 515 */
+ { 74, 7, 12, 0, 0, }, /* 516 */
+ { 74, 12, 3, 0, 0, }, /* 517 */
+ { 74, 21, 12, 0, 0, }, /* 518 */
+ { 74, 13, 12, 0, 0, }, /* 519 */
+ { 68, 13, 12, 0, 0, }, /* 520 */
+ { 68, 7, 12, 0, 0, }, /* 521 */
+ { 68, 12, 3, 0, 0, }, /* 522 */
+ { 68, 21, 12, 0, 0, }, /* 523 */
+ { 73, 7, 12, 0, 0, }, /* 524 */
+ { 73, 12, 3, 0, 0, }, /* 525 */
+ { 73, 10, 5, 0, 0, }, /* 526 */
+ { 73, 21, 12, 0, 0, }, /* 527 */
+ { 83, 12, 3, 0, 0, }, /* 528 */
+ { 83, 10, 5, 0, 0, }, /* 529 */
+ { 83, 7, 12, 0, 0, }, /* 530 */
+ { 83, 21, 12, 0, 0, }, /* 531 */
+ { 83, 13, 12, 0, 0, }, /* 532 */
+ { 38, 6, 12, 0, 0, }, /* 533 */
+ { 67, 7, 12, 0, 0, }, /* 534 */
+ { 67, 12, 3, 0, 0, }, /* 535 */
+ { 67, 10, 5, 0, 0, }, /* 536 */
+ { 67, 13, 12, 0, 0, }, /* 537 */
+ { 67, 21, 12, 0, 0, }, /* 538 */
+ { 91, 7, 12, 0, 0, }, /* 539 */
+ { 91, 12, 3, 0, 0, }, /* 540 */
+ { 91, 6, 12, 0, 0, }, /* 541 */
+ { 91, 21, 12, 0, 0, }, /* 542 */
+ { 86, 7, 12, 0, 0, }, /* 543 */
+ { 86, 10, 5, 0, 0, }, /* 544 */
+ { 86, 12, 3, 0, 0, }, /* 545 */
+ { 86, 21, 12, 0, 0, }, /* 546 */
+ { 86, 6, 12, 0, 0, }, /* 547 */
+ { 86, 13, 12, 0, 0, }, /* 548 */
+ { 23, 7, 9, 0, 0, }, /* 549 */
+ { 23, 7, 10, 0, 0, }, /* 550 */
+ { 9, 4, 2, 0, 0, }, /* 551 */
+ { 9, 3, 12, 0, 0, }, /* 552 */
+ { 25, 25, 12, 0, 0, }, /* 553 */
+ { 0, 24, 12, 0, 0, }, /* 554 */
+ { 9, 6, 3, 0, 0, }, /* 555 */
+ { 35, 7, 12, 0, 0, }, /* 556 */
+ { 19, 14, 12, 0, 0, }, /* 557 */
+ { 19, 15, 12, 0, 0, }, /* 558 */
+ { 19, 26, 12, 0, 0, }, /* 559 */
+ { 70, 7, 12, 0, 0, }, /* 560 */
+ { 66, 7, 12, 0, 0, }, /* 561 */
+ { 41, 7, 12, 0, 0, }, /* 562 */
+ { 41, 15, 12, 0, 0, }, /* 563 */
+ { 18, 7, 12, 0, 0, }, /* 564 */
+ { 18, 14, 12, 0, 0, }, /* 565 */
+ { 117, 7, 12, 0, 0, }, /* 566 */
+ { 117, 12, 3, 0, 0, }, /* 567 */
+ { 59, 7, 12, 0, 0, }, /* 568 */
+ { 59, 21, 12, 0, 0, }, /* 569 */
+ { 42, 7, 12, 0, 0, }, /* 570 */
+ { 42, 21, 12, 0, 0, }, /* 571 */
+ { 42, 14, 12, 0, 0, }, /* 572 */
+ { 13, 9, 12, 0, 40, }, /* 573 */
+ { 13, 5, 12, 0, -40, }, /* 574 */
+ { 46, 7, 12, 0, 0, }, /* 575 */
+ { 44, 7, 12, 0, 0, }, /* 576 */
+ { 44, 13, 12, 0, 0, }, /* 577 */
+ { 105, 7, 12, 0, 0, }, /* 578 */
+ { 103, 7, 12, 0, 0, }, /* 579 */
+ { 103, 21, 12, 0, 0, }, /* 580 */
+ { 109, 7, 12, 0, 0, }, /* 581 */
+ { 11, 7, 12, 0, 0, }, /* 582 */
+ { 80, 7, 12, 0, 0, }, /* 583 */
+ { 80, 21, 12, 0, 0, }, /* 584 */
+ { 80, 15, 12, 0, 0, }, /* 585 */
+ { 119, 7, 12, 0, 0, }, /* 586 */
+ { 119, 26, 12, 0, 0, }, /* 587 */
+ { 119, 15, 12, 0, 0, }, /* 588 */
+ { 115, 7, 12, 0, 0, }, /* 589 */
+ { 115, 15, 12, 0, 0, }, /* 590 */
+ { 65, 7, 12, 0, 0, }, /* 591 */
+ { 65, 15, 12, 0, 0, }, /* 592 */
+ { 65, 21, 12, 0, 0, }, /* 593 */
+ { 71, 7, 12, 0, 0, }, /* 594 */
+ { 71, 21, 12, 0, 0, }, /* 595 */
+ { 97, 7, 12, 0, 0, }, /* 596 */
+ { 96, 7, 12, 0, 0, }, /* 597 */
+ { 30, 7, 12, 0, 0, }, /* 598 */
+ { 30, 12, 3, 0, 0, }, /* 599 */
+ { 30, 15, 12, 0, 0, }, /* 600 */
+ { 30, 21, 12, 0, 0, }, /* 601 */
+ { 87, 7, 12, 0, 0, }, /* 602 */
+ { 87, 15, 12, 0, 0, }, /* 603 */
+ { 87, 21, 12, 0, 0, }, /* 604 */
+ { 116, 7, 12, 0, 0, }, /* 605 */
+ { 116, 15, 12, 0, 0, }, /* 606 */
+ { 111, 7, 12, 0, 0, }, /* 607 */
+ { 111, 26, 12, 0, 0, }, /* 608 */
+ { 111, 12, 3, 0, 0, }, /* 609 */
+ { 111, 15, 12, 0, 0, }, /* 610 */
+ { 111, 21, 12, 0, 0, }, /* 611 */
+ { 77, 7, 12, 0, 0, }, /* 612 */
+ { 77, 21, 12, 0, 0, }, /* 613 */
+ { 82, 7, 12, 0, 0, }, /* 614 */
+ { 82, 15, 12, 0, 0, }, /* 615 */
+ { 81, 7, 12, 0, 0, }, /* 616 */
+ { 81, 15, 12, 0, 0, }, /* 617 */
+ { 120, 7, 12, 0, 0, }, /* 618 */
+ { 120, 21, 12, 0, 0, }, /* 619 */
+ { 120, 15, 12, 0, 0, }, /* 620 */
+ { 88, 7, 12, 0, 0, }, /* 621 */
+ { 0, 15, 12, 0, 0, }, /* 622 */
+ { 93, 10, 5, 0, 0, }, /* 623 */
+ { 93, 12, 3, 0, 0, }, /* 624 */
+ { 93, 7, 12, 0, 0, }, /* 625 */
+ { 93, 21, 12, 0, 0, }, /* 626 */
+ { 93, 15, 12, 0, 0, }, /* 627 */
+ { 93, 13, 12, 0, 0, }, /* 628 */
+ { 84, 12, 3, 0, 0, }, /* 629 */
+ { 84, 10, 5, 0, 0, }, /* 630 */
+ { 84, 7, 12, 0, 0, }, /* 631 */
+ { 84, 21, 12, 0, 0, }, /* 632 */
+ { 84, 1, 2, 0, 0, }, /* 633 */
+ { 100, 7, 12, 0, 0, }, /* 634 */
+ { 100, 13, 12, 0, 0, }, /* 635 */
+ { 95, 12, 3, 0, 0, }, /* 636 */
+ { 95, 7, 12, 0, 0, }, /* 637 */
+ { 95, 10, 5, 0, 0, }, /* 638 */
+ { 95, 13, 12, 0, 0, }, /* 639 */
+ { 95, 21, 12, 0, 0, }, /* 640 */
+ { 110, 7, 12, 0, 0, }, /* 641 */
+ { 110, 12, 3, 0, 0, }, /* 642 */
+ { 110, 21, 12, 0, 0, }, /* 643 */
+ { 99, 12, 3, 0, 0, }, /* 644 */
+ { 99, 10, 5, 0, 0, }, /* 645 */
+ { 99, 7, 12, 0, 0, }, /* 646 */
+ { 99, 21, 12, 0, 0, }, /* 647 */
+ { 99, 13, 12, 0, 0, }, /* 648 */
+ { 47, 15, 12, 0, 0, }, /* 649 */
+ { 107, 7, 12, 0, 0, }, /* 650 */
+ { 107, 10, 5, 0, 0, }, /* 651 */
+ { 107, 12, 3, 0, 0, }, /* 652 */
+ { 107, 21, 12, 0, 0, }, /* 653 */
+ { 108, 7, 12, 0, 0, }, /* 654 */
+ { 108, 12, 3, 0, 0, }, /* 655 */
+ { 108, 10, 5, 0, 0, }, /* 656 */
+ { 108, 13, 12, 0, 0, }, /* 657 */
+ { 106, 12, 3, 0, 0, }, /* 658 */
+ { 106, 10, 5, 0, 0, }, /* 659 */
+ { 106, 7, 12, 0, 0, }, /* 660 */
+ { 106, 10, 3, 0, 0, }, /* 661 */
+ { 123, 7, 12, 0, 0, }, /* 662 */
+ { 123, 10, 3, 0, 0, }, /* 663 */
+ { 123, 10, 5, 0, 0, }, /* 664 */
+ { 123, 12, 3, 0, 0, }, /* 665 */
+ { 123, 21, 12, 0, 0, }, /* 666 */
+ { 123, 13, 12, 0, 0, }, /* 667 */
+ { 122, 7, 12, 0, 0, }, /* 668 */
+ { 122, 10, 3, 0, 0, }, /* 669 */
+ { 122, 10, 5, 0, 0, }, /* 670 */
+ { 122, 12, 3, 0, 0, }, /* 671 */
+ { 122, 21, 12, 0, 0, }, /* 672 */
+ { 113, 7, 12, 0, 0, }, /* 673 */
+ { 113, 10, 5, 0, 0, }, /* 674 */
+ { 113, 12, 3, 0, 0, }, /* 675 */
+ { 113, 21, 12, 0, 0, }, /* 676 */
+ { 113, 13, 12, 0, 0, }, /* 677 */
+ { 101, 7, 12, 0, 0, }, /* 678 */
+ { 101, 12, 3, 0, 0, }, /* 679 */
+ { 101, 10, 5, 0, 0, }, /* 680 */
+ { 101, 13, 12, 0, 0, }, /* 681 */
+ { 124, 9, 12, 0, 32, }, /* 682 */
+ { 124, 5, 12, 0, -32, }, /* 683 */
+ { 124, 13, 12, 0, 0, }, /* 684 */
+ { 124, 15, 12, 0, 0, }, /* 685 */
+ { 124, 7, 12, 0, 0, }, /* 686 */
+ { 121, 7, 12, 0, 0, }, /* 687 */
+ { 62, 7, 12, 0, 0, }, /* 688 */
+ { 62, 14, 12, 0, 0, }, /* 689 */
+ { 62, 21, 12, 0, 0, }, /* 690 */
+ { 79, 7, 12, 0, 0, }, /* 691 */
+ { 114, 7, 12, 0, 0, }, /* 692 */
+ { 114, 13, 12, 0, 0, }, /* 693 */
+ { 114, 21, 12, 0, 0, }, /* 694 */
+ { 102, 7, 12, 0, 0, }, /* 695 */
+ { 102, 12, 3, 0, 0, }, /* 696 */
+ { 102, 21, 12, 0, 0, }, /* 697 */
+ { 118, 7, 12, 0, 0, }, /* 698 */
+ { 118, 12, 3, 0, 0, }, /* 699 */
+ { 118, 21, 12, 0, 0, }, /* 700 */
+ { 118, 26, 12, 0, 0, }, /* 701 */
+ { 118, 6, 12, 0, 0, }, /* 702 */
+ { 118, 13, 12, 0, 0, }, /* 703 */
+ { 118, 15, 12, 0, 0, }, /* 704 */
+ { 98, 7, 12, 0, 0, }, /* 705 */
+ { 98, 10, 5, 0, 0, }, /* 706 */
+ { 98, 12, 3, 0, 0, }, /* 707 */
+ { 98, 6, 12, 0, 0, }, /* 708 */
+ { 104, 7, 12, 0, 0, }, /* 709 */
+ { 104, 26, 12, 0, 0, }, /* 710 */
+ { 104, 12, 3, 0, 0, }, /* 711 */
+ { 104, 21, 12, 0, 0, }, /* 712 */
+ { 9, 10, 3, 0, 0, }, /* 713 */
+ { 19, 12, 3, 0, 0, }, /* 714 */
+ { 112, 7, 12, 0, 0, }, /* 715 */
+ { 112, 15, 12, 0, 0, }, /* 716 */
+ { 112, 12, 3, 0, 0, }, /* 717 */
+ { 9, 26, 11, 0, 0, }, /* 718 */
+ { 26, 26, 12, 0, 0, }, /* 719 */
};
const pcre_uint8 PRIV(ucd_stage1)[] = { /* 8704 bytes */
@@ -743,38 +849,38 @@ const pcre_uint8 PRIV(ucd_stage1)[] = { /* 8704 bytes */
123,123,123,123,123,123,123,123,123,123,123,123,123,123,123,123, /* U+E800 */
123,123,123,123,123,123,123,123,123,123,123,123,123,123,123,123, /* U+F000 */
123,123, 95, 95,124,125,126,127,128,128,129,130,131,132,133,134, /* U+F800 */
-135,136,137,138, 79,139,140,141,142,143, 79, 79, 79, 79, 79, 79, /* U+10000 */
-144, 79,145,146,147, 79,148, 79,149, 79, 79, 79,150, 79, 79, 79, /* U+10800 */
-151,152,153,154, 79, 79, 79, 79, 79, 79, 79, 79, 79,155, 79, 79, /* U+11000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+11800 */
-156,156,156,156,156,156,157, 79,158, 79, 79, 79, 79, 79, 79, 79, /* U+12000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+12800 */
-159,159,159,159,159,159,159,159,160, 79, 79, 79, 79, 79, 79, 79, /* U+13000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+13800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+14000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+14800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+15000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+15800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+16000 */
-161,161,161,161,162, 79, 79, 79, 79, 79, 79, 79, 79, 79,163,164, /* U+16800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+17000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+17800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+18000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+18800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+19000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+19800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+1A000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+1A800 */
-165, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+1B000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+1B800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+1C000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+1C800 */
- 71,166,167,168,169, 79,170, 79,171,172,173,174,175,176,177,178, /* U+1D000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+1D800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+1E000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79,179,180, 79, 79, /* U+1E800 */
-181,182,183,184,185, 79,186,187,188,189,190,191,192,193,194, 79, /* U+1F000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+1F800 */
+135,136,137,138,139,140,141,142,143,144,145,139,146,146,147,139, /* U+10000 */
+148,149,150,151,152,153,154,155,156,139,139,139,157,139,139,139, /* U+10800 */
+158,159,160,161,162,163,164,139,139,165,139,166,167,168,139,139, /* U+11000 */
+139,169,139,139,139,170,139,139,139,139,139,139,139,139,139,139, /* U+11800 */
+171,171,171,171,171,171,171,172,173,139,139,139,139,139,139,139, /* U+12000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+12800 */
+174,174,174,174,174,174,174,174,175,139,139,139,139,139,139,139, /* U+13000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+13800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+14000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+14800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+15000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+15800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+16000 */
+176,176,176,176,177,178,179,180,139,139,139,139,139,139,181,182, /* U+16800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+17000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+17800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+18000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+18800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+19000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+19800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+1A000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+1A800 */
+183,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+1B000 */
+139,139,139,139,139,139,139,139,184,185,139,139,139,139,139,139, /* U+1B800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+1C000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+1C800 */
+ 71,186,187,188,189,139,190,139,191,192,193,194,195,196,197,198, /* U+1D000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+1D800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+1E000 */
+199,200,139,139,139,139,139,139,139,139,139,139,201,202,139,139, /* U+1E800 */
+203,204,205,206,207,139,208,209, 71,210,211,212,213,214,215,216, /* U+1F000 */
+217,218,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+1F800 */
95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, /* U+20000 */
95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, /* U+20800 */
95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, /* U+21000 */
@@ -795,402 +901,402 @@ const pcre_uint8 PRIV(ucd_stage1)[] = { /* 8704 bytes */
95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, /* U+28800 */
95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, /* U+29000 */
95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, /* U+29800 */
- 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95,195, 95, 95, /* U+2A000 */
+ 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95,219, 95, 95, /* U+2A000 */
95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, /* U+2A800 */
- 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95,196, 95, /* U+2B000 */
-197, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+2B800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+2C000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+2C800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+2D000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+2D800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+2E000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+2E800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+2F000 */
- 95, 95, 95, 95,197, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+2F800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+30000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+30800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+31000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+31800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+32000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+32800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+33000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+33800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+34000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+34800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+35000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+35800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+36000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+36800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+37000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+37800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+38000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+38800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+39000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+39800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+3A000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+3A800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+3B000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+3B800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+3C000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+3C800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+3D000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+3D800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+3E000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+3E800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+3F000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+3F800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+40000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+40800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+41000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+41800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+42000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+42800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+43000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+43800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+44000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+44800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+45000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+45800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+46000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+46800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+47000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+47800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+48000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+48800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+49000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+49800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+4A000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+4A800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+4B000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+4B800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+4C000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+4C800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+4D000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+4D800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+4E000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+4E800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+4F000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+4F800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+50000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+50800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+51000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+51800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+52000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+52800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+53000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+53800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+54000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+54800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+55000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+55800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+56000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+56800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+57000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+57800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+58000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+58800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+59000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+59800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+5A000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+5A800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+5B000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+5B800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+5C000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+5C800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+5D000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+5D800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+5E000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+5E800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+5F000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+5F800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+60000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+60800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+61000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+61800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+62000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+62800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+63000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+63800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+64000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+64800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+65000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+65800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+66000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+66800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+67000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+67800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+68000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+68800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+69000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+69800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+6A000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+6A800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+6B000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+6B800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+6C000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+6C800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+6D000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+6D800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+6E000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+6E800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+6F000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+6F800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+70000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+70800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+71000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+71800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+72000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+72800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+73000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+73800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+74000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+74800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+75000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+75800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+76000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+76800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+77000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+77800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+78000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+78800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+79000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+79800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+7A000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+7A800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+7B000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+7B800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+7C000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+7C800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+7D000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+7D800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+7E000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+7E800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+7F000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+7F800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+80000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+80800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+81000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+81800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+82000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+82800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+83000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+83800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+84000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+84800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+85000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+85800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+86000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+86800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+87000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+87800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+88000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+88800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+89000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+89800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+8A000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+8A800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+8B000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+8B800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+8C000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+8C800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+8D000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+8D800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+8E000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+8E800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+8F000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+8F800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+90000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+90800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+91000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+91800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+92000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+92800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+93000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+93800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+94000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+94800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+95000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+95800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+96000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+96800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+97000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+97800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+98000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+98800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+99000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+99800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+9A000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+9A800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+9B000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+9B800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+9C000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+9C800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+9D000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+9D800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+9E000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+9E800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+9F000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+9F800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+A0000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+A0800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+A1000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+A1800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+A2000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+A2800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+A3000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+A3800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+A4000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+A4800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+A5000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+A5800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+A6000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+A6800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+A7000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+A7800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+A8000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+A8800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+A9000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+A9800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+AA000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+AA800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+AB000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+AB800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+AC000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+AC800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+AD000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+AD800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+AE000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+AE800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+AF000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+AF800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+B0000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+B0800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+B1000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+B1800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+B2000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+B2800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+B3000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+B3800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+B4000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+B4800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+B5000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+B5800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+B6000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+B6800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+B7000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+B7800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+B8000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+B8800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+B9000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+B9800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+BA000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+BA800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+BB000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+BB800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+BC000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+BC800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+BD000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+BD800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+BE000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+BE800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+BF000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+BF800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+C0000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+C0800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+C1000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+C1800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+C2000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+C2800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+C3000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+C3800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+C4000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+C4800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+C5000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+C5800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+C6000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+C6800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+C7000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+C7800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+C8000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+C8800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+C9000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+C9800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+CA000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+CA800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+CB000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+CB800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+CC000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+CC800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+CD000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+CD800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+CE000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+CE800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+CF000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+CF800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+D0000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+D0800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+D1000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+D1800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+D2000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+D2800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+D3000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+D3800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+D4000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+D4800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+D5000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+D5800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+D6000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+D6800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+D7000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+D7800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+D8000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+D8800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+D9000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+D9800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+DA000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+DA800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+DB000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+DB800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+DC000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+DC800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+DD000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+DD800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+DE000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+DE800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+DF000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+DF800 */
-198,199,200,201,199,199,199,199,199,199,199,199,199,199,199,199, /* U+E0000 */
-199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199, /* U+E0800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+E1000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+E1800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+E2000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+E2800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+E3000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+E3800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+E4000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+E4800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+E5000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+E5800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+E6000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+E6800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+E7000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+E7800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+E8000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+E8800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+E9000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+E9800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+EA000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+EA800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+EB000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+EB800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+EC000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+EC800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+ED000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+ED800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+EE000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+EE800 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+EF000 */
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, /* U+EF800 */
+ 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95, 95,220, 95, /* U+2B000 */
+221,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+2B800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+2C000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+2C800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+2D000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+2D800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+2E000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+2E800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+2F000 */
+ 95, 95, 95, 95,221,139,139,139,139,139,139,139,139,139,139,139, /* U+2F800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+30000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+30800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+31000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+31800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+32000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+32800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+33000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+33800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+34000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+34800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+35000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+35800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+36000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+36800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+37000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+37800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+38000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+38800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+39000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+39800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+3A000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+3A800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+3B000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+3B800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+3C000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+3C800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+3D000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+3D800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+3E000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+3E800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+3F000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+3F800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+40000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+40800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+41000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+41800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+42000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+42800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+43000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+43800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+44000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+44800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+45000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+45800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+46000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+46800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+47000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+47800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+48000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+48800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+49000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+49800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+4A000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+4A800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+4B000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+4B800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+4C000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+4C800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+4D000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+4D800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+4E000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+4E800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+4F000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+4F800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+50000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+50800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+51000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+51800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+52000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+52800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+53000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+53800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+54000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+54800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+55000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+55800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+56000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+56800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+57000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+57800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+58000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+58800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+59000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+59800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+5A000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+5A800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+5B000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+5B800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+5C000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+5C800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+5D000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+5D800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+5E000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+5E800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+5F000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+5F800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+60000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+60800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+61000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+61800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+62000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+62800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+63000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+63800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+64000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+64800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+65000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+65800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+66000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+66800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+67000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+67800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+68000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+68800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+69000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+69800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+6A000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+6A800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+6B000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+6B800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+6C000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+6C800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+6D000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+6D800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+6E000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+6E800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+6F000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+6F800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+70000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+70800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+71000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+71800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+72000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+72800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+73000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+73800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+74000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+74800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+75000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+75800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+76000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+76800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+77000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+77800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+78000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+78800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+79000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+79800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+7A000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+7A800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+7B000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+7B800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+7C000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+7C800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+7D000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+7D800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+7E000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+7E800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+7F000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+7F800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+80000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+80800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+81000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+81800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+82000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+82800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+83000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+83800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+84000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+84800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+85000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+85800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+86000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+86800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+87000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+87800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+88000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+88800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+89000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+89800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+8A000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+8A800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+8B000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+8B800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+8C000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+8C800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+8D000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+8D800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+8E000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+8E800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+8F000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+8F800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+90000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+90800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+91000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+91800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+92000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+92800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+93000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+93800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+94000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+94800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+95000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+95800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+96000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+96800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+97000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+97800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+98000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+98800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+99000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+99800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+9A000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+9A800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+9B000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+9B800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+9C000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+9C800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+9D000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+9D800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+9E000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+9E800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+9F000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+9F800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+A0000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+A0800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+A1000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+A1800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+A2000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+A2800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+A3000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+A3800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+A4000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+A4800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+A5000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+A5800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+A6000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+A6800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+A7000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+A7800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+A8000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+A8800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+A9000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+A9800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+AA000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+AA800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+AB000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+AB800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+AC000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+AC800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+AD000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+AD800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+AE000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+AE800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+AF000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+AF800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+B0000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+B0800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+B1000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+B1800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+B2000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+B2800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+B3000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+B3800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+B4000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+B4800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+B5000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+B5800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+B6000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+B6800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+B7000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+B7800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+B8000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+B8800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+B9000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+B9800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+BA000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+BA800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+BB000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+BB800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+BC000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+BC800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+BD000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+BD800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+BE000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+BE800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+BF000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+BF800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+C0000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+C0800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+C1000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+C1800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+C2000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+C2800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+C3000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+C3800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+C4000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+C4800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+C5000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+C5800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+C6000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+C6800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+C7000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+C7800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+C8000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+C8800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+C9000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+C9800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+CA000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+CA800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+CB000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+CB800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+CC000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+CC800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+CD000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+CD800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+CE000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+CE800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+CF000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+CF800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+D0000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+D0800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+D1000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+D1800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+D2000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+D2800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+D3000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+D3800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+D4000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+D4800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+D5000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+D5800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+D6000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+D6800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+D7000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+D7800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+D8000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+D8800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+D9000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+D9800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+DA000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+DA800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+DB000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+DB800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+DC000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+DC800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+DD000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+DD800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+DE000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+DE800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+DF000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+DF800 */
+222,223,224,225,223,223,223,223,223,223,223,223,223,223,223,223, /* U+E0000 */
+223,223,223,223,223,223,223,223,223,223,223,223,223,223,223,223, /* U+E0800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+E1000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+E1800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+E2000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+E2800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+E3000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+E3800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+E4000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+E4800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+E5000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+E5800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+E6000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+E6800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+E7000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+E7800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+E8000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+E8800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+E9000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+E9800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+EA000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+EA800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+EB000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+EB800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+EC000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+EC800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+ED000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+ED800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+EE000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+EE800 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+EF000 */
+139,139,139,139,139,139,139,139,139,139,139,139,139,139,139,139, /* U+EF800 */
123,123,123,123,123,123,123,123,123,123,123,123,123,123,123,123, /* U+F0000 */
123,123,123,123,123,123,123,123,123,123,123,123,123,123,123,123, /* U+F0800 */
123,123,123,123,123,123,123,123,123,123,123,123,123,123,123,123, /* U+F1000 */
@@ -1222,7 +1328,7 @@ const pcre_uint8 PRIV(ucd_stage1)[] = { /* 8704 bytes */
123,123,123,123,123,123,123,123,123,123,123,123,123,123,123,123, /* U+FE000 */
123,123,123,123,123,123,123,123,123,123,123,123,123,123,123,123, /* U+FE800 */
123,123,123,123,123,123,123,123,123,123,123,123,123,123,123,123, /* U+FF000 */
-123,123,123,123,123,123,123,123,123,123,123,123,123,123,123,202, /* U+FF800 */
+123,123,123,123,123,123,123,123,123,123,123,123,123,123,123,226, /* U+FF800 */
123,123,123,123,123,123,123,123,123,123,123,123,123,123,123,123, /* U+100000 */
123,123,123,123,123,123,123,123,123,123,123,123,123,123,123,123, /* U+100800 */
123,123,123,123,123,123,123,123,123,123,123,123,123,123,123,123, /* U+101000 */
@@ -1254,10 +1360,10 @@ const pcre_uint8 PRIV(ucd_stage1)[] = { /* 8704 bytes */
123,123,123,123,123,123,123,123,123,123,123,123,123,123,123,123, /* U+10E000 */
123,123,123,123,123,123,123,123,123,123,123,123,123,123,123,123, /* U+10E800 */
123,123,123,123,123,123,123,123,123,123,123,123,123,123,123,123, /* U+10F000 */
-123,123,123,123,123,123,123,123,123,123,123,123,123,123,123,202, /* U+10F800 */
+123,123,123,123,123,123,123,123,123,123,123,123,123,123,123,226, /* U+10F800 */
};
-const pcre_uint16 PRIV(ucd_stage2)[] = { /* 51968 bytes, block = 128 */
+const pcre_uint16 PRIV(ucd_stage2)[] = { /* 58112 bytes, block = 128 */
/* block 0 */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 2, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
@@ -1304,539 +1410,539 @@ const pcre_uint16 PRIV(ucd_stage2)[] = { /* 51968 bytes, block = 128 */
70, 33, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31,
30, 31, 30, 31, 33, 33, 33, 33, 33, 33, 71, 30, 31, 72, 73, 74,
74, 30, 31, 75, 76, 77, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31,
- 78, 79, 80, 81, 82, 33, 83, 83, 33, 84, 33, 85, 33, 33, 33, 33,
- 83, 33, 33, 86, 33, 87, 88, 33, 89, 90, 33, 91, 33, 33, 33, 90,
- 33, 92, 93, 33, 33, 94, 33, 33, 33, 33, 33, 33, 33, 95, 33, 33,
+ 78, 79, 80, 81, 82, 33, 83, 83, 33, 84, 33, 85, 86, 33, 33, 33,
+ 83, 87, 33, 88, 33, 89, 90, 33, 91, 92, 33, 93, 94, 33, 33, 92,
+ 33, 95, 96, 33, 33, 97, 33, 33, 33, 33, 33, 33, 33, 98, 33, 33,
/* block 5 */
- 96, 33, 33, 96, 33, 33, 33, 33, 96, 97, 98, 98, 99, 33, 33, 33,
- 33, 33,100, 33, 20, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33,
+ 99, 33, 33, 99, 33, 33, 33,100, 99,101,102,102,103, 33, 33, 33,
+ 33, 33,104, 33, 20, 33, 33, 33, 33, 33, 33, 33, 33, 33,105, 33,
33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33,
-101,101,101,101,101,101,101,101,101,102,102,102,102,102,102,102,
-102,102, 14, 14, 14, 14,102,102,102,102,102,102,102,102,102,102,
-102,102, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
-101,101,101,101,101, 14, 14, 14, 14, 14,103,103,102, 14,102, 14,
+106,106,106,106,106,106,106,106,106,107,107,107,107,107,107,107,
+107,107, 14, 14, 14, 14,107,107,107,107,107,107,107,107,107,107,
+107,107, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+106,106,106,106,106, 14, 14, 14, 14, 14,108,108,107, 14,107, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
/* block 6 */
-104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,
-104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,
-104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,
-104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,
-104,104,104,104,104,105,104,104,104,104,104,104,104,104,104,104,
-104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,
-104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,
-106,107,106,107,102,108,106,107,109,109,110,111,111,111, 4,109,
+109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+109,109,109,109,109,110,109,109,109,109,109,109,109,109,109,109,
+109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+111,112,111,112,107,113,111,112,114,114,115,116,116,116, 4,117,
/* block 7 */
-109,109,109,109,108, 14,112, 4,113,113,113,109,114,109,115,115,
-116,117,118,117,117,119,117,117,120,121,122,117,123,117,117,117,
-124,125,109,126,117,117,127,117,117,128,117,117,129,130,130,130,
-116,131,132,131,131,133,131,131,134,135,136,131,137,131,131,131,
-138,139,140,141,131,131,142,131,131,143,131,131,144,145,145,146,
-147,148,149,149,149,150,151,152,106,107,106,107,106,107,106,107,
-106,107,153,154,153,154,153,154,153,154,153,154,153,154,153,154,
-155,156,157,116,158,159,160,106,107,161,106,107,116,162,162,162,
+114,114,114,114,113, 14,118, 4,119,119,119,114,120,114,121,121,
+122,123,124,123,123,125,123,123,126,127,128,123,129,123,123,123,
+130,131,114,132,123,123,133,123,123,134,123,123,135,136,136,136,
+122,137,138,137,137,139,137,137,140,141,142,137,143,137,137,137,
+144,145,146,147,137,137,148,137,137,149,137,137,150,151,151,152,
+153,154,155,155,155,156,157,158,111,112,111,112,111,112,111,112,
+111,112,159,160,159,160,159,160,159,160,159,160,159,160,159,160,
+161,162,163,164,165,166,167,111,112,168,111,112,122,169,169,169,
/* block 8 */
-163,163,163,163,163,163,163,163,163,163,163,163,163,163,163,163,
-164,164,164,164,164,164,164,164,164,164,164,164,164,164,164,164,
-164,164,164,164,164,164,164,164,164,164,164,164,164,164,164,164,
-165,165,165,165,165,165,165,165,165,165,165,165,165,165,165,165,
-165,165,165,165,165,165,165,165,165,165,165,165,165,165,165,165,
-166,166,166,166,166,166,166,166,166,166,166,166,166,166,166,166,
-167,168,167,168,167,168,167,168,167,168,167,168,167,168,167,168,
-167,168,167,168,167,168,167,168,167,168,167,168,167,168,167,168,
+170,170,170,170,170,170,170,170,170,170,170,170,170,170,170,170,
+171,171,171,171,171,171,171,171,171,171,171,171,171,171,171,171,
+171,171,171,171,171,171,171,171,171,171,171,171,171,171,171,171,
+172,172,172,172,172,172,172,172,172,172,172,172,172,172,172,172,
+172,172,172,172,172,172,172,172,172,172,172,172,172,172,172,172,
+173,173,173,173,173,173,173,173,173,173,173,173,173,173,173,173,
+174,175,174,175,174,175,174,175,174,175,174,175,174,175,174,175,
+174,175,174,175,174,175,174,175,174,175,174,175,174,175,174,175,
/* block 9 */
-167,168,169,170,170,104,104,170,171,171,167,168,167,168,167,168,
-167,168,167,168,167,168,167,168,167,168,167,168,167,168,167,168,
-167,168,167,168,167,168,167,168,167,168,167,168,167,168,167,168,
-167,168,167,168,167,168,167,168,167,168,167,168,167,168,167,168,
-172,167,168,167,168,167,168,167,168,167,168,167,168,167,168,173,
-167,168,167,168,167,168,167,168,167,168,167,168,167,168,167,168,
-167,168,167,168,167,168,167,168,167,168,167,168,167,168,167,168,
-167,168,167,168,167,168,167,168,167,168,167,168,167,168,167,168,
+174,175,176,177,177,109,109,177,178,178,174,175,174,175,174,175,
+174,175,174,175,174,175,174,175,174,175,174,175,174,175,174,175,
+174,175,174,175,174,175,174,175,174,175,174,175,174,175,174,175,
+174,175,174,175,174,175,174,175,174,175,174,175,174,175,174,175,
+179,174,175,174,175,174,175,174,175,174,175,174,175,174,175,180,
+174,175,174,175,174,175,174,175,174,175,174,175,174,175,174,175,
+174,175,174,175,174,175,174,175,174,175,174,175,174,175,174,175,
+174,175,174,175,174,175,174,175,174,175,174,175,174,175,174,175,
/* block 10 */
-167,168,167,168,167,168,167,168,167,168,167,168,167,168,167,168,
-167,168,167,168,167,168,167,168,167,168,167,168,167,168,167,168,
-167,168,167,168,167,168,167,168,109,109,109,109,109,109,109,109,
-109,174,174,174,174,174,174,174,174,174,174,174,174,174,174,174,
-174,174,174,174,174,174,174,174,174,174,174,174,174,174,174,174,
-174,174,174,174,174,174,174,109,109,175,176,176,176,176,176,176,
-109,177,177,177,177,177,177,177,177,177,177,177,177,177,177,177,
-177,177,177,177,177,177,177,177,177,177,177,177,177,177,177,177,
-
-/* block 11 */
-177,177,177,177,177,177,177,178,109, 4,179,109,109,109,109,180,
-109,181,181,181,181,181,181,181,181,181,181,181,181,181,181,181,
+174,175,174,175,174,175,174,175,174,175,174,175,174,175,174,175,
+174,175,174,175,174,175,174,175,174,175,174,175,174,175,174,175,
+174,175,174,175,174,175,174,175,174,175,174,175,174,175,174,175,
+114,181,181,181,181,181,181,181,181,181,181,181,181,181,181,181,
181,181,181,181,181,181,181,181,181,181,181,181,181,181,181,181,
-181,181,181,181,181,181,181,181,181,181,181,181,181,181,182,181,
-183,181,181,183,181,181,183,181,109,109,109,109,109,109,109,109,
+181,181,181,181,181,181,181,114,114,182,183,183,183,183,183,183,
+114,184,184,184,184,184,184,184,184,184,184,184,184,184,184,184,
184,184,184,184,184,184,184,184,184,184,184,184,184,184,184,184,
-184,184,184,184,184,184,184,184,184,184,184,109,109,109,109,109,
-184,184,184,183,183,109,109,109,109,109,109,109,109,109,109,109,
+
+/* block 11 */
+184,184,184,184,184,184,184,185,114, 4,186,114,114,187,187,188,
+114,189,189,189,189,189,189,189,189,189,189,189,189,189,189,189,
+189,189,189,189,189,189,189,189,189,189,189,189,189,189,189,189,
+189,189,189,189,189,189,189,189,189,189,189,189,189,189,190,189,
+191,189,189,191,189,189,191,189,114,114,114,114,114,114,114,114,
+192,192,192,192,192,192,192,192,192,192,192,192,192,192,192,192,
+192,192,192,192,192,192,192,192,192,192,192,114,114,114,114,114,
+192,192,192,191,191,114,114,114,114,114,114,114,114,114,114,114,
/* block 12 */
-185,185,185,185,185,109,186,186,186,187,187,188, 4,187,189,189,
-190,190,190,190,190,190,190,190,190,190,190, 4,109,109,187, 4,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-102,191,191,191,191,191,191,191,191,191,191,104,104,104,104,104,
-104,104,104,104,104,104,190,190,190,190,190,190,190,190,190,190,
- 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,187,187,187,187,191,191,
-104,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
+193,193,193,193,193, 22,194,194,194,195,195,196, 4,195,197,197,
+198,198,198,198,198,198,198,198,198,198,198, 4, 22,114,195, 4,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+107,199,199,199,199,199,199,199,199,199,199,109,109,109,109,109,
+109,109,109,109,109,109,198,198,198,198,198,198,198,198,198,198,
+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,195,195,195,195,199,199,
+109,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
/* block 13 */
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,187,191,190,190,190,190,190,190,190, 22,189,190,
-190,190,190,190,190,192,192,190,190,189,190,190,190,190,191,191,
-193,193,193,193,193,193,193,193,193,193,191,191,191,189,189,191,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,195,199,198,198,198,198,198,198,198, 22,197,198,
+198,198,198,198,198,200,200,198,198,197,198,198,198,198,199,199,
+201,201,201,201,201,201,201,201,201,201,199,199,199,197,197,199,
/* block 14 */
-194,194,194,194,194,194,194,194,194,194,194,194,194,194,109,195,
-196,197,196,196,196,196,196,196,196,196,196,196,196,196,196,196,
-196,196,196,196,196,196,196,196,196,196,196,196,196,196,196,196,
-197,197,197,197,197,197,197,197,197,197,197,197,197,197,197,197,
-197,197,197,197,197,197,197,197,197,197,197,109,109,196,196,196,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
+202,202,202,202,202,202,202,202,202,202,202,202,202,202,114,203,
+204,205,204,204,204,204,204,204,204,204,204,204,204,204,204,204,
+204,204,204,204,204,204,204,204,204,204,204,204,204,204,204,204,
+205,205,205,205,205,205,205,205,205,205,205,205,205,205,205,205,
+205,205,205,205,205,205,205,205,205,205,205,114,114,204,204,204,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
/* block 15 */
-198,198,198,198,198,198,198,198,198,198,198,198,198,198,198,198,
-198,198,198,198,198,198,198,198,198,198,198,198,198,198,198,198,
-198,198,198,198,198,198,199,199,199,199,199,199,199,199,199,199,
-199,198,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-200,200,200,200,200,200,200,200,200,200,201,201,201,201,201,201,
-201,201,201,201,201,201,201,201,201,201,201,201,201,201,201,201,
-201,201,201,201,201,201,201,201,201,201,201,202,202,202,202,202,
-202,202,202,202,203,203,204,205,205,205,203,109,109,109,109,109,
+206,206,206,206,206,206,206,206,206,206,206,206,206,206,206,206,
+206,206,206,206,206,206,206,206,206,206,206,206,206,206,206,206,
+206,206,206,206,206,206,207,207,207,207,207,207,207,207,207,207,
+207,206,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+208,208,208,208,208,208,208,208,208,208,209,209,209,209,209,209,
+209,209,209,209,209,209,209,209,209,209,209,209,209,209,209,209,
+209,209,209,209,209,209,209,209,209,209,209,210,210,210,210,210,
+210,210,210,210,211,211,212,213,213,213,211,114,114,114,114,114,
/* block 16 */
-206,206,206,206,206,206,206,206,206,206,206,206,206,206,206,206,
-206,206,206,206,206,206,207,207,207,207,208,207,207,207,207,207,
-207,207,207,207,208,207,207,207,208,207,207,207,207,207,109,109,
-209,209,209,209,209,209,209,209,209,209,209,209,209,209,209,109,
-210,210,210,210,210,210,210,210,210,210,210,210,210,210,210,210,
-210,210,210,210,210,210,210,210,210,211,211,211,109,109,212,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+214,214,214,214,214,214,214,214,214,214,214,214,214,214,214,214,
+214,214,214,214,214,214,215,215,215,215,216,215,215,215,215,215,
+215,215,215,215,216,215,215,215,216,215,215,215,215,215,114,114,
+217,217,217,217,217,217,217,217,217,217,217,217,217,217,217,114,
+218,218,218,218,218,218,218,218,218,218,218,218,218,218,218,218,
+218,218,218,218,218,218,218,218,218,219,219,219,114,114,220,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
/* block 17 */
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-191,109,191,191,191,191,191,191,191,191,191,191,191,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,190,190,190,190,190,190,190,190,190,190,190,190,
-190,190,190,190,190,190,190,190,190,190,190,190,190,190,190,109,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,198,198,198,198,198,198,198,198,198,198,198,198,
+198,198,198,198,198,198,198,198,198,198,198,198,198,198,198,198,
/* block 18 */
-213,213,213,214,215,215,215,215,215,215,215,215,215,215,215,215,
-215,215,215,215,215,215,215,215,215,215,215,215,215,215,215,215,
-215,215,215,215,215,215,215,215,215,215,215,215,215,215,215,215,
-215,215,215,215,215,215,215,215,215,215,213,214,213,215,214,214,
-214,213,213,213,213,213,213,213,213,214,214,214,214,213,214,214,
-215,104,104,213,213,213,213,213,215,215,215,215,215,215,215,215,
-215,215,213,213, 4, 4,216,216,216,216,216,216,216,216,216,216,
-217,218,215,215,215,215,215,215,109,215,215,215,215,215,215,215,
+221,221,221,222,223,223,223,223,223,223,223,223,223,223,223,223,
+223,223,223,223,223,223,223,223,223,223,223,223,223,223,223,223,
+223,223,223,223,223,223,223,223,223,223,223,223,223,223,223,223,
+223,223,223,223,223,223,223,223,223,223,221,222,221,223,222,222,
+222,221,221,221,221,221,221,221,221,222,222,222,222,221,222,222,
+223,109,109,221,221,221,221,221,223,223,223,223,223,223,223,223,
+223,223,221,221, 4, 4,224,224,224,224,224,224,224,224,224,224,
+225,226,223,223,223,223,223,223,223,223,223,223,223,223,223,223,
/* block 19 */
-109,219,220,220,109,221,221,221,221,221,221,221,221,109,109,221,
-221,109,109,221,221,221,221,221,221,221,221,221,221,221,221,221,
-221,221,221,221,221,221,221,221,221,109,221,221,221,221,221,221,
-221,109,221,109,109,109,221,221,221,221,109,109,219,221,222,220,
-220,219,219,219,219,109,109,220,220,109,109,220,220,219,221,109,
-109,109,109,109,109,109,109,222,109,109,109,109,221,221,109,221,
-221,221,219,219,109,109,223,223,223,223,223,223,223,223,223,223,
-221,221,224,224,225,225,225,225,225,225,226,224,109,109,109,109,
+227,228,229,229,114,227,227,227,227,227,227,227,227,114,114,227,
+227,114,114,227,227,227,227,227,227,227,227,227,227,227,227,227,
+227,227,227,227,227,227,227,227,227,114,227,227,227,227,227,227,
+227,114,227,114,114,114,227,227,227,227,114,114,228,227,230,229,
+229,228,228,228,228,114,114,229,229,114,114,229,229,228,227,114,
+114,114,114,114,114,114,114,230,114,114,114,114,227,227,114,227,
+227,227,228,228,114,114,231,231,231,231,231,231,231,231,231,231,
+227,227,232,232,233,233,233,233,233,233,234,232,114,114,114,114,
/* block 20 */
-109,227,227,228,109,229,229,229,229,229,229,109,109,109,109,229,
-229,109,109,229,229,229,229,229,229,229,229,229,229,229,229,229,
-229,229,229,229,229,229,229,229,229,109,229,229,229,229,229,229,
-229,109,229,229,109,229,229,109,229,229,109,109,227,109,228,228,
-228,227,227,109,109,109,109,227,227,109,109,227,227,227,109,109,
-109,227,109,109,109,109,109,109,109,229,229,229,229,109,229,109,
-109,109,109,109,109,109,230,230,230,230,230,230,230,230,230,230,
-227,227,229,229,229,227,109,109,109,109,109,109,109,109,109,109,
+114,235,235,236,114,237,237,237,237,237,237,114,114,114,114,237,
+237,114,114,237,237,237,237,237,237,237,237,237,237,237,237,237,
+237,237,237,237,237,237,237,237,237,114,237,237,237,237,237,237,
+237,114,237,237,114,237,237,114,237,237,114,114,235,114,236,236,
+236,235,235,114,114,114,114,235,235,114,114,235,235,235,114,114,
+114,235,114,114,114,114,114,114,114,237,237,237,237,114,237,114,
+114,114,114,114,114,114,238,238,238,238,238,238,238,238,238,238,
+235,235,237,237,237,235,114,114,114,114,114,114,114,114,114,114,
/* block 21 */
-109,231,231,232,109,233,233,233,233,233,233,233,233,233,109,233,
-233,233,109,233,233,233,233,233,233,233,233,233,233,233,233,233,
-233,233,233,233,233,233,233,233,233,109,233,233,233,233,233,233,
-233,109,233,233,109,233,233,233,233,233,109,109,231,233,232,232,
-232,231,231,231,231,231,109,231,231,232,109,232,232,231,109,109,
-233,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-233,233,231,231,109,109,234,234,234,234,234,234,234,234,234,234,
-235,236,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+114,239,239,240,114,241,241,241,241,241,241,241,241,241,114,241,
+241,241,114,241,241,241,241,241,241,241,241,241,241,241,241,241,
+241,241,241,241,241,241,241,241,241,114,241,241,241,241,241,241,
+241,114,241,241,114,241,241,241,241,241,114,114,239,241,240,240,
+240,239,239,239,239,239,114,239,239,240,114,240,240,239,114,114,
+241,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+241,241,239,239,114,114,242,242,242,242,242,242,242,242,242,242,
+243,244,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
/* block 22 */
-109,237,238,238,109,239,239,239,239,239,239,239,239,109,109,239,
-239,109,109,239,239,239,239,239,239,239,239,239,239,239,239,239,
-239,239,239,239,239,239,239,239,239,109,239,239,239,239,239,239,
-239,109,239,239,109,239,239,239,239,239,109,109,237,239,240,237,
-238,237,237,237,237,109,109,238,238,109,109,238,238,237,109,109,
-109,109,109,109,109,109,237,240,109,109,109,109,239,239,109,239,
-239,239,237,237,109,109,241,241,241,241,241,241,241,241,241,241,
-242,239,243,243,243,243,243,243,109,109,109,109,109,109,109,109,
+114,245,246,246,114,247,247,247,247,247,247,247,247,114,114,247,
+247,114,114,247,247,247,247,247,247,247,247,247,247,247,247,247,
+247,247,247,247,247,247,247,247,247,114,247,247,247,247,247,247,
+247,114,247,247,114,247,247,247,247,247,114,114,245,247,248,245,
+246,245,245,245,245,114,114,246,246,114,114,246,246,245,114,114,
+114,114,114,114,114,114,245,248,114,114,114,114,247,247,114,247,
+247,247,245,245,114,114,249,249,249,249,249,249,249,249,249,249,
+250,247,251,251,251,251,251,251,114,114,114,114,114,114,114,114,
/* block 23 */
-109,109,244,245,109,245,245,245,245,245,245,109,109,109,245,245,
-245,109,245,245,245,245,109,109,109,245,245,109,245,109,245,245,
-109,109,109,245,245,109,109,109,245,245,245,109,109,109,245,245,
-245,245,245,245,245,245,245,245,245,245,109,109,109,109,246,247,
-244,247,247,109,109,109,247,247,247,109,247,247,247,244,109,109,
-245,109,109,109,109,109,109,246,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,248,248,248,248,248,248,248,248,248,248,
-249,249,249,250,250,250,250,250,250,251,250,109,109,109,109,109,
+114,114,252,253,114,253,253,253,253,253,253,114,114,114,253,253,
+253,114,253,253,253,253,114,114,114,253,253,114,253,114,253,253,
+114,114,114,253,253,114,114,114,253,253,253,114,114,114,253,253,
+253,253,253,253,253,253,253,253,253,253,114,114,114,114,254,255,
+252,255,255,114,114,114,255,255,255,114,255,255,255,252,114,114,
+253,114,114,114,114,114,114,254,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,256,256,256,256,256,256,256,256,256,256,
+257,257,257,258,258,258,258,258,258,259,258,114,114,114,114,114,
/* block 24 */
-109,252,252,252,109,253,253,253,253,253,253,253,253,109,253,253,
-253,109,253,253,253,253,253,253,253,253,253,253,253,253,253,253,
-253,253,253,253,253,253,253,253,253,109,253,253,253,253,253,253,
-253,253,253,253,109,253,253,253,253,253,109,109,109,253,254,254,
-254,252,252,252,252,109,254,254,254,109,254,254,254,254,109,109,
-109,109,109,109,109,254,254,109,253,253,109,109,109,109,109,109,
-253,253,254,254,109,109,255,255,255,255,255,255,255,255,255,255,
-109,109,109,109,109,109,109,109,256,256,256,256,256,256,256,257,
+260,261,261,261,114,262,262,262,262,262,262,262,262,114,262,262,
+262,114,262,262,262,262,262,262,262,262,262,262,262,262,262,262,
+262,262,262,262,262,262,262,262,262,114,262,262,262,262,262,262,
+262,262,262,262,262,262,262,262,262,262,114,114,114,262,260,260,
+260,261,261,261,261,114,260,260,260,114,260,260,260,260,114,114,
+114,114,114,114,114,260,260,114,262,262,114,114,114,114,114,114,
+262,262,260,260,114,114,263,263,263,263,263,263,263,263,263,263,
+114,114,114,114,114,114,114,114,264,264,264,264,264,264,264,265,
/* block 25 */
-109,109,258,258,109,259,259,259,259,259,259,259,259,109,259,259,
-259,109,259,259,259,259,259,259,259,259,259,259,259,259,259,259,
-259,259,259,259,259,259,259,259,259,109,259,259,259,259,259,259,
-259,259,259,259,109,259,259,259,259,259,109,109,260,259,258,260,
-258,258,261,258,258,109,260,258,258,109,258,258,260,260,109,109,
-109,109,109,109,109,261,261,109,109,109,109,109,109,109,259,109,
-259,259,260,260,109,109,262,262,262,262,262,262,262,262,262,262,
-109,259,259,109,109,109,109,109,109,109,109,109,109,109,109,109,
+114,266,267,267,114,268,268,268,268,268,268,268,268,114,268,268,
+268,114,268,268,268,268,268,268,268,268,268,268,268,268,268,268,
+268,268,268,268,268,268,268,268,268,114,268,268,268,268,268,268,
+268,268,268,268,114,268,268,268,268,268,114,114,266,268,267,266,
+267,267,269,267,267,114,266,267,267,114,267,267,266,266,114,114,
+114,114,114,114,114,269,269,114,114,114,114,114,114,114,268,114,
+268,268,266,266,114,114,270,270,270,270,270,270,270,270,270,270,
+114,268,268,114,114,114,114,114,114,114,114,114,114,114,114,114,
/* block 26 */
-109,109,263,263,109,264,264,264,264,264,264,264,264,109,264,264,
-264,109,264,264,264,264,264,264,264,264,264,264,264,264,264,264,
-264,264,264,264,264,264,264,264,264,264,264,264,264,264,264,264,
-264,264,264,264,264,264,264,264,264,264,264,109,109,264,265,263,
-263,266,266,266,266,109,263,263,263,109,263,263,263,266,264,109,
-109,109,109,109,109,109,109,265,109,109,109,109,109,109,109,109,
-264,264,266,266,109,109,267,267,267,267,267,267,267,267,267,267,
-268,268,268,268,268,268,109,109,109,269,264,264,264,264,264,264,
+114,271,272,272,114,273,273,273,273,273,273,273,273,114,273,273,
+273,114,273,273,273,273,273,273,273,273,273,273,273,273,273,273,
+273,273,273,273,273,273,273,273,273,273,273,273,273,273,273,273,
+273,273,273,273,273,273,273,273,273,273,273,114,114,273,274,272,
+272,271,271,271,271,114,272,272,272,114,272,272,272,271,273,114,
+114,114,114,114,114,114,114,274,114,114,114,114,114,114,114,114,
+273,273,271,271,114,114,275,275,275,275,275,275,275,275,275,275,
+276,276,276,276,276,276,114,114,114,277,273,273,273,273,273,273,
/* block 27 */
-109,109,270,270,109,271,271,271,271,271,271,271,271,271,271,271,
-271,271,271,271,271,271,271,109,109,109,271,271,271,271,271,271,
-271,271,271,271,271,271,271,271,271,271,271,271,271,271,271,271,
-271,271,109,271,271,271,271,271,271,271,271,271,109,271,109,109,
-271,271,271,271,271,271,271,109,109,109,272,109,109,109,109,273,
-270,270,272,272,272,109,272,109,270,270,270,270,270,270,270,273,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,270,270,274,109,109,109,109,109,109,109,109,109,109,109,
+114,114,278,278,114,279,279,279,279,279,279,279,279,279,279,279,
+279,279,279,279,279,279,279,114,114,114,279,279,279,279,279,279,
+279,279,279,279,279,279,279,279,279,279,279,279,279,279,279,279,
+279,279,114,279,279,279,279,279,279,279,279,279,114,279,114,114,
+279,279,279,279,279,279,279,114,114,114,280,114,114,114,114,281,
+278,278,280,280,280,114,280,114,278,278,278,278,278,278,278,281,
+114,114,114,114,114,114,282,282,282,282,282,282,282,282,282,282,
+114,114,278,278,283,114,114,114,114,114,114,114,114,114,114,114,
/* block 28 */
-109,275,275,275,275,275,275,275,275,275,275,275,275,275,275,275,
-275,275,275,275,275,275,275,275,275,275,275,275,275,275,275,275,
-275,275,275,275,275,275,275,275,275,275,275,275,275,275,275,275,
-275,276,275,277,276,276,276,276,276,276,276,109,109,109,109, 5,
-275,275,275,275,275,275,278,276,276,276,276,276,276,276,276,279,
-280,280,280,280,280,280,280,280,280,280,279,279,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+114,284,284,284,284,284,284,284,284,284,284,284,284,284,284,284,
+284,284,284,284,284,284,284,284,284,284,284,284,284,284,284,284,
+284,284,284,284,284,284,284,284,284,284,284,284,284,284,284,284,
+284,285,284,286,285,285,285,285,285,285,285,114,114,114,114, 5,
+284,284,284,284,284,284,287,285,285,285,285,285,285,285,285,288,
+289,289,289,289,289,289,289,289,289,289,288,288,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
/* block 29 */
-109,281,281,109,281,109,109,281,281,109,281,109,109,281,109,109,
-109,109,109,109,281,281,281,281,109,281,281,281,281,281,281,281,
-109,281,281,281,109,281,109,281,109,109,281,281,109,281,281,281,
-281,282,281,283,282,282,282,282,282,282,109,282,282,281,109,109,
-281,281,281,281,281,109,284,109,282,282,282,282,282,282,109,109,
-285,285,285,285,285,285,285,285,285,285,109,109,281,281,281,281,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+114,290,290,114,290,114,114,290,290,114,290,114,114,290,114,114,
+114,114,114,114,290,290,290,290,114,290,290,290,290,290,290,290,
+114,290,290,290,114,290,114,290,114,114,290,290,114,290,290,290,
+290,291,290,292,291,291,291,291,291,291,114,291,291,290,114,114,
+290,290,290,290,290,114,293,114,291,291,291,291,291,291,114,114,
+294,294,294,294,294,294,294,294,294,294,114,114,290,290,290,290,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
/* block 30 */
-286,287,287,287,288,288,288,288,288,288,288,288,288,288,288,288,
-288,288,288,287,288,287,287,287,289,289,287,287,287,287,287,287,
-290,290,290,290,290,290,290,290,290,290,291,291,291,291,291,291,
-291,291,291,291,287,289,287,289,287,289,292,293,292,293,294,294,
-286,286,286,286,286,286,286,286,109,286,286,286,286,286,286,286,
-286,286,286,286,286,286,286,286,286,286,286,286,286,286,286,286,
-286,286,286,286,286,286,286,286,286,286,286,286,286,109,109,109,
-109,289,289,289,289,289,289,289,289,289,289,289,289,289,289,294,
+295,296,296,296,297,297,297,297,297,297,297,297,297,297,297,297,
+297,297,297,296,297,296,296,296,298,298,296,296,296,296,296,296,
+299,299,299,299,299,299,299,299,299,299,300,300,300,300,300,300,
+300,300,300,300,296,298,296,298,296,298,301,302,301,302,303,303,
+295,295,295,295,295,295,295,295,114,295,295,295,295,295,295,295,
+295,295,295,295,295,295,295,295,295,295,295,295,295,295,295,295,
+295,295,295,295,295,295,295,295,295,295,295,295,295,114,114,114,
+114,298,298,298,298,298,298,298,298,298,298,298,298,298,298,303,
/* block 31 */
-289,289,289,289,289,288,289,289,286,286,286,286,286,289,289,289,
-289,289,289,289,289,289,289,289,109,289,289,289,289,289,289,289,
-289,289,289,289,289,289,289,289,289,289,289,289,289,289,289,289,
-289,289,289,289,289,289,289,289,289,289,289,289,289,109,287,287,
-287,287,287,287,287,287,289,287,287,287,287,287,287,109,287,287,
-288,288,288,288,288, 19, 19, 19, 19,288,288,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+298,298,298,298,298,297,298,298,295,295,295,295,295,298,298,298,
+298,298,298,298,298,298,298,298,114,298,298,298,298,298,298,298,
+298,298,298,298,298,298,298,298,298,298,298,298,298,298,298,298,
+298,298,298,298,298,298,298,298,298,298,298,298,298,114,296,296,
+296,296,296,296,296,296,298,296,296,296,296,296,296,114,296,296,
+297,297,297,297,297, 19, 19, 19, 19,297,297,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
/* block 32 */
-295,295,295,295,295,295,295,295,295,295,295,295,295,295,295,295,
-295,295,295,295,295,295,295,295,295,295,295,295,295,295,295,295,
-295,295,295,295,295,295,295,295,295,295,295,296,296,297,297,297,
-297,298,297,297,297,297,297,297,296,297,297,298,298,297,297,295,
-299,299,299,299,299,299,299,299,299,299,300,300,300,300,300,300,
-295,295,295,295,295,295,298,298,297,297,295,295,295,295,297,297,
-297,295,296,296,296,295,295,296,296,296,296,296,296,296,295,295,
-295,297,297,297,297,295,295,295,295,295,295,295,295,295,295,295,
+304,304,304,304,304,304,304,304,304,304,304,304,304,304,304,304,
+304,304,304,304,304,304,304,304,304,304,304,304,304,304,304,304,
+304,304,304,304,304,304,304,304,304,304,304,305,305,306,306,306,
+306,307,306,306,306,306,306,306,305,306,306,307,307,306,306,304,
+308,308,308,308,308,308,308,308,308,308,309,309,309,309,309,309,
+304,304,304,304,304,304,307,307,306,306,304,304,304,304,306,306,
+306,304,305,305,305,304,304,305,305,305,305,305,305,305,304,304,
+304,306,306,306,306,304,304,304,304,304,304,304,304,304,304,304,
/* block 33 */
-295,295,297,296,298,297,297,296,296,296,296,296,296,297,295,296,
-299,299,299,299,299,299,299,299,299,299,296,296,296,297,301,301,
-302,302,302,302,302,302,302,302,302,302,302,302,302,302,302,302,
-302,302,302,302,302,302,302,302,302,302,302,302,302,302,302,302,
-302,302,302,302,302,302,109,302,109,109,109,109,109,302,109,109,
-303,303,303,303,303,303,303,303,303,303,303,303,303,303,303,303,
-303,303,303,303,303,303,303,303,303,303,303,303,303,303,303,303,
-303,303,303,303,303,303,303,303,303,303,303, 4,304,303,303,303,
+304,304,306,305,307,306,306,305,305,305,305,305,305,306,304,305,
+308,308,308,308,308,308,308,308,308,308,305,305,305,306,310,310,
+311,311,311,311,311,311,311,311,311,311,311,311,311,311,311,311,
+311,311,311,311,311,311,311,311,311,311,311,311,311,311,311,311,
+311,311,311,311,311,311,114,311,114,114,114,114,114,311,114,114,
+312,312,312,312,312,312,312,312,312,312,312,312,312,312,312,312,
+312,312,312,312,312,312,312,312,312,312,312,312,312,312,312,312,
+312,312,312,312,312,312,312,312,312,312,312, 4,313,312,312,312,
/* block 34 */
-305,305,305,305,305,305,305,305,305,305,305,305,305,305,305,305,
-305,305,305,305,305,305,305,305,305,305,305,305,305,305,305,305,
-305,305,305,305,305,305,305,305,305,305,305,305,305,305,305,305,
-305,305,305,305,305,305,305,305,305,305,305,305,305,305,305,305,
-305,305,305,305,305,305,305,305,305,305,305,305,305,305,305,305,
-305,305,305,305,305,305,305,305,305,305,305,305,305,305,305,305,
-306,306,306,306,306,306,306,306,306,306,306,306,306,306,306,306,
-306,306,306,306,306,306,306,306,306,306,306,306,306,306,306,306,
+314,314,314,314,314,314,314,314,314,314,314,314,314,314,314,314,
+314,314,314,314,314,314,314,314,314,314,314,314,314,314,314,314,
+314,314,314,314,314,314,314,314,314,314,314,314,314,314,314,314,
+314,314,314,314,314,314,314,314,314,314,314,314,314,314,314,314,
+314,314,314,314,314,314,314,314,314,314,314,314,314,314,314,314,
+314,314,314,314,314,314,314,314,314,314,314,314,314,314,314,314,
+315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,
+315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,
/* block 35 */
-306,306,306,306,306,306,306,306,306,306,306,306,306,306,306,306,
-306,306,306,306,306,306,306,306,306,306,306,306,306,306,306,306,
-306,306,306,306,306,306,306,306,307,307,307,307,307,307,307,307,
-307,307,307,307,307,307,307,307,307,307,307,307,307,307,307,307,
-307,307,307,307,307,307,307,307,307,307,307,307,307,307,307,307,
-307,307,307,307,307,307,307,307,307,307,307,307,307,307,307,307,
-307,307,307,307,307,307,307,307,307,307,307,307,307,307,307,307,
-307,307,307,307,307,307,307,307,307,307,307,307,307,307,307,307,
+315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,
+315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,
+315,315,315,315,315,315,315,315,316,316,316,316,316,316,316,316,
+316,316,316,316,316,316,316,316,316,316,316,316,316,316,316,316,
+316,316,316,316,316,316,316,316,316,316,316,316,316,316,316,316,
+316,316,316,316,316,316,316,316,316,316,316,316,316,316,316,316,
+316,316,316,316,316,316,316,316,316,316,316,316,316,316,316,316,
+316,316,316,316,316,316,316,316,316,316,316,316,316,316,316,316,
/* block 36 */
-308,308,308,308,308,308,308,308,308,308,308,308,308,308,308,308,
-308,308,308,308,308,308,308,308,308,308,308,308,308,308,308,308,
-308,308,308,308,308,308,308,308,308,308,308,308,308,308,308,308,
-308,308,308,308,308,308,308,308,308,308,308,308,308,308,308,308,
-308,308,308,308,308,308,308,308,308,109,308,308,308,308,109,109,
-308,308,308,308,308,308,308,109,308,109,308,308,308,308,109,109,
-308,308,308,308,308,308,308,308,308,308,308,308,308,308,308,308,
-308,308,308,308,308,308,308,308,308,308,308,308,308,308,308,308,
+317,317,317,317,317,317,317,317,317,317,317,317,317,317,317,317,
+317,317,317,317,317,317,317,317,317,317,317,317,317,317,317,317,
+317,317,317,317,317,317,317,317,317,317,317,317,317,317,317,317,
+317,317,317,317,317,317,317,317,317,317,317,317,317,317,317,317,
+317,317,317,317,317,317,317,317,317,114,317,317,317,317,114,114,
+317,317,317,317,317,317,317,114,317,114,317,317,317,317,114,114,
+317,317,317,317,317,317,317,317,317,317,317,317,317,317,317,317,
+317,317,317,317,317,317,317,317,317,317,317,317,317,317,317,317,
/* block 37 */
-308,308,308,308,308,308,308,308,308,109,308,308,308,308,109,109,
-308,308,308,308,308,308,308,308,308,308,308,308,308,308,308,308,
-308,308,308,308,308,308,308,308,308,308,308,308,308,308,308,308,
-308,109,308,308,308,308,109,109,308,308,308,308,308,308,308,109,
-308,109,308,308,308,308,109,109,308,308,308,308,308,308,308,308,
-308,308,308,308,308,308,308,109,308,308,308,308,308,308,308,308,
-308,308,308,308,308,308,308,308,308,308,308,308,308,308,308,308,
-308,308,308,308,308,308,308,308,308,308,308,308,308,308,308,308,
+317,317,317,317,317,317,317,317,317,114,317,317,317,317,114,114,
+317,317,317,317,317,317,317,317,317,317,317,317,317,317,317,317,
+317,317,317,317,317,317,317,317,317,317,317,317,317,317,317,317,
+317,114,317,317,317,317,114,114,317,317,317,317,317,317,317,114,
+317,114,317,317,317,317,114,114,317,317,317,317,317,317,317,317,
+317,317,317,317,317,317,317,114,317,317,317,317,317,317,317,317,
+317,317,317,317,317,317,317,317,317,317,317,317,317,317,317,317,
+317,317,317,317,317,317,317,317,317,317,317,317,317,317,317,317,
/* block 38 */
-308,308,308,308,308,308,308,308,308,308,308,308,308,308,308,308,
-308,109,308,308,308,308,109,109,308,308,308,308,308,308,308,308,
-308,308,308,308,308,308,308,308,308,308,308,308,308,308,308,308,
-308,308,308,308,308,308,308,308,308,308,308,308,308,308,308,308,
-308,308,308,308,308,308,308,308,308,308,308,308,308,308,308,308,
-308,308,308,308,308,308,308,308,308,308,308,109,109,309,309,309,
-310,310,310,310,310,310,310,310,310,311,311,311,311,311,311,311,
-311,311,311,311,311,311,311,311,311,311,311,311,311,109,109,109,
+317,317,317,317,317,317,317,317,317,317,317,317,317,317,317,317,
+317,114,317,317,317,317,114,114,317,317,317,317,317,317,317,317,
+317,317,317,317,317,317,317,317,317,317,317,317,317,317,317,317,
+317,317,317,317,317,317,317,317,317,317,317,317,317,317,317,317,
+317,317,317,317,317,317,317,317,317,317,317,317,317,317,317,317,
+317,317,317,317,317,317,317,317,317,317,317,114,114,318,318,318,
+319,319,319,319,319,319,319,319,319,320,320,320,320,320,320,320,
+320,320,320,320,320,320,320,320,320,320,320,320,320,114,114,114,
/* block 39 */
-308,308,308,308,308,308,308,308,308,308,308,308,308,308,308,308,
-312,312,312,312,312,312,312,312,312,312,109,109,109,109,109,109,
-313,313,313,313,313,313,313,313,313,313,313,313,313,313,313,313,
-313,313,313,313,313,313,313,313,313,313,313,313,313,313,313,313,
-313,313,313,313,313,313,313,313,313,313,313,313,313,313,313,313,
-313,313,313,313,313,313,313,313,313,313,313,313,313,313,313,313,
-313,313,313,313,313,313,313,313,313,313,313,313,313,313,313,313,
-313,313,313,313,313,109,109,109,109,109,109,109,109,109,109,109,
+317,317,317,317,317,317,317,317,317,317,317,317,317,317,317,317,
+321,321,321,321,321,321,321,321,321,321,114,114,114,114,114,114,
+322,322,322,322,322,322,322,322,322,322,322,322,322,322,322,322,
+322,322,322,322,322,322,322,322,322,322,322,322,322,322,322,322,
+322,322,322,322,322,322,322,322,322,322,322,322,322,322,322,322,
+322,322,322,322,322,322,322,322,322,322,322,322,322,322,322,322,
+322,322,322,322,322,322,322,322,322,322,322,322,322,322,322,322,
+322,322,322,322,322,114,114,114,114,114,114,114,114,114,114,114,
/* block 40 */
-314,315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,
-315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,
-315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,
-315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,
-315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,
-315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,
-315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,
-315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,
+323,324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,
+324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,
+324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,
+324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,
+324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,
+324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,
+324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,
+324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,
/* block 41 */
-315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,
-315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,
-315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,
-315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,
-315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,
-315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,
-315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,
-315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,
+324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,
+324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,
+324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,
+324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,
+324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,
+324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,
+324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,
+324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,
/* block 42 */
-315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,
-315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,
-315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,
-315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,
-315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,
-315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,
-315,315,315,315,315,315,315,315,315,315,315,315,315,316,316,315,
-315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,
+324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,
+324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,
+324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,
+324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,
+324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,
+324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,
+324,324,324,324,324,324,324,324,324,324,324,324,324,325,325,324,
+324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,
/* block 43 */
-317,318,318,318,318,318,318,318,318,318,318,318,318,318,318,318,
-318,318,318,318,318,318,318,318,318,318,318,319,320,109,109,109,
-321,321,321,321,321,321,321,321,321,321,321,321,321,321,321,321,
-321,321,321,321,321,321,321,321,321,321,321,321,321,321,321,321,
-321,321,321,321,321,321,321,321,321,321,321,321,321,321,321,321,
-321,321,321,321,321,321,321,321,321,321,321,321,321,321,321,321,
-321,321,321,321,321,321,321,321,321,321,321, 4, 4, 4,322,322,
-322,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+326,327,327,327,327,327,327,327,327,327,327,327,327,327,327,327,
+327,327,327,327,327,327,327,327,327,327,327,328,329,114,114,114,
+330,330,330,330,330,330,330,330,330,330,330,330,330,330,330,330,
+330,330,330,330,330,330,330,330,330,330,330,330,330,330,330,330,
+330,330,330,330,330,330,330,330,330,330,330,330,330,330,330,330,
+330,330,330,330,330,330,330,330,330,330,330,330,330,330,330,330,
+330,330,330,330,330,330,330,330,330,330,330, 4, 4, 4,331,331,
+331,330,330,330,330,330,330,330,330,114,114,114,114,114,114,114,
/* block 44 */
-323,323,323,323,323,323,323,323,323,323,323,323,323,109,323,323,
-323,323,324,324,324,109,109,109,109,109,109,109,109,109,109,109,
-325,325,325,325,325,325,325,325,325,325,325,325,325,325,325,325,
-325,325,326,326,326, 4, 4,109,109,109,109,109,109,109,109,109,
-327,327,327,327,327,327,327,327,327,327,327,327,327,327,327,327,
-327,327,328,328,109,109,109,109,109,109,109,109,109,109,109,109,
-329,329,329,329,329,329,329,329,329,329,329,329,329,109,329,329,
-329,109,330,330,109,109,109,109,109,109,109,109,109,109,109,109,
+332,332,332,332,332,332,332,332,332,332,332,332,332,114,332,332,
+332,332,333,333,333,114,114,114,114,114,114,114,114,114,114,114,
+334,334,334,334,334,334,334,334,334,334,334,334,334,334,334,334,
+334,334,335,335,335, 4, 4,114,114,114,114,114,114,114,114,114,
+336,336,336,336,336,336,336,336,336,336,336,336,336,336,336,336,
+336,336,337,337,114,114,114,114,114,114,114,114,114,114,114,114,
+338,338,338,338,338,338,338,338,338,338,338,338,338,114,338,338,
+338,114,339,339,114,114,114,114,114,114,114,114,114,114,114,114,
/* block 45 */
-331,331,331,331,331,331,331,331,331,331,331,331,331,331,331,331,
-331,331,331,331,331,331,331,331,331,331,331,331,331,331,331,331,
-331,331,331,331,331,331,331,331,331,331,331,331,331,331,331,331,
-331,331,331,331,332,332,333,332,332,332,332,332,332,332,333,333,
-333,333,333,333,333,333,332,333,333,332,332,332,332,332,332,332,
-332,332,332,332,334,334,334,335,334,334,334,336,331,332,109,109,
-337,337,337,337,337,337,337,337,337,337,109,109,109,109,109,109,
-338,338,338,338,338,338,338,338,338,338,109,109,109,109,109,109,
+340,340,340,340,340,340,340,340,340,340,340,340,340,340,340,340,
+340,340,340,340,340,340,340,340,340,340,340,340,340,340,340,340,
+340,340,340,340,340,340,340,340,340,340,340,340,340,340,340,340,
+340,340,340,340,341,341,342,341,341,341,341,341,341,341,342,342,
+342,342,342,342,342,342,341,342,342,341,341,341,341,341,341,341,
+341,341,341,341,343,343,343,344,343,343,343,345,340,341,114,114,
+346,346,346,346,346,346,346,346,346,346,114,114,114,114,114,114,
+347,347,347,347,347,347,347,347,347,347,114,114,114,114,114,114,
/* block 46 */
-339,339, 4, 4,339, 4,340,339,339,339,339,341,341,341,342,109,
-343,343,343,343,343,343,343,343,343,343,109,109,109,109,109,109,
-344,344,344,344,344,344,344,344,344,344,344,344,344,344,344,344,
-344,344,344,344,344,344,344,344,344,344,344,344,344,344,344,344,
-344,344,344,345,344,344,344,344,344,344,344,344,344,344,344,344,
-344,344,344,344,344,344,344,344,344,344,344,344,344,344,344,344,
-344,344,344,344,344,344,344,344,344,344,344,344,344,344,344,344,
-344,344,344,344,344,344,344,344,109,109,109,109,109,109,109,109,
+348,348, 4, 4,348, 4,349,348,348,348,348,350,350,350,351,114,
+352,352,352,352,352,352,352,352,352,352,114,114,114,114,114,114,
+353,353,353,353,353,353,353,353,353,353,353,353,353,353,353,353,
+353,353,353,353,353,353,353,353,353,353,353,353,353,353,353,353,
+353,353,353,354,353,353,353,353,353,353,353,353,353,353,353,353,
+353,353,353,353,353,353,353,353,353,353,353,353,353,353,353,353,
+353,353,353,353,353,353,353,353,353,353,353,353,353,353,353,353,
+353,353,353,353,353,353,353,353,114,114,114,114,114,114,114,114,
/* block 47 */
-344,344,344,344,344,344,344,344,344,344,344,344,344,344,344,344,
-344,344,344,344,344,344,344,344,344,344,344,344,344,344,344,344,
-344,344,344,344,344,344,344,344,344,341,344,109,109,109,109,109,
-315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,
-315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,
-315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,
-315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,
-315,315,315,315,315,315,109,109,109,109,109,109,109,109,109,109,
+353,353,353,353,353,353,353,353,353,353,353,353,353,353,353,353,
+353,353,353,353,353,353,353,353,353,353,353,353,353,353,353,353,
+353,353,353,353,353,353,353,353,353,350,353,114,114,114,114,114,
+324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,
+324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,
+324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,
+324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,324,
+324,324,324,324,324,324,114,114,114,114,114,114,114,114,114,114,
/* block 48 */
-346,346,346,346,346,346,346,346,346,346,346,346,346,346,346,346,
-346,346,346,346,346,346,346,346,346,346,346,346,346,109,109,109,
-347,347,347,348,348,348,348,347,347,348,348,348,109,109,109,109,
-348,348,347,348,348,348,348,348,348,347,347,347,109,109,109,109,
-349,109,109,109,350,350,351,351,351,351,351,351,351,351,351,351,
-352,352,352,352,352,352,352,352,352,352,352,352,352,352,352,352,
-352,352,352,352,352,352,352,352,352,352,352,352,352,352,109,109,
-352,352,352,352,352,109,109,109,109,109,109,109,109,109,109,109,
+355,355,355,355,355,355,355,355,355,355,355,355,355,355,355,355,
+355,355,355,355,355,355,355,355,355,355,355,355,355,355,355,114,
+356,356,356,357,357,357,357,356,356,357,357,357,114,114,114,114,
+357,357,356,357,357,357,357,357,357,356,356,356,114,114,114,114,
+358,114,114,114,359,359,360,360,360,360,360,360,360,360,360,360,
+361,361,361,361,361,361,361,361,361,361,361,361,361,361,361,361,
+361,361,361,361,361,361,361,361,361,361,361,361,361,361,114,114,
+361,361,361,361,361,114,114,114,114,114,114,114,114,114,114,114,
/* block 49 */
-353,353,353,353,353,353,353,353,353,353,353,353,353,353,353,353,
-353,353,353,353,353,353,353,353,353,353,353,353,353,353,353,353,
-353,353,353,353,353,353,353,353,353,353,353,353,109,109,109,109,
-354,354,354,354,354,355,355,355,354,354,355,354,354,354,354,354,
-354,353,353,353,353,353,353,353,354,354,109,109,109,109,109,109,
-356,356,356,356,356,356,356,356,356,356,357,109,109,109,358,358,
-359,359,359,359,359,359,359,359,359,359,359,359,359,359,359,359,
-359,359,359,359,359,359,359,359,359,359,359,359,359,359,359,359,
+362,362,362,362,362,362,362,362,362,362,362,362,362,362,362,362,
+362,362,362,362,362,362,362,362,362,362,362,362,362,362,362,362,
+362,362,362,362,362,362,362,362,362,362,362,362,114,114,114,114,
+363,363,363,363,363,364,364,364,363,363,364,363,363,363,363,363,
+363,362,362,362,362,362,362,362,363,363,114,114,114,114,114,114,
+365,365,365,365,365,365,365,365,365,365,366,114,114,114,367,367,
+368,368,368,368,368,368,368,368,368,368,368,368,368,368,368,368,
+368,368,368,368,368,368,368,368,368,368,368,368,368,368,368,368,
/* block 50 */
-360,360,360,360,360,360,360,360,360,360,360,360,360,360,360,360,
-360,360,360,360,360,360,360,361,361,362,362,362,109,109,363,363,
-364,364,364,364,364,364,364,364,364,364,364,364,364,364,364,364,
-364,364,364,364,364,364,364,364,364,364,364,364,364,364,364,364,
-364,364,364,364,364,364,364,364,364,364,364,364,364,364,364,364,
-364,364,364,364,364,365,366,365,366,366,366,366,366,366,366,109,
-366,367,366,367,367,366,366,366,366,366,366,366,366,365,365,365,
-365,365,365,366,366,366,366,366,366,366,366,366,366,109,109,366,
+369,369,369,369,369,369,369,369,369,369,369,369,369,369,369,369,
+369,369,369,369,369,369,369,370,370,371,371,370,114,114,372,372,
+373,373,373,373,373,373,373,373,373,373,373,373,373,373,373,373,
+373,373,373,373,373,373,373,373,373,373,373,373,373,373,373,373,
+373,373,373,373,373,373,373,373,373,373,373,373,373,373,373,373,
+373,373,373,373,373,374,375,374,375,375,375,375,375,375,375,114,
+375,376,375,376,376,375,375,375,375,375,375,375,375,374,374,374,
+374,374,374,375,375,375,375,375,375,375,375,375,375,114,114,375,
/* block 51 */
-368,368,368,368,368,368,368,368,368,368,109,109,109,109,109,109,
-368,368,368,368,368,368,368,368,368,368,109,109,109,109,109,109,
-369,369,369,369,369,369,369,370,369,369,369,369,369,369,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+377,377,377,377,377,377,377,377,377,377,114,114,114,114,114,114,
+377,377,377,377,377,377,377,377,377,377,114,114,114,114,114,114,
+378,378,378,378,378,378,378,379,378,378,378,378,378,378,114,114,
+109,109,109,109,109,109,109,109,109,109,109,109,109,109,380,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
/* block 52 */
-371,371,371,371,372,373,373,373,373,373,373,373,373,373,373,373,
-373,373,373,373,373,373,373,373,373,373,373,373,373,373,373,373,
-373,373,373,373,373,373,373,373,373,373,373,373,373,373,373,373,
-373,373,373,373,371,372,371,371,371,371,371,372,371,372,372,372,
-372,372,371,372,372,373,373,373,373,373,373,373,109,109,109,109,
-374,374,374,374,374,374,374,374,374,374,375,375,375,375,375,375,
-375,376,376,376,376,376,376,376,376,376,376,371,371,371,371,371,
-371,371,371,371,376,376,376,376,376,376,376,376,376,109,109,109,
+381,381,381,381,382,383,383,383,383,383,383,383,383,383,383,383,
+383,383,383,383,383,383,383,383,383,383,383,383,383,383,383,383,
+383,383,383,383,383,383,383,383,383,383,383,383,383,383,383,383,
+383,383,383,383,381,382,381,381,381,381,381,382,381,382,382,382,
+382,382,381,382,382,383,383,383,383,383,383,383,114,114,114,114,
+384,384,384,384,384,384,384,384,384,384,385,385,385,385,385,385,
+385,386,386,386,386,386,386,386,386,386,386,381,381,381,381,381,
+381,381,381,381,386,386,386,386,386,386,386,386,386,114,114,114,
/* block 53 */
-377,377,378,379,379,379,379,379,379,379,379,379,379,379,379,379,
-379,379,379,379,379,379,379,379,379,379,379,379,379,379,379,379,
-379,378,377,377,377,377,378,378,377,377,378,377,378,378,379,379,
-380,380,380,380,380,380,380,380,380,380,379,379,379,379,379,379,
-381,381,381,381,381,381,381,381,381,381,381,381,381,381,381,381,
-381,381,381,381,381,381,381,381,381,381,381,381,381,381,381,381,
-381,381,381,381,381,381,382,383,382,382,383,383,383,382,383,382,
-382,382,383,383,109,109,109,109,109,109,109,109,384,384,384,384,
+387,387,388,389,389,389,389,389,389,389,389,389,389,389,389,389,
+389,389,389,389,389,389,389,389,389,389,389,389,389,389,389,389,
+389,388,387,387,387,387,388,388,387,387,388,387,387,387,389,389,
+390,390,390,390,390,390,390,390,390,390,389,389,389,389,389,389,
+391,391,391,391,391,391,391,391,391,391,391,391,391,391,391,391,
+391,391,391,391,391,391,391,391,391,391,391,391,391,391,391,391,
+391,391,391,391,391,391,392,393,392,392,393,393,393,392,393,392,
+392,392,393,393,114,114,114,114,114,114,114,114,394,394,394,394,
/* block 54 */
-385,385,385,385,385,385,385,385,385,385,385,385,385,385,385,385,
-385,385,385,385,385,385,385,385,385,385,385,385,385,385,385,385,
-385,385,385,385,386,386,386,386,386,386,386,386,387,387,387,387,
-387,387,387,387,386,386,387,387,109,109,109,388,388,388,388,388,
-389,389,389,389,389,389,389,389,389,389,109,109,109,385,385,385,
-390,390,390,390,390,390,390,390,390,390,391,391,391,391,391,391,
-391,391,391,391,391,391,391,391,391,391,391,391,391,391,391,391,
-391,391,391,391,391,391,391,391,392,392,392,392,392,392,393,393,
+395,395,395,395,395,395,395,395,395,395,395,395,395,395,395,395,
+395,395,395,395,395,395,395,395,395,395,395,395,395,395,395,395,
+395,395,395,395,396,396,396,396,396,396,396,396,397,397,397,397,
+397,397,397,397,396,396,397,397,114,114,114,398,398,398,398,398,
+399,399,399,399,399,399,399,399,399,399,114,114,114,395,395,395,
+400,400,400,400,400,400,400,400,400,400,401,401,401,401,401,401,
+401,401,401,401,401,401,401,401,401,401,401,401,401,401,401,401,
+401,401,401,401,401,401,401,401,402,402,402,402,402,402,403,403,
/* block 55 */
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-394,394,394,394,394,394,394,394,109,109,109,109,109,109,109,109,
-104,104,104, 4,104,104,104,104,104,104,104,104,104,104,104,104,
-104,395,104,104,104,104,104,104,104,396,396,396,396,104,396,396,
-396,396,395,395,104,396,396,109,109,109,109,109,109,109,109,109,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+404,404,404,404,404,404,404,404,114,114,114,114,114,114,114,114,
+109,109,109, 4,109,109,109,109,109,109,109,109,109,109,109,109,
+109,405,109,109,109,109,109,109,109,406,406,406,406,109,406,406,
+406,406,405,405,109,406,406,114,109,109,114,114,114,114,114,114,
/* block 56 */
33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33,
33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33,
- 33, 33, 33, 33, 33, 33,116,116,116,116,116,397,101,101,101,101,
-101,101,101,101,101,101,101,101,101,101,101,101,101,101,101,101,
-101,101,101,101,101,101,101,101,101,101,101,101,101,101,101,101,
-101,101,101,101,101,101,101,101,101,101,101,101,101,110,110,110,
-110,110,101,101,101,101,110,110,110,110,110, 33, 33, 33, 33, 33,
- 33, 33, 33, 33, 33, 33, 33, 33,398,399, 33, 33, 33,400, 33, 33,
+ 33, 33, 33, 33, 33, 33,122,122,122,122,122,407,106,106,106,106,
+106,106,106,106,106,106,106,106,106,106,106,106,106,106,106,106,
+106,106,106,106,106,106,106,106,106,106,106,106,106,106,106,106,
+106,106,106,106,106,106,106,106,106,106,106,106,106,115,115,115,
+115,115,106,106,106,106,115,115,115,115,115, 33, 33, 33, 33, 33,
+ 33, 33, 33, 33, 33, 33, 33, 33,408,409, 33, 33, 33,410, 33, 33,
/* block 57 */
33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33,
- 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33,101,101,101,101,101,
-101,101,101,101,101,101,101,101,101,101,101,101,101,101,101,101,
-101,101,101,101,101,101,101,101,101,101,101,101,101,101,101,110,
-104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,
-104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,
-104,104,104,104,104,104,104,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,104,104,104,104,
+ 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33,106,106,106,106,106,
+106,106,106,106,106,106,106,106,106,106,106,106,106,106,106,106,
+106,106,106,106,106,106,106,106,106,106,106,106,106,106,106,115,
+109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+109,109,109,109,109,109,114,114,114,114,114,114,109,109,109,109,
/* block 58 */
30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31,
@@ -1845,12 +1951,12 @@ const pcre_uint16 PRIV(ucd_stage2)[] = { /* 51968 bytes, block = 128 */
30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31,
30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31,
30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31,
-401,402, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31,
+411,412, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31,
30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31,
/* block 59 */
30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31,
- 30, 31, 30, 31, 30, 31, 33, 33, 33, 33, 33,403, 33, 33,404, 33,
+ 30, 31, 30, 31, 30, 31, 33, 33, 33, 33, 33,413, 33, 33,414, 33,
30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31,
30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31,
30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31,
@@ -1859,57 +1965,57 @@ const pcre_uint16 PRIV(ucd_stage2)[] = { /* 51968 bytes, block = 128 */
30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31,
/* block 60 */
-405,405,405,405,405,405,405,405,406,406,406,406,406,406,406,406,
-405,405,405,405,405,405,109,109,406,406,406,406,406,406,109,109,
-405,405,405,405,405,405,405,405,406,406,406,406,406,406,406,406,
-405,405,405,405,405,405,405,405,406,406,406,406,406,406,406,406,
-405,405,405,405,405,405,109,109,406,406,406,406,406,406,109,109,
-116,405,116,405,116,405,116,405,109,406,109,406,109,406,109,406,
-405,405,405,405,405,405,405,405,406,406,406,406,406,406,406,406,
-407,407,408,408,408,408,409,409,410,410,411,411,412,412,109,109,
+415,415,415,415,415,415,415,415,416,416,416,416,416,416,416,416,
+415,415,415,415,415,415,114,114,416,416,416,416,416,416,114,114,
+415,415,415,415,415,415,415,415,416,416,416,416,416,416,416,416,
+415,415,415,415,415,415,415,415,416,416,416,416,416,416,416,416,
+415,415,415,415,415,415,114,114,416,416,416,416,416,416,114,114,
+122,415,122,415,122,415,122,415,114,416,114,416,114,416,114,416,
+415,415,415,415,415,415,415,415,416,416,416,416,416,416,416,416,
+417,417,418,418,418,418,419,419,420,420,421,421,422,422,114,114,
/* block 61 */
-405,405,405,405,405,405,405,405,413,413,413,413,413,413,413,413,
-405,405,405,405,405,405,405,405,413,413,413,413,413,413,413,413,
-405,405,405,405,405,405,405,405,413,413,413,413,413,413,413,413,
-405,405,116,414,116,109,116,116,406,406,415,415,416,108,417,108,
-108,108,116,414,116,109,116,116,418,418,418,418,416,108,108,108,
-405,405,116,116,109,109,116,116,406,406,419,419,109,108,108,108,
-405,405,116,116,116,157,116,116,406,406,420,420,161,108,108,108,
-109,109,116,414,116,109,116,116,421,421,422,422,416,108,108,109,
+415,415,415,415,415,415,415,415,423,423,423,423,423,423,423,423,
+415,415,415,415,415,415,415,415,423,423,423,423,423,423,423,423,
+415,415,415,415,415,415,415,415,423,423,423,423,423,423,423,423,
+415,415,122,424,122,114,122,122,416,416,425,425,426,113,427,113,
+113,113,122,424,122,114,122,122,428,428,428,428,426,113,113,113,
+415,415,122,122,114,114,122,122,416,416,429,429,114,113,113,113,
+415,415,122,122,122,163,122,122,416,416,430,430,168,113,113,113,
+114,114,122,424,122,114,122,122,431,431,432,432,426,113,113,114,
/* block 62 */
- 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 22,423,423, 22, 22,
+ 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 22,433,433, 22, 22,
9, 9, 9, 9, 9, 9, 4, 4, 21, 25, 6, 21, 21, 25, 6, 21,
- 4, 4, 4, 4, 4, 4, 4, 4,424,425, 22, 22, 22, 22, 22, 3,
+ 4, 4, 4, 4, 4, 4, 4, 4,434,435, 22, 22, 22, 22, 22, 3,
4, 4, 4, 4, 4, 4, 4, 4, 4, 21, 25, 4, 4, 4, 4, 15,
15, 4, 4, 4, 8, 6, 7, 4, 4, 4, 4, 4, 4, 4, 4, 4,
4, 4, 8, 4, 15, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 3,
- 22, 22, 22, 22, 22,426,426,426,426,426, 22, 22, 22, 22, 22, 22,
- 23,101,109,109, 23, 23, 23, 23, 23, 23, 8, 8, 8, 6, 7,101,
+ 22, 22, 22, 22, 22,436, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22,
+ 23,106,114,114, 23, 23, 23, 23, 23, 23, 8, 8, 8, 6, 7,106,
/* block 63 */
- 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 8, 8, 8, 6, 7,109,
-101,101,101,101,101,101,101,101,101,101,101,101,101,109,109,109,
+ 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 8, 8, 8, 6, 7,114,
+106,106,106,106,106,106,106,106,106,106,106,106,106,114,114,114,
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,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-104,104,104,104,104,104,104,104,104,104,104,104,104,427,427,427,
-427,104,427,427,427,104,104,104,104,104,104,104,104,104,104,104,
-104,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+ 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+109,109,109,109,109,109,109,109,109,109,109,109,109,380,380,380,
+380,109,380,380,380,109,109,109,109,109,109,109,109,109,109,109,
+109,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
/* block 64 */
- 19, 19,428, 19, 19, 19, 19,428, 19, 19,429,428,428,428,429,429,
-428,428,428,429, 19,428, 19, 19, 8,428,428,428,428,428, 19, 19,
- 19, 19, 19, 19,428, 19,430, 19,428, 19,431,432,428,428, 19,429,
-428,428,433,428,429,396,396,396,396,429, 19, 19,429,429,428,428,
- 8, 8, 8, 8, 8,428,429,429,429,429, 19, 8, 19, 19,434, 19,
+ 19, 19,437, 19, 19, 19, 19,437, 19, 19,438,437,437,437,438,438,
+437,437,437,438, 19,437, 19, 19, 8,437,437,437,437,437, 19, 19,
+ 19, 19, 19, 19,437, 19,439, 19,437, 19,440,441,437,437, 19,438,
+437,437,442,437,438,406,406,406,406,438, 19, 19,438,438,437,437,
+ 8, 8, 8, 8, 8,437,438,438,438,438, 19, 8, 19, 19,443, 19,
23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23,
-435,435,435,435,435,435,435,435,435,435,435,435,435,435,435,435,
-436,436,436,436,436,436,436,436,436,436,436,436,436,436,436,436,
+444,444,444,444,444,444,444,444,444,444,444,444,444,444,444,444,
+445,445,445,445,445,445,445,445,445,445,445,445,445,445,445,445,
/* block 65 */
-437,437,437, 30, 31,437,437,437,437, 23,109,109,109,109,109,109,
+446,446,446, 30, 31,446,446,446,446, 23,114,114,114,114,114,114,
8, 8, 8, 8, 8, 19, 19, 19, 19, 19, 8, 8, 19, 19, 19, 19,
8, 19, 19, 8, 19, 19, 8, 19, 19, 19, 19, 19, 19, 19, 8, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
@@ -1929,7 +2035,7 @@ const pcre_uint16 PRIV(ucd_stage2)[] = { /* 51968 bytes, block = 128 */
8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
/* block 67 */
- 19, 19, 19, 19, 19, 19, 19, 19, 8, 8, 8, 8, 19, 19, 19, 19,
+ 19, 19, 19, 19, 19, 19, 19, 19, 6, 7, 6, 7, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
8, 8, 19, 19, 19, 19, 19, 19, 19, 6, 7, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
@@ -1946,15 +2052,15 @@ const pcre_uint16 PRIV(ucd_stage2)[] = { /* 51968 bytes, block = 128 */
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 8, 8, 8, 8,
8, 8, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
- 19, 19, 19, 19,109,109,109,109,109,109,109,109,109,109,109,109,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,114,114,114,114,114,
/* block 69 */
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
- 19, 19, 19, 19, 19, 19, 19,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
- 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+ 19, 19, 19, 19, 19, 19, 19,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23,
23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23,
@@ -1962,10 +2068,10 @@ const pcre_uint16 PRIV(ucd_stage2)[] = { /* 51968 bytes, block = 128 */
23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23,
23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
- 19, 19, 19, 19, 19, 19,438,438,438,438,438,438,438,438,438,438,
-438,438,438,438,438,438,438,438,438,438,438,438,438,438,438,438,
-439,439,439,439,439,439,439,439,439,439,439,439,439,439,439,439,
-439,439,439,439,439,439,439,439,439,439, 23, 23, 23, 23, 23, 23,
+ 19, 19, 19, 19, 19, 19,447,447,447,447,447,447,447,447,447,447,
+447,447,447,447,447,447,447,447,447,447,447,447,447,447,447,447,
+448,448,448,448,448,448,448,448,448,448,448,448,448,448,448,448,
+448,448,448,448,448,448,448,448,448,448, 23, 23, 23, 23, 23, 23,
23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23,
/* block 71 */
@@ -1999,7 +2105,7 @@ const pcre_uint16 PRIV(ucd_stage2)[] = { /* 51968 bytes, block = 128 */
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
/* block 74 */
-109, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
@@ -2019,14 +2125,14 @@ const pcre_uint16 PRIV(ucd_stage2)[] = { /* 51968 bytes, block = 128 */
8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
/* block 76 */
-440,440,440,440,440,440,440,440,440,440,440,440,440,440,440,440,
-440,440,440,440,440,440,440,440,440,440,440,440,440,440,440,440,
-440,440,440,440,440,440,440,440,440,440,440,440,440,440,440,440,
-440,440,440,440,440,440,440,440,440,440,440,440,440,440,440,440,
-440,440,440,440,440,440,440,440,440,440,440,440,440,440,440,440,
-440,440,440,440,440,440,440,440,440,440,440,440,440,440,440,440,
-440,440,440,440,440,440,440,440,440,440,440,440,440,440,440,440,
-440,440,440,440,440,440,440,440,440,440,440,440,440,440,440,440,
+449,449,449,449,449,449,449,449,449,449,449,449,449,449,449,449,
+449,449,449,449,449,449,449,449,449,449,449,449,449,449,449,449,
+449,449,449,449,449,449,449,449,449,449,449,449,449,449,449,449,
+449,449,449,449,449,449,449,449,449,449,449,449,449,449,449,449,
+449,449,449,449,449,449,449,449,449,449,449,449,449,449,449,449,
+449,449,449,449,449,449,449,449,449,449,449,449,449,449,449,449,
+449,449,449,449,449,449,449,449,449,449,449,449,449,449,449,449,
+449,449,449,449,449,449,449,449,449,449,449,449,449,449,449,449,
/* block 77 */
8, 8, 8, 6, 7, 6, 7, 6, 7, 6, 7, 6, 7, 6, 7, 6,
@@ -2043,150 +2149,150 @@ const pcre_uint16 PRIV(ucd_stage2)[] = { /* 51968 bytes, block = 128 */
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
- 8, 8, 8, 8, 8, 19, 19, 8, 8, 8, 8, 8, 8,109,109,109,
- 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+ 8, 8, 8, 8, 8, 19, 19, 8, 8, 8, 8, 8, 8, 19, 19, 19,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+ 19, 19, 19, 19,114,114, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
/* block 79 */
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+ 19, 19, 19, 19, 19, 19,114,114, 19, 19, 19, 19, 19, 19, 19, 19,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,114,114,114, 19, 19, 19,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19,114, 19, 19, 19, 19, 19, 19,
+ 19, 19,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
/* block 80 */
-441,441,441,441,441,441,441,441,441,441,441,441,441,441,441,441,
-441,441,441,441,441,441,441,441,441,441,441,441,441,441,441,441,
-441,441,441,441,441,441,441,441,441,441,441,441,441,441,441,109,
-442,442,442,442,442,442,442,442,442,442,442,442,442,442,442,442,
-442,442,442,442,442,442,442,442,442,442,442,442,442,442,442,442,
-442,442,442,442,442,442,442,442,442,442,442,442,442,442,442,109,
- 30, 31,443,444,445,446,447, 30, 31, 30, 31, 30, 31,448,449,450,
-451, 33, 30, 31, 33, 30, 31, 33, 33, 33, 33, 33,101,101,452,452,
+450,450,450,450,450,450,450,450,450,450,450,450,450,450,450,450,
+450,450,450,450,450,450,450,450,450,450,450,450,450,450,450,450,
+450,450,450,450,450,450,450,450,450,450,450,450,450,450,450,114,
+451,451,451,451,451,451,451,451,451,451,451,451,451,451,451,451,
+451,451,451,451,451,451,451,451,451,451,451,451,451,451,451,451,
+451,451,451,451,451,451,451,451,451,451,451,451,451,451,451,114,
+ 30, 31,452,453,454,455,456, 30, 31, 30, 31, 30, 31,457,458,459,
+460, 33, 30, 31, 33, 30, 31, 33, 33, 33, 33, 33,106,106,461,461,
/* block 81 */
-153,154,153,154,153,154,153,154,153,154,153,154,153,154,153,154,
-153,154,153,154,153,154,153,154,153,154,153,154,153,154,153,154,
-153,154,153,154,153,154,153,154,153,154,153,154,153,154,153,154,
-153,154,153,154,153,154,153,154,153,154,153,154,153,154,153,154,
-153,154,153,154,153,154,153,154,153,154,153,154,153,154,153,154,
-153,154,153,154,153,154,153,154,153,154,153,154,153,154,153,154,
-153,154,153,154,453,454,454,454,454,454,454,153,154,153,154,455,
-455,455,153,154,109,109,109,109,109,456,456,456,456,457,456,456,
+159,160,159,160,159,160,159,160,159,160,159,160,159,160,159,160,
+159,160,159,160,159,160,159,160,159,160,159,160,159,160,159,160,
+159,160,159,160,159,160,159,160,159,160,159,160,159,160,159,160,
+159,160,159,160,159,160,159,160,159,160,159,160,159,160,159,160,
+159,160,159,160,159,160,159,160,159,160,159,160,159,160,159,160,
+159,160,159,160,159,160,159,160,159,160,159,160,159,160,159,160,
+159,160,159,160,462,463,463,463,463,463,463,159,160,159,160,464,
+464,464,159,160,114,114,114,114,114,465,465,465,465,466,465,465,
/* block 82 */
-458,458,458,458,458,458,458,458,458,458,458,458,458,458,458,458,
-458,458,458,458,458,458,458,458,458,458,458,458,458,458,458,458,
-458,458,458,458,458,458,109,458,109,109,109,109,109,458,109,109,
-459,459,459,459,459,459,459,459,459,459,459,459,459,459,459,459,
-459,459,459,459,459,459,459,459,459,459,459,459,459,459,459,459,
-459,459,459,459,459,459,459,459,459,459,459,459,459,459,459,459,
-459,459,459,459,459,459,459,459,109,109,109,109,109,109,109,460,
-461,109,109,109,109,109,109,109,109,109,109,109,109,109,109,462,
+467,467,467,467,467,467,467,467,467,467,467,467,467,467,467,467,
+467,467,467,467,467,467,467,467,467,467,467,467,467,467,467,467,
+467,467,467,467,467,467,114,467,114,114,114,114,114,467,114,114,
+468,468,468,468,468,468,468,468,468,468,468,468,468,468,468,468,
+468,468,468,468,468,468,468,468,468,468,468,468,468,468,468,468,
+468,468,468,468,468,468,468,468,468,468,468,468,468,468,468,468,
+468,468,468,468,468,468,468,468,114,114,114,114,114,114,114,469,
+470,114,114,114,114,114,114,114,114,114,114,114,114,114,114,471,
/* block 83 */
-308,308,308,308,308,308,308,308,308,308,308,308,308,308,308,308,
-308,308,308,308,308,308,308,109,109,109,109,109,109,109,109,109,
-308,308,308,308,308,308,308,109,308,308,308,308,308,308,308,109,
-308,308,308,308,308,308,308,109,308,308,308,308,308,308,308,109,
-308,308,308,308,308,308,308,109,308,308,308,308,308,308,308,109,
-308,308,308,308,308,308,308,109,308,308,308,308,308,308,308,109,
-170,170,170,170,170,170,170,170,170,170,170,170,170,170,170,170,
-170,170,170,170,170,170,170,170,170,170,170,170,170,170,170,170,
+317,317,317,317,317,317,317,317,317,317,317,317,317,317,317,317,
+317,317,317,317,317,317,317,114,114,114,114,114,114,114,114,114,
+317,317,317,317,317,317,317,114,317,317,317,317,317,317,317,114,
+317,317,317,317,317,317,317,114,317,317,317,317,317,317,317,114,
+317,317,317,317,317,317,317,114,317,317,317,317,317,317,317,114,
+317,317,317,317,317,317,317,114,317,317,317,317,317,317,317,114,
+177,177,177,177,177,177,177,177,177,177,177,177,177,177,177,177,
+177,177,177,177,177,177,177,177,177,177,177,177,177,177,177,177,
/* block 84 */
4, 4, 21, 25, 21, 25, 4, 4, 4, 21, 25, 4, 21, 25, 4, 4,
4, 4, 4, 4, 4, 4, 4, 9, 4, 4, 9, 4, 21, 25, 4, 4,
- 21, 25, 6, 7, 6, 7, 6, 7, 6, 7, 4, 4, 4, 4, 4,102,
- 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 9, 9,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+ 21, 25, 6, 7, 6, 7, 6, 7, 6, 7, 4, 4, 4, 4, 4,107,
+ 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 9, 9, 4, 4, 4, 4,
+ 9, 4, 6,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
/* block 85 */
-463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,
-463,463,463,463,463,463,463,463,463,463,109,463,463,463,463,463,
-463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,
-463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,
-463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,
-463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,
-463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,
-463,463,463,463,109,109,109,109,109,109,109,109,109,109,109,109,
+472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,
+472,472,472,472,472,472,472,472,472,472,114,472,472,472,472,472,
+472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,
+472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,
+472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,
+472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,
+472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,
+472,472,472,472,114,114,114,114,114,114,114,114,114,114,114,114,
/* block 86 */
-463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,
-463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,
-463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,
-463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,
-463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,
-463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,
-463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,
-463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,
+472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,
+472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,
+472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,
+472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,
+472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,
+472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,
+472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,
+472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,
/* block 87 */
-463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,
-463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,
-463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,
-463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,
-463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,463,
-463,463,463,463,463,463,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
- 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,109,109,109,109,
+472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,
+472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,
+472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,
+472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,
+472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,
+472,472,472,472,472,472,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,114,114,114,114,
/* block 88 */
- 3, 4, 4, 4, 19,464,396,465, 6, 7, 6, 7, 6, 7, 6, 7,
+ 3, 4, 4, 4, 19,473,406,474, 6, 7, 6, 7, 6, 7, 6, 7,
6, 7, 19, 19, 6, 7, 6, 7, 6, 7, 6, 7, 9, 6, 7, 7,
- 19,465,465,465,465,465,465,465,465,465,104,104,104,104,466,466,
- 9,102,102,102,102,102, 19, 19,465,465,465,464,396, 4, 19, 19,
-109,467,467,467,467,467,467,467,467,467,467,467,467,467,467,467,
-467,467,467,467,467,467,467,467,467,467,467,467,467,467,467,467,
-467,467,467,467,467,467,467,467,467,467,467,467,467,467,467,467,
-467,467,467,467,467,467,467,467,467,467,467,467,467,467,467,467,
+ 19,474,474,474,474,474,474,474,474,474,109,109,109,109,475,475,
+ 9,107,107,107,107,107, 19, 19,474,474,474,473,406, 4, 19, 19,
+114,476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,
+476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,
+476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,
+476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,
/* block 89 */
-467,467,467,467,467,467,467,467,467,467,467,467,467,467,467,467,
-467,467,467,467,467,467,467,109,109,104,104, 14, 14,468,468,467,
- 9,469,469,469,469,469,469,469,469,469,469,469,469,469,469,469,
-469,469,469,469,469,469,469,469,469,469,469,469,469,469,469,469,
-469,469,469,469,469,469,469,469,469,469,469,469,469,469,469,469,
-469,469,469,469,469,469,469,469,469,469,469,469,469,469,469,469,
-469,469,469,469,469,469,469,469,469,469,469,469,469,469,469,469,
-469,469,469,469,469,469,469,469,469,469,469, 4,102,470,470,469,
+476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,
+476,476,476,476,476,476,476,114,114,109,109, 14, 14,477,477,476,
+ 9,478,478,478,478,478,478,478,478,478,478,478,478,478,478,478,
+478,478,478,478,478,478,478,478,478,478,478,478,478,478,478,478,
+478,478,478,478,478,478,478,478,478,478,478,478,478,478,478,478,
+478,478,478,478,478,478,478,478,478,478,478,478,478,478,478,478,
+478,478,478,478,478,478,478,478,478,478,478,478,478,478,478,478,
+478,478,478,478,478,478,478,478,478,478,478, 4,107,479,479,478,
/* block 90 */
-109,109,109,109,109,471,471,471,471,471,471,471,471,471,471,471,
-471,471,471,471,471,471,471,471,471,471,471,471,471,471,471,471,
-471,471,471,471,471,471,471,471,471,471,471,471,471,471,109,109,
-109,472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,
-472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,
-472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,
-472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,
-472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,
+114,114,114,114,114,480,480,480,480,480,480,480,480,480,480,480,
+480,480,480,480,480,480,480,480,480,480,480,480,480,480,480,480,
+480,480,480,480,480,480,480,480,480,480,480,480,480,480,114,114,
+114,481,481,481,481,481,481,481,481,481,481,481,481,481,481,481,
+481,481,481,481,481,481,481,481,481,481,481,481,481,481,481,481,
+481,481,481,481,481,481,481,481,481,481,481,481,481,481,481,481,
+481,481,481,481,481,481,481,481,481,481,481,481,481,481,481,481,
+481,481,481,481,481,481,481,481,481,481,481,481,481,481,481,481,
/* block 91 */
-472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,109,
+481,481,481,481,481,481,481,481,481,481,481,481,481,481,481,114,
19, 19, 23, 23, 23, 23, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
-471,471,471,471,471,471,471,471,471,471,471,471,471,471,471,471,
-471,471,471,471,471,471,471,471,471,471,471,109,109,109,109,109,
+480,480,480,480,480,480,480,480,480,480,480,480,480,480,480,480,
+480,480,480,480,480,480,480,480,480,480,480,114,114,114,114,114,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
- 19, 19, 19, 19,109,109,109,109,109,109,109,109,109,109,109,109,
-469,469,469,469,469,469,469,469,469,469,469,469,469,469,469,469,
+ 19, 19, 19, 19,114,114,114,114,114,114,114,114,114,114,114,114,
+478,478,478,478,478,478,478,478,478,478,478,478,478,478,478,478,
/* block 92 */
-473,473,473,473,473,473,473,473,473,473,473,473,473,473,473,473,
-473,473,473,473,473,473,473,473,473,473,473,473,473,473,473,109,
+482,482,482,482,482,482,482,482,482,482,482,482,482,482,482,482,
+482,482,482,482,482,482,482,482,482,482,482,482,482,482,482,114,
23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 23, 23, 23, 23, 23, 23, 23, 23,
19, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23,
-473,473,473,473,473,473,473,473,473,473,473,473,473,473,473,473,
-473,473,473,473,473,473,473,473,473,473,473,473,473,473,473, 19,
+482,482,482,482,482,482,482,482,482,482,482,482,482,482,482,482,
+482,482,482,482,482,482,482,482,482,482,482,482,482,482,482, 19,
/* block 93 */
23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 19, 19, 19, 19, 19, 19,
@@ -2194,731 +2300,931 @@ const pcre_uint16 PRIV(ucd_stage2)[] = { /* 51968 bytes, block = 128 */
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
-474,474,474,474,474,474,474,474,474,474,474,474,474,474,474,474,
-474,474,474,474,474,474,474,474,474,474,474,474,474,474,474,474,
-474,474,474,474,474,474,474,474,474,474,474,474,474,474,474,109,
+483,483,483,483,483,483,483,483,483,483,483,483,483,483,483,483,
+483,483,483,483,483,483,483,483,483,483,483,483,483,483,483,483,
+483,483,483,483,483,483,483,483,483,483,483,483,483,483,483,114,
/* block 94 */
-474,474,474,474,474,474,474,474,474,474,474,474,474,474,474,474,
-474,474,474,474,474,474,474,474,474,474,474,474,474,474,474,474,
-474,474,474,474,474,474,474,474,474,474,474,474,474,474,474,474,
-474,474,474,474,474,474,474,474,474,474,474,474,474,474,474,474,
-474,474,474,474,474,474,474,474,474,474,474,474,474,474,474,474,
-474,474,474,474,474,474,474,474, 19, 19, 19, 19, 19, 19, 19, 19,
+483,483,483,483,483,483,483,483,483,483,483,483,483,483,483,483,
+483,483,483,483,483,483,483,483,483,483,483,483,483,483,483,483,
+483,483,483,483,483,483,483,483,483,483,483,483,483,483,483,483,
+483,483,483,483,483,483,483,483,483,483,483,483,483,483,483,483,
+483,483,483,483,483,483,483,483,483,483,483,483,483,483,483,483,
+483,483,483,483,483,483,483,483, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
/* block 95 */
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
/* block 96 */
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,109,109,109,109,109,109,109,109,109,109,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,114,114,114,114,114,114,114,114,114,114,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
/* block 97 */
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
/* block 98 */
-476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,
-476,476,476,476,476,477,476,476,476,476,476,476,476,476,476,476,
-476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,
-476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,
-476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,
-476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,
-476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,
-476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,
+485,485,485,485,485,485,485,485,485,485,485,485,485,485,485,485,
+485,485,485,485,485,486,485,485,485,485,485,485,485,485,485,485,
+485,485,485,485,485,485,485,485,485,485,485,485,485,485,485,485,
+485,485,485,485,485,485,485,485,485,485,485,485,485,485,485,485,
+485,485,485,485,485,485,485,485,485,485,485,485,485,485,485,485,
+485,485,485,485,485,485,485,485,485,485,485,485,485,485,485,485,
+485,485,485,485,485,485,485,485,485,485,485,485,485,485,485,485,
+485,485,485,485,485,485,485,485,485,485,485,485,485,485,485,485,
/* block 99 */
-476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,
-476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,
-476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,
-476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,
-476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,
-476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,
-476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,
-476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,476,
+485,485,485,485,485,485,485,485,485,485,485,485,485,485,485,485,
+485,485,485,485,485,485,485,485,485,485,485,485,485,485,485,485,
+485,485,485,485,485,485,485,485,485,485,485,485,485,485,485,485,
+485,485,485,485,485,485,485,485,485,485,485,485,485,485,485,485,
+485,485,485,485,485,485,485,485,485,485,485,485,485,485,485,485,
+485,485,485,485,485,485,485,485,485,485,485,485,485,485,485,485,
+485,485,485,485,485,485,485,485,485,485,485,485,485,485,485,485,
+485,485,485,485,485,485,485,485,485,485,485,485,485,485,485,485,
/* block 100 */
-476,476,476,476,476,476,476,476,476,476,476,476,476,109,109,109,
-478,478,478,478,478,478,478,478,478,478,478,478,478,478,478,478,
-478,478,478,478,478,478,478,478,478,478,478,478,478,478,478,478,
-478,478,478,478,478,478,478,478,478,478,478,478,478,478,478,478,
-478,478,478,478,478,478,478,109,109,109,109,109,109,109,109,109,
-479,479,479,479,479,479,479,479,479,479,479,479,479,479,479,479,
-479,479,479,479,479,479,479,479,479,479,479,479,479,479,479,479,
-479,479,479,479,479,479,479,479,480,480,480,480,480,480,481,481,
+485,485,485,485,485,485,485,485,485,485,485,485,485,114,114,114,
+487,487,487,487,487,487,487,487,487,487,487,487,487,487,487,487,
+487,487,487,487,487,487,487,487,487,487,487,487,487,487,487,487,
+487,487,487,487,487,487,487,487,487,487,487,487,487,487,487,487,
+487,487,487,487,487,487,487,114,114,114,114,114,114,114,114,114,
+488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,
+488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,
+488,488,488,488,488,488,488,488,489,489,489,489,489,489,490,490,
/* block 101 */
-482,482,482,482,482,482,482,482,482,482,482,482,482,482,482,482,
-482,482,482,482,482,482,482,482,482,482,482,482,482,482,482,482,
-482,482,482,482,482,482,482,482,482,482,482,482,482,482,482,482,
-482,482,482,482,482,482,482,482,482,482,482,482,482,482,482,482,
-482,482,482,482,482,482,482,482,482,482,482,482,482,482,482,482,
-482,482,482,482,482,482,482,482,482,482,482,482,482,482,482,482,
-482,482,482,482,482,482,482,482,482,482,482,482,482,482,482,482,
-482,482,482,482,482,482,482,482,482,482,482,482,482,482,482,482,
+491,491,491,491,491,491,491,491,491,491,491,491,491,491,491,491,
+491,491,491,491,491,491,491,491,491,491,491,491,491,491,491,491,
+491,491,491,491,491,491,491,491,491,491,491,491,491,491,491,491,
+491,491,491,491,491,491,491,491,491,491,491,491,491,491,491,491,
+491,491,491,491,491,491,491,491,491,491,491,491,491,491,491,491,
+491,491,491,491,491,491,491,491,491,491,491,491,491,491,491,491,
+491,491,491,491,491,491,491,491,491,491,491,491,491,491,491,491,
+491,491,491,491,491,491,491,491,491,491,491,491,491,491,491,491,
/* block 102 */
-482,482,482,482,482,482,482,482,482,482,482,482,483,484,484,484,
-482,482,482,482,482,482,482,482,482,482,482,482,482,482,482,482,
-485,485,485,485,485,485,485,485,485,485,482,482,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-167,168,167,168,167,168,167,168,167,168,167,168,167,168,167,168,
-167,168,167,168,167,168,167,168,167,168,167,168,167,168,167,168,
-167,168,167,168,167,168,167,168,167,168,167,168,167,168,486,170,
-171,171,171,487,170,170,170,170,170,170,170,170,170,170,487,398,
+491,491,491,491,491,491,491,491,491,491,491,491,492,493,493,493,
+491,491,491,491,491,491,491,491,491,491,491,491,491,491,491,491,
+494,494,494,494,494,494,494,494,494,494,491,491,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+174,175,174,175,174,175,174,175,174,175,174,175,174,175,174,175,
+174,175,174,175,174,175,174,175,174,175,174,175,174,175,174,175,
+174,175,174,175,174,175,174,175,174,175,174,175,174,175,495,177,
+178,178,178,496,177,177,177,177,177,177,177,177,177,177,496,408,
/* block 103 */
-167,168,167,168,167,168,167,168,167,168,167,168,167,168,167,168,
-167,168,167,168,167,168,167,168,109,109,109,109,109,109,109,170,
-488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,
-488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,
-488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,
-488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,
-488,488,488,488,488,488,489,489,489,489,489,489,489,489,489,489,
-490,490,491,491,491,491,491,491,109,109,109,109,109,109,109,109,
+174,175,174,175,174,175,174,175,174,175,174,175,174,175,174,175,
+174,175,174,175,174,175,174,175,174,175,174,175,408,408,114,177,
+497,497,497,497,497,497,497,497,497,497,497,497,497,497,497,497,
+497,497,497,497,497,497,497,497,497,497,497,497,497,497,497,497,
+497,497,497,497,497,497,497,497,497,497,497,497,497,497,497,497,
+497,497,497,497,497,497,497,497,497,497,497,497,497,497,497,497,
+497,497,497,497,497,497,498,498,498,498,498,498,498,498,498,498,
+499,499,500,500,500,500,500,500,114,114,114,114,114,114,114,114,
/* block 104 */
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14,102,102,102,102,102,102,102,102,102,
+ 14, 14, 14, 14, 14, 14, 14,107,107,107,107,107,107,107,107,107,
14, 14, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31,
33, 33, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31,
30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31,
30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31,
30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31,
-101, 33, 33, 33, 33, 33, 33, 33, 33, 30, 31, 30, 31,492, 30, 31,
+106, 33, 33, 33, 33, 33, 33, 33, 33, 30, 31, 30, 31,501, 30, 31,
/* block 105 */
- 30, 31, 30, 31, 30, 31, 30, 31,102, 14, 14, 30, 31,493, 33,109,
- 30, 31, 30, 31,109,109,109,109,109,109,109,109,109,109,109,109,
- 30, 31, 30, 31, 30, 31, 30, 31, 30, 31,494,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,101,101, 33, 20, 20, 20, 20, 20,
+ 30, 31, 30, 31, 30, 31, 30, 31,107, 14, 14, 30, 31,502, 33,114,
+ 30, 31, 30, 31, 33, 33, 30, 31, 30, 31, 30, 31, 30, 31, 30, 31,
+ 30, 31, 30, 31, 30, 31, 30, 31, 30, 31,503,504,505,506,114,114,
+507,508,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114, 20,106,106, 33, 20, 20, 20, 20, 20,
/* block 106 */
-495,495,496,495,495,495,496,495,495,495,495,496,495,495,495,495,
-495,495,495,495,495,495,495,495,495,495,495,495,495,495,495,495,
-495,495,495,497,497,496,496,497,498,498,498,498,109,109,109,109,
- 23, 23, 23, 23, 23, 23, 19, 19, 5, 19,109,109,109,109,109,109,
-499,499,499,499,499,499,499,499,499,499,499,499,499,499,499,499,
-499,499,499,499,499,499,499,499,499,499,499,499,499,499,499,499,
-499,499,499,499,499,499,499,499,499,499,499,499,499,499,499,499,
-499,499,499,499,500,500,500,500,109,109,109,109,109,109,109,109,
+509,509,510,509,509,509,510,509,509,509,509,510,509,509,509,509,
+509,509,509,509,509,509,509,509,509,509,509,509,509,509,509,509,
+509,509,509,511,511,510,510,511,512,512,512,512,114,114,114,114,
+ 23, 23, 23, 23, 23, 23, 19, 19, 5, 19,114,114,114,114,114,114,
+513,513,513,513,513,513,513,513,513,513,513,513,513,513,513,513,
+513,513,513,513,513,513,513,513,513,513,513,513,513,513,513,513,
+513,513,513,513,513,513,513,513,513,513,513,513,513,513,513,513,
+513,513,513,513,514,514,514,514,114,114,114,114,114,114,114,114,
/* block 107 */
-501,501,502,502,502,502,502,502,502,502,502,502,502,502,502,502,
-502,502,502,502,502,502,502,502,502,502,502,502,502,502,502,502,
-502,502,502,502,502,502,502,502,502,502,502,502,502,502,502,502,
-502,502,502,502,501,501,501,501,501,501,501,501,501,501,501,501,
-501,501,501,501,503,109,109,109,109,109,109,109,109,109,504,504,
-505,505,505,505,505,505,505,505,505,505,109,109,109,109,109,109,
-213,213,213,213,213,213,213,213,213,213,213,213,213,213,213,213,
-213,213,215,215,215,215,215,215,217,217,217,215,109,109,109,109,
+515,515,516,516,516,516,516,516,516,516,516,516,516,516,516,516,
+516,516,516,516,516,516,516,516,516,516,516,516,516,516,516,516,
+516,516,516,516,516,516,516,516,516,516,516,516,516,516,516,516,
+516,516,516,516,515,515,515,515,515,515,515,515,515,515,515,515,
+515,515,515,515,517,114,114,114,114,114,114,114,114,114,518,518,
+519,519,519,519,519,519,519,519,519,519,114,114,114,114,114,114,
+221,221,221,221,221,221,221,221,221,221,221,221,221,221,221,221,
+221,221,223,223,223,223,223,223,225,225,225,223,114,114,114,114,
/* block 108 */
-506,506,506,506,506,506,506,506,506,506,507,507,507,507,507,507,
-507,507,507,507,507,507,507,507,507,507,507,507,507,507,507,507,
-507,507,507,507,507,507,508,508,508,508,508,508,508,508,509,509,
-510,510,510,510,510,510,510,510,510,510,510,510,510,510,510,510,
-510,510,510,510,510,510,510,511,511,511,511,511,511,511,511,511,
-511,511,512,512,109,109,109,109,109,109,109,109,109,109,109,513,
-305,305,305,305,305,305,305,305,305,305,305,305,305,305,305,305,
-305,305,305,305,305,305,305,305,305,305,305,305,305,109,109,109,
+520,520,520,520,520,520,520,520,520,520,521,521,521,521,521,521,
+521,521,521,521,521,521,521,521,521,521,521,521,521,521,521,521,
+521,521,521,521,521,521,522,522,522,522,522,522,522,522, 4,523,
+524,524,524,524,524,524,524,524,524,524,524,524,524,524,524,524,
+524,524,524,524,524,524,524,525,525,525,525,525,525,525,525,525,
+525,525,526,526,114,114,114,114,114,114,114,114,114,114,114,527,
+314,314,314,314,314,314,314,314,314,314,314,314,314,314,314,314,
+314,314,314,314,314,314,314,314,314,314,314,314,314,114,114,114,
/* block 109 */
-514,514,514,515,516,516,516,516,516,516,516,516,516,516,516,516,
-516,516,516,516,516,516,516,516,516,516,516,516,516,516,516,516,
-516,516,516,516,516,516,516,516,516,516,516,516,516,516,516,516,
-516,516,516,514,515,515,514,514,514,514,515,515,514,515,515,515,
-515,517,517,517,517,517,517,517,517,517,517,517,517,517,109,518,
-519,519,519,519,519,519,519,519,519,519,109,109,109,109,517,517,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+528,528,528,529,530,530,530,530,530,530,530,530,530,530,530,530,
+530,530,530,530,530,530,530,530,530,530,530,530,530,530,530,530,
+530,530,530,530,530,530,530,530,530,530,530,530,530,530,530,530,
+530,530,530,528,529,529,528,528,528,528,529,529,528,529,529,529,
+529,531,531,531,531,531,531,531,531,531,531,531,531,531,114,107,
+532,532,532,532,532,532,532,532,532,532,114,114,114,114,531,531,
+304,304,304,304,304,306,533,304,304,304,304,304,304,304,304,304,
+308,308,308,308,308,308,308,308,308,308,304,304,304,304,304,114,
/* block 110 */
-520,520,520,520,520,520,520,520,520,520,520,520,520,520,520,520,
-520,520,520,520,520,520,520,520,520,520,520,520,520,520,520,520,
-520,520,520,520,520,520,520,520,520,521,521,521,521,521,521,522,
-522,521,521,522,522,521,521,109,109,109,109,109,109,109,109,109,
-520,520,520,521,520,520,520,520,520,520,520,520,521,522,109,109,
-523,523,523,523,523,523,523,523,523,523,109,109,524,524,524,524,
-295,295,295,295,295,295,295,295,295,295,295,295,295,295,295,295,
-525,295,295,295,295,295,295,301,301,301,295,296,109,109,109,109,
+534,534,534,534,534,534,534,534,534,534,534,534,534,534,534,534,
+534,534,534,534,534,534,534,534,534,534,534,534,534,534,534,534,
+534,534,534,534,534,534,534,534,534,535,535,535,535,535,535,536,
+536,535,535,536,536,535,535,114,114,114,114,114,114,114,114,114,
+534,534,534,535,534,534,534,534,534,534,534,534,535,536,114,114,
+537,537,537,537,537,537,537,537,537,537,114,114,538,538,538,538,
+304,304,304,304,304,304,304,304,304,304,304,304,304,304,304,304,
+533,304,304,304,304,304,304,310,310,310,304,305,306,305,304,304,
/* block 111 */
-526,526,526,526,526,526,526,526,526,526,526,526,526,526,526,526,
-526,526,526,526,526,526,526,526,526,526,526,526,526,526,526,526,
-526,526,526,526,526,526,526,526,526,526,526,526,526,526,526,526,
-527,526,527,527,527,526,526,527,527,526,526,526,526,526,527,527,
-526,527,526,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,526,526,528,529,529,
-530,530,530,530,530,530,530,530,530,530,530,531,532,532,531,531,
-533,533,530,534,534,531,532,109,109,109,109,109,109,109,109,109,
+539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,
+539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,
+539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,
+540,539,540,540,540,539,539,540,540,539,539,539,539,539,540,540,
+539,540,539,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,539,539,541,542,542,
+543,543,543,543,543,543,543,543,543,543,543,544,545,545,544,544,
+546,546,543,547,547,544,545,114,114,114,114,114,114,114,114,114,
/* block 112 */
-109,308,308,308,308,308,308,109,109,308,308,308,308,308,308,109,
-109,308,308,308,308,308,308,109,109,109,109,109,109,109,109,109,
-308,308,308,308,308,308,308,109,308,308,308,308,308,308,308,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+114,317,317,317,317,317,317,114,114,317,317,317,317,317,317,114,
+114,317,317,317,317,317,317,114,114,114,114,114,114,114,114,114,
+317,317,317,317,317,317,317,114,317,317,317,317,317,317,317,114,
+ 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33,
+ 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33,
+ 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 14,106,106,106,106,
+114,114,114,114, 33,122,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
/* block 113 */
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-530,530,530,530,530,530,530,530,530,530,530,530,530,530,530,530,
-530,530,530,530,530,530,530,530,530,530,530,530,530,530,530,530,
-530,530,530,531,531,532,531,531,532,531,531,533,531,532,109,109,
-535,535,535,535,535,535,535,535,535,535,109,109,109,109,109,109,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+543,543,543,543,543,543,543,543,543,543,543,543,543,543,543,543,
+543,543,543,543,543,543,543,543,543,543,543,543,543,543,543,543,
+543,543,543,544,544,545,544,544,545,544,544,546,544,545,114,114,
+548,548,548,548,548,548,548,548,548,548,114,114,114,114,114,114,
/* block 114 */
-536,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
-537,537,537,537,537,537,537,537,537,537,537,537,536,537,537,537,
-537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
-537,537,537,537,537,537,537,537,536,537,537,537,537,537,537,537,
-537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
-537,537,537,537,536,537,537,537,537,537,537,537,537,537,537,537,
-537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
-536,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
+549,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
+550,550,550,550,550,550,550,550,550,550,550,550,549,550,550,550,
+550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
+550,550,550,550,550,550,550,550,549,550,550,550,550,550,550,550,
+550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
+550,550,550,550,549,550,550,550,550,550,550,550,550,550,550,550,
+550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
+549,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
/* block 115 */
-537,537,537,537,537,537,537,537,537,537,537,537,536,537,537,537,
-537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
-537,537,537,537,537,537,537,537,536,537,537,537,537,537,537,537,
-537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
-537,537,537,537,536,537,537,537,537,537,537,537,537,537,537,537,
-537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
-536,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
-537,537,537,537,537,537,537,537,537,537,537,537,536,537,537,537,
+550,550,550,550,550,550,550,550,550,550,550,550,549,550,550,550,
+550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
+550,550,550,550,550,550,550,550,549,550,550,550,550,550,550,550,
+550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
+550,550,550,550,549,550,550,550,550,550,550,550,550,550,550,550,
+550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
+549,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
+550,550,550,550,550,550,550,550,550,550,550,550,549,550,550,550,
/* block 116 */
-537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
-537,537,537,537,537,537,537,537,536,537,537,537,537,537,537,537,
-537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
-537,537,537,537,536,537,537,537,537,537,537,537,537,537,537,537,
-537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
-536,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
-537,537,537,537,537,537,537,537,537,537,537,537,536,537,537,537,
-537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
+550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
+550,550,550,550,550,550,550,550,549,550,550,550,550,550,550,550,
+550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
+550,550,550,550,549,550,550,550,550,550,550,550,550,550,550,550,
+550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
+549,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
+550,550,550,550,550,550,550,550,550,550,550,550,549,550,550,550,
+550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
/* block 117 */
-537,537,537,537,537,537,537,537,536,537,537,537,537,537,537,537,
-537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
-537,537,537,537,536,537,537,537,537,537,537,537,537,537,537,537,
-537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
-536,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
-537,537,537,537,537,537,537,537,537,537,537,537,536,537,537,537,
-537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
-537,537,537,537,537,537,537,537,536,537,537,537,537,537,537,537,
+550,550,550,550,550,550,550,550,549,550,550,550,550,550,550,550,
+550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
+550,550,550,550,549,550,550,550,550,550,550,550,550,550,550,550,
+550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
+549,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
+550,550,550,550,550,550,550,550,550,550,550,550,549,550,550,550,
+550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
+550,550,550,550,550,550,550,550,549,550,550,550,550,550,550,550,
/* block 118 */
-537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
-537,537,537,537,536,537,537,537,537,537,537,537,537,537,537,537,
-537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
-536,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
-537,537,537,537,537,537,537,537,537,537,537,537,536,537,537,537,
-537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
-537,537,537,537,537,537,537,537,536,537,537,537,537,537,537,537,
-537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
+550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
+550,550,550,550,549,550,550,550,550,550,550,550,550,550,550,550,
+550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
+549,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
+550,550,550,550,550,550,550,550,550,550,550,550,549,550,550,550,
+550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
+550,550,550,550,550,550,550,550,549,550,550,550,550,550,550,550,
+550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
/* block 119 */
-537,537,537,537,536,537,537,537,537,537,537,537,537,537,537,537,
-537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
-536,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
-537,537,537,537,537,537,537,537,537,537,537,537,536,537,537,537,
-537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
-537,537,537,537,537,537,537,537,536,537,537,537,537,537,537,537,
-537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
-537,537,537,537,536,537,537,537,537,537,537,537,537,537,537,537,
+550,550,550,550,549,550,550,550,550,550,550,550,550,550,550,550,
+550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
+549,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
+550,550,550,550,550,550,550,550,550,550,550,550,549,550,550,550,
+550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
+550,550,550,550,550,550,550,550,549,550,550,550,550,550,550,550,
+550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
+550,550,550,550,549,550,550,550,550,550,550,550,550,550,550,550,
/* block 120 */
-537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
-536,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
-537,537,537,537,537,537,537,537,537,537,537,537,536,537,537,537,
-537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
-537,537,537,537,537,537,537,537,536,537,537,537,537,537,537,537,
-537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
-537,537,537,537,536,537,537,537,537,537,537,537,537,537,537,537,
-537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
+550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
+549,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
+550,550,550,550,550,550,550,550,550,550,550,550,549,550,550,550,
+550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
+550,550,550,550,550,550,550,550,549,550,550,550,550,550,550,550,
+550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
+550,550,550,550,549,550,550,550,550,550,550,550,550,550,550,550,
+550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
/* block 121 */
-537,537,537,537,537,537,537,537,536,537,537,537,537,537,537,537,
-537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,537,
-537,537,537,537,109,109,109,109,109,109,109,109,109,109,109,109,
-306,306,306,306,306,306,306,306,306,306,306,306,306,306,306,306,
-306,306,306,306,306,306,306,109,109,109,109,307,307,307,307,307,
-307,307,307,307,307,307,307,307,307,307,307,307,307,307,307,307,
-307,307,307,307,307,307,307,307,307,307,307,307,307,307,307,307,
-307,307,307,307,307,307,307,307,307,307,307,307,109,109,109,109,
+550,550,550,550,550,550,550,550,549,550,550,550,550,550,550,550,
+550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,550,
+550,550,550,550,114,114,114,114,114,114,114,114,114,114,114,114,
+315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,315,
+315,315,315,315,315,315,315,114,114,114,114,316,316,316,316,316,
+316,316,316,316,316,316,316,316,316,316,316,316,316,316,316,316,
+316,316,316,316,316,316,316,316,316,316,316,316,316,316,316,316,
+316,316,316,316,316,316,316,316,316,316,316,316,114,114,114,114,
/* block 122 */
-538,538,538,538,538,538,538,538,538,538,538,538,538,538,538,538,
-538,538,538,538,538,538,538,538,538,538,538,538,538,538,538,538,
-538,538,538,538,538,538,538,538,538,538,538,538,538,538,538,538,
-538,538,538,538,538,538,538,538,538,538,538,538,538,538,538,538,
-538,538,538,538,538,538,538,538,538,538,538,538,538,538,538,538,
-538,538,538,538,538,538,538,538,538,538,538,538,538,538,538,538,
-538,538,538,538,538,538,538,538,538,538,538,538,538,538,538,538,
-538,538,538,538,538,538,538,538,538,538,538,538,538,538,538,538,
+551,551,551,551,551,551,551,551,551,551,551,551,551,551,551,551,
+551,551,551,551,551,551,551,551,551,551,551,551,551,551,551,551,
+551,551,551,551,551,551,551,551,551,551,551,551,551,551,551,551,
+551,551,551,551,551,551,551,551,551,551,551,551,551,551,551,551,
+551,551,551,551,551,551,551,551,551,551,551,551,551,551,551,551,
+551,551,551,551,551,551,551,551,551,551,551,551,551,551,551,551,
+551,551,551,551,551,551,551,551,551,551,551,551,551,551,551,551,
+551,551,551,551,551,551,551,551,551,551,551,551,551,551,551,551,
/* block 123 */
-539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,
-539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,
-539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,
-539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,
-539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,
-539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,
-539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,
-539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,
+552,552,552,552,552,552,552,552,552,552,552,552,552,552,552,552,
+552,552,552,552,552,552,552,552,552,552,552,552,552,552,552,552,
+552,552,552,552,552,552,552,552,552,552,552,552,552,552,552,552,
+552,552,552,552,552,552,552,552,552,552,552,552,552,552,552,552,
+552,552,552,552,552,552,552,552,552,552,552,552,552,552,552,552,
+552,552,552,552,552,552,552,552,552,552,552,552,552,552,552,552,
+552,552,552,552,552,552,552,552,552,552,552,552,552,552,552,552,
+552,552,552,552,552,552,552,552,552,552,552,552,552,552,552,552,
/* block 124 */
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,109,109,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,114,114,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
/* block 125 */
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
/* block 126 */
- 33, 33, 33, 33, 33, 33, 33,109,109,109,109,109,109,109,109,109,
-109,109,109,178,178,178,178,178,109,109,109,109,109,184,181,184,
-184,184,184,184,184,184,184,184,184,540,184,184,184,184,184,184,
-184,184,184,184,184,184,184,109,184,184,184,184,184,109,184,109,
-184,184,109,184,184,109,184,184,184,184,184,184,184,184,184,184,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
+ 33, 33, 33, 33, 33, 33, 33,114,114,114,114,114,114,114,114,114,
+114,114,114,185,185,185,185,185,114,114,114,114,114,192,189,192,
+192,192,192,192,192,192,192,192,192,553,192,192,192,192,192,192,
+192,192,192,192,192,192,192,114,192,192,192,192,192,114,192,114,
+192,192,114,192,192,114,192,192,192,192,192,192,192,192,192,192,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
/* block 127 */
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,541,541,541,541,541,541,541,541,541,541,541,541,541,541,
-541,541,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,554,554,554,554,554,554,554,554,554,554,554,554,554,554,
+554,554,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
/* block 128 */
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
/* block 129 */
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191, 6, 7,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199, 7, 6,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
/* block 130 */
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-109,109,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-191,191,191,191,191,191,191,191,191,191,191,191,188, 19,109,109,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+114,114,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+199,199,199,199,199,199,199,199,199,199,199,199,196,197,114,114,
/* block 131 */
-104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,
- 4, 4, 4, 4, 4, 4, 4, 6, 7, 4,109,109,109,109,109,109,
-104,104,104,104,104,104,104,109,109,109,109,109,109,109,109,109,
+109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+ 4, 4, 4, 4, 4, 4, 4, 6, 7, 4,114,114,114,114,114,114,
+109,109,109,109,109,109,109,109,109,109,109,109,109,109,114,114,
4, 9, 9, 15, 15, 6, 7, 6, 7, 6, 7, 6, 7, 6, 7, 6,
7, 6, 7, 6, 7, 4, 4, 6, 7, 4, 4, 4, 4, 15, 15, 15,
- 4, 4, 4,109, 4, 4, 4, 4, 9, 6, 7, 6, 7, 6, 7, 4,
- 4, 4, 8, 9, 8, 8, 8,109, 4, 5, 4, 4,109,109,109,109,
-191,191,191,191,191,109,191,191,191,191,191,191,191,191,191,191,
+ 4, 4, 4,114, 4, 4, 4, 4, 9, 6, 7, 6, 7, 6, 7, 4,
+ 4, 4, 8, 9, 8, 8, 8,114, 4, 5, 4, 4,114,114,114,114,
+199,199,199,199,199,114,199,199,199,199,199,199,199,199,199,199,
/* block 132 */
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,109,109, 22,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,114,114, 22,
/* block 133 */
-109, 4, 4, 4, 5, 4, 4, 4, 6, 7, 4, 8, 4, 9, 4, 4,
+114, 4, 4, 4, 5, 4, 4, 4, 6, 7, 4, 8, 4, 9, 4, 4,
10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 4, 4, 8, 8, 8, 4,
4, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11,
11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 6, 4, 7, 14, 15,
14, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 6, 8, 7, 8, 6,
- 7, 4, 6, 7, 4, 4,469,469,469,469,469,469,469,469,469,469,
-102,469,469,469,469,469,469,469,469,469,469,469,469,469,469,469,
+ 7, 4, 6, 7, 4, 4,478,478,478,478,478,478,478,478,478,478,
+107,478,478,478,478,478,478,478,478,478,478,478,478,478,478,478,
/* block 134 */
-469,469,469,469,469,469,469,469,469,469,469,469,469,469,469,469,
-469,469,469,469,469,469,469,469,469,469,469,469,469,469,542,542,
-472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,
-472,472,472,472,472,472,472,472,472,472,472,472,472,472,472,109,
-109,109,472,472,472,472,472,472,109,109,472,472,472,472,472,472,
-109,109,472,472,472,472,472,472,109,109,472,472,472,109,109,109,
- 5, 5, 8, 14, 19, 5, 5,109, 19, 8, 8, 8, 8, 19, 19,109,
-426,426,426,426,426,426,426,426,426, 22, 22, 22, 19, 19,109,109,
+478,478,478,478,478,478,478,478,478,478,478,478,478,478,478,478,
+478,478,478,478,478,478,478,478,478,478,478,478,478,478,555,555,
+481,481,481,481,481,481,481,481,481,481,481,481,481,481,481,481,
+481,481,481,481,481,481,481,481,481,481,481,481,481,481,481,114,
+114,114,481,481,481,481,481,481,114,114,481,481,481,481,481,481,
+114,114,481,481,481,481,481,481,114,114,481,481,481,114,114,114,
+ 5, 5, 8, 14, 19, 5, 5,114, 19, 8, 8, 8, 8, 19, 19,114,
+436,436,436,436,436,436,436,436,436, 22, 22, 22, 19, 19,114,114,
/* block 135 */
-543,543,543,543,543,543,543,543,543,543,543,543,109,543,543,543,
-543,543,543,543,543,543,543,543,543,543,543,543,543,543,543,543,
-543,543,543,543,543,543,543,109,543,543,543,543,543,543,543,543,
-543,543,543,543,543,543,543,543,543,543,543,109,543,543,109,543,
-543,543,543,543,543,543,543,543,543,543,543,543,543,543,109,109,
-543,543,543,543,543,543,543,543,543,543,543,543,543,543,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+556,556,556,556,556,556,556,556,556,556,556,556,114,556,556,556,
+556,556,556,556,556,556,556,556,556,556,556,556,556,556,556,556,
+556,556,556,556,556,556,556,114,556,556,556,556,556,556,556,556,
+556,556,556,556,556,556,556,556,556,556,556,114,556,556,114,556,
+556,556,556,556,556,556,556,556,556,556,556,556,556,556,114,114,
+556,556,556,556,556,556,556,556,556,556,556,556,556,556,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
/* block 136 */
-543,543,543,543,543,543,543,543,543,543,543,543,543,543,543,543,
-543,543,543,543,543,543,543,543,543,543,543,543,543,543,543,543,
-543,543,543,543,543,543,543,543,543,543,543,543,543,543,543,543,
-543,543,543,543,543,543,543,543,543,543,543,543,543,543,543,543,
-543,543,543,543,543,543,543,543,543,543,543,543,543,543,543,543,
-543,543,543,543,543,543,543,543,543,543,543,543,543,543,543,543,
-543,543,543,543,543,543,543,543,543,543,543,543,543,543,543,543,
-543,543,543,543,543,543,543,543,543,543,543,109,109,109,109,109,
+556,556,556,556,556,556,556,556,556,556,556,556,556,556,556,556,
+556,556,556,556,556,556,556,556,556,556,556,556,556,556,556,556,
+556,556,556,556,556,556,556,556,556,556,556,556,556,556,556,556,
+556,556,556,556,556,556,556,556,556,556,556,556,556,556,556,556,
+556,556,556,556,556,556,556,556,556,556,556,556,556,556,556,556,
+556,556,556,556,556,556,556,556,556,556,556,556,556,556,556,556,
+556,556,556,556,556,556,556,556,556,556,556,556,556,556,556,556,
+556,556,556,556,556,556,556,556,556,556,556,114,114,114,114,114,
/* block 137 */
- 4, 4, 4,109,109,109,109, 23, 23, 23, 23, 23, 23, 23, 23, 23,
+ 4, 4, 4,114,114,114,114, 23, 23, 23, 23, 23, 23, 23, 23, 23,
23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23,
23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23,
- 23, 23, 23, 23,109,109,109, 19, 19, 19, 19, 19, 19, 19, 19, 19,
-544,544,544,544,544,544,544,544,544,544,544,544,544,544,544,544,
-544,544,544,544,544,544,544,544,544,544,544,544,544,544,544,544,
-544,544,544,544,544,544,544,544,544,544,544,544,544,544,544,544,
-544,544,544,544,544,545,545,545,545,546,546,546,546,546,546,546,
+ 23, 23, 23, 23,114,114,114, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+557,557,557,557,557,557,557,557,557,557,557,557,557,557,557,557,
+557,557,557,557,557,557,557,557,557,557,557,557,557,557,557,557,
+557,557,557,557,557,557,557,557,557,557,557,557,557,557,557,557,
+557,557,557,557,557,558,558,558,558,559,559,559,559,559,559,559,
/* block 138 */
-546,546,546,546,546,546,546,546,546,546,545,109,109,109,109,109,
- 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+559,559,559,559,559,559,559,559,559,559,558,558,559,114,114,114,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,114,114,114,114,
+559,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
- 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,104,109,109,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,109,114,114,
/* block 139 */
-547,547,547,547,547,547,547,547,547,547,547,547,547,547,547,547,
-547,547,547,547,547,547,547,547,547,547,547,547,547,109,109,109,
-548,548,548,548,548,548,548,548,548,548,548,548,548,548,548,548,
-548,548,548,548,548,548,548,548,548,548,548,548,548,548,548,548,
-548,548,548,548,548,548,548,548,548,548,548,548,548,548,548,548,
-548,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
/* block 140 */
-549,549,549,549,549,549,549,549,549,549,549,549,549,549,549,549,
-549,549,549,549,549,549,549,549,549,549,549,549,549,549,549,109,
-550,550,550,550,109,109,109,109,109,109,109,109,109,109,109,109,
-551,551,551,551,551,551,551,551,551,551,551,551,551,551,551,551,
-551,552,551,551,551,551,551,551,551,551,552,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+560,560,560,560,560,560,560,560,560,560,560,560,560,560,560,560,
+560,560,560,560,560,560,560,560,560,560,560,560,560,114,114,114,
+561,561,561,561,561,561,561,561,561,561,561,561,561,561,561,561,
+561,561,561,561,561,561,561,561,561,561,561,561,561,561,561,561,
+561,561,561,561,561,561,561,561,561,561,561,561,561,561,561,561,
+561,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+109, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23,
+ 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23,114,114,114,114,
/* block 141 */
-553,553,553,553,553,553,553,553,553,553,553,553,553,553,553,553,
-553,553,553,553,553,553,553,553,553,553,553,553,553,553,109,554,
-555,555,555,555,555,555,555,555,555,555,555,555,555,555,555,555,
-555,555,555,555,555,555,555,555,555,555,555,555,555,555,555,555,
-555,555,555,555,109,109,109,109,555,555,555,555,555,555,555,555,
-556,557,557,557,557,557,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+562,562,562,562,562,562,562,562,562,562,562,562,562,562,562,562,
+562,562,562,562,562,562,562,562,562,562,562,562,562,562,562,562,
+563,563,563,563,114,114,114,114,114,114,114,114,114,114,114,114,
+564,564,564,564,564,564,564,564,564,564,564,564,564,564,564,564,
+564,565,564,564,564,564,564,564,564,564,565,114,114,114,114,114,
+566,566,566,566,566,566,566,566,566,566,566,566,566,566,566,566,
+566,566,566,566,566,566,566,566,566,566,566,566,566,566,566,566,
+566,566,566,566,566,566,567,567,567,567,567,114,114,114,114,114,
/* block 142 */
-558,558,558,558,558,558,558,558,558,558,558,558,558,558,558,558,
-558,558,558,558,558,558,558,558,558,558,558,558,558,558,558,558,
-558,558,558,558,558,558,558,558,559,559,559,559,559,559,559,559,
-559,559,559,559,559,559,559,559,559,559,559,559,559,559,559,559,
-559,559,559,559,559,559,559,559,559,559,559,559,559,559,559,559,
-560,560,560,560,560,560,560,560,560,560,560,560,560,560,560,560,
-560,560,560,560,560,560,560,560,560,560,560,560,560,560,560,560,
-560,560,560,560,560,560,560,560,560,560,560,560,560,560,560,560,
+568,568,568,568,568,568,568,568,568,568,568,568,568,568,568,568,
+568,568,568,568,568,568,568,568,568,568,568,568,568,568,114,569,
+570,570,570,570,570,570,570,570,570,570,570,570,570,570,570,570,
+570,570,570,570,570,570,570,570,570,570,570,570,570,570,570,570,
+570,570,570,570,114,114,114,114,570,570,570,570,570,570,570,570,
+571,572,572,572,572,572,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
/* block 143 */
-561,561,561,561,561,561,561,561,561,561,561,561,561,561,561,561,
-561,561,561,561,561,561,561,561,561,561,561,561,561,561,109,109,
-562,562,562,562,562,562,562,562,562,562,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+573,573,573,573,573,573,573,573,573,573,573,573,573,573,573,573,
+573,573,573,573,573,573,573,573,573,573,573,573,573,573,573,573,
+573,573,573,573,573,573,573,573,574,574,574,574,574,574,574,574,
+574,574,574,574,574,574,574,574,574,574,574,574,574,574,574,574,
+574,574,574,574,574,574,574,574,574,574,574,574,574,574,574,574,
+575,575,575,575,575,575,575,575,575,575,575,575,575,575,575,575,
+575,575,575,575,575,575,575,575,575,575,575,575,575,575,575,575,
+575,575,575,575,575,575,575,575,575,575,575,575,575,575,575,575,
/* block 144 */
-563,563,563,563,563,563,109,109,563,109,563,563,563,563,563,563,
-563,563,563,563,563,563,563,563,563,563,563,563,563,563,563,563,
-563,563,563,563,563,563,563,563,563,563,563,563,563,563,563,563,
-563,563,563,563,563,563,109,563,563,109,109,109,563,109,109,563,
-564,564,564,564,564,564,564,564,564,564,564,564,564,564,564,564,
-564,564,564,564,564,564,109,565,566,566,566,566,566,566,566,566,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+576,576,576,576,576,576,576,576,576,576,576,576,576,576,576,576,
+576,576,576,576,576,576,576,576,576,576,576,576,576,576,114,114,
+577,577,577,577,577,577,577,577,577,577,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
/* block 145 */
-567,567,567,567,567,567,567,567,567,567,567,567,567,567,567,567,
-567,567,567,567,567,567,568,568,568,568,568,568,109,109,109,569,
-570,570,570,570,570,570,570,570,570,570,570,570,570,570,570,570,
-570,570,570,570,570,570,570,570,570,570,109,109,109,109,109,571,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+578,578,578,578,578,578,578,578,578,578,578,578,578,578,578,578,
+578,578,578,578,578,578,578,578,578,578,578,578,578,578,578,578,
+578,578,578,578,578,578,578,578,114,114,114,114,114,114,114,114,
+579,579,579,579,579,579,579,579,579,579,579,579,579,579,579,579,
+579,579,579,579,579,579,579,579,579,579,579,579,579,579,579,579,
+579,579,579,579,579,579,579,579,579,579,579,579,579,579,579,579,
+579,579,579,579,114,114,114,114,114,114,114,114,114,114,114,580,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
/* block 146 */
-572,572,572,572,572,572,572,572,572,572,572,572,572,572,572,572,
-572,572,572,572,572,572,572,572,572,572,572,572,572,572,572,572,
-573,573,573,573,573,573,573,573,573,573,573,573,573,573,573,573,
-573,573,573,573,573,573,573,573,109,109,109,109,109,109,573,573,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+581,581,581,581,581,581,581,581,581,581,581,581,581,581,581,581,
+581,581,581,581,581,581,581,581,581,581,581,581,581,581,581,581,
+581,581,581,581,581,581,581,581,581,581,581,581,581,581,581,581,
+581,581,581,581,581,581,581,581,581,581,581,581,581,581,581,581,
+581,581,581,581,581,581,581,581,581,581,581,581,581,581,581,581,
+581,581,581,581,581,581,581,581,581,581,581,581,581,581,581,581,
+581,581,581,581,581,581,581,581,581,581,581,581,581,581,581,581,
+581,581,581,581,581,581,581,581,581,581,581,581,581,581,581,581,
/* block 147 */
-574,575,575,575,109,575,575,109,109,109,109,109,575,575,575,575,
-574,574,574,574,109,574,574,574,109,574,574,574,574,574,574,574,
-574,574,574,574,574,574,574,574,574,574,574,574,574,574,574,574,
-574,574,574,574,109,109,109,109,575,575,575,109,109,109,109,575,
-576,576,576,576,576,576,576,576,109,109,109,109,109,109,109,109,
-577,577,577,577,577,577,577,577,577,109,109,109,109,109,109,109,
-578,578,578,578,578,578,578,578,578,578,578,578,578,578,578,578,
-578,578,578,578,578,578,578,578,578,578,578,578,578,579,579,580,
-
-/* block 148 */
581,581,581,581,581,581,581,581,581,581,581,581,581,581,581,581,
581,581,581,581,581,581,581,581,581,581,581,581,581,581,581,581,
581,581,581,581,581,581,581,581,581,581,581,581,581,581,581,581,
-581,581,581,581,581,581,109,109,109,582,582,582,582,582,582,582,
+581,581,581,581,581,581,581,114,114,114,114,114,114,114,114,114,
+581,581,581,581,581,581,581,581,581,581,581,581,581,581,581,581,
+581,581,581,581,581,581,114,114,114,114,114,114,114,114,114,114,
+581,581,581,581,581,581,581,581,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+
+/* block 148 */
+582,582,582,582,582,582,114,114,582,114,582,582,582,582,582,582,
+582,582,582,582,582,582,582,582,582,582,582,582,582,582,582,582,
+582,582,582,582,582,582,582,582,582,582,582,582,582,582,582,582,
+582,582,582,582,582,582,114,582,582,114,114,114,582,114,114,582,
583,583,583,583,583,583,583,583,583,583,583,583,583,583,583,583,
-583,583,583,583,583,583,109,109,584,584,584,584,584,584,584,584,
-585,585,585,585,585,585,585,585,585,585,585,585,585,585,585,585,
-585,585,585,109,109,109,109,109,586,586,586,586,586,586,586,586,
+583,583,583,583,583,583,114,584,585,585,585,585,585,585,585,585,
+586,586,586,586,586,586,586,586,586,586,586,586,586,586,586,586,
+586,586,586,586,586,586,586,587,587,588,588,588,588,588,588,588,
/* block 149 */
-587,587,587,587,587,587,587,587,587,587,587,587,587,587,587,587,
-587,587,587,587,587,587,587,587,587,587,587,587,587,587,587,587,
-587,587,587,587,587,587,587,587,587,587,587,587,587,587,587,587,
-587,587,587,587,587,587,587,587,587,587,587,587,587,587,587,587,
-587,587,587,587,587,587,587,587,587,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+589,589,589,589,589,589,589,589,589,589,589,589,589,589,589,589,
+589,589,589,589,589,589,589,589,589,589,589,589,589,589,589,114,
+114,114,114,114,114,114,114,590,590,590,590,590,590,590,590,590,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
/* block 150 */
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-588,588,588,588,588,588,588,588,588,588,588,588,588,588,588,588,
-588,588,588,588,588,588,588,588,588,588,588,588,588,588,588,109,
+591,591,591,591,591,591,591,591,591,591,591,591,591,591,591,591,
+591,591,591,591,591,591,592,592,592,592,592,592,114,114,114,593,
+594,594,594,594,594,594,594,594,594,594,594,594,594,594,594,594,
+594,594,594,594,594,594,594,594,594,594,114,114,114,114,114,595,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
/* block 151 */
-589,590,589,591,591,591,591,591,591,591,591,591,591,591,591,591,
-591,591,591,591,591,591,591,591,591,591,591,591,591,591,591,591,
-591,591,591,591,591,591,591,591,591,591,591,591,591,591,591,591,
-591,591,591,591,591,591,591,591,590,590,590,590,590,590,590,590,
-590,590,590,590,590,590,590,592,592,592,592,592,592,592,109,109,
-109,109,593,593,593,593,593,593,593,593,593,593,593,593,593,593,
-593,593,593,593,593,593,594,594,594,594,594,594,594,594,594,594,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+596,596,596,596,596,596,596,596,596,596,596,596,596,596,596,596,
+596,596,596,596,596,596,596,596,596,596,596,596,596,596,596,596,
+597,597,597,597,597,597,597,597,597,597,597,597,597,597,597,597,
+597,597,597,597,597,597,597,597,114,114,114,114,114,114,597,597,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
/* block 152 */
-595,595,596,597,597,597,597,597,597,597,597,597,597,597,597,597,
-597,597,597,597,597,597,597,597,597,597,597,597,597,597,597,597,
-597,597,597,597,597,597,597,597,597,597,597,597,597,597,597,597,
-596,596,596,595,595,595,595,596,596,595,595,598,598,599,598,598,
-598,598,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-600,600,600,600,600,600,600,600,600,600,600,600,600,600,600,600,
-600,600,600,600,600,600,600,600,600,109,109,109,109,109,109,109,
-601,601,601,601,601,601,601,601,601,601,109,109,109,109,109,109,
+598,599,599,599,114,599,599,114,114,114,114,114,599,599,599,599,
+598,598,598,598,114,598,598,598,114,598,598,598,598,598,598,598,
+598,598,598,598,598,598,598,598,598,598,598,598,598,598,598,598,
+598,598,598,598,114,114,114,114,599,599,599,114,114,114,114,599,
+600,600,600,600,600,600,600,600,114,114,114,114,114,114,114,114,
+601,601,601,601,601,601,601,601,601,114,114,114,114,114,114,114,
+602,602,602,602,602,602,602,602,602,602,602,602,602,602,602,602,
+602,602,602,602,602,602,602,602,602,602,602,602,602,603,603,604,
/* block 153 */
-602,602,602,603,603,603,603,603,603,603,603,603,603,603,603,603,
-603,603,603,603,603,603,603,603,603,603,603,603,603,603,603,603,
-603,603,603,603,603,603,603,602,602,602,602,602,604,602,602,602,
-602,602,602,602,602,109,605,605,605,605,605,605,605,605,605,605,
-606,606,606,606,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+605,605,605,605,605,605,605,605,605,605,605,605,605,605,605,605,
+605,605,605,605,605,605,605,605,605,605,605,605,605,606,606,606,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+607,607,607,607,607,607,607,607,608,607,607,607,607,607,607,607,
+607,607,607,607,607,607,607,607,607,607,607,607,607,607,607,607,
+607,607,607,607,607,609,609,114,114,114,114,610,610,610,610,610,
+611,611,611,611,611,611,611,114,114,114,114,114,114,114,114,114,
/* block 154 */
-607,607,608,609,609,609,609,609,609,609,609,609,609,609,609,609,
-609,609,609,609,609,609,609,609,609,609,609,609,609,609,609,609,
-609,609,609,609,609,609,609,609,609,609,609,609,609,609,609,609,
-609,609,609,608,608,608,607,607,607,607,607,607,607,607,607,608,
-608,609,609,609,609,610,610,610,610,109,109,109,109,109,109,109,
-611,611,611,611,611,611,611,611,611,611,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-
-/* block 155 */
612,612,612,612,612,612,612,612,612,612,612,612,612,612,612,612,
612,612,612,612,612,612,612,612,612,612,612,612,612,612,612,612,
-612,612,612,612,612,612,612,612,612,612,612,613,614,613,614,614,
-613,613,613,613,613,613,614,613,109,109,109,109,109,109,109,109,
-615,615,615,615,615,615,615,615,615,615,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+612,612,612,612,612,612,612,612,612,612,612,612,612,612,612,612,
+612,612,612,612,612,612,114,114,114,613,613,613,613,613,613,613,
+614,614,614,614,614,614,614,614,614,614,614,614,614,614,614,614,
+614,614,614,614,614,614,114,114,615,615,615,615,615,615,615,615,
+616,616,616,616,616,616,616,616,616,616,616,616,616,616,616,616,
+616,616,616,114,114,114,114,114,617,617,617,617,617,617,617,617,
+
+/* block 155 */
+618,618,618,618,618,618,618,618,618,618,618,618,618,618,618,618,
+618,618,114,114,114,114,114,114,114,619,619,619,619,114,114,114,
+114,114,114,114,114,114,114,114,114,620,620,620,620,620,620,620,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
/* block 156 */
-616,616,616,616,616,616,616,616,616,616,616,616,616,616,616,616,
-616,616,616,616,616,616,616,616,616,616,616,616,616,616,616,616,
-616,616,616,616,616,616,616,616,616,616,616,616,616,616,616,616,
-616,616,616,616,616,616,616,616,616,616,616,616,616,616,616,616,
-616,616,616,616,616,616,616,616,616,616,616,616,616,616,616,616,
-616,616,616,616,616,616,616,616,616,616,616,616,616,616,616,616,
-616,616,616,616,616,616,616,616,616,616,616,616,616,616,616,616,
-616,616,616,616,616,616,616,616,616,616,616,616,616,616,616,616,
+621,621,621,621,621,621,621,621,621,621,621,621,621,621,621,621,
+621,621,621,621,621,621,621,621,621,621,621,621,621,621,621,621,
+621,621,621,621,621,621,621,621,621,621,621,621,621,621,621,621,
+621,621,621,621,621,621,621,621,621,621,621,621,621,621,621,621,
+621,621,621,621,621,621,621,621,621,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
/* block 157 */
-616,616,616,616,616,616,616,616,616,616,616,616,616,616,616,616,
-616,616,616,616,616,616,616,616,616,616,616,616,616,616,616,616,
-616,616,616,616,616,616,616,616,616,616,616,616,616,616,616,616,
-616,616,616,616,616,616,616,616,616,616,616,616,616,616,616,616,
-616,616,616,616,616,616,616,616,616,616,616,616,616,616,616,616,
-616,616,616,616,616,616,616,616,616,616,616,616,616,616,616,616,
-616,616,616,616,616,616,616,616,616,616,616,616,616,616,616,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+622,622,622,622,622,622,622,622,622,622,622,622,622,622,622,622,
+622,622,622,622,622,622,622,622,622,622,622,622,622,622,622,114,
/* block 158 */
-617,617,617,617,617,617,617,617,617,617,617,617,617,617,617,617,
-617,617,617,617,617,617,617,617,617,617,617,617,617,617,617,617,
-617,617,617,617,617,617,617,617,617,617,617,617,617,617,617,617,
-617,617,617,617,617,617,617,617,617,617,617,617,617,617,617,617,
-617,617,617,617,617,617,617,617,617,617,617,617,617,617,617,617,
-617,617,617,617,617,617,617,617,617,617,617,617,617,617,617,617,
-617,617,617,109,109,109,109,109,109,109,109,109,109,109,109,109,
-618,618,618,618,109,109,109,109,109,109,109,109,109,109,109,109,
+623,624,623,625,625,625,625,625,625,625,625,625,625,625,625,625,
+625,625,625,625,625,625,625,625,625,625,625,625,625,625,625,625,
+625,625,625,625,625,625,625,625,625,625,625,625,625,625,625,625,
+625,625,625,625,625,625,625,625,624,624,624,624,624,624,624,624,
+624,624,624,624,624,624,624,626,626,626,626,626,626,626,114,114,
+114,114,627,627,627,627,627,627,627,627,627,627,627,627,627,627,
+627,627,627,627,627,627,628,628,628,628,628,628,628,628,628,628,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,624,
/* block 159 */
-619,619,619,619,619,619,619,619,619,619,619,619,619,619,619,619,
-619,619,619,619,619,619,619,619,619,619,619,619,619,619,619,619,
-619,619,619,619,619,619,619,619,619,619,619,619,619,619,619,619,
-619,619,619,619,619,619,619,619,619,619,619,619,619,619,619,619,
-619,619,619,619,619,619,619,619,619,619,619,619,619,619,619,619,
-619,619,619,619,619,619,619,619,619,619,619,619,619,619,619,619,
-619,619,619,619,619,619,619,619,619,619,619,619,619,619,619,619,
-619,619,619,619,619,619,619,619,619,619,619,619,619,619,619,619,
+629,629,630,631,631,631,631,631,631,631,631,631,631,631,631,631,
+631,631,631,631,631,631,631,631,631,631,631,631,631,631,631,631,
+631,631,631,631,631,631,631,631,631,631,631,631,631,631,631,631,
+630,630,630,629,629,629,629,630,630,629,629,632,632,633,632,632,
+632,632,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+634,634,634,634,634,634,634,634,634,634,634,634,634,634,634,634,
+634,634,634,634,634,634,634,634,634,114,114,114,114,114,114,114,
+635,635,635,635,635,635,635,635,635,635,114,114,114,114,114,114,
/* block 160 */
-619,619,619,619,619,619,619,619,619,619,619,619,619,619,619,619,
-619,619,619,619,619,619,619,619,619,619,619,619,619,619,619,619,
-619,619,619,619,619,619,619,619,619,619,619,619,619,619,619,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+636,636,636,637,637,637,637,637,637,637,637,637,637,637,637,637,
+637,637,637,637,637,637,637,637,637,637,637,637,637,637,637,637,
+637,637,637,637,637,637,637,636,636,636,636,636,638,636,636,636,
+636,636,636,636,636,114,639,639,639,639,639,639,639,639,639,639,
+640,640,640,640,114,114,114,114,114,114,114,114,114,114,114,114,
+641,641,641,641,641,641,641,641,641,641,641,641,641,641,641,641,
+641,641,641,641,641,641,641,641,641,641,641,641,641,641,641,641,
+641,641,641,642,643,643,641,114,114,114,114,114,114,114,114,114,
/* block 161 */
-488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,
-488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,
-488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,
-488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,
-488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,
-488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,
-488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,
-488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,
+644,644,645,646,646,646,646,646,646,646,646,646,646,646,646,646,
+646,646,646,646,646,646,646,646,646,646,646,646,646,646,646,646,
+646,646,646,646,646,646,646,646,646,646,646,646,646,646,646,646,
+646,646,646,645,645,645,644,644,644,644,644,644,644,644,644,645,
+645,646,646,646,646,647,647,647,647,114,114,114,114,647,114,114,
+648,648,648,648,648,648,648,648,648,648,646,114,114,114,114,114,
+114,649,649,649,649,649,649,649,649,649,649,649,649,649,649,649,
+649,649,649,649,649,114,114,114,114,114,114,114,114,114,114,114,
/* block 162 */
-488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,
-488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,
-488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,488,
-488,488,488,488,488,488,488,488,488,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+650,650,650,650,650,650,650,650,650,650,650,650,650,650,650,650,
+650,650,114,650,650,650,650,650,650,650,650,650,650,650,650,650,
+650,650,650,650,650,650,650,650,650,650,650,650,651,651,651,652,
+652,652,651,651,652,651,652,652,653,653,653,653,653,653,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
/* block 163 */
-620,620,620,620,620,620,620,620,620,620,620,620,620,620,620,620,
-620,620,620,620,620,620,620,620,620,620,620,620,620,620,620,620,
-620,620,620,620,620,620,620,620,620,620,620,620,620,620,620,620,
-620,620,620,620,620,620,620,620,620,620,620,620,620,620,620,620,
-620,620,620,620,620,109,109,109,109,109,109,109,109,109,109,109,
-620,621,621,621,621,621,621,621,621,621,621,621,621,621,621,621,
-621,621,621,621,621,621,621,621,621,621,621,621,621,621,621,621,
-621,621,621,621,621,621,621,621,621,621,621,621,621,621,621,109,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+654,654,654,654,654,654,654,654,654,654,654,654,654,654,654,654,
+654,654,654,654,654,654,654,654,654,654,654,654,654,654,654,654,
+654,654,654,654,654,654,654,654,654,654,654,654,654,654,654,655,
+656,656,656,655,655,655,655,655,655,655,655,114,114,114,114,114,
+657,657,657,657,657,657,657,657,657,657,114,114,114,114,114,114,
/* block 164 */
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,622,
-622,622,622,623,623,623,623,623,623,623,623,623,623,623,623,623,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+114,658,659,659,114,660,660,660,660,660,660,660,660,114,114,660,
+660,114,114,660,660,660,660,660,660,660,660,660,660,660,660,660,
+660,660,660,660,660,660,660,660,660,114,660,660,660,660,660,660,
+660,114,660,660,114,660,660,660,660,660,114,114,658,660,661,659,
+658,659,659,659,659,114,114,659,659,114,114,659,659,659,114,114,
+114,114,114,114,114,114,114,661,114,114,114,114,114,660,660,660,
+660,660,659,659,114,114,658,658,658,658,658,658,658,114,114,114,
+658,658,658,658,658,114,114,114,114,114,114,114,114,114,114,114,
/* block 165 */
-469,467,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+662,662,662,662,662,662,662,662,662,662,662,662,662,662,662,662,
+662,662,662,662,662,662,662,662,662,662,662,662,662,662,662,662,
+662,662,662,662,662,662,662,662,662,662,662,662,662,662,662,662,
+663,664,664,665,665,665,665,665,665,664,665,664,664,663,664,665,
+665,664,665,665,662,662,666,662,114,114,114,114,114,114,114,114,
+667,667,667,667,667,667,667,667,667,667,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
/* block 166 */
+668,668,668,668,668,668,668,668,668,668,668,668,668,668,668,668,
+668,668,668,668,668,668,668,668,668,668,668,668,668,668,668,668,
+668,668,668,668,668,668,668,668,668,668,668,668,668,668,668,669,
+670,670,671,671,671,671,114,114,670,670,670,670,671,671,670,671,
+671,672,672,672,672,672,672,672,672,672,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+
+/* block 167 */
+673,673,673,673,673,673,673,673,673,673,673,673,673,673,673,673,
+673,673,673,673,673,673,673,673,673,673,673,673,673,673,673,673,
+673,673,673,673,673,673,673,673,673,673,673,673,673,673,673,673,
+674,674,674,675,675,675,675,675,675,675,675,674,674,675,674,675,
+675,676,676,676,673,114,114,114,114,114,114,114,114,114,114,114,
+677,677,677,677,677,677,677,677,677,677,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+
+/* block 168 */
+678,678,678,678,678,678,678,678,678,678,678,678,678,678,678,678,
+678,678,678,678,678,678,678,678,678,678,678,678,678,678,678,678,
+678,678,678,678,678,678,678,678,678,678,678,679,680,679,680,680,
+679,679,679,679,679,679,680,679,114,114,114,114,114,114,114,114,
+681,681,681,681,681,681,681,681,681,681,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+
+/* block 169 */
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+682,682,682,682,682,682,682,682,682,682,682,682,682,682,682,682,
+682,682,682,682,682,682,682,682,682,682,682,682,682,682,682,682,
+683,683,683,683,683,683,683,683,683,683,683,683,683,683,683,683,
+683,683,683,683,683,683,683,683,683,683,683,683,683,683,683,683,
+684,684,684,684,684,684,684,684,684,684,685,685,685,685,685,685,
+685,685,685,114,114,114,114,114,114,114,114,114,114,114,114,686,
+
+/* block 170 */
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+687,687,687,687,687,687,687,687,687,687,687,687,687,687,687,687,
+687,687,687,687,687,687,687,687,687,687,687,687,687,687,687,687,
+687,687,687,687,687,687,687,687,687,687,687,687,687,687,687,687,
+687,687,687,687,687,687,687,687,687,114,114,114,114,114,114,114,
+
+/* block 171 */
+688,688,688,688,688,688,688,688,688,688,688,688,688,688,688,688,
+688,688,688,688,688,688,688,688,688,688,688,688,688,688,688,688,
+688,688,688,688,688,688,688,688,688,688,688,688,688,688,688,688,
+688,688,688,688,688,688,688,688,688,688,688,688,688,688,688,688,
+688,688,688,688,688,688,688,688,688,688,688,688,688,688,688,688,
+688,688,688,688,688,688,688,688,688,688,688,688,688,688,688,688,
+688,688,688,688,688,688,688,688,688,688,688,688,688,688,688,688,
+688,688,688,688,688,688,688,688,688,688,688,688,688,688,688,688,
+
+/* block 172 */
+688,688,688,688,688,688,688,688,688,688,688,688,688,688,688,688,
+688,688,688,688,688,688,688,688,688,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+
+/* block 173 */
+689,689,689,689,689,689,689,689,689,689,689,689,689,689,689,689,
+689,689,689,689,689,689,689,689,689,689,689,689,689,689,689,689,
+689,689,689,689,689,689,689,689,689,689,689,689,689,689,689,689,
+689,689,689,689,689,689,689,689,689,689,689,689,689,689,689,689,
+689,689,689,689,689,689,689,689,689,689,689,689,689,689,689,689,
+689,689,689,689,689,689,689,689,689,689,689,689,689,689,689,689,
+689,689,689,689,689,689,689,689,689,689,689,689,689,689,689,114,
+690,690,690,690,690,114,114,114,114,114,114,114,114,114,114,114,
+
+/* block 174 */
+691,691,691,691,691,691,691,691,691,691,691,691,691,691,691,691,
+691,691,691,691,691,691,691,691,691,691,691,691,691,691,691,691,
+691,691,691,691,691,691,691,691,691,691,691,691,691,691,691,691,
+691,691,691,691,691,691,691,691,691,691,691,691,691,691,691,691,
+691,691,691,691,691,691,691,691,691,691,691,691,691,691,691,691,
+691,691,691,691,691,691,691,691,691,691,691,691,691,691,691,691,
+691,691,691,691,691,691,691,691,691,691,691,691,691,691,691,691,
+691,691,691,691,691,691,691,691,691,691,691,691,691,691,691,691,
+
+/* block 175 */
+691,691,691,691,691,691,691,691,691,691,691,691,691,691,691,691,
+691,691,691,691,691,691,691,691,691,691,691,691,691,691,691,691,
+691,691,691,691,691,691,691,691,691,691,691,691,691,691,691,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+
+/* block 176 */
+497,497,497,497,497,497,497,497,497,497,497,497,497,497,497,497,
+497,497,497,497,497,497,497,497,497,497,497,497,497,497,497,497,
+497,497,497,497,497,497,497,497,497,497,497,497,497,497,497,497,
+497,497,497,497,497,497,497,497,497,497,497,497,497,497,497,497,
+497,497,497,497,497,497,497,497,497,497,497,497,497,497,497,497,
+497,497,497,497,497,497,497,497,497,497,497,497,497,497,497,497,
+497,497,497,497,497,497,497,497,497,497,497,497,497,497,497,497,
+497,497,497,497,497,497,497,497,497,497,497,497,497,497,497,497,
+
+/* block 177 */
+497,497,497,497,497,497,497,497,497,497,497,497,497,497,497,497,
+497,497,497,497,497,497,497,497,497,497,497,497,497,497,497,497,
+497,497,497,497,497,497,497,497,497,497,497,497,497,497,497,497,
+497,497,497,497,497,497,497,497,497,114,114,114,114,114,114,114,
+692,692,692,692,692,692,692,692,692,692,692,692,692,692,692,692,
+692,692,692,692,692,692,692,692,692,692,692,692,692,692,692,114,
+693,693,693,693,693,693,693,693,693,693,114,114,114,114,694,694,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+
+/* block 178 */
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+695,695,695,695,695,695,695,695,695,695,695,695,695,695,695,695,
+695,695,695,695,695,695,695,695,695,695,695,695,695,695,114,114,
+696,696,696,696,696,697,114,114,114,114,114,114,114,114,114,114,
+
+/* block 179 */
+698,698,698,698,698,698,698,698,698,698,698,698,698,698,698,698,
+698,698,698,698,698,698,698,698,698,698,698,698,698,698,698,698,
+698,698,698,698,698,698,698,698,698,698,698,698,698,698,698,698,
+699,699,699,699,699,699,699,700,700,700,700,700,701,701,701,701,
+702,702,702,702,700,701,114,114,114,114,114,114,114,114,114,114,
+703,703,703,703,703,703,703,703,703,703,114,704,704,704,704,704,
+704,704,114,698,698,698,698,698,698,698,698,698,698,698,698,698,
+698,698,698,698,698,698,698,698,114,114,114,114,114,698,698,698,
+
+/* block 180 */
+698,698,698,698,698,698,698,698,698,698,698,698,698,698,698,698,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+
+/* block 181 */
+705,705,705,705,705,705,705,705,705,705,705,705,705,705,705,705,
+705,705,705,705,705,705,705,705,705,705,705,705,705,705,705,705,
+705,705,705,705,705,705,705,705,705,705,705,705,705,705,705,705,
+705,705,705,705,705,705,705,705,705,705,705,705,705,705,705,705,
+705,705,705,705,705,114,114,114,114,114,114,114,114,114,114,114,
+705,706,706,706,706,706,706,706,706,706,706,706,706,706,706,706,
+706,706,706,706,706,706,706,706,706,706,706,706,706,706,706,706,
+706,706,706,706,706,706,706,706,706,706,706,706,706,706,706,114,
+
+/* block 182 */
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,707,
+707,707,707,708,708,708,708,708,708,708,708,708,708,708,708,708,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+
+/* block 183 */
+478,476,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+
+/* block 184 */
+709,709,709,709,709,709,709,709,709,709,709,709,709,709,709,709,
+709,709,709,709,709,709,709,709,709,709,709,709,709,709,709,709,
+709,709,709,709,709,709,709,709,709,709,709,709,709,709,709,709,
+709,709,709,709,709,709,709,709,709,709,709,709,709,709,709,709,
+709,709,709,709,709,709,709,709,709,709,709,709,709,709,709,709,
+709,709,709,709,709,709,709,709,709,709,709,709,709,709,709,709,
+709,709,709,709,709,709,709,709,709,709,709,114,114,114,114,114,
+709,709,709,709,709,709,709,709,709,709,709,709,709,114,114,114,
+
+/* block 185 */
+709,709,709,709,709,709,709,709,709,114,114,114,114,114,114,114,
+709,709,709,709,709,709,709,709,709,709,114,114,710,711,711,712,
+ 22, 22, 22, 22,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+
+/* block 186 */
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
@@ -2926,321 +3232,361 @@ const pcre_uint16 PRIV(ucd_stage2)[] = { /* 51968 bytes, block = 128 */
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
- 19, 19, 19, 19, 19, 19,109,109,109,109,109,109,109,109,109,109,
+ 19, 19, 19, 19, 19, 19,114,114,114,114,114,114,114,114,114,114,
-/* block 167 */
+/* block 187 */
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
- 19, 19, 19, 19, 19, 19, 19,109,109, 19, 19, 19, 19, 19, 19, 19,
+ 19, 19, 19, 19, 19, 19, 19,114,114, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
- 19, 19, 19, 19, 19,624,395,104,104,104, 19, 19, 19,395,624,624,
-624,624,624, 22, 22, 22, 22, 22, 22, 22, 22,104,104,104,104,104,
+ 19, 19, 19, 19, 19,713,405,109,109,109, 19, 19, 19,405,713,713,
+713,713,713, 22, 22, 22, 22, 22, 22, 22, 22,109,109,109,109,109,
-/* block 168 */
-104,104,104, 19, 19,104,104,104,104,104,104,104, 19, 19, 19, 19,
+/* block 188 */
+109,109,109, 19, 19,109,109,109,109,109,109,109, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
- 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,104,104,104,104, 19, 19,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,109,109,109,109, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
- 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
-/* block 169 */
-546,546,546,546,546,546,546,546,546,546,546,546,546,546,546,546,
-546,546,546,546,546,546,546,546,546,546,546,546,546,546,546,546,
-546,546,546,546,546,546,546,546,546,546,546,546,546,546,546,546,
-546,546,546,546,546,546,546,546,546,546,546,546,546,546,546,546,
-546,546,625,625,625,546,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+/* block 189 */
+559,559,559,559,559,559,559,559,559,559,559,559,559,559,559,559,
+559,559,559,559,559,559,559,559,559,559,559,559,559,559,559,559,
+559,559,559,559,559,559,559,559,559,559,559,559,559,559,559,559,
+559,559,559,559,559,559,559,559,559,559,559,559,559,559,559,559,
+559,559,714,714,714,559,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
-/* block 170 */
+/* block 190 */
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
- 19, 19, 19, 19, 19, 19, 19,109,109,109,109,109,109,109,109,109,
+ 19, 19, 19, 19, 19, 19, 19,114,114,114,114,114,114,114,114,114,
23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23,
- 23, 23,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+ 23, 23,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
-/* block 171 */
-428,428,428,428,428,428,428,428,428,428,428,428,428,428,428,428,
-428,428,428,428,428,428,428,428,428,428,429,429,429,429,429,429,
-429,429,429,429,429,429,429,429,429,429,429,429,429,429,429,429,
-429,429,429,429,428,428,428,428,428,428,428,428,428,428,428,428,
-428,428,428,428,428,428,428,428,428,428,428,428,428,428,429,429,
-429,429,429,429,429,109,429,429,429,429,429,429,429,429,429,429,
-429,429,429,429,429,429,429,429,428,428,428,428,428,428,428,428,
-428,428,428,428,428,428,428,428,428,428,428,428,428,428,428,428,
+/* block 191 */
+437,437,437,437,437,437,437,437,437,437,437,437,437,437,437,437,
+437,437,437,437,437,437,437,437,437,437,438,438,438,438,438,438,
+438,438,438,438,438,438,438,438,438,438,438,438,438,438,438,438,
+438,438,438,438,437,437,437,437,437,437,437,437,437,437,437,437,
+437,437,437,437,437,437,437,437,437,437,437,437,437,437,438,438,
+438,438,438,438,438,114,438,438,438,438,438,438,438,438,438,438,
+438,438,438,438,438,438,438,438,437,437,437,437,437,437,437,437,
+437,437,437,437,437,437,437,437,437,437,437,437,437,437,437,437,
-/* block 172 */
-428,428,429,429,429,429,429,429,429,429,429,429,429,429,429,429,
-429,429,429,429,429,429,429,429,429,429,429,429,428,109,428,428,
-109,109,428,109,109,428,428,109,109,428,428,428,428,109,428,428,
-428,428,428,428,428,428,429,429,429,429,109,429,109,429,429,429,
-429,429,429,429,109,429,429,429,429,429,429,429,429,429,429,429,
-428,428,428,428,428,428,428,428,428,428,428,428,428,428,428,428,
-428,428,428,428,428,428,428,428,428,428,429,429,429,429,429,429,
-429,429,429,429,429,429,429,429,429,429,429,429,429,429,429,429,
+/* block 192 */
+437,437,438,438,438,438,438,438,438,438,438,438,438,438,438,438,
+438,438,438,438,438,438,438,438,438,438,438,438,437,114,437,437,
+114,114,437,114,114,437,437,114,114,437,437,437,437,114,437,437,
+437,437,437,437,437,437,438,438,438,438,114,438,114,438,438,438,
+438,438,438,438,114,438,438,438,438,438,438,438,438,438,438,438,
+437,437,437,437,437,437,437,437,437,437,437,437,437,437,437,437,
+437,437,437,437,437,437,437,437,437,437,438,438,438,438,438,438,
+438,438,438,438,438,438,438,438,438,438,438,438,438,438,438,438,
-/* block 173 */
-429,429,429,429,428,428,109,428,428,428,428,109,109,428,428,428,
-428,428,428,428,428,109,428,428,428,428,428,428,428,109,429,429,
-429,429,429,429,429,429,429,429,429,429,429,429,429,429,429,429,
-429,429,429,429,429,429,429,429,428,428,109,428,428,428,428,109,
-428,428,428,428,428,109,428,109,109,109,428,428,428,428,428,428,
-428,109,429,429,429,429,429,429,429,429,429,429,429,429,429,429,
-429,429,429,429,429,429,429,429,429,429,429,429,428,428,428,428,
-428,428,428,428,428,428,428,428,428,428,428,428,428,428,428,428,
+/* block 193 */
+438,438,438,438,437,437,114,437,437,437,437,114,114,437,437,437,
+437,437,437,437,437,114,437,437,437,437,437,437,437,114,438,438,
+438,438,438,438,438,438,438,438,438,438,438,438,438,438,438,438,
+438,438,438,438,438,438,438,438,437,437,114,437,437,437,437,114,
+437,437,437,437,437,114,437,114,114,114,437,437,437,437,437,437,
+437,114,438,438,438,438,438,438,438,438,438,438,438,438,438,438,
+438,438,438,438,438,438,438,438,438,438,438,438,437,437,437,437,
+437,437,437,437,437,437,437,437,437,437,437,437,437,437,437,437,
-/* block 174 */
-428,428,428,428,428,428,429,429,429,429,429,429,429,429,429,429,
-429,429,429,429,429,429,429,429,429,429,429,429,429,429,429,429,
-428,428,428,428,428,428,428,428,428,428,428,428,428,428,428,428,
-428,428,428,428,428,428,428,428,428,428,429,429,429,429,429,429,
-429,429,429,429,429,429,429,429,429,429,429,429,429,429,429,429,
-429,429,429,429,428,428,428,428,428,428,428,428,428,428,428,428,
-428,428,428,428,428,428,428,428,428,428,428,428,428,428,429,429,
-429,429,429,429,429,429,429,429,429,429,429,429,429,429,429,429,
+/* block 194 */
+437,437,437,437,437,437,438,438,438,438,438,438,438,438,438,438,
+438,438,438,438,438,438,438,438,438,438,438,438,438,438,438,438,
+437,437,437,437,437,437,437,437,437,437,437,437,437,437,437,437,
+437,437,437,437,437,437,437,437,437,437,438,438,438,438,438,438,
+438,438,438,438,438,438,438,438,438,438,438,438,438,438,438,438,
+438,438,438,438,437,437,437,437,437,437,437,437,437,437,437,437,
+437,437,437,437,437,437,437,437,437,437,437,437,437,437,438,438,
+438,438,438,438,438,438,438,438,438,438,438,438,438,438,438,438,
-/* block 175 */
-429,429,429,429,429,429,429,429,428,428,428,428,428,428,428,428,
-428,428,428,428,428,428,428,428,428,428,428,428,428,428,428,428,
-428,428,429,429,429,429,429,429,429,429,429,429,429,429,429,429,
-429,429,429,429,429,429,429,429,429,429,429,429,428,428,428,428,
-428,428,428,428,428,428,428,428,428,428,428,428,428,428,428,428,
-428,428,428,428,428,428,429,429,429,429,429,429,429,429,429,429,
-429,429,429,429,429,429,429,429,429,429,429,429,429,429,429,429,
-428,428,428,428,428,428,428,428,428,428,428,428,428,428,428,428,
+/* block 195 */
+438,438,438,438,438,438,438,438,437,437,437,437,437,437,437,437,
+437,437,437,437,437,437,437,437,437,437,437,437,437,437,437,437,
+437,437,438,438,438,438,438,438,438,438,438,438,438,438,438,438,
+438,438,438,438,438,438,438,438,438,438,438,438,437,437,437,437,
+437,437,437,437,437,437,437,437,437,437,437,437,437,437,437,437,
+437,437,437,437,437,437,438,438,438,438,438,438,438,438,438,438,
+438,438,438,438,438,438,438,438,438,438,438,438,438,438,438,438,
+437,437,437,437,437,437,437,437,437,437,437,437,437,437,437,437,
-/* block 176 */
-428,428,428,428,428,428,428,428,428,428,429,429,429,429,429,429,
-429,429,429,429,429,429,429,429,429,429,429,429,429,429,429,429,
-429,429,429,429,429,429,109,109,428,428,428,428,428,428,428,428,
-428,428,428,428,428,428,428,428,428,428,428,428,428,428,428,428,
-428, 8,429,429,429,429,429,429,429,429,429,429,429,429,429,429,
-429,429,429,429,429,429,429,429,429,429,429, 8,429,429,429,429,
-429,429,428,428,428,428,428,428,428,428,428,428,428,428,428,428,
-428,428,428,428,428,428,428,428,428,428,428, 8,429,429,429,429,
+/* block 196 */
+437,437,437,437,437,437,437,437,437,437,438,438,438,438,438,438,
+438,438,438,438,438,438,438,438,438,438,438,438,438,438,438,438,
+438,438,438,438,438,438,114,114,437,437,437,437,437,437,437,437,
+437,437,437,437,437,437,437,437,437,437,437,437,437,437,437,437,
+437, 8,438,438,438,438,438,438,438,438,438,438,438,438,438,438,
+438,438,438,438,438,438,438,438,438,438,438, 8,438,438,438,438,
+438,438,437,437,437,437,437,437,437,437,437,437,437,437,437,437,
+437,437,437,437,437,437,437,437,437,437,437, 8,438,438,438,438,
-/* block 177 */
-429,429,429,429,429,429,429,429,429,429,429,429,429,429,429,429,
-429,429,429,429,429, 8,429,429,429,429,429,429,428,428,428,428,
-428,428,428,428,428,428,428,428,428,428,428,428,428,428,428,428,
-428,428,428,428,428, 8,429,429,429,429,429,429,429,429,429,429,
-429,429,429,429,429,429,429,429,429,429,429,429,429,429,429, 8,
-429,429,429,429,429,429,428,428,428,428,428,428,428,428,428,428,
-428,428,428,428,428,428,428,428,428,428,428,428,428,428,428, 8,
-429,429,429,429,429,429,429,429,429,429,429,429,429,429,429,429,
+/* block 197 */
+438,438,438,438,438,438,438,438,438,438,438,438,438,438,438,438,
+438,438,438,438,438, 8,438,438,438,438,438,438,437,437,437,437,
+437,437,437,437,437,437,437,437,437,437,437,437,437,437,437,437,
+437,437,437,437,437, 8,438,438,438,438,438,438,438,438,438,438,
+438,438,438,438,438,438,438,438,438,438,438,438,438,438,438, 8,
+438,438,438,438,438,438,437,437,437,437,437,437,437,437,437,437,
+437,437,437,437,437,437,437,437,437,437,437,437,437,437,437, 8,
+438,438,438,438,438,438,438,438,438,438,438,438,438,438,438,438,
-/* block 178 */
-429,429,429,429,429,429,429,429,429, 8,429,429,429,429,429,429,
-428,428,428,428,428,428,428,428,428,428,428,428,428,428,428,428,
-428,428,428,428,428,428,428,428,428, 8,429,429,429,429,429,429,
-429,429,429,429,429,429,429,429,429,429,429,429,429,429,429,429,
-429,429,429, 8,429,429,429,429,429,429,428,429,109,109, 10, 10,
+/* block 198 */
+438,438,438,438,438,438,438,438,438, 8,438,438,438,438,438,438,
+437,437,437,437,437,437,437,437,437,437,437,437,437,437,437,437,
+437,437,437,437,437,437,437,437,437, 8,438,438,438,438,438,438,
+438,438,438,438,438,438,438,438,438,438,438,438,438,438,438,438,
+438,438,438, 8,438,438,438,438,438,438,437,438,114,114, 10, 10,
10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
-/* block 179 */
-191,191,191,191,109,191,191,191,191,191,191,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,191,
-109,191,191,109,191,109,109,191,109,191,191,191,191,191,191,191,
-191,191,191,109,191,191,191,191,109,191,109,191,109,109,109,109,
-109,109,191,109,109,109,109,191,109,191,109,191,109,191,191,191,
-109,191,191,109,191,109,109,191,109,191,109,191,109,191,109,191,
-109,191,191,109,191,109,109,191,191,191,191,109,191,191,191,191,
-191,191,191,109,191,191,191,191,109,191,191,191,191,109,191,109,
+/* block 199 */
+715,715,715,715,715,715,715,715,715,715,715,715,715,715,715,715,
+715,715,715,715,715,715,715,715,715,715,715,715,715,715,715,715,
+715,715,715,715,715,715,715,715,715,715,715,715,715,715,715,715,
+715,715,715,715,715,715,715,715,715,715,715,715,715,715,715,715,
+715,715,715,715,715,715,715,715,715,715,715,715,715,715,715,715,
+715,715,715,715,715,715,715,715,715,715,715,715,715,715,715,715,
+715,715,715,715,715,715,715,715,715,715,715,715,715,715,715,715,
+715,715,715,715,715,715,715,715,715,715,715,715,715,715,715,715,
-/* block 180 */
-191,191,191,191,191,191,191,191,191,191,109,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,109,109,109,109,
-109,191,191,191,109,191,191,191,191,191,109,191,191,191,191,191,
-191,191,191,191,191,191,191,191,191,191,191,191,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-186,186,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+/* block 200 */
+715,715,715,715,715,715,715,715,715,715,715,715,715,715,715,715,
+715,715,715,715,715,715,715,715,715,715,715,715,715,715,715,715,
+715,715,715,715,715,715,715,715,715,715,715,715,715,715,715,715,
+715,715,715,715,715,715,715,715,715,715,715,715,715,715,715,715,
+715,715,715,715,715,114,114,716,716,716,716,716,716,716,716,716,
+717,717,717,717,717,717,717,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
-/* block 181 */
+/* block 201 */
+199,199,199,199,114,199,199,199,199,199,199,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,199,
+114,199,199,114,199,114,114,199,114,199,199,199,199,199,199,199,
+199,199,199,114,199,199,199,199,114,199,114,199,114,114,114,114,
+114,114,199,114,114,114,114,199,114,199,114,199,114,199,199,199,
+114,199,199,114,199,114,114,199,114,199,114,199,114,199,114,199,
+114,199,199,114,199,114,114,199,199,199,199,114,199,199,199,199,
+199,199,199,114,199,199,199,199,114,199,199,199,199,114,199,114,
+
+/* block 202 */
+199,199,199,199,199,199,199,199,199,199,114,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,114,114,114,114,
+114,199,199,199,114,199,199,199,199,199,114,199,199,199,199,199,
+199,199,199,199,199,199,199,199,199,199,199,199,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+194,194,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+
+/* block 203 */
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
- 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,109,109,109,109,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,114,114,114,114,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
-/* block 182 */
+/* block 204 */
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
- 19, 19, 19, 19,109,109,109,109,109,109,109,109,109,109,109,109,
- 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,109,
-109, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,109,
-109, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
-109, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+ 19, 19, 19, 19,114,114,114,114,114,114,114,114,114,114,114,114,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,114,
+114, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+114, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+114, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+ 19, 19, 19, 19, 19, 19,114,114,114,114,114,114,114,114,114,114,
-/* block 183 */
- 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23,109,109,109,109,109,
+/* block 205 */
+ 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23,114,114,114,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
- 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,109,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,114,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
- 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,109,109,109,109,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,114,114,114,114,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
-/* block 184 */
+/* block 206 */
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
- 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,626,626,626,626,626,626,626,626,626,626,
-626,626,626,626,626,626,626,626,626,626,626,626,626,626,626,626,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,718,718,718,718,718,718,718,718,718,718,
+718,718,718,718,718,718,718,718,718,718,718,718,718,718,718,718,
-/* block 185 */
-627, 19, 19,109,109,109,109,109,109,109,109,109,109,109,109,109,
+/* block 207 */
+719, 19, 19,114,114,114,114,114,114,114,114,114,114,114,114,114,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
- 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,109,109,109,109,109,
- 19, 19, 19, 19, 19, 19, 19, 19, 19,109,109,109,109,109,109,109,
- 19, 19,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,114,114,114,114,114,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19,114,114,114,114,114,114,114,
+ 19, 19,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
-/* block 186 */
+/* block 208 */
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,114,114,114,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
- 19,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
- 19, 19, 19, 19, 19, 19,109, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
- 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,109,109,109,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,114,114,
-/* block 187 */
+/* block 209 */
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
- 19, 19, 19, 19,109,109,109,109,109,109,109,109,109,109,109,109,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
- 19, 19, 19, 19, 19,109, 19, 19, 19, 19, 19,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
- 19,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,114,
+114,114,114,114, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+ 19, 19, 19, 19, 19, 19, 19, 19,114,114,114,114,114,114,114,114,
-/* block 188 */
+/* block 210 */
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
- 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,109,
- 19,109, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
-
-/* block 189 */
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,114,
+
+/* block 211 */
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,114,114,114,114,114,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
- 19, 19, 19, 19, 19, 19, 19, 19,109, 19, 19, 19, 19,109,109,109,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,114, 19, 19, 19, 19, 19,
-/* block 190 */
+/* block 212 */
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+ 19, 19, 19, 19,114, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
- 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,109,109,
- 19, 19, 19, 19,109,109,109,109,109,109,109,109,109,109,109,109,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
- 19, 19, 19, 19, 19, 19, 19, 19,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-/* block 191 */
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109, 19, 19, 19, 19, 19,
+/* block 213 */
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+ 19, 19, 19,114,114, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
-/* block 192 */
+/* block 214 */
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
- 19,109,109,109,109, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,114,114,114,
+ 19, 19, 19, 19,114,114,114,114,114,114,114,114,114,114,114,114,
-/* block 193 */
+/* block 215 */
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
- 19, 19, 19, 19, 19, 19,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+ 19, 19, 19, 19,114,114,114,114,114,114,114,114,114,114,114,114,
-/* block 194 */
+/* block 216 */
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+ 19, 19, 19, 19, 19,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+
+/* block 217 */
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,114,114,114,114,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+ 19, 19, 19, 19, 19, 19, 19, 19,114,114,114,114,114,114,114,114,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,114,114,114,114,114,114,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
- 19, 19, 19, 19,109,109,109,109,109,109,109,109,109,109,109,109,
-/* block 195 */
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+/* block 218 */
+ 19, 19, 19, 19, 19, 19, 19, 19,114,114,114,114,114,114,114,114,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
+ 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
-/* block 196 */
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,109,109,109,109,109,109,109,109,109,109,109,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
+/* block 219 */
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
-/* block 197 */
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,475,
-475,475,475,475,475,475,475,475,475,475,475,475,475,475,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+/* block 220 */
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,114,114,114,114,114,114,114,114,114,114,114,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
-/* block 198 */
-426, 22,426,426,426,426,426,426,426,426,426,426,426,426,426,426,
-426,426,426,426,426,426,426,426,426,426,426,426,426,426,426,426,
+/* block 221 */
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,484,
+484,484,484,484,484,484,484,484,484,484,484,484,484,484,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,114,
+
+/* block 222 */
+436, 22,436,436,436,436,436,436,436,436,436,436,436,436,436,436,
+436,436,436,436,436,436,436,436,436,436,436,436,436,436,436,436,
22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22,
22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22,
22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22,
@@ -3248,45 +3594,45 @@ const pcre_uint16 PRIV(ucd_stage2)[] = { /* 51968 bytes, block = 128 */
22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22,
22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22,
-/* block 199 */
-426,426,426,426,426,426,426,426,426,426,426,426,426,426,426,426,
-426,426,426,426,426,426,426,426,426,426,426,426,426,426,426,426,
-426,426,426,426,426,426,426,426,426,426,426,426,426,426,426,426,
-426,426,426,426,426,426,426,426,426,426,426,426,426,426,426,426,
-426,426,426,426,426,426,426,426,426,426,426,426,426,426,426,426,
-426,426,426,426,426,426,426,426,426,426,426,426,426,426,426,426,
-426,426,426,426,426,426,426,426,426,426,426,426,426,426,426,426,
-426,426,426,426,426,426,426,426,426,426,426,426,426,426,426,426,
+/* block 223 */
+436,436,436,436,436,436,436,436,436,436,436,436,436,436,436,436,
+436,436,436,436,436,436,436,436,436,436,436,436,436,436,436,436,
+436,436,436,436,436,436,436,436,436,436,436,436,436,436,436,436,
+436,436,436,436,436,436,436,436,436,436,436,436,436,436,436,436,
+436,436,436,436,436,436,436,436,436,436,436,436,436,436,436,436,
+436,436,436,436,436,436,436,436,436,436,436,436,436,436,436,436,
+436,436,436,436,436,436,436,436,436,436,436,436,436,436,436,436,
+436,436,436,436,436,436,436,436,436,436,436,436,436,436,436,436,
-/* block 200 */
-104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,
-104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,
-104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,
-104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,
-104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,
-104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,
-104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,
-104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,
+/* block 224 */
+109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
-/* block 201 */
-104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,
-104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,
-104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,
-104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,
-104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,
-104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,
-104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,104,
-426,426,426,426,426,426,426,426,426,426,426,426,426,426,426,426,
+/* block 225 */
+109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,109,
+436,436,436,436,436,436,436,436,436,436,436,436,436,436,436,436,
-/* block 202 */
-539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,
-539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,
-539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,
-539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,
-539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,
-539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,
-539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,539,
-539,539,539,539,539,539,539,539,539,539,539,539,539,539,109,109,
+/* block 226 */
+552,552,552,552,552,552,552,552,552,552,552,552,552,552,552,552,
+552,552,552,552,552,552,552,552,552,552,552,552,552,552,552,552,
+552,552,552,552,552,552,552,552,552,552,552,552,552,552,552,552,
+552,552,552,552,552,552,552,552,552,552,552,552,552,552,552,552,
+552,552,552,552,552,552,552,552,552,552,552,552,552,552,552,552,
+552,552,552,552,552,552,552,552,552,552,552,552,552,552,552,552,
+552,552,552,552,552,552,552,552,552,552,552,552,552,552,552,552,
+552,552,552,552,552,552,552,552,552,552,552,552,552,552,114,114,
};
diff --git a/erts/emulator/pcre/pcre_xclass.c b/erts/emulator/pcre/pcre_xclass.c
index cf07451a10..67095fa18b 100644
--- a/erts/emulator/pcre/pcre_xclass.c
+++ b/erts/emulator/pcre/pcre_xclass.c
@@ -82,6 +82,11 @@ additional data. */
if (c < 256)
{
+ if ((*data & XCL_HASPROP) == 0)
+ {
+ if ((*data & XCL_MAP) == 0) return negated;
+ return (((pcre_uint8 *)(data + 1))[c/8] & (1 << (c&7))) != 0;
+ }
if ((*data & XCL_MAP) != 0 &&
(((pcre_uint8 *)(data + 1))[c/8] & (1 << (c&7))) != 0)
return !negated; /* char found */
@@ -129,55 +134,62 @@ while ((t = *data++) != XCL_END)
else /* XCL_PROP & XCL_NOTPROP */
{
const ucd_record *prop = GET_UCD(c);
+ BOOL isprop = t == XCL_PROP;
switch(*data)
{
case PT_ANY:
- if (t == XCL_PROP) return !negated;
+ if (isprop) return !negated;
break;
case PT_LAMP:
if ((prop->chartype == ucp_Lu || prop->chartype == ucp_Ll ||
- prop->chartype == ucp_Lt) == (t == XCL_PROP)) return !negated;
+ prop->chartype == ucp_Lt) == isprop) return !negated;
break;
case PT_GC:
- if ((data[1] == PRIV(ucp_gentype)[prop->chartype]) == (t == XCL_PROP))
+ if ((data[1] == PRIV(ucp_gentype)[prop->chartype]) == isprop)
return !negated;
break;
case PT_PC:
- if ((data[1] == prop->chartype) == (t == XCL_PROP)) return !negated;
+ if ((data[1] == prop->chartype) == isprop) return !negated;
break;
case PT_SC:
- if ((data[1] == prop->script) == (t == XCL_PROP)) return !negated;
+ if ((data[1] == prop->script) == isprop) return !negated;
break;
case PT_ALNUM:
if ((PRIV(ucp_gentype)[prop->chartype] == ucp_L ||
- PRIV(ucp_gentype)[prop->chartype] == ucp_N) == (t == XCL_PROP))
+ PRIV(ucp_gentype)[prop->chartype] == ucp_N) == isprop)
return !negated;
break;
- case PT_SPACE: /* Perl space */
- if ((PRIV(ucp_gentype)[prop->chartype] == ucp_Z ||
- c == CHAR_HT || c == CHAR_NL || c == CHAR_FF || c == CHAR_CR)
- == (t == XCL_PROP))
- return !negated;
- break;
+ /* Perl space used to exclude VT, but from Perl 5.18 it is included,
+ which means that Perl space and POSIX space are now identical. PCRE
+ was changed at release 8.34. */
+ case PT_SPACE: /* Perl space */
case PT_PXSPACE: /* POSIX space */
- if ((PRIV(ucp_gentype)[prop->chartype] == ucp_Z ||
- c == CHAR_HT || c == CHAR_NL || c == CHAR_VT ||
- c == CHAR_FF || c == CHAR_CR) == (t == XCL_PROP))
- return !negated;
+ switch(c)
+ {
+ HSPACE_CASES:
+ VSPACE_CASES:
+ if (isprop) return !negated;
+ break;
+
+ default:
+ if ((PRIV(ucp_gentype)[prop->chartype] == ucp_Z) == isprop)
+ return !negated;
+ break;
+ }
break;
case PT_WORD:
if ((PRIV(ucp_gentype)[prop->chartype] == ucp_L ||
PRIV(ucp_gentype)[prop->chartype] == ucp_N || c == CHAR_UNDERSCORE)
- == (t == XCL_PROP))
+ == isprop)
return !negated;
break;
@@ -185,16 +197,60 @@ while ((t = *data++) != XCL_END)
if (c < 0xa0)
{
if ((c == CHAR_DOLLAR_SIGN || c == CHAR_COMMERCIAL_AT ||
- c == CHAR_GRAVE_ACCENT) == (t == XCL_PROP))
+ c == CHAR_GRAVE_ACCENT) == isprop)
return !negated;
}
else
{
- if ((c < 0xd800 || c > 0xdfff) == (t == XCL_PROP))
+ if ((c < 0xd800 || c > 0xdfff) == isprop)
return !negated;
}
break;
+ /* The following three properties can occur only in an XCLASS, as there
+ is no \p or \P coding for them. */
+
+ /* Graphic character. Implement this as not Z (space or separator) and
+ not C (other), except for Cf (format) with a few exceptions. This seems
+ to be what Perl does. The exceptional characters are:
+
+ U+061C Arabic Letter Mark
+ U+180E Mongolian Vowel Separator
+ U+2066 - U+2069 Various "isolate"s
+ */
+
+ case PT_PXGRAPH:
+ if ((PRIV(ucp_gentype)[prop->chartype] != ucp_Z &&
+ (PRIV(ucp_gentype)[prop->chartype] != ucp_C ||
+ (prop->chartype == ucp_Cf &&
+ c != 0x061c && c != 0x180e && (c < 0x2066 || c > 0x2069))
+ )) == isprop)
+ return !negated;
+ break;
+
+ /* Printable character: same as graphic, with the addition of Zs, i.e.
+ not Zl and not Zp, and U+180E. */
+
+ case PT_PXPRINT:
+ if ((prop->chartype != ucp_Zl &&
+ prop->chartype != ucp_Zp &&
+ (PRIV(ucp_gentype)[prop->chartype] != ucp_C ||
+ (prop->chartype == ucp_Cf &&
+ c != 0x061c && (c < 0x2066 || c > 0x2069))
+ )) == isprop)
+ return !negated;
+ break;
+
+ /* Punctuation: all Unicode punctuation, plus ASCII characters that
+ Unicode treats as symbols rather than punctuation, for Perl
+ compatibility (these are $+<=>^`|~). */
+
+ case PT_PXPUNCT:
+ if ((PRIV(ucp_gentype)[prop->chartype] == ucp_P ||
+ (c < 128 && PRIV(ucp_gentype)[prop->chartype] == ucp_S)) == isprop)
+ return !negated;
+ break;
+
/* This should never occur, but compilers may mutter if there is no
default. */
diff --git a/erts/emulator/pcre/ucp.h b/erts/emulator/pcre/ucp.h
index bbfe0f3ecb..7073bb9806 100644
--- a/erts/emulator/pcre/ucp.h
+++ b/erts/emulator/pcre/ucp.h
@@ -13,7 +13,10 @@ should always be at the end of each enum, for backwards compatibility.
IMPORTANT: Note also that the specific numeric values of the enums have to be
the same as the values that are generated by the maint/MultiStage2.py script,
-where the equivalent property descriptive names are listed in vectors. */
+where the equivalent property descriptive names are listed in vectors.
+
+ALSO: The specific values of the first two enums are assumed for the table
+called catposstab in pcre_compile.c. */
/* These are the general character categories. */
@@ -191,7 +194,31 @@ enum {
ucp_Miao,
ucp_Sharada,
ucp_Sora_Sompeng,
- ucp_Takri
+ ucp_Takri,
+ /* New for Unicode 7.0.0: */
+ ucp_Bassa_Vah,
+ ucp_Caucasian_Albanian,
+ ucp_Duployan,
+ ucp_Elbasan,
+ ucp_Grantha,
+ ucp_Khojki,
+ ucp_Khudawadi,
+ ucp_Linear_A,
+ ucp_Mahajani,
+ ucp_Manichaean,
+ ucp_Mende_Kikakui,
+ ucp_Modi,
+ ucp_Mro,
+ ucp_Nabataean,
+ ucp_Old_North_Arabian,
+ ucp_Old_Permic,
+ ucp_Pahawh_Hmong,
+ ucp_Palmyrene,
+ ucp_Psalter_Pahlavi,
+ ucp_Pau_Cin_Hau,
+ ucp_Siddham,
+ ucp_Tirhuta,
+ ucp_Warang_Citi
};
#endif
diff --git a/erts/emulator/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c
index 1db673e7f3..799f67fc45 100644
--- a/erts/emulator/sys/common/erl_check_io.c
+++ b/erts/emulator/sys/common/erl_check_io.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2006-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2006-2017. 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.
+ * 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%
*/
@@ -37,10 +38,13 @@
#include "erl_port.h"
#include "erl_check_io.h"
#include "erl_thr_progress.h"
+#include "erl_bif_unique.h"
#include "dtrace-wrapper.h"
+#include "lttng-wrapper.h"
+#define ERTS_WANT_TIMER_WHEEL_API
+#include "erl_time.h"
-#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
-#else
+#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS
# include "safe_hash.h"
# define DRV_EV_STATE_HTAB_SIZE 1024
#endif
@@ -50,10 +54,21 @@ typedef char EventStateType;
#define ERTS_EV_TYPE_DRV_SEL ((EventStateType) 1) /* driver_select */
#define ERTS_EV_TYPE_DRV_EV ((EventStateType) 2) /* driver_event */
#define ERTS_EV_TYPE_STOP_USE ((EventStateType) 3) /* pending stop_select */
+#define ERTS_EV_TYPE_NIF ((EventStateType) 4) /* enif_select */
+#define ERTS_EV_TYPE_STOP_NIF ((EventStateType) 5) /* pending nif stop */
typedef char EventStateFlags;
-#define ERTS_EV_FLAG_USED ((EventStateFlags) 1) /* ERL_DRV_USE has been turned on */
+#define ERTS_EV_FLAG_USED ((EventStateFlags) 1) /* ERL_DRV_USE has been turned on */
+#define ERTS_EV_FLAG_DEFER_IN_EV ((EventStateFlags) 2)
+#define ERTS_EV_FLAG_DEFER_OUT_EV ((EventStateFlags) 4)
+#ifdef DEBUG
+# define ERTS_ACTIVE_FD_INC 2
+#else
+# define ERTS_ACTIVE_FD_INC 128
+#endif
+
+#define ERTS_CHECK_IO_POLL_RES_LEN 512
#if defined(ERTS_KERNEL_POLL_VERSION)
# define ERTS_CIO_EXPORT(FUNC) FUNC ## _kp
@@ -67,6 +82,7 @@ typedef char EventStateFlags;
(ERTS_POLL_USE_POLL && !ERTS_POLL_USE_KERNEL_POLL)
#define ERTS_CIO_POLL_CTL ERTS_POLL_EXPORT(erts_poll_control)
+#define ERTS_CIO_POLL_CTLV ERTS_POLL_EXPORT(erts_poll_controlv)
#define ERTS_CIO_POLL_WAIT ERTS_POLL_EXPORT(erts_poll_wait)
#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
#define ERTS_CIO_POLL_AS_INTR ERTS_POLL_EXPORT(erts_poll_async_sig_interrupt)
@@ -85,6 +101,13 @@ static struct pollset_info
{
ErtsPollSet ps;
erts_smp_atomic_t in_poll_wait; /* set while doing poll */
+ struct {
+ int six; /* start index */
+ int eix; /* end index */
+ erts_smp_atomic32_t no;
+ int size;
+ ErtsSysFdType *array;
+ } active_fd;
#ifdef ERTS_SMP
struct removed_fd* removed_list; /* list of deselected fd's*/
erts_smp_spinlock_t removed_list_lock;
@@ -97,10 +120,16 @@ typedef struct {
SafeHashBucket hb;
#endif
ErtsSysFdType fd;
- union {
- ErtsDrvEventDataState *event; /* ERTS_EV_TYPE_DRV_EV */
+ struct {
ErtsDrvSelectDataState *select; /* ERTS_EV_TYPE_DRV_SEL */
- erts_driver_t* drv_ptr; /* ERTS_EV_TYPE_STOP_USE */
+#if ERTS_CIO_HAVE_DRV_EVENT
+ ErtsDrvEventDataState *event; /* ERTS_EV_TYPE_DRV_EV */
+#endif
+ ErtsNifSelectDataState *nif; /* ERTS_EV_TYPE_NIF */
+ union {
+ erts_driver_t* drv_ptr; /* ERTS_EV_TYPE_STOP_USE */
+ ErtsResource* resource; /* ERTS_EV_TYPE_STOP_NIF */
+ }stop;
} driver;
ErtsPollEvents events;
unsigned short remove_cnt; /* number of removed_fd's referring to this fd */
@@ -169,6 +198,11 @@ static ERTS_INLINE ErtsDrvEventState* hash_new_drv_ev_state(ErtsSysFdType fd)
ErtsDrvEventState tmpl;
tmpl.fd = fd;
tmpl.driver.select = NULL;
+#if ERTS_CIO_HAVE_DRV_EVENT
+ tmpl.driver.event = NULL;
+#endif
+ tmpl.driver.nif = NULL;
+ tmpl.driver.stop.drv_ptr = NULL;
tmpl.events = 0;
tmpl.remove_cnt = 0;
tmpl.type = ERTS_EV_TYPE_NONE;
@@ -185,30 +219,122 @@ static ERTS_INLINE void hash_erase_drv_ev_state(ErtsDrvEventState *state)
#endif /* !ERTS_SYS_CONTINOUS_FD_NUMBERS */
static void stale_drv_select(Eterm id, ErtsDrvEventState *state, int mode);
-static void select_steal(ErlDrvPort ix, ErtsDrvEventState *state,
- int mode, int on);
-static void print_select_op(erts_dsprintf_buf_t *dsbufp,
- ErlDrvPort ix, ErtsSysFdType fd, int mode, int on);
+static void drv_select_steal(ErlDrvPort ix, ErtsDrvEventState *state,
+ int mode, int on);
+static void nif_select_steal(ErtsDrvEventState *state, int mode,
+ ErtsResource* resource, Eterm ref);
+
+static void print_drv_select_op(erts_dsprintf_buf_t *dsbufp,
+ ErlDrvPort ix, ErtsSysFdType fd, int mode, int on);
+static void print_nif_select_op(erts_dsprintf_buf_t*, ErtsSysFdType,
+ int mode, ErtsResource*, Eterm ref);
+
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
-static void select_large_fd_error(ErlDrvPort, ErtsSysFdType, int, int);
+static void drv_select_large_fd_error(ErlDrvPort, ErtsSysFdType, int, int);
+static void nif_select_large_fd_error(ErtsSysFdType, int, ErtsResource*,Eterm ref);
#endif
#if ERTS_CIO_HAVE_DRV_EVENT
-static void event_steal(ErlDrvPort ix, ErtsDrvEventState *state,
+static void drv_event_steal(ErlDrvPort ix, ErtsDrvEventState *state,
ErlDrvEventData event_data);
-static void print_event_op(erts_dsprintf_buf_t *dsbufp,
- ErlDrvPort, ErtsSysFdType, ErlDrvEventData);
+static void print_drv_event_op(erts_dsprintf_buf_t *dsbufp,
+ ErlDrvPort, ErtsSysFdType, ErlDrvEventData);
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
static void event_large_fd_error(ErlDrvPort, ErtsSysFdType, ErlDrvEventData);
#endif
#endif
-static void steal_pending_stop_select(erts_dsprintf_buf_t*, ErlDrvPort,
- ErtsDrvEventState*, int mode, int on);
+static void
+steal_pending_stop_use(erts_dsprintf_buf_t*, ErlDrvPort, ErtsDrvEventState*,
+ int mode, int on);
+static void
+steal_pending_stop_nif(erts_dsprintf_buf_t *dsbufp, ErtsResource*,
+ ErtsDrvEventState *state, int mode, int on);
#ifdef ERTS_SMP
ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(removed_fd, struct removed_fd, 64, ERTS_ALC_T_FD_LIST)
#endif
static ERTS_INLINE void
+init_iotask(ErtsIoTask *io_task)
+{
+ erts_port_task_handle_init(&io_task->task);
+ erts_smp_atomic_init_nob(&io_task->executed_time, ~((erts_aint_t) 0));
+}
+
+static ERTS_INLINE int
+is_iotask_active(ErtsIoTask *io_task, erts_aint_t current_cio_time)
+{
+ if (erts_port_task_is_scheduled(&io_task->task))
+ return 1;
+ if (erts_smp_atomic_read_nob(&io_task->executed_time) == current_cio_time)
+ return 1;
+ return 0;
+}
+
+static ERTS_INLINE ErtsDrvSelectDataState *
+alloc_drv_select_data(void)
+{
+ ErtsDrvSelectDataState *dsp = erts_alloc(ERTS_ALC_T_DRV_SEL_D_STATE,
+ sizeof(ErtsDrvSelectDataState));
+ dsp->inport = NIL;
+ dsp->outport = NIL;
+ init_iotask(&dsp->iniotask);
+ init_iotask(&dsp->outiotask);
+ return dsp;
+}
+
+static ERTS_INLINE ErtsNifSelectDataState *
+alloc_nif_select_data(void)
+{
+ ErtsNifSelectDataState *dsp = erts_alloc(ERTS_ALC_T_NIF_SEL_D_STATE,
+ sizeof(ErtsNifSelectDataState));
+ dsp->in.pid = NIL;
+ dsp->out.pid = NIL;
+ dsp->in.ddeselect_cnt = 0;
+ dsp->out.ddeselect_cnt = 0;
+ return dsp;
+}
+
+static ERTS_INLINE void
+free_drv_select_data(ErtsDrvSelectDataState *dsp)
+{
+ ASSERT(!erts_port_task_is_scheduled(&dsp->iniotask.task));
+ ASSERT(!erts_port_task_is_scheduled(&dsp->outiotask.task));
+ erts_free(ERTS_ALC_T_DRV_SEL_D_STATE, dsp);
+}
+
+static ERTS_INLINE void
+free_nif_select_data(ErtsNifSelectDataState *dsp)
+{
+ erts_free(ERTS_ALC_T_NIF_SEL_D_STATE, dsp);
+}
+
+#if ERTS_CIO_HAVE_DRV_EVENT
+
+static ERTS_INLINE ErtsDrvEventDataState *
+alloc_drv_event_data(void)
+{
+ ErtsDrvEventDataState *dep = erts_alloc(ERTS_ALC_T_DRV_EV_D_STATE,
+ sizeof(ErtsDrvEventDataState));
+ dep->port = NIL;
+ dep->data = NULL;
+ dep->removed_events = 0;
+#if ERTS_CIO_DEFER_ACTIVE_EVENTS
+ dep->deferred_events = 0;
+#endif
+ init_iotask(&dep->iotask);
+ return dep;
+}
+
+static ERTS_INLINE void
+free_drv_event_data(ErtsDrvEventDataState *dep)
+{
+ ASSERT(!erts_port_task_is_scheduled(&dep->iotask.task));
+ erts_free(ERTS_ALC_T_DRV_EV_D_STATE, dep);
+}
+
+#endif /* ERTS_CIO_HAVE_DRV_EVENT */
+
+static ERTS_INLINE void
remember_removed(ErtsDrvEventState *state, struct pollset_info* psi)
{
#ifdef ERTS_SMP
@@ -263,6 +389,7 @@ forget_removed(struct pollset_info* psi)
erts_smp_spin_unlock(&psi->removed_list_lock);
while (fdlp) {
+ ErtsResource* resource = NULL;
erts_driver_t* drv_ptr = NULL;
erts_smp_mtx_t* mtx;
ErtsSysFdType fd;
@@ -283,15 +410,25 @@ forget_removed(struct pollset_info* psi)
ASSERT(state->remove_cnt > 0);
if (--state->remove_cnt == 0) {
switch (state->type) {
+ case ERTS_EV_TYPE_STOP_NIF:
+ /* Now we can call stop */
+ resource = state->driver.stop.resource;
+ state->driver.stop.resource = NULL;
+ ASSERT(resource);
+ state->type = ERTS_EV_TYPE_NONE;
+ state->flags &= ~ERTS_EV_FLAG_USED;
+ goto case_ERTS_EV_TYPE_NONE;
+
case ERTS_EV_TYPE_STOP_USE:
/* Now we can call stop_select */
- drv_ptr = state->driver.drv_ptr;
+ drv_ptr = state->driver.stop.drv_ptr;
ASSERT(drv_ptr);
state->type = ERTS_EV_TYPE_NONE;
- state->flags = 0;
- state->driver.drv_ptr = NULL;
+ state->flags &= ~ERTS_EV_FLAG_USED;
+ state->driver.stop.drv_ptr = NULL;
/* Fall through */
- case ERTS_EV_TYPE_NONE:
+ case ERTS_EV_TYPE_NONE:
+ case_ERTS_EV_TYPE_NONE:
#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS
hash_erase_drv_ev_state(state);
#endif
@@ -307,12 +444,18 @@ forget_removed(struct pollset_info* psi)
if (drv_ptr) {
int was_unmasked = erts_block_fpe();
DTRACE1(driver_stop_select, drv_ptr->name);
+ LTTNG1(driver_stop_select, drv_ptr->name);
(*drv_ptr->stop_select) ((ErlDrvEvent) fd, NULL);
erts_unblock_fpe(was_unmasked);
if (drv_ptr->handle) {
erts_ddll_dereference_driver(drv_ptr->handle);
}
}
+ if (resource) {
+ erts_resource_stop(resource, (ErlNifEvent)fd, 0);
+ enif_release_resource(resource->data);
+ }
+
tofree = fdlp;
fdlp = fdlp->next;
removed_fd_free(tofree);
@@ -325,14 +468,16 @@ static void
grow_drv_ev_state(int min_ix)
{
int i;
+ int old_len;
int new_len;
- new_len = ERTS_POLL_EXPORT(erts_poll_get_table_len)(min_ix + 1);
- if (new_len > max_fds)
- new_len = max_fds;
-
erts_smp_mtx_lock(&drv_ev_state_grow_lock);
- if (erts_smp_atomic_read_nob(&drv_ev_state_len) <= min_ix) {
+ old_len = erts_smp_atomic_read_nob(&drv_ev_state_len);
+ if (min_ix >= old_len) {
+ new_len = erts_poll_new_table_len(old_len, min_ix + 1);
+ if (new_len > max_fds)
+ new_len = max_fds;
+
for (i=0; i<DRV_EV_STATE_LOCK_CNT; i++) { /* lock all fd's */
erts_smp_mtx_lock(&drv_ev_state_locks[i].lck);
}
@@ -342,9 +487,14 @@ grow_drv_ev_state(int min_ix)
sizeof(ErtsDrvEventState)*new_len)
: erts_alloc(ERTS_ALC_T_DRV_EV_STATE,
sizeof(ErtsDrvEventState)*new_len));
- for (i = erts_smp_atomic_read_nob(&drv_ev_state_len); i < new_len; i++) {
+ for (i = old_len; i < new_len; i++) {
drv_ev_state[i].fd = (ErtsSysFdType) i;
drv_ev_state[i].driver.select = NULL;
+#if ERTS_CIO_HAVE_DRV_EVENT
+ drv_ev_state[i].driver.event = NULL;
+#endif
+ drv_ev_state[i].driver.stop.drv_ptr = NULL;
+ drv_ev_state[i].driver.nif = NULL;
drv_ev_state[i].events = 0;
drv_ev_state[i].remove_cnt = 0;
drv_ev_state[i].type = ERTS_EV_TYPE_NONE;
@@ -365,11 +515,7 @@ grow_drv_ev_state(int min_ix)
static ERTS_INLINE void
abort_task(Eterm id, ErtsPortTaskHandle *pthp, EventStateType type)
{
- if (is_nil(id)) {
- ASSERT(type == ERTS_EV_TYPE_NONE
- || !erts_port_task_is_scheduled(pthp));
- }
- else if (erts_port_task_is_scheduled(pthp)) {
+ if (is_not_nil(id) && erts_port_task_is_scheduled(pthp)) {
erts_port_task_abort(pthp);
ASSERT(erts_is_port_alive(id));
}
@@ -384,10 +530,11 @@ abort_tasks(ErtsDrvEventState *state, int mode)
#if ERTS_CIO_HAVE_DRV_EVENT
case ERTS_EV_TYPE_DRV_EV:
abort_task(state->driver.event->port,
- &state->driver.event->task,
+ &state->driver.event->iotask.task,
ERTS_EV_TYPE_DRV_EV);
return;
#endif
+ case ERTS_EV_TYPE_NIF:
case ERTS_EV_TYPE_NONE:
return;
default:
@@ -398,14 +545,14 @@ abort_tasks(ErtsDrvEventState *state, int mode)
case ERL_DRV_WRITE:
ASSERT(state->type == ERTS_EV_TYPE_DRV_SEL);
abort_task(state->driver.select->outport,
- &state->driver.select->outtask,
+ &state->driver.select->outiotask.task,
state->type);
if (mode == ERL_DRV_WRITE)
break;
case ERL_DRV_READ:
ASSERT(state->type == ERTS_EV_TYPE_DRV_SEL);
abort_task(state->driver.select->inport,
- &state->driver.select->intask,
+ &state->driver.select->iniotask.task,
state->type);
break;
default:
@@ -442,17 +589,23 @@ deselect(ErtsDrvEventState *state, int mode)
if (!(state->events)) {
switch (state->type) {
+ case ERTS_EV_TYPE_NIF:
+ state->driver.nif->in.pid = NIL;
+ state->driver.nif->out.pid = NIL;
+ state->driver.nif->in.ddeselect_cnt = 0;
+ state->driver.nif->out.ddeselect_cnt = 0;
+ enif_release_resource(state->driver.stop.resource);
+ state->driver.stop.resource = NULL;
+ break;
case ERTS_EV_TYPE_DRV_SEL:
- ASSERT(!erts_port_task_is_scheduled(&state->driver.select->intask));
- ASSERT(!erts_port_task_is_scheduled(&state->driver.select->outtask));
- erts_free(ERTS_ALC_T_DRV_SEL_D_STATE,
- state->driver.select);
+ state->driver.select->inport = NIL;
+ state->driver.select->outport = NIL;
break;
#if ERTS_CIO_HAVE_DRV_EVENT
case ERTS_EV_TYPE_DRV_EV:
- ASSERT(!erts_port_task_is_scheduled(&state->driver.event->task));
- erts_free(ERTS_ALC_T_DRV_EV_D_STATE,
- state->driver.event);
+ state->driver.event->port = NIL;
+ state->driver.event->data = NULL;
+ state->driver.event->removed_events = (ErtsPollEvents) 0;
break;
#endif
case ERTS_EV_TYPE_NONE:
@@ -462,20 +615,345 @@ deselect(ErtsDrvEventState *state, int mode)
break;
}
- state->driver.select = NULL;
state->type = ERTS_EV_TYPE_NONE;
- state->flags = 0;
+ state->flags &= ~ERTS_EV_FLAG_USED;
remember_removed(state, &pollset);
}
}
-
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
# define IS_FD_UNKNOWN(state) ((state)->type == ERTS_EV_TYPE_NONE && (state)->remove_cnt == 0)
#else
# define IS_FD_UNKNOWN(state) ((state) == NULL)
#endif
+static ERTS_INLINE void
+check_fd_cleanup(ErtsDrvEventState *state,
+#if ERTS_CIO_HAVE_DRV_EVENT
+ ErtsDrvEventDataState **free_event,
+#endif
+ ErtsDrvSelectDataState **free_select,
+ ErtsNifSelectDataState **free_nif)
+{
+ erts_aint_t current_cio_time;
+
+ ERTS_SMP_LC_ASSERT(erts_smp_lc_mtx_is_locked(fd_mtx(state->fd)));
+
+ current_cio_time = erts_smp_atomic_read_acqb(&erts_check_io_time);
+ *free_select = NULL;
+ if (state->driver.select
+ && (state->type != ERTS_EV_TYPE_DRV_SEL)
+ && !is_iotask_active(&state->driver.select->iniotask, current_cio_time)
+ && !is_iotask_active(&state->driver.select->outiotask, current_cio_time)) {
+
+ *free_select = state->driver.select;
+ state->driver.select = NULL;
+ }
+
+ *free_nif = NULL;
+ if (state->driver.nif && (state->type != ERTS_EV_TYPE_NIF)) {
+ *free_nif = state->driver.nif;
+ state->driver.nif = NULL;
+ }
+
+#if ERTS_CIO_HAVE_DRV_EVENT
+ *free_event = NULL;
+ if (state->driver.event
+ && (state->type != ERTS_EV_TYPE_DRV_EV)
+ && !is_iotask_active(&state->driver.event->iotask, current_cio_time)) {
+
+ *free_event = state->driver.event;
+ state->driver.event = NULL;
+ }
+#endif
+
+#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS
+ if (((state->type != ERTS_EV_TYPE_NONE)
+ | state->remove_cnt
+#if ERTS_CIO_HAVE_DRV_EVENT
+ | (state->driver.event != NULL)
+#endif
+ | (state->driver.select != NULL)) == 0) {
+
+ hash_erase_drv_ev_state(state);
+
+ }
+#endif
+}
+
+static ERTS_INLINE int
+check_cleanup_active_fd(ErtsSysFdType fd,
+#if ERTS_CIO_DEFER_ACTIVE_EVENTS
+ ErtsPollControlEntry *pce,
+ int *pce_ix,
+#endif
+ erts_aint_t current_cio_time,
+ int may_sleep)
+{
+ ErtsDrvEventState *state;
+ int active = 0;
+ erts_smp_mtx_t *mtx = fd_mtx(fd);
+ void *free_select = NULL;
+ void *free_nif = NULL;
+#if ERTS_CIO_HAVE_DRV_EVENT
+ void *free_event = NULL;
+#endif
+#if ERTS_CIO_DEFER_ACTIVE_EVENTS
+ ErtsPollEvents evon = 0, evoff = 0;
+#endif
+
+ erts_smp_mtx_lock(mtx);
+
+#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
+ state = &drv_ev_state[(int) fd];
+#else
+ state = hash_get_drv_ev_state(fd); /* may be NULL! */
+ if (state)
+#endif
+ {
+ if (state->driver.select) {
+#if ERTS_CIO_DEFER_ACTIVE_EVENTS
+ if (is_iotask_active(&state->driver.select->iniotask, current_cio_time)) {
+ active = 1;
+ if ((state->events & ERTS_POLL_EV_IN)
+ && !(state->flags & ERTS_EV_FLAG_DEFER_IN_EV)) {
+ evoff |= ERTS_POLL_EV_IN;
+ state->flags |= ERTS_EV_FLAG_DEFER_IN_EV;
+ }
+ }
+ else if (state->flags & ERTS_EV_FLAG_DEFER_IN_EV) {
+ if (state->events & ERTS_POLL_EV_IN)
+ evon |= ERTS_POLL_EV_IN;
+ state->flags &= ~ERTS_EV_FLAG_DEFER_IN_EV;
+ }
+ if (is_iotask_active(&state->driver.select->outiotask, current_cio_time)) {
+ active = 1;
+ if ((state->events & ERTS_POLL_EV_OUT)
+ && !(state->flags & ERTS_EV_FLAG_DEFER_OUT_EV)) {
+ evoff |= ERTS_POLL_EV_OUT;
+ state->flags |= ERTS_EV_FLAG_DEFER_OUT_EV;
+ }
+ }
+ else if (state->flags & ERTS_EV_FLAG_DEFER_OUT_EV) {
+ if (state->events & ERTS_POLL_EV_OUT)
+ evon |= ERTS_POLL_EV_OUT;
+ state->flags &= ~ERTS_EV_FLAG_DEFER_OUT_EV;
+ }
+ if (active)
+ (void) 0;
+ else
+#else
+ if (is_iotask_active(&state->driver.select->iniotask, current_cio_time)
+ || is_iotask_active(&state->driver.select->outiotask, current_cio_time))
+ active = 1;
+ else
+#endif
+ if (state->type != ERTS_EV_TYPE_DRV_SEL) {
+ free_select = state->driver.select;
+ state->driver.select = NULL;
+ }
+ }
+
+ if (state->driver.nif) {
+ ErtsPollEvents rm_events = 0;
+ if (state->driver.nif->in.ddeselect_cnt) {
+ ASSERT(state->type == ERTS_EV_TYPE_NIF);
+ ASSERT(state->events & ERTS_POLL_EV_IN);
+ ASSERT(is_nil(state->driver.nif->in.pid));
+ if (may_sleep || state->driver.nif->in.ddeselect_cnt == 1) {
+ rm_events = ERTS_POLL_EV_IN;
+ state->driver.nif->in.ddeselect_cnt = 0;
+ }
+ }
+ if (state->driver.nif->out.ddeselect_cnt) {
+ ASSERT(state->type == ERTS_EV_TYPE_NIF);
+ ASSERT(state->events & ERTS_POLL_EV_OUT);
+ ASSERT(is_nil(state->driver.nif->out.pid));
+ if (may_sleep || state->driver.nif->out.ddeselect_cnt == 1) {
+ rm_events |= ERTS_POLL_EV_OUT;
+ state->driver.nif->out.ddeselect_cnt = 0;
+ }
+ }
+ if (rm_events) {
+ int do_wake = 0;
+ state->events = ERTS_CIO_POLL_CTL(pollset.ps, state->fd,
+ rm_events, 0, &do_wake);
+ }
+ if (state->events)
+ active = 1;
+ else if (state->type != ERTS_EV_TYPE_NIF) {
+ free_nif = state->driver.nif;
+ state->driver.nif = NULL;
+ }
+ }
+
+#if ERTS_CIO_HAVE_DRV_EVENT
+ if (state->driver.event) {
+ if (is_iotask_active(&state->driver.event->iotask, current_cio_time)) {
+#if ERTS_CIO_DEFER_ACTIVE_EVENTS
+ ErtsPollEvents evs = state->events & ~state->driver.event->deferred_events;
+ if (evs) {
+ evoff |= evs;
+ state->driver.event->deferred_events |= evs;
+ }
+#endif
+ active = 1;
+ }
+ else if (state->type != ERTS_EV_TYPE_DRV_EV) {
+ free_event = state->driver.event;
+ state->driver.event = NULL;
+ }
+#if ERTS_CIO_DEFER_ACTIVE_EVENTS
+ else {
+ ErtsPollEvents evs = state->events & state->driver.event->deferred_events;
+ if (evs) {
+ evon |= evs;
+ state->driver.event->deferred_events = 0;
+ }
+ }
+#endif
+
+ }
+#endif
+
+#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS
+ if (((state->type != ERTS_EV_TYPE_NONE) | state->remove_cnt | active) == 0)
+ hash_erase_drv_ev_state(state);
+#endif
+
+ }
+
+ erts_smp_mtx_unlock(mtx);
+
+ if (free_select)
+ free_drv_select_data(free_select);
+ if (free_nif)
+ free_nif_select_data(free_nif);
+#if ERTS_CIO_HAVE_DRV_EVENT
+ if (free_event)
+ free_drv_event_data(free_event);
+#endif
+
+#if ERTS_CIO_DEFER_ACTIVE_EVENTS
+ if (evoff) {
+ ErtsPollControlEntry *pcep = &pce[(*pce_ix)++];
+ pcep->fd = fd;
+ pcep->events = evoff;
+ pcep->on = 0;
+ }
+ if (evon) {
+ ErtsPollControlEntry *pcep = &pce[(*pce_ix)++];
+ pcep->fd = fd;
+ pcep->events = evon;
+ pcep->on = 1;
+ }
+#endif
+
+ return active;
+}
+
+static void
+check_cleanup_active_fds(erts_aint_t current_cio_time, int may_sleep)
+{
+ int six = pollset.active_fd.six;
+ int eix = pollset.active_fd.eix;
+ erts_aint32_t no = erts_smp_atomic32_read_dirty(&pollset.active_fd.no);
+ int size = pollset.active_fd.size;
+ int ix = six;
+#if ERTS_CIO_DEFER_ACTIVE_EVENTS
+ /* every fd might add two entries */
+ Uint pce_sz = 2*sizeof(ErtsPollControlEntry)*no;
+ ErtsPollControlEntry *pctrl_entries = (pce_sz
+ ? erts_alloc(ERTS_ALC_T_TMP, pce_sz)
+ : NULL);
+ int pctrl_ix = 0;
+#endif
+
+ while (ix != eix) {
+ ErtsSysFdType fd = pollset.active_fd.array[ix];
+ int nix = ix + 1;
+ if (nix >= size)
+ nix = 0;
+ ASSERT(fd != ERTS_SYS_FD_INVALID);
+ if (!check_cleanup_active_fd(fd,
+#if ERTS_CIO_DEFER_ACTIVE_EVENTS
+ pctrl_entries,
+ &pctrl_ix,
+#endif
+ current_cio_time,
+ may_sleep)) {
+ no--;
+ if (ix == six) {
+#ifdef DEBUG
+ pollset.active_fd.array[ix] = ERTS_SYS_FD_INVALID;
+#endif
+ six = nix;
+ }
+ else {
+ pollset.active_fd.array[ix] = pollset.active_fd.array[six];
+#ifdef DEBUG
+ pollset.active_fd.array[six] = ERTS_SYS_FD_INVALID;
+#endif
+ six++;
+ if (six >= size)
+ six = 0;
+ }
+ }
+ ix = nix;
+ }
+
+#if ERTS_CIO_DEFER_ACTIVE_EVENTS
+ ASSERT(pctrl_ix <= pce_sz/sizeof(ErtsPollControlEntry));
+ if (pctrl_ix)
+ ERTS_CIO_POLL_CTLV(pollset.ps, pctrl_entries, pctrl_ix);
+ if (pctrl_entries)
+ erts_free(ERTS_ALC_T_TMP, pctrl_entries);
+#endif
+
+ pollset.active_fd.six = six;
+ pollset.active_fd.eix = eix;
+ erts_smp_atomic32_set_relb(&pollset.active_fd.no, no);
+}
+
+static void grow_active_fds(void)
+{
+ ASSERT(pollset.active_fd.six == pollset.active_fd.eix);
+ pollset.active_fd.six = 0;
+ pollset.active_fd.eix = pollset.active_fd.size;
+ pollset.active_fd.size += ERTS_ACTIVE_FD_INC;
+ pollset.active_fd.array = erts_realloc(ERTS_ALC_T_ACTIVE_FD_ARR,
+ pollset.active_fd.array,
+ pollset.active_fd.size*sizeof(ErtsSysFdType));
+#ifdef DEBUG
+ {
+ int i;
+ for (i = pollset.active_fd.eix + 1; i < pollset.active_fd.size; i++)
+ pollset.active_fd.array[i] = ERTS_SYS_FD_INVALID;
+ }
+#endif
+}
+
+static ERTS_INLINE void
+add_active_fd(ErtsSysFdType fd)
+{
+ int eix = pollset.active_fd.eix;
+ int size = pollset.active_fd.size;
+
+ pollset.active_fd.array[eix] = fd;
+
+ erts_smp_atomic32_set_relb(&pollset.active_fd.no,
+ (erts_smp_atomic32_read_dirty(&pollset.active_fd.no)
+ + 1));
+
+ eix++;
+ if (eix >= size)
+ eix = 0;
+ pollset.active_fd.eix = eix;
+
+ if (pollset.active_fd.six == eix) {
+ grow_active_fds();
+ }
+}
int
ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix,
@@ -492,6 +970,11 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix,
ErtsDrvEventState *state;
int wake_poller;
int ret;
+#if ERTS_CIO_HAVE_DRV_EVENT
+ ErtsDrvEventDataState *free_event = NULL;
+#endif
+ ErtsDrvSelectDataState *free_select = NULL;
+ ErtsNifSelectDataState *free_nif = NULL;
#ifdef USE_VM_PROBES
DTRACE_CHARBUF(name, 64);
#endif
@@ -507,7 +990,7 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix,
return -1;
}
if (fd >= max_fds) {
- select_large_fd_error(ix, fd, mode, on);
+ drv_select_large_fd_error(ix, fd, mode, on);
return -1;
}
grow_drv_ev_state(fd);
@@ -545,26 +1028,38 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix,
}
#endif
+ switch (state->type) {
#if ERTS_CIO_HAVE_DRV_EVENT
- if (state->type == ERTS_EV_TYPE_DRV_EV)
- select_steal(ix, state, mode, on);
+ case ERTS_EV_TYPE_DRV_EV:
#endif
- if (state->type == ERTS_EV_TYPE_STOP_USE) {
- erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
- print_select_op(dsbufp, ix, state->fd, mode, on);
- steal_pending_stop_select(dsbufp, ix, state, mode, on);
- if (state->type == ERTS_EV_TYPE_STOP_USE) {
- ret = 0;
- goto done; /* stop_select still pending */
- }
- ASSERT(state->type == ERTS_EV_TYPE_NONE);
+ case ERTS_EV_TYPE_NIF:
+ drv_select_steal(ix, state, mode, on);
+ break;
+ case ERTS_EV_TYPE_STOP_USE: {
+ erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
+ print_drv_select_op(dsbufp, ix, state->fd, mode, on);
+ steal_pending_stop_use(dsbufp, ix, state, mode, on);
+ if (state->type == ERTS_EV_TYPE_STOP_USE) {
+ ret = 0;
+ goto done; /* stop_select still pending */
+ }
+ ASSERT(state->type == ERTS_EV_TYPE_NONE);
+ break;
}
+ case ERTS_EV_TYPE_STOP_NIF: {
+ erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
+ print_drv_select_op(dsbufp, ix, state->fd, mode, on);
+ steal_pending_stop_nif(dsbufp, NULL, state, mode, on);
+ ASSERT(state->type == ERTS_EV_TYPE_NONE);
+ break;
+
+ }}
if (mode & ERL_DRV_READ) {
if (state->type == ERTS_EV_TYPE_DRV_SEL) {
Eterm owner = state->driver.select->inport;
if (owner != id && is_not_nil(owner))
- select_steal(ix, state, mode, on);
+ drv_select_steal(ix, state, mode, on);
}
ctl_events |= ERTS_POLL_EV_IN;
}
@@ -572,7 +1067,7 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix,
if (state->type == ERTS_EV_TYPE_DRV_SEL) {
Eterm owner = state->driver.select->outport;
if (owner != id && is_not_nil(owner))
- select_steal(ix, state, mode, on);
+ drv_select_steal(ix, state, mode, on);
}
ctl_events |= ERTS_POLL_EV_OUT;
}
@@ -593,9 +1088,9 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix,
if (new_events & (ERTS_POLL_EV_ERR|ERTS_POLL_EV_NVAL)) {
if (state->type == ERTS_EV_TYPE_DRV_SEL && !state->events) {
state->type = ERTS_EV_TYPE_NONE;
- state->flags = 0;
- erts_free(ERTS_ALC_T_DRV_SEL_D_STATE, state->driver.select);
- state->driver.select = NULL;
+ state->flags &= ~ERTS_EV_FLAG_USED;
+ state->driver.select->inport = NIL;
+ state->driver.select->outport = NIL;
}
ret = -1;
goto done;
@@ -613,18 +1108,10 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix,
state->events = new_events;
if (ctl_events) {
if (on) {
- if (state->type == ERTS_EV_TYPE_NONE) {
- ErtsDrvSelectDataState *dsdsp
- = erts_alloc(ERTS_ALC_T_DRV_SEL_D_STATE,
- sizeof(ErtsDrvSelectDataState));
- dsdsp->inport = NIL;
- dsdsp->outport = NIL;
- erts_port_task_handle_init(&dsdsp->intask);
- erts_port_task_handle_init(&dsdsp->outtask);
- ASSERT(state->driver.select == NULL);
- state->driver.select = dsdsp;
+ if (!state->driver.select)
+ state->driver.select = alloc_drv_select_data();
+ if (state->type == ERTS_EV_TYPE_NONE)
state->type = ERTS_EV_TYPE_DRV_SEL;
- }
ASSERT(state->type == ERTS_EV_TYPE_DRV_SEL);
if (ctl_events & ERTS_POLL_EV_IN)
state->driver.select->inport = id;
@@ -645,17 +1132,12 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix,
state->driver.select->outport = NIL;
}
if (new_events == 0) {
- ASSERT(!erts_port_task_is_scheduled(&state->driver.select->intask));
- ASSERT(!erts_port_task_is_scheduled(&state->driver.select->outtask));
if (old_events != 0) {
remember_removed(state, &pollset);
}
if ((mode & ERL_DRV_USE) || !(state->flags & ERTS_EV_FLAG_USED)) {
state->type = ERTS_EV_TYPE_NONE;
- state->flags = 0;
- erts_free(ERTS_ALC_T_DRV_SEL_D_STATE,
- state->driver.select);
- state->driver.select = NULL;
+ state->flags &= ~ERTS_EV_FLAG_USED;
}
/*else keep it, as fd will probably be selected upon again */
}
@@ -675,7 +1157,7 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix,
else {
/* Not safe to close fd, postpone stop_select callback. */
state->type = ERTS_EV_TYPE_STOP_USE;
- state->driver.drv_ptr = drv_ptr;
+ state->driver.stop.drv_ptr = drv_ptr;
if (drv_ptr->handle) {
erts_ddll_reference_referenced_driver(drv_ptr->handle);
}
@@ -686,23 +1168,291 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix,
ret = 0;
-done:;
-#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS
- if (state->type == ERTS_EV_TYPE_NONE && state->remove_cnt == 0) {
- hash_erase_drv_ev_state(state);
- }
+done:
+
+ check_fd_cleanup(state,
+#if ERTS_CIO_HAVE_DRV_EVENT
+ &free_event,
#endif
-done_unknown:
+ &free_select,
+ &free_nif);
+
+done_unknown:
erts_smp_mtx_unlock(fd_mtx(fd));
if (stop_select_fn) {
int was_unmasked = erts_block_fpe();
DTRACE1(driver_stop_select, name);
+ LTTNG1(driver_stop_select, "unknown");
(*stop_select_fn)(e, NULL);
erts_unblock_fpe(was_unmasked);
}
+ if (free_select)
+ free_drv_select_data(free_select);
+ if (free_nif)
+ free_nif_select_data(free_nif);
+
+#if ERTS_CIO_HAVE_DRV_EVENT
+ if (free_event)
+ free_drv_event_data(free_event);
+#endif
+ return ret;
+}
+
+int
+ERTS_CIO_EXPORT(enif_select)(ErlNifEnv* env,
+ ErlNifEvent e,
+ enum ErlNifSelectFlags mode,
+ void* obj,
+ const ErlNifPid* pid,
+ Eterm ref)
+{
+ int on;
+ ErtsResource* resource = DATA_TO_RESOURCE(obj);
+ ErtsSysFdType fd = (ErtsSysFdType) e;
+ ErtsPollEvents ctl_events = (ErtsPollEvents) 0;
+ ErtsPollEvents new_events, old_events;
+ ErtsDrvEventState *state;
+ int wake_poller;
+ int ret;
+ enum { NO_STOP=0, CALL_STOP, CALL_STOP_AND_RELEASE } call_stop = NO_STOP;
+#if ERTS_CIO_HAVE_DRV_EVENT
+ ErtsDrvEventDataState *free_event = NULL;
+#endif
+ ErtsDrvSelectDataState *free_select = NULL;
+ ErtsNifSelectDataState *free_nif = NULL;
+#ifdef USE_VM_PROBES
+ DTRACE_CHARBUF(name, 64);
+#endif
+
+ ASSERT(!(resource->monitors && resource->monitors->is_dying));
+
+#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
+ if ((unsigned)fd >= (unsigned)erts_smp_atomic_read_nob(&drv_ev_state_len)) {
+ if (fd < 0) {
+ return INT_MIN | ERL_NIF_SELECT_INVALID_EVENT;
+ }
+ if (fd >= max_fds) {
+ nif_select_large_fd_error(fd, mode, resource, ref);
+ return INT_MIN | ERL_NIF_SELECT_INVALID_EVENT;
+ }
+ grow_drv_ev_state(fd);
+ }
+#endif
+
+ erts_smp_mtx_lock(fd_mtx(fd));
+
+#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
+ state = &drv_ev_state[(int) fd];
+#else
+ state = hash_get_drv_ev_state(fd); /* may be NULL! */
+#endif
+
+ if (mode & ERL_NIF_SELECT_STOP) {
+ ASSERT(resource->type->stop);
+ if (IS_FD_UNKNOWN(state)) {
+ /* fast track to stop callback */
+ call_stop = CALL_STOP;
+ ret = ERL_NIF_SELECT_STOP_CALLED;
+ goto done_unknown;
+ }
+ on = 0;
+ mode = ERL_DRV_READ | ERL_DRV_WRITE | ERL_DRV_USE;
+ wake_poller = 1; /* to eject fd from pollset (if needed) */
+ ctl_events = ERTS_POLL_EV_IN | ERTS_POLL_EV_OUT;
+ }
+ else {
+ on = 1;
+ ASSERT(mode);
+ wake_poller = 0;
+ if (mode & ERL_DRV_READ) {
+ ctl_events |= ERTS_POLL_EV_IN;
+ }
+ if (mode & ERL_DRV_WRITE) {
+ ctl_events |= ERTS_POLL_EV_OUT;
+ }
+ }
+
+#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS
+ if (state == NULL) {
+ state = hash_new_drv_ev_state(fd);
+ }
+#endif
+
+ switch (state->type) {
+ case ERTS_EV_TYPE_NIF:
+ /*
+ * Changing resource is considered stealing.
+ * Changing process and/or ref is ok (I think?).
+ */
+ if (state->driver.stop.resource != resource)
+ nif_select_steal(state, ERL_DRV_READ | ERL_DRV_WRITE, resource, ref);
+ break;
+#if ERTS_CIO_HAVE_DRV_EVENT
+ case ERTS_EV_TYPE_DRV_EV:
+#endif
+ case ERTS_EV_TYPE_DRV_SEL:
+ nif_select_steal(state, mode, resource, ref);
+ break;
+ case ERTS_EV_TYPE_STOP_USE: {
+ erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
+ print_nif_select_op(dsbufp, fd, mode, resource, ref);
+ steal_pending_stop_use(dsbufp, ERTS_INVALID_ERL_DRV_PORT, state, mode, on);
+ ASSERT(state->type == ERTS_EV_TYPE_NONE);
+ break;
+ }
+ case ERTS_EV_TYPE_STOP_NIF: {
+ erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
+ print_nif_select_op(dsbufp, fd, mode, resource, ref);
+ steal_pending_stop_nif(dsbufp, resource, state, mode, on);
+ if (state->type == ERTS_EV_TYPE_STOP_NIF) {
+ ret = ERL_NIF_SELECT_STOP_SCHEDULED; /* ?? */
+ goto done;
+ }
+ ASSERT(state->type == ERTS_EV_TYPE_NONE);
+ break;
+ }}
+
+ ASSERT((state->type == ERTS_EV_TYPE_NIF) ||
+ (state->type == ERTS_EV_TYPE_NONE && !state->events));
+
+ new_events = ERTS_CIO_POLL_CTL(pollset.ps, state->fd, ctl_events, on, &wake_poller);
+
+ if (new_events & (ERTS_POLL_EV_ERR|ERTS_POLL_EV_NVAL)) {
+ if (state->type == ERTS_EV_TYPE_NIF && !state->events) {
+ state->type = ERTS_EV_TYPE_NONE;
+ state->flags &= ~ERTS_EV_FLAG_USED;
+ state->driver.nif->in.pid = NIL;
+ state->driver.nif->out.pid = NIL;
+ state->driver.nif->in.ddeselect_cnt = 0;
+ state->driver.nif->out.ddeselect_cnt = 0;
+ state->driver.stop.resource = NULL;
+ }
+ ret = INT_MIN | ERL_NIF_SELECT_FAILED;
+ goto done;
+ }
+
+ old_events = state->events;
+
+ ASSERT(on
+ ? (new_events == (state->events | ctl_events))
+ : (new_events == (state->events & ~ctl_events)));
+
+ ASSERT(state->type == ERTS_EV_TYPE_NIF
+ || state->type == ERTS_EV_TYPE_NONE);
+
+ state->events = new_events;
+ if (on) {
+ const Eterm recipient = pid ? pid->pid : env->proc->common.id;
+ Uint32* refn;
+ if (!state->driver.nif)
+ state->driver.nif = alloc_nif_select_data();
+ if (state->type == ERTS_EV_TYPE_NONE) {
+ state->type = ERTS_EV_TYPE_NIF;
+ state->driver.stop.resource = resource;
+ enif_keep_resource(resource->data);
+ }
+ ASSERT(state->type == ERTS_EV_TYPE_NIF);
+ ASSERT(state->driver.stop.resource == resource);
+ if (ctl_events & ERTS_POLL_EV_IN) {
+ state->driver.nif->in.pid = recipient;
+ if (is_immed(ref)) {
+ state->driver.nif->in.immed = ref;
+ } else {
+ ASSERT(is_internal_ref(ref));
+ refn = internal_ref_numbers(ref);
+ state->driver.nif->in.immed = THE_NON_VALUE;
+ state->driver.nif->in.refn[0] = refn[0];
+ state->driver.nif->in.refn[1] = refn[1];
+ state->driver.nif->in.refn[2] = refn[2];
+ }
+ state->driver.nif->in.ddeselect_cnt = 0;
+ }
+ if (ctl_events & ERTS_POLL_EV_OUT) {
+ state->driver.nif->out.pid = recipient;
+ if (is_immed(ref)) {
+ state->driver.nif->out.immed = ref;
+ } else {
+ ASSERT(is_internal_ref(ref));
+ refn = internal_ref_numbers(ref);
+ state->driver.nif->out.immed = THE_NON_VALUE;
+ state->driver.nif->out.refn[0] = refn[0];
+ state->driver.nif->out.refn[1] = refn[1];
+ state->driver.nif->out.refn[2] = refn[2];
+ }
+ state->driver.nif->out.ddeselect_cnt = 0;
+ }
+ ret = 0;
+ }
+ else { /* off */
+ if (state->type == ERTS_EV_TYPE_NIF) {
+ state->driver.nif->in.pid = NIL;
+ state->driver.nif->out.pid = NIL;
+ state->driver.nif->in.ddeselect_cnt = 0;
+ state->driver.nif->out.ddeselect_cnt = 0;
+ if (old_events != 0) {
+ remember_removed(state, &pollset);
+ }
+ }
+ ASSERT(new_events==0);
+ if (state->remove_cnt == 0 || !wake_poller) {
+ /*
+ * Safe to close fd now as it is not in pollset
+ * or there was no need to eject fd (kernel poll)
+ */
+ if (state->type == ERTS_EV_TYPE_NIF) {
+ ASSERT(state->driver.stop.resource == resource);
+ call_stop = CALL_STOP_AND_RELEASE;
+ state->driver.stop.resource = NULL;
+ }
+ else {
+ ASSERT(!state->driver.stop.resource);
+ call_stop = CALL_STOP;
+ }
+ state->type = ERTS_EV_TYPE_NONE;
+ ret = ERL_NIF_SELECT_STOP_CALLED;
+ }
+ else {
+ /* Not safe to close fd, postpone stop_select callback. */
+ if (state->type == ERTS_EV_TYPE_NONE) {
+ ASSERT(!state->driver.stop.resource);
+ state->driver.stop.resource = resource;
+ enif_keep_resource(resource);
+ }
+ state->type = ERTS_EV_TYPE_STOP_NIF;
+ ret = ERL_NIF_SELECT_STOP_SCHEDULED;
+ }
+ }
+
+done:
+
+ check_fd_cleanup(state,
+#if ERTS_CIO_HAVE_DRV_EVENT
+ &free_event,
+#endif
+ &free_select,
+ &free_nif);
+
+done_unknown:
+ erts_smp_mtx_unlock(fd_mtx(fd));
+ if (call_stop) {
+ erts_resource_stop(resource, (ErlNifEvent)fd, 1);
+ if (call_stop == CALL_STOP_AND_RELEASE) {
+ enif_release_resource(resource->data);
+ }
+ }
+ if (free_select)
+ free_drv_select_data(free_select);
+ if (free_nif)
+ free_nif_select_data(free_nif);
+
+#if ERTS_CIO_HAVE_DRV_EVENT
+ if (free_event)
+ free_drv_event_data(free_event);
+#endif
return ret;
}
+
int
ERTS_CIO_EXPORT(driver_event)(ErlDrvPort ix,
ErlDrvEvent e,
@@ -719,6 +1469,11 @@ ERTS_CIO_EXPORT(driver_event)(ErlDrvPort ix,
ErtsDrvEventState *state;
int do_wake = 0;
int ret;
+#if ERTS_CIO_HAVE_DRV_EVENT
+ ErtsDrvEventDataState *free_event;
+#endif
+ ErtsDrvSelectDataState *free_select;
+ ErtsNifSelectDataState *free_nif;
Port *prt = erts_drvport2port(ix);
if (prt == ERTS_INVALID_ERL_DRV_PORT)
@@ -755,12 +1510,12 @@ ERTS_CIO_EXPORT(driver_event)(ErlDrvPort ix,
if (state->driver.event->port == id) break;
/*fall through*/
case ERTS_EV_TYPE_DRV_SEL:
- event_steal(ix, state, event_data);
+ drv_event_steal(ix, state, event_data);
break;
case ERTS_EV_TYPE_STOP_USE: {
erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
- print_event_op(dsbufp, ix, fd, event_data);
- steal_pending_stop_select(dsbufp, ix, state, 0, 1);
+ print_drv_event_op(dsbufp, ix, fd, event_data);
+ steal_pending_stop_use(dsbufp, ix, state, 0, 1);
break;
}
}
@@ -799,10 +1554,8 @@ ERTS_CIO_EXPORT(driver_event)(ErlDrvPort ix,
state->driver.event->removed_events |= remove_events;
}
else {
- state->driver.event
- = erts_alloc(ERTS_ALC_T_DRV_EV_D_STATE,
- sizeof(ErtsDrvEventDataState));
- erts_port_task_handle_init(&state->driver.event->task);
+ if (!state->driver.event)
+ state->driver.event = alloc_drv_event_data();
state->driver.event->port = id;
state->driver.event->removed_events = (ErtsPollEvents) 0;
state->type = ERTS_EV_TYPE_DRV_EV;
@@ -812,10 +1565,10 @@ ERTS_CIO_EXPORT(driver_event)(ErlDrvPort ix,
else {
if (state->type == ERTS_EV_TYPE_DRV_EV) {
abort_tasks(state, 0);
- erts_free(ERTS_ALC_T_DRV_EV_D_STATE,
- state->driver.event);
+ state->driver.event->port = NIL;
+ state->driver.event->data = NULL;
+ state->driver.event->removed_events = (ErtsPollEvents) 0;
}
- state->driver.select = NULL;
state->type = ERTS_EV_TYPE_NONE;
remember_removed(state, &pollset);
}
@@ -825,12 +1578,25 @@ ERTS_CIO_EXPORT(driver_event)(ErlDrvPort ix,
ret = 0;
done:
-#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS
- if (state->type == ERTS_EV_TYPE_NONE && state->remove_cnt == 0) {
- hash_erase_drv_ev_state(state);
- }
+
+ check_fd_cleanup(state,
+#if ERTS_CIO_HAVE_DRV_EVENT
+ &free_event,
#endif
+ &free_select,
+ &free_nif);
+
erts_smp_mtx_unlock(fd_mtx(fd));
+
+ if (free_select)
+ free_drv_select_data(free_select);
+ if (free_nif)
+ free_nif_select_data(free_nif);
+#if ERTS_CIO_HAVE_DRV_EVENT
+ if (free_event)
+ free_drv_event_data(free_event);
+#endif
+
return ret;
#endif
}
@@ -861,13 +1627,19 @@ need2steal(ErtsDrvEventState *state, int mode)
state,
ERL_DRV_WRITE);
break;
+ case ERTS_EV_TYPE_NIF:
+ ASSERT(state->driver.stop.resource);
+ do_steal = 1;
+ break;
+
#if ERTS_CIO_HAVE_DRV_EVENT
case ERTS_EV_TYPE_DRV_EV:
do_steal |= chk_stale(state->driver.event->port, state, 0);
break;
#endif
case ERTS_EV_TYPE_STOP_USE:
- ASSERT(0);
+ case ERTS_EV_TYPE_STOP_NIF:
+ ASSERT(0);
break;
default:
break;
@@ -928,6 +1700,25 @@ steal(erts_dsprintf_buf_t *dsbufp, ErtsDrvEventState *state, int mode)
erts_dsprintf(dsbufp, "\n");
break;
}
+ case ERTS_EV_TYPE_NIF: {
+ Eterm iid = state->driver.nif->in.pid;
+ Eterm oid = state->driver.nif->out.pid;
+ const char* with = "with";
+ ErlNifResourceType* rt = state->driver.stop.resource->type;
+
+ erts_dsprintf(dsbufp, "resource %T:%T", rt->module, rt->name);
+
+ if (is_not_nil(iid)) {
+ erts_dsprintf(dsbufp, " %s in-pid %T", with, iid);
+ with = "and";
+ }
+ if (is_not_nil(oid)) {
+ erts_dsprintf(dsbufp, " %s out-pid %T", with, oid);
+ }
+ deselect(state, 0);
+ erts_dsprintf(dsbufp, "\n");
+ break;
+ }
#if ERTS_CIO_HAVE_DRV_EVENT
case ERTS_EV_TYPE_DRV_EV: {
Eterm eid = state->driver.event->port;
@@ -945,7 +1736,8 @@ steal(erts_dsprintf_buf_t *dsbufp, ErtsDrvEventState *state, int mode)
break;
}
#endif
- case ERTS_EV_TYPE_STOP_USE: {
+ case ERTS_EV_TYPE_STOP_USE:
+ case ERTS_EV_TYPE_STOP_NIF: {
ASSERT(0);
break;
}
@@ -956,16 +1748,12 @@ steal(erts_dsprintf_buf_t *dsbufp, ErtsDrvEventState *state, int mode)
}
static void
-print_select_op(erts_dsprintf_buf_t *dsbufp,
- ErlDrvPort ix, ErtsSysFdType fd, int mode, int on)
+print_drv_select_op(erts_dsprintf_buf_t *dsbufp,
+ ErlDrvPort ix, ErtsSysFdType fd, int mode, int on)
{
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),
@@ -979,11 +1767,40 @@ print_select_op(erts_dsprintf_buf_t *dsbufp,
}
static void
-select_steal(ErlDrvPort ix, ErtsDrvEventState *state, int mode, int on)
+print_nif_select_op(erts_dsprintf_buf_t *dsbufp,
+ ErtsSysFdType fd, int mode,
+ ErtsResource* resource, Eterm ref)
+{
+ erts_dsprintf(dsbufp,
+ "enif_select(_, %d,%s%s%s, %T:%T, %T) ",
+ (int) GET_FD(fd),
+ mode & ERL_NIF_SELECT_READ ? " READ" : "",
+ mode & ERL_NIF_SELECT_WRITE ? " WRITE" : "",
+ mode & ERL_NIF_SELECT_STOP ? " STOP" : "",
+ resource->type->module,
+ resource->type->name,
+ ref);
+}
+
+
+static void
+drv_select_steal(ErlDrvPort ix, ErtsDrvEventState *state, int mode, int on)
+{
+ if (need2steal(state, mode)) {
+ erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
+ print_drv_select_op(dsbufp, ix, state->fd, mode, on);
+ steal(dsbufp, state, mode);
+ erts_send_error_to_logger_nogl(dsbufp);
+ }
+}
+
+static void
+nif_select_steal(ErtsDrvEventState *state, int mode,
+ ErtsResource* resource, Eterm ref)
{
if (need2steal(state, mode)) {
erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
- print_select_op(dsbufp, ix, state->fd, mode, on);
+ print_nif_select_op(dsbufp, state->fd, mode, resource, ref);
steal(dsbufp, state, mode);
erts_send_error_to_logger_nogl(dsbufp);
}
@@ -999,10 +1816,20 @@ large_fd_error_common(erts_dsprintf_buf_t *dsbufp, ErtsSysFdType fd)
}
static void
-select_large_fd_error(ErlDrvPort ix, ErtsSysFdType fd, int mode, int on)
+drv_select_large_fd_error(ErlDrvPort ix, ErtsSysFdType fd, int mode, int on)
{
erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
- print_select_op(dsbufp, ix, fd, mode, on);
+ print_drv_select_op(dsbufp, ix, fd, mode, on);
+ erts_dsprintf(dsbufp, "failed: ");
+ large_fd_error_common(dsbufp, fd);
+ erts_send_error_to_logger_nogl(dsbufp);
+}
+static void
+nif_select_large_fd_error(ErtsSysFdType fd, int mode,
+ ErtsResource* resource, Eterm ref)
+{
+ erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
+ print_nif_select_op(dsbufp, fd, mode, resource, ref);
erts_dsprintf(dsbufp, "failed: ");
large_fd_error_common(dsbufp, fd);
erts_send_error_to_logger_nogl(dsbufp);
@@ -1012,50 +1839,90 @@ select_large_fd_error(ErlDrvPort ix, ErtsSysFdType fd, int mode, int on)
static void
-steal_pending_stop_select(erts_dsprintf_buf_t *dsbufp, ErlDrvPort ix,
- ErtsDrvEventState *state, int mode, int on)
+steal_pending_stop_use(erts_dsprintf_buf_t *dsbufp, ErlDrvPort ix,
+ ErtsDrvEventState *state, int mode, int on)
{
+ int cancel = 0;
ASSERT(state->type == ERTS_EV_TYPE_STOP_USE);
- erts_dsprintf(dsbufp, "failed: fd=%d (re)selected before stop_select "
- "was called for driver %s\n",
- (int) GET_FD(state->fd), state->driver.drv_ptr->name);
- erts_send_error_to_logger_nogl(dsbufp);
if (on) {
/* Either fd-owner changed its mind about closing
* or closed fd before stop_select callback and fd is now reused.
* In either case stop_select should not be called.
- */
- state->type = ERTS_EV_TYPE_NONE;
- state->flags = 0;
- if (state->driver.drv_ptr->handle) {
- erts_ddll_dereference_driver(state->driver.drv_ptr->handle);
- }
- state->driver.drv_ptr = NULL;
+ */
+ cancel = 1;
}
else if ((mode & ERL_DRV_USE_NO_CALLBACK) == ERL_DRV_USE) {
Port *prt = erts_drvport2port(ix);
- erts_driver_t* drv_ptr = prt != ERTS_INVALID_ERL_DRV_PORT ? prt->drv_ptr : NULL;
- if (drv_ptr && drv_ptr != state->driver.drv_ptr) {
- /* Some other driver wants the stop_select callback */
- if (state->driver.drv_ptr->handle) {
- erts_ddll_dereference_driver(state->driver.drv_ptr->handle);
- }
- if (drv_ptr->handle) {
- erts_ddll_reference_referenced_driver(drv_ptr->handle);
- }
- state->driver.drv_ptr = drv_ptr;
- }
+ if (prt == ERTS_INVALID_ERL_DRV_PORT
+ || prt->drv_ptr != state->driver.stop.drv_ptr) {
+ /* Some other driver or nif wants the stop_select callback */
+ cancel = 1;
+ }
}
+ if (cancel) {
+ erts_dsprintf(dsbufp, "called before stop_select was called for driver '%s'\n",
+ state->driver.stop.drv_ptr->name);
+ if (state->driver.stop.drv_ptr->handle) {
+ erts_ddll_dereference_driver(state->driver.stop.drv_ptr->handle);
+ }
+ state->type = ERTS_EV_TYPE_NONE;
+ state->flags &= ~ERTS_EV_FLAG_USED;
+ state->driver.stop.drv_ptr = NULL;
+ }
+ else {
+ erts_dsprintf(dsbufp, "ignored repeated call\n");
+ }
+ erts_send_error_to_logger_nogl(dsbufp);
+}
+
+static void
+steal_pending_stop_nif(erts_dsprintf_buf_t *dsbufp, ErtsResource* resource,
+ ErtsDrvEventState *state, int mode, int on)
+{
+ int cancel = 0;
+
+ ASSERT(state->type == ERTS_EV_TYPE_STOP_NIF);
+ ASSERT(state->driver.stop.resource);
+
+ if (on) {
+ ASSERT(mode & (ERL_NIF_SELECT_READ | ERL_NIF_SELECT_WRITE));
+ /* Either fd-owner changed its mind about closing
+ * or closed fd before stop callback and fd is now reused.
+ * In either case, stop should not be called.
+ */
+ cancel = 1;
+ }
+ else if ((mode & ERL_DRV_USE_NO_CALLBACK) == ERL_DRV_USE
+ && resource != state->driver.stop.resource) {
+ /* Some driver or other resource wants the stop callback */
+ cancel = 1;
+ }
+
+ if (cancel) {
+ ErlNifResourceType* rt = state->driver.stop.resource->type;
+ erts_dsprintf(dsbufp, "called before stop was called for NIF resource %T:%T\n",
+ rt->module, rt->name);
+
+ enif_release_resource(state->driver.stop.resource);
+ state->type = ERTS_EV_TYPE_NONE;
+ state->flags &= ~ERTS_EV_FLAG_USED;
+ state->driver.stop.resource = NULL;
+ }
+ else {
+ erts_dsprintf(dsbufp, "ignored repeated call\n");
+ }
+ erts_send_error_to_logger_nogl(dsbufp);
+
}
#if ERTS_CIO_HAVE_DRV_EVENT
static void
-print_event_op(erts_dsprintf_buf_t *dsbufp,
- ErlDrvPort ix, ErtsSysFdType fd, ErlDrvEventData event_data)
+print_drv_event_op(erts_dsprintf_buf_t *dsbufp,
+ ErlDrvPort ix, ErtsSysFdType fd, ErlDrvEventData event_data)
{
Port *pp = erts_drvport2port(ix);
erts_dsprintf(dsbufp, "driver_event(%p, %d, ", ix, (int) fd);
@@ -1072,11 +1939,11 @@ print_event_op(erts_dsprintf_buf_t *dsbufp,
}
static void
-event_steal(ErlDrvPort ix, ErtsDrvEventState *state, ErlDrvEventData event_data)
+drv_event_steal(ErlDrvPort ix, ErtsDrvEventState *state, ErlDrvEventData event_data)
{
if (need2steal(state, ERL_DRV_READ|ERL_DRV_WRITE)) {
erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
- print_event_op(dsbufp, ix, state->fd, event_data);
+ print_drv_event_op(dsbufp, ix, state->fd, event_data);
steal(dsbufp, state, ERL_DRV_READ|ERL_DRV_WRITE);
erts_send_error_to_logger_nogl(dsbufp);
}
@@ -1091,7 +1958,7 @@ static void
event_large_fd_error(ErlDrvPort ix, ErtsSysFdType fd, ErlDrvEventData event_data)
{
erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
- print_event_op(dsbufp, ix, fd, event_data);
+ print_drv_event_op(dsbufp, ix, fd, event_data);
erts_dsprintf(dsbufp, "failed: ");
large_fd_error_common(dsbufp, fd);
erts_send_error_to_logger_nogl(dsbufp);
@@ -1099,43 +1966,157 @@ event_large_fd_error(ErlDrvPort ix, ErtsSysFdType fd, ErlDrvEventData event_data
#endif
#endif
+static ERTS_INLINE int
+io_task_schedule_allowed(ErtsDrvEventState *state,
+ ErtsPortTaskType type,
+ erts_aint_t current_cio_time)
+{
+ ErtsIoTask *io_task;
+
+ switch (type) {
+ case ERTS_PORT_TASK_INPUT:
+ if (!state->driver.select)
+ return 0;
+#if ERTS_CIO_HAVE_DRV_EVENT
+ if (state->driver.event)
+ return 0;
+#endif
+ io_task = &state->driver.select->iniotask;
+ break;
+ case ERTS_PORT_TASK_OUTPUT:
+ if (!state->driver.select)
+ return 0;
+#if ERTS_CIO_HAVE_DRV_EVENT
+ if (state->driver.event)
+ return 0;
+#endif
+ io_task = &state->driver.select->outiotask;
+ break;
+#if ERTS_CIO_HAVE_DRV_EVENT
+ case ERTS_PORT_TASK_EVENT:
+ if (!state->driver.event)
+ return 0;
+ if (state->driver.select)
+ return 0;
+ io_task = &state->driver.event->iotask;
+ break;
+#endif
+ default:
+ ERTS_INTERNAL_ERROR("Invalid I/O-task type");
+ return 0;
+ }
+
+ return !is_iotask_active(io_task, current_cio_time);
+}
+
+static ERTS_INLINE void
+iready(Eterm id, ErtsDrvEventState *state, erts_aint_t current_cio_time)
+{
+ if (io_task_schedule_allowed(state,
+ ERTS_PORT_TASK_INPUT,
+ current_cio_time)) {
+ ErtsIoTask *iotask = &state->driver.select->iniotask;
+ erts_smp_atomic_set_nob(&iotask->executed_time, current_cio_time);
+ if (erts_port_task_schedule(id,
+ &iotask->task,
+ ERTS_PORT_TASK_INPUT,
+ (ErlDrvEvent) state->fd) != 0) {
+ stale_drv_select(id, state, ERL_DRV_READ);
+ }
+ add_active_fd(state->fd);
+ }
+}
+
static ERTS_INLINE void
-iready(Eterm id, ErtsDrvEventState *state)
+oready(Eterm id, ErtsDrvEventState *state, erts_aint_t current_cio_time)
{
- if (erts_port_task_schedule(id,
- &state->driver.select->intask,
- ERTS_PORT_TASK_INPUT,
- (ErlDrvEvent) state->fd) != 0) {
- stale_drv_select(id, state, ERL_DRV_READ);
+ if (io_task_schedule_allowed(state,
+ ERTS_PORT_TASK_OUTPUT,
+ current_cio_time)) {
+ ErtsIoTask *iotask = &state->driver.select->outiotask;
+ erts_smp_atomic_set_nob(&iotask->executed_time, current_cio_time);
+ if (erts_port_task_schedule(id,
+ &iotask->task,
+ ERTS_PORT_TASK_OUTPUT,
+ (ErlDrvEvent) state->fd) != 0) {
+ stale_drv_select(id, state, ERL_DRV_WRITE);
+ }
+ add_active_fd(state->fd);
}
}
static ERTS_INLINE void
-oready(Eterm id, ErtsDrvEventState *state)
+send_event_tuple(struct erts_nif_select_event* e, ErtsResource* resource,
+ Eterm event_atom)
{
- if (erts_port_task_schedule(id,
- &state->driver.select->outtask,
- ERTS_PORT_TASK_OUTPUT,
- (ErlDrvEvent) state->fd) != 0) {
- stale_drv_select(id, state, ERL_DRV_WRITE);
+ Process* rp = erts_proc_lookup(e->pid);
+ ErtsProcLocks rp_locks = 0;
+ ErtsMessage* mp;
+ ErlOffHeap* ohp;
+ ErtsBinary* bin;
+ Eterm* hp;
+ Uint hsz;
+ Eterm resource_term, ref_term, tuple;
+
+ if (!rp) {
+ return;
+ }
+
+ bin = ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(resource);
+
+ /* {select, Resource, Ref, EventAtom} */
+ if (is_value(e->immed)) {
+ hsz = 5 + ERTS_MAGIC_REF_THING_SIZE;
+ }
+ else {
+ hsz = 5 + ERTS_MAGIC_REF_THING_SIZE + ERTS_REF_THING_SIZE;
+ }
+
+ mp = erts_alloc_message_heap(rp, &rp_locks, hsz, &hp, &ohp);
+
+ resource_term = erts_mk_magic_ref(&hp, ohp, &bin->binary);
+ if (is_value(e->immed)) {
+ ASSERT(is_immed(e->immed));
+ ref_term = e->immed;
+ }
+ else {
+ write_ref_thing(hp, e->refn[0], e->refn[1], e->refn[2]);
+ ref_term = make_internal_ref(hp);
+ hp += ERTS_REF_THING_SIZE;
}
+ tuple = TUPLE4(hp, am_select, resource_term, ref_term, event_atom);
+
+ ERL_MESSAGE_TOKEN(mp) = am_undefined;
+ erts_queue_message(rp, rp_locks, mp, tuple, am_system);
+
+ if (rp_locks)
+ erts_smp_proc_unlock(rp, rp_locks);
}
+
#if ERTS_CIO_HAVE_DRV_EVENT
static ERTS_INLINE void
-eready(Eterm id, ErtsDrvEventState *state, ErlDrvEventData event_data)
+eready(Eterm id, ErtsDrvEventState *state, ErlDrvEventData event_data,
+ erts_aint_t current_cio_time)
{
- if (erts_port_task_schedule(id,
- &state->driver.event->task,
- ERTS_PORT_TASK_EVENT,
- (ErlDrvEvent) state->fd,
- event_data) != 0) {
- stale_drv_select(id, state, 0);
+ if (io_task_schedule_allowed(state,
+ ERTS_PORT_TASK_EVENT,
+ current_cio_time)) {
+ ErtsIoTask *iotask = &state->driver.event->iotask;
+ erts_smp_atomic_set_nob(&iotask->executed_time, current_cio_time);
+ if (erts_port_task_schedule(id,
+ &iotask->task,
+ ERTS_PORT_TASK_EVENT,
+ (ErlDrvEvent) state->fd,
+ event_data) != 0) {
+ stale_drv_select(id, state, 0);
+ }
+ add_active_fd(state->fd);
}
}
#endif
-static void bad_fd_in_pollset( ErtsDrvEventState *, Eterm, Eterm, ErtsPollEvents);
+static void bad_fd_in_pollset(ErtsDrvEventState *, Eterm inport, Eterm outport);
#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
void
@@ -1153,18 +2134,33 @@ ERTS_CIO_EXPORT(erts_check_io_interrupt)(int set)
void
ERTS_CIO_EXPORT(erts_check_io_interrupt_timed)(int set,
- erts_short_time_t msec)
+ ErtsMonotonicTime timeout_time)
{
- ERTS_CIO_POLL_INTR_TMD(pollset.ps, set, msec);
+ ERTS_CIO_POLL_INTR_TMD(pollset.ps, set, timeout_time);
}
+#if !ERTS_CIO_DEFER_ACTIVE_EVENTS
+/*
+ * Number of ignored events, for a lingering fd added by enif_select(),
+ * until we deselect fd-event from pollset.
+ */
+# define ERTS_NIF_DELAYED_DESELECT 20
+#else
+/* Disable delayed deselect as pollset cannot handle active events */
+# define ERTS_NIF_DELAYED_DESELECT 1
+#endif
+
void
ERTS_CIO_EXPORT(erts_check_io)(int do_wait)
{
- ErtsPollResFd pollres[256];
+ ErtsPollResFd *pollres;
int pollres_len;
- SysTimeval wait_time;
+ ErtsMonotonicTime timeout_time;
int poll_ret, i;
+ erts_aint_t current_cio_time;
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
+
+ ASSERT(esdp);
restart:
@@ -1173,37 +2169,62 @@ ERTS_CIO_EXPORT(erts_check_io)(int do_wait)
erts_do_break_handling();
#endif
- /* Figure out timeout value */
- if (do_wait) {
- erts_time_remaining(&wait_time);
- } else { /* poll only */
- wait_time.tv_sec = 0;
- wait_time.tv_usec = 0;
+#ifdef ERTS_SIGNAL_STATE /* ifndef ERTS_SMP */
+ if (ERTS_SIGNAL_STATE) {
+ erts_handle_signal_state();
}
+#endif
+
+ /* Figure out timeout value */
+ timeout_time = (do_wait
+ ? erts_check_next_timeout_time(esdp)
+ : ERTS_POLL_NO_TIMEOUT /* poll only */);
+
+ /*
+ * No need for an atomic inc op when incrementing
+ * erts_check_io_time, since only one thread can
+ * check io at a time.
+ */
+ current_cio_time = erts_smp_atomic_read_dirty(&erts_check_io_time);
+ current_cio_time++;
+ erts_smp_atomic_set_relb(&erts_check_io_time, current_cio_time);
+
+ check_cleanup_active_fds(current_cio_time,
+ timeout_time != ERTS_POLL_NO_TIMEOUT);
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_check_exact(NULL, 0); /* No locks should be locked */
#endif
- pollres_len = sizeof(pollres)/sizeof(ErtsPollResFd);
+
+ pollres_len = erts_smp_atomic32_read_dirty(&pollset.active_fd.no) + ERTS_CHECK_IO_POLL_RES_LEN;
+
+ pollres = erts_alloc(ERTS_ALC_T_TMP, sizeof(ErtsPollResFd)*pollres_len);
erts_smp_atomic_set_nob(&pollset.in_poll_wait, 1);
- poll_ret = ERTS_CIO_POLL_WAIT(pollset.ps, pollres, &pollres_len, &wait_time);
+ poll_ret = ERTS_CIO_POLL_WAIT(pollset.ps, pollres, &pollres_len, timeout_time);
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_check_exact(NULL, 0); /* No locks should be locked */
#endif
- erts_deliver_time(); /* sync the machine's idea of time */
-
#ifdef ERTS_BREAK_REQUESTED
if (ERTS_BREAK_REQUESTED)
erts_do_break_handling();
#endif
+
+#ifdef ERTS_SIGNAL_STATE /* ifndef ERTS_SMP */
+ if (ERTS_SIGNAL_STATE) {
+ erts_handle_signal_state();
+ }
+#endif
+
+
if (poll_ret != 0) {
erts_smp_atomic_set_nob(&pollset.in_poll_wait, 0);
forget_removed(&pollset);
+ erts_free(ERTS_ALC_T_TMP, pollres);
if (poll_ret == EAGAIN) {
goto restart;
}
@@ -1245,52 +2266,107 @@ ERTS_CIO_EXPORT(erts_check_io)(int do_wait)
switch (state->type) {
case ERTS_EV_TYPE_DRV_SEL: { /* Requested via driver_select()... */
- ErtsPollEvents revents;
- ErtsPollEvents revent_mask;
-
- revent_mask = ~(ERTS_POLL_EV_IN|ERTS_POLL_EV_OUT);
- revent_mask |= state->events;
- revents = pollres[i].events & revent_mask;
-
- if (revents & ERTS_POLL_EV_ERR) {
- /*
- * Let the driver handle the error condition. Only input,
- * only output, or nothing might have been selected.
- * We *do not* want to call a callback that corresponds
- * to an event not selected. revents might give us a clue
- * on which one to call.
- */
- if ((revents & ERTS_POLL_EV_IN)
- || (!(revents & ERTS_POLL_EV_OUT)
- && state->events & ERTS_POLL_EV_IN)) {
- iready(state->driver.select->inport, state);
- }
- else if (state->events & ERTS_POLL_EV_OUT) {
- oready(state->driver.select->outport, state);
- }
- }
- else if (revents & (ERTS_POLL_EV_IN|ERTS_POLL_EV_OUT)) {
+ ErtsPollEvents revents = pollres[i].events;
+
+ if (revents & ERTS_POLL_EV_ERR) {
+ /*
+ * Handle error events by triggering all in/out events
+ * that the driver has selected.
+ * We *do not* want to call a callback that corresponds
+ * to an event not selected.
+ */
+ revents = state->events;
+ }
+ else {
+ revents &= (state->events | ERTS_POLL_EV_NVAL);
+ }
+
+ if (revents & (ERTS_POLL_EV_IN|ERTS_POLL_EV_OUT)) {
if (revents & ERTS_POLL_EV_OUT) {
- oready(state->driver.select->outport, state);
+ oready(state->driver.select->outport, state, current_cio_time);
}
/* Someone might have deselected input since revents
was read (true also on the non-smp emulator since
oready() may have been called); therefore, update
revents... */
- revents &= ~(~state->events & ERTS_POLL_EV_IN);
+ revents &= state->events;
if (revents & ERTS_POLL_EV_IN) {
- iready(state->driver.select->inport, state);
+ iready(state->driver.select->inport, state, current_cio_time);
}
}
else if (revents & ERTS_POLL_EV_NVAL) {
bad_fd_in_pollset(state,
- state->driver.select->inport,
- state->driver.select->outport,
- state->events);
+ state->driver.select->inport,
+ state->driver.select->outport);
+ add_active_fd(state->fd);
}
break;
}
+ case ERTS_EV_TYPE_NIF: { /* Requested via enif_select()... */
+ struct erts_nif_select_event in = {NIL};
+ struct erts_nif_select_event out = {NIL};
+ ErtsResource* resource = NULL;
+ ErtsPollEvents revents = pollres[i].events;
+
+ if (revents & ERTS_POLL_EV_ERR) {
+ /*
+ * Handle error events by triggering all in/out events
+ * that the NIF has selected.
+ * We *do not* want to send a message that corresponds
+ * to an event not selected.
+ */
+ revents = state->events;
+ }
+ else {
+ revents &= (state->events | ERTS_POLL_EV_NVAL);
+ }
+
+ if (revents & (ERTS_POLL_EV_IN|ERTS_POLL_EV_OUT)) {
+ if (revents & ERTS_POLL_EV_OUT) {
+ if (is_not_nil(state->driver.nif->out.pid)) {
+ out = state->driver.nif->out;
+ resource = state->driver.stop.resource;
+ state->driver.nif->out.ddeselect_cnt = ERTS_NIF_DELAYED_DESELECT;
+ state->driver.nif->out.pid = NIL;
+ add_active_fd(state->fd);
+ }
+ else {
+ ASSERT(state->driver.nif->out.ddeselect_cnt >= 2);
+ state->driver.nif->out.ddeselect_cnt--;
+ }
+ }
+ if (revents & ERTS_POLL_EV_IN) {
+ if (is_not_nil(state->driver.nif->in.pid)) {
+ in = state->driver.nif->in;
+ resource = state->driver.stop.resource;
+ state->driver.nif->in.ddeselect_cnt = ERTS_NIF_DELAYED_DESELECT;
+ state->driver.nif->in.pid = NIL;
+ add_active_fd(state->fd);
+ }
+ else {
+ ASSERT(state->driver.nif->in.ddeselect_cnt >= 2);
+ state->driver.nif->in.ddeselect_cnt--;
+ }
+ }
+ }
+ else if (revents & ERTS_POLL_EV_NVAL) {
+ bad_fd_in_pollset(state, NIL, NIL);
+ add_active_fd(state->fd);
+ }
+
+#ifdef ERTS_SMP
+ erts_smp_mtx_unlock(fd_mtx(fd));
+#endif
+ if (is_not_nil(in.pid)) {
+ send_event_tuple(&in, resource, am_ready_input);
+ }
+ if (is_not_nil(out.pid)) {
+ send_event_tuple(&out, resource, am_ready_output);
+ }
+ goto next_pollres_unlocked;
+ }
+
#if ERTS_CIO_HAVE_DRV_EVENT
case ERTS_EV_TYPE_DRV_EV: { /* Requested via driver_event()... */
ErlDrvEventData event_data;
@@ -1304,8 +2380,7 @@ ERTS_CIO_EXPORT(erts_check_io)(int do_wait)
if (revents) {
event_data->events = state->events;
event_data->revents = revents;
-
- eready(state->driver.event->port, state, event_data);
+ eready(state->driver.event->port, state, event_data, current_cio_time);
}
break;
}
@@ -1323,6 +2398,7 @@ ERTS_CIO_EXPORT(erts_check_io)(int do_wait)
(int) state->type);
ASSERT(0);
deselect(state, 0);
+ add_active_fd(state->fd);
break;
}
}
@@ -1331,16 +2407,18 @@ ERTS_CIO_EXPORT(erts_check_io)(int do_wait)
#ifdef ERTS_SMP
erts_smp_mtx_unlock(fd_mtx(fd));
#endif
+ next_pollres_unlocked:;
}
erts_smp_atomic_set_nob(&pollset.in_poll_wait, 0);
+ erts_free(ERTS_ALC_T_TMP, pollres);
forget_removed(&pollset);
}
static void
-bad_fd_in_pollset(ErtsDrvEventState *state, Eterm inport,
- Eterm outport, ErtsPollEvents events)
+bad_fd_in_pollset(ErtsDrvEventState *state, Eterm inport, Eterm outport)
{
+ ErtsPollEvents events = state->events;
erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
if (events & (ERTS_POLL_EV_IN|ERTS_POLL_EV_OUT)) {
@@ -1364,27 +2442,36 @@ bad_fd_in_pollset(ErtsDrvEventState *state, Eterm inport,
erts_dsprintf(dsbufp,
"Bad %s fd in erts_poll()! fd=%d, ",
io_str, (int) state->fd);
- if (is_nil(port)) {
- ErtsPortNames *ipnp = erts_get_port_names(inport, ERTS_INVALID_ERL_DRV_PORT);
- ErtsPortNames *opnp = erts_get_port_names(outport, ERTS_INVALID_ERL_DRV_PORT);
- erts_dsprintf(dsbufp, "ports=%T/%T, drivers=%s/%s, names=%s/%s\n",
- is_nil(inport) ? am_undefined : inport,
- is_nil(outport) ? am_undefined : outport,
- ipnp->driver_name ? ipnp->driver_name : "<unknown>",
- opnp->driver_name ? opnp->driver_name : "<unknown>",
- ipnp->name ? ipnp->name : "<unknown>",
- opnp->name ? opnp->name : "<unknown>");
- erts_free_port_names(ipnp);
- erts_free_port_names(opnp);
- }
- else {
- ErtsPortNames *pnp = erts_get_port_names(port, ERTS_INVALID_ERL_DRV_PORT);
- erts_dsprintf(dsbufp, "port=%T, driver=%s, name=%s\n",
- is_nil(port) ? am_undefined : port,
- pnp->driver_name ? pnp->driver_name : "<unknown>",
- pnp->name ? pnp->name : "<unknown>");
- erts_free_port_names(pnp);
- }
+ if (state->type == ERTS_EV_TYPE_DRV_SEL) {
+ if (is_nil(port)) {
+ ErtsPortNames *ipnp = erts_get_port_names(inport, ERTS_INVALID_ERL_DRV_PORT);
+ ErtsPortNames *opnp = erts_get_port_names(outport, ERTS_INVALID_ERL_DRV_PORT);
+ erts_dsprintf(dsbufp, "ports=%T/%T, drivers=%s/%s, names=%s/%s\n",
+ is_nil(inport) ? am_undefined : inport,
+ is_nil(outport) ? am_undefined : outport,
+ ipnp->driver_name ? ipnp->driver_name : "<unknown>",
+ opnp->driver_name ? opnp->driver_name : "<unknown>",
+ ipnp->name ? ipnp->name : "<unknown>",
+ opnp->name ? opnp->name : "<unknown>");
+ erts_free_port_names(ipnp);
+ erts_free_port_names(opnp);
+ }
+ else {
+ ErtsPortNames *pnp = erts_get_port_names(port, ERTS_INVALID_ERL_DRV_PORT);
+ erts_dsprintf(dsbufp, "port=%T, driver=%s, name=%s\n",
+ is_nil(port) ? am_undefined : port,
+ pnp->driver_name ? pnp->driver_name : "<unknown>",
+ pnp->name ? pnp->name : "<unknown>");
+ erts_free_port_names(pnp);
+ }
+ }
+ else {
+ ErlNifResourceType* rt;
+ ASSERT(state->type == ERTS_EV_TYPE_NIF);
+ ASSERT(state->driver.stop.resource);
+ rt = state->driver.stop.resource->type;
+ erts_dsprintf(dsbufp, "resource={%T,%T}\n", rt->module, rt->name);
+ }
}
else {
erts_dsprintf(dsbufp, "Bad fd in erts_poll()! fd=%d\n", (int) state->fd);
@@ -1404,25 +2491,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;
@@ -1434,7 +2502,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)
{
@@ -1469,31 +2536,50 @@ static void drv_ev_state_free(void *des)
void
ERTS_CIO_EXPORT(erts_init_check_io)(void)
{
+ ERTS_CT_ASSERT((INT_MIN & (ERL_NIF_SELECT_STOP_CALLED |
+ ERL_NIF_SELECT_STOP_SCHEDULED |
+ ERL_NIF_SELECT_INVALID_EVENT |
+ ERL_NIF_SELECT_FAILED)) == 0);
+ erts_smp_atomic_init_nob(&erts_check_io_time, 0);
erts_smp_atomic_init_nob(&pollset.in_poll_wait, 0);
+
ERTS_CIO_POLL_INIT();
pollset.ps = ERTS_CIO_NEW_POLLSET();
+ pollset.active_fd.six = 0;
+ pollset.active_fd.eix = 0;
+ erts_smp_atomic32_init_nob(&pollset.active_fd.no, 0);
+ pollset.active_fd.size = ERTS_ACTIVE_FD_INC;
+ pollset.active_fd.array = erts_alloc(ERTS_ALC_T_ACTIVE_FD_ARR,
+ sizeof(ErtsSysFdType)*ERTS_ACTIVE_FD_INC);
+#ifdef DEBUG
+ {
+ int i;
+ for (i = 0; i < ERTS_ACTIVE_FD_INC; i++)
+ pollset.active_fd.array[i] = ERTS_SYS_FD_INVALID;
+ }
+#endif
+
+
#ifdef ERTS_SMP
init_removed_fd_alloc();
pollset.removed_list = NULL;
- erts_smp_spinlock_init(&pollset.removed_list_lock,
- "pollset_rm_list");
+ erts_smp_spinlock_init(&pollset.removed_list_lock, "pollset_rm_list", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_IO);
{
- int i;
- for (i=0; i<DRV_EV_STATE_LOCK_CNT; i++) {
-#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_smp_mtx_init_x(&drv_ev_state_locks[i].lck, "drv_ev_state", make_small(i));
-#else
- erts_smp_mtx_init(&drv_ev_state_locks[i].lck, "drv_ev_state");
-#endif
- }
+ int i;
+ for (i=0; i<DRV_EV_STATE_LOCK_CNT; i++) {
+ erts_smp_mtx_init(&drv_ev_state_locks[i].lck, "drv_ev_state", make_small(i),
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_IO);
+ }
}
#endif
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
max_fds = ERTS_CIO_POLL_MAX_FDS();
erts_smp_atomic_init_nob(&drv_ev_state_len, 0);
drv_ev_state = NULL;
- erts_smp_mtx_init(&drv_ev_state_grow_lock, "drv_ev_state_grow");
+ erts_smp_mtx_init(&drv_ev_state_grow_lock, "drv_ev_state_grow", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_IO);
#else
{
SafeHashFunctions hf;
@@ -1503,10 +2589,11 @@ ERTS_CIO_EXPORT(erts_init_check_io)(void)
hf.free = &drv_ev_state_free;
num_state_prealloc = 0;
state_prealloc_first = NULL;
- erts_smp_spinlock_init(&state_prealloc_lock,"state_prealloc");
+ erts_smp_spinlock_init(&state_prealloc_lock,"state_prealloc", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_IO);
- safe_hash_init(ERTS_ALC_T_DRV_EV_STATE, &drv_ev_state_tab, "drv_ev_state_tab",
- DRV_EV_STATE_HTAB_SIZE, hf);
+ safe_hash_init(ERTS_ALC_T_DRV_EV_STATE, &drv_ev_state_tab, "drv_ev_state_tab",
+ ERTS_LOCK_FLAGS_CATEGORY_IO, DRV_EV_STATE_HTAB_SIZE, hf);
}
#endif
}
@@ -1548,12 +2635,27 @@ Eterm
ERTS_CIO_EXPORT(erts_check_io_info)(void *proc)
{
Process *p = (Process *) proc;
- Eterm tags[15], values[15], res;
+ Eterm tags[16], values[16], res;
Uint sz, *szp, *hp, **hpp, memory_size;
Sint i;
ErtsPollInfo pi;
-
- ERTS_CIO_POLL_INFO(pollset.ps, &pi);
+ erts_aint_t cio_time = erts_smp_atomic_read_acqb(&erts_check_io_time);
+ int active_fds = (int) erts_smp_atomic32_read_acqb(&pollset.active_fd.no);
+
+ while (1) {
+ erts_aint_t post_cio_time;
+ int post_active_fds;
+
+ ERTS_CIO_POLL_INFO(pollset.ps, &pi);
+
+ post_cio_time = erts_smp_atomic_read_mb(&erts_check_io_time);
+ post_active_fds = (int) erts_smp_atomic32_read_acqb(&pollset.active_fd.no);
+ if (cio_time == post_cio_time && active_fds == post_active_fds)
+ break;
+ cio_time = post_cio_time;
+ active_fds = post_active_fds;
+ }
+
memory_size = pi.memory_size;
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
memory_size += sizeof(ErtsDrvEventState) * erts_smp_atomic_read_nob(&drv_ev_state_len);
@@ -1617,6 +2719,9 @@ ERTS_CIO_EXPORT(erts_check_io_info)(void *proc)
tags[i] = erts_bld_atom(hpp, szp, "max_fds");
values[i++] = erts_bld_uint(hpp, szp, (Uint) pi.max_fds);
+ tags[i] = erts_bld_atom(hpp, szp, "active_fds");
+ values[i++] = erts_bld_uint(hpp, szp, (Uint) active_fds);
+
#ifdef ERTS_POLL_COUNT_AVOIDED_WAKEUPS
tags[i] = erts_bld_atom(hpp, szp, "no_avoided_wakeups");
values[i++] = erts_bld_uint(hpp, szp, (Uint) pi.no_avoided_wakeups);
@@ -1671,6 +2776,8 @@ print_events(ErtsPollEvents ev)
typedef struct {
int used_fds;
int num_errors;
+ int no_driver_select_structs;
+ int no_driver_event_structs;
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
int internal_fds;
ErtsPollEvents *epep;
@@ -1693,6 +2800,13 @@ static void doit_erts_check_io_debug(void *vstate, void *vcounters)
struct stat stat_buf;
#endif
+ if (state->driver.select)
+ counters->no_driver_select_structs++;
+#if ERTS_CIO_HAVE_DRV_EVENT
+ if (state->driver.event)
+ counters->no_driver_event_structs++;
+#endif
+
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
if (state->events || ep_events) {
if (ep_events & ERTS_POLL_EV_NVAL) {
@@ -1831,6 +2945,40 @@ static void doit_erts_check_io_debug(void *vstate, void *vcounters)
}
}
}
+ else if (state->type == ERTS_EV_TYPE_NIF) {
+ ErtsResource* r;
+ erts_printf("enif_select ");
+
+#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
+ if (internal) {
+ erts_printf("internal ");
+ err = 1;
+ }
+
+ if (cio_events == ep_events) {
+ erts_printf("ev=");
+ if (print_events(cio_events) != 0)
+ err = 1;
+ }
+ else {
+ err = 1;
+ erts_printf("cio_ev=");
+ print_events(cio_events);
+ erts_printf(" ep_ev=");
+ print_events(ep_events);
+ }
+#else
+ if (print_events(cio_events) != 0)
+ err = 1;
+#endif
+ erts_printf(" inpid=%T dd_cnt=%b32d", state->driver.nif->in.pid,
+ state->driver.nif->in.ddeselect_cnt);
+ erts_printf(" outpid=%T dd_cnt=%b32d", state->driver.nif->out.pid,
+ state->driver.nif->out.ddeselect_cnt);
+ r = state->driver.stop.resource;
+ erts_printf(" resource=%p(%T:%T)", r, r->type->module, r->type->name);
+ }
+#if ERTS_CIO_HAVE_DRV_EVENT
else if (state->type == ERTS_EV_TYPE_DRV_EV) {
Eterm id;
erts_printf("driver_event ");
@@ -1866,6 +3014,7 @@ static void doit_erts_check_io_debug(void *vstate, void *vcounters)
erts_free_port_names(pnp);
}
}
+#endif
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
else if (internal) {
erts_printf("internal ");
@@ -1885,11 +3034,12 @@ static void doit_erts_check_io_debug(void *vstate, void *vcounters)
erts_printf("control_type=%d ", (int)state->type);
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
if (cio_events == ep_events) {
- erts_printf("ev=0x%b32x", (Uint32) cio_events);
+ erts_printf("ev=");
+ print_events(cio_events);
}
else {
- erts_printf("cio_ev=0x%b32x", (Uint32) cio_events);
- erts_printf(" ep_ev=0x%b32x", (Uint32) ep_events);
+ erts_printf("cio_ev="); print_events(cio_events);
+ erts_printf(" ep_ev="); print_events(ep_events);
}
#else
erts_printf("ev=0x%b32x", (Uint32) cio_events);
@@ -1905,7 +3055,7 @@ static void doit_erts_check_io_debug(void *vstate, void *vcounters)
}
int
-ERTS_CIO_EXPORT(erts_check_io_debug)(void)
+ERTS_CIO_EXPORT(erts_check_io_debug)(ErtsCheckIoDebugInfo *ciodip)
{
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
int fd, len;
@@ -1915,6 +3065,10 @@ ERTS_CIO_EXPORT(erts_check_io_debug)(void)
ErtsDrvEventState null_des;
null_des.driver.select = NULL;
+#if ERTS_CIO_HAVE_DRV_EVENT
+ null_des.driver.event = NULL;
+#endif
+ null_des.driver.stop.drv_ptr = NULL;
null_des.events = 0;
null_des.remove_cnt = 0;
null_des.type = ERTS_EV_TYPE_NONE;
@@ -1935,6 +3089,8 @@ ERTS_CIO_EXPORT(erts_check_io_debug)(void)
#endif
counters.used_fds = 0;
counters.num_errors = 0;
+ counters.no_driver_select_structs = 0;
+ counters.no_driver_event_structs = 0;
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
len = erts_smp_atomic_read_nob(&drv_ev_state_len);
@@ -1951,8 +3107,16 @@ ERTS_CIO_EXPORT(erts_check_io_debug)(void)
erts_smp_thr_progress_unblock();
+ ciodip->no_used_fds = counters.used_fds;
+ ciodip->no_driver_select_structs = counters.no_driver_select_structs;
+ ciodip->no_driver_event_structs = counters.no_driver_event_structs;
+
erts_printf("\n");
erts_printf("used fds=%d\n", counters.used_fds);
+ erts_printf("Number of driver_select() structures=%d\n", counters.no_driver_select_structs);
+#if ERTS_CIO_HAVE_DRV_EVENT
+ erts_printf("Number of driver_event() structures=%d\n", counters.no_driver_event_structs);
+#endif
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
erts_printf("internal fds=%d\n", counters.internal_fds);
#endif
@@ -1961,6 +3125,16 @@ ERTS_CIO_EXPORT(erts_check_io_debug)(void)
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
erts_free(ERTS_ALC_T_TMP, (void *) counters.epep);
#endif
+
return counters.num_errors;
}
+#ifdef ERTS_ENABLE_LOCK_COUNT
+void ERTS_CIO_EXPORT(erts_lcnt_update_cio_locks)(int enable) {
+#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS
+ erts_lcnt_enable_hash_lock_count(&drv_ev_state_tab, ERTS_LOCK_FLAGS_CATEGORY_IO, enable);
+#else
+ (void)enable;
+#endif
+}
+#endif /* ERTS_ENABLE_LOCK_COUNT */
diff --git a/erts/emulator/sys/common/erl_check_io.h b/erts/emulator/sys/common/erl_check_io.h
index edab7947ba..2d3bb98afa 100644
--- a/erts/emulator/sys/common/erl_check_io.h
+++ b/erts/emulator/sys/common/erl_check_io.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2006-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2006-2017. 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.
+ * 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%
*/
@@ -26,12 +27,15 @@
#ifndef ERL_CHECK_IO_H__
#define ERL_CHECK_IO_H__
+#include "sys.h"
#include "erl_sys_driver.h"
#ifdef ERTS_ENABLE_KERNEL_POLL
int driver_select_kp(ErlDrvPort, ErlDrvEvent, int, int);
int driver_select_nkp(ErlDrvPort, ErlDrvEvent, int, int);
+int enif_select_kp(ErlNifEnv*, ErlNifEvent, enum ErlNifSelectFlags, void*, const ErlNifPid*, Eterm);
+int enif_select_nkp(ErlNifEnv*, ErlNifEvent, enum ErlNifSelectFlags, void*, const ErlNifPid*, Eterm);
int driver_event_kp(ErlDrvPort, ErlDrvEvent, ErlDrvEventData);
int driver_event_nkp(ErlDrvPort, ErlDrvEvent, ErlDrvEventData);
Uint erts_check_io_size_kp(void);
@@ -46,14 +50,19 @@ void erts_check_io_async_sig_interrupt_nkp(void);
#endif
void erts_check_io_interrupt_kp(int);
void erts_check_io_interrupt_nkp(int);
-void erts_check_io_interrupt_timed_kp(int, erts_short_time_t);
-void erts_check_io_interrupt_timed_nkp(int, erts_short_time_t);
+void erts_check_io_interrupt_timed_kp(int, ErtsMonotonicTime);
+void erts_check_io_interrupt_timed_nkp(int, ErtsMonotonicTime);
void erts_check_io_kp(int);
void erts_check_io_nkp(int);
void erts_init_check_io_kp(void);
void erts_init_check_io_nkp(void);
-int erts_check_io_debug_kp(void);
-int erts_check_io_debug_nkp(void);
+int erts_check_io_debug_kp(ErtsCheckIoDebugInfo *);
+int erts_check_io_debug_nkp(ErtsCheckIoDebugInfo *);
+
+#ifdef ERTS_ENABLE_LOCK_COUNT
+void erts_lcnt_update_cio_locks_kp(int enable);
+void erts_lcnt_update_cio_locks_nkp(int enable);
+#endif
#else /* !ERTS_ENABLE_KERNEL_POLL */
@@ -64,10 +73,35 @@ int erts_check_io_max_files(void);
void erts_check_io_async_sig_interrupt(void);
#endif
void erts_check_io_interrupt(int);
-void erts_check_io_interrupt_timed(int, erts_short_time_t);
+void erts_check_io_interrupt_timed(int, ErtsMonotonicTime);
void erts_check_io(int);
void erts_init_check_io(void);
+#ifdef ERTS_ENABLE_LOCK_COUNT
+void erts_lcnt_update_cio_locks(int enable);
+#endif
+
+#endif
+
+extern erts_smp_atomic_t erts_check_io_time;
+
+typedef struct {
+ ErtsPortTaskHandle task;
+ erts_smp_atomic_t executed_time;
+} ErtsIoTask;
+
+ERTS_GLB_INLINE void erts_io_notify_port_task_executed(ErtsPortTaskHandle *pthp);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_INLINE void
+erts_io_notify_port_task_executed(ErtsPortTaskHandle *pthp)
+{
+ ErtsIoTask *itp = (ErtsIoTask *) (((char *) pthp) - offsetof(ErtsIoTask, task));
+ erts_aint_t ci_time = erts_smp_atomic_read_acqb(&erts_check_io_time);
+ erts_smp_atomic_set_relb(&itp->executed_time, ci_time);
+}
+
#endif
#endif /* ERL_CHECK_IO_H__ */
@@ -81,6 +115,16 @@ void erts_init_check_io(void);
#include "erl_poll.h"
#include "erl_port_task.h"
+#ifdef __WIN32__
+/*
+ * Current erts_poll implementation for Windows cannot handle
+ * active events in the set of events polled.
+ */
+# define ERTS_CIO_DEFER_ACTIVE_EVENTS 1
+#else
+# define ERTS_CIO_DEFER_ACTIVE_EVENTS 0
+#endif
+
/*
* ErtsDrvEventDataState is used by driver_event() which is almost never
* used. We allocate ErtsDrvEventDataState separate since we dont wan't
@@ -91,13 +135,32 @@ typedef struct {
Eterm port;
ErlDrvEventData data;
ErtsPollEvents removed_events;
- ErtsPortTaskHandle task;
+#if ERTS_CIO_DEFER_ACTIVE_EVENTS
+ ErtsPollEvents deferred_events;
+#endif
+ ErtsIoTask iotask;
} ErtsDrvEventDataState;
typedef struct {
Eterm inport;
Eterm outport;
- ErtsPortTaskHandle intask;
- ErtsPortTaskHandle outtask;
+ ErtsIoTask iniotask;
+ ErtsIoTask outiotask;
} ErtsDrvSelectDataState;
+
+struct erts_nif_select_event {
+ Eterm pid;
+ Eterm immed;
+ Uint32 refn[ERTS_REF_NUMBERS];
+ Sint32 ddeselect_cnt; /* 0: No delayed deselect in progress
+ * 1: Do deselect before next poll
+ * >1: Countdown of ignored events
+ */
+};
+
+typedef struct {
+ struct erts_nif_select_event in;
+ struct erts_nif_select_event out;
+} ErtsNifSelectDataState;
+
#endif /* #ifndef ERL_CHECK_IO_INTERNAL__ */
diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c
index 3f6813e1a5..214ed01c82 100644
--- a/erts/emulator/sys/common/erl_mmap.c
+++ b/erts/emulator/sys/common/erl_mmap.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2002-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2002-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -20,6 +21,7 @@
# include "config.h"
#endif
+#define ERTS_WANT_MEM_MAPPERS
#include "sys.h"
#include "erl_process.h"
#include "erl_smp.h"
@@ -27,6 +29,8 @@
#include "erl_mmap.h"
#include <stddef.h>
+#if HAVE_ERTS_MMAP
+
/* #define ERTS_MMAP_OP_RINGBUF_SZ 100 */
#if defined(DEBUG) || 0
@@ -50,23 +54,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)
@@ -196,10 +199,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) \
@@ -218,9 +221,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) \
@@ -246,10 +249,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() \
@@ -293,13 +296,14 @@ typedef struct {
Uint nseg;
}ErtsFreeSegMap;
-static struct {
- int (*reserve_physical)(char *, UWord);
+struct ErtsMemMapper_ {
+ int (*reserve_physical)(char *, UWord, int exec);
void (*unreserve_physical)(char *, UWord);
int supercarrier;
int no_os_mmap;
+ int executable; /* is client a native code allocator? */
/*
- * Super unaligend area is located above super aligned
+ * Super unaligned area is located above super aligned
* area. That is, `sa.bot` is beginning of the super
* carrier, `sua.top` is the end of the super carrier,
* and sa.top and sua.bot moves towards eachother.
@@ -345,54 +349,67 @@ 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
+
+#ifdef ERTS_HAVE_EXEC_MMAPPER
+ErtsMemMapper erts_exec_mmapper;
+#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)) {
@@ -402,7 +419,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);
@@ -413,59 +430,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)
@@ -1224,6 +1241,7 @@ Eterm build_free_seg_list(Process* p, ErtsFreeSegMap* map)
#if HAVE_MMAP
# define ERTS_MMAP_PROT (PROT_READ|PROT_WRITE)
+# define ERTS_MMAP_PROT_EXEC (PROT_READ|PROT_WRITE|PROT_EXEC)
# if defined(MAP_ANONYMOUS)
# define ERTS_MMAP_FLAGS (MAP_ANON|MAP_PRIVATE)
# define ERTS_MMAP_FD (-1)
@@ -1232,29 +1250,31 @@ 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
static ERTS_INLINE void *
-os_mmap(void *hint_ptr, UWord size, int try_superalign)
+os_mmap(void *hint_ptr, UWord size, int try_superalign, int executable)
{
#if HAVE_MMAP
+ const int prot = executable ? ERTS_MMAP_PROT_EXEC : ERTS_MMAP_PROT;
void *res;
#ifdef MAP_ALIGN
if (try_superalign)
- res = mmap((void *) ERTS_SUPERALIGNED_SIZE, size, ERTS_MMAP_PROT,
+ res = mmap((void *) ERTS_SUPERALIGNED_SIZE, size, prot,
ERTS_MMAP_FLAGS|MAP_ALIGN, ERTS_MMAP_FD, 0);
else
#endif
- res = mmap((void *) hint_ptr, size, ERTS_MMAP_PROT,
+ res = mmap((void *) hint_ptr, size, prot,
ERTS_MMAP_FLAGS, ERTS_MMAP_FD, 0);
if (res == MAP_FAILED)
return NULL;
return res;
#elif HAVE_VIRTUALALLOC
+ const DWORD prot = executable ? PAGE_EXECUTE_READWRITE : PAGE_READWRITE;
return (void *) VirtualAlloc(NULL, (SIZE_T) size,
- MEM_COMMIT|MEM_RESERVE, PAGE_READWRITE);
+ MEM_COMMIT|MEM_RESERVE, prot);
#else
# error "missing mmap() or similar"
#endif
@@ -1311,16 +1331,26 @@ os_mremap(void *ptr, UWord old_size, UWord new_size, int try_superalign)
#if HAVE_MMAP
#define ERTS_MMAP_RESERVE_PROT (ERTS_MMAP_PROT)
+#define ERTS_MMAP_RESERVE_PROT_EXEC (ERTS_MMAP_PROT_EXEC)
#define ERTS_MMAP_RESERVE_FLAGS (ERTS_MMAP_FLAGS|MAP_FIXED)
#define ERTS_MMAP_UNRESERVE_PROT (PROT_NONE)
+#if defined(__FreeBSD__)
+#define ERTS_MMAP_UNRESERVE_FLAGS (ERTS_MMAP_FLAGS|MAP_FIXED)
+#else
#define ERTS_MMAP_UNRESERVE_FLAGS (ERTS_MMAP_FLAGS|MAP_NORESERVE|MAP_FIXED)
+#endif /* __FreeBSD__ */
#define ERTS_MMAP_VIRTUAL_PROT (PROT_NONE)
+#if defined(__FreeBSD__)
+#define ERTS_MMAP_VIRTUAL_FLAGS (ERTS_MMAP_FLAGS)
+#else
#define ERTS_MMAP_VIRTUAL_FLAGS (ERTS_MMAP_FLAGS|MAP_NORESERVE)
+#endif /* __FreeBSD__ */
static int
-os_reserve_physical(char *ptr, UWord size)
+os_reserve_physical(char *ptr, UWord size, int exec)
{
- void *res = mmap((void *) ptr, (size_t) size, ERTS_MMAP_RESERVE_PROT,
+ const int prot = exec ? ERTS_MMAP_RESERVE_PROT_EXEC : ERTS_MMAP_RESERVE_PROT;
+ void *res = mmap((void *) ptr, (size_t) size, prot,
ERTS_MMAP_RESERVE_FLAGS, ERTS_MMAP_FD, 0);
if (res == (void *) MAP_FAILED)
return 0;
@@ -1333,14 +1363,43 @@ 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 *
-os_mmap_virtual(char *ptr, UWord size)
+os_mmap_virtual(char *ptr, UWord size, int exec)
{
- void *res = mmap((void *) ptr, (size_t) size, ERTS_MMAP_VIRTUAL_PROT,
- ERTS_MMAP_VIRTUAL_FLAGS, ERTS_MMAP_FD, 0);
+ int flags = ERTS_MMAP_VIRTUAL_FLAGS;
+ void* res;
+
+#ifdef ERTS_ALC_A_EXEC
+ if (exec) {
+ ASSERT(!ptr);
+ /* OTP-19.0: Nice hack below cut-and-pasted from hipe_amd64.c */
+
+# ifdef MAP_32BIT
+ /* If we got MAP_32BIT (Linux), then use that to ask for low memory */
+ flags |= MAP_32BIT;
+# else
+ /* FreeBSD doesn't have MAP_32BIT, and it doesn't respect
+ a plain map_hint (returns high mappings even though the
+ hint refers to a free area), so we have to use both map_hint
+ and MAP_FIXED to get addresses below the 2GB boundary.
+ This is even worse than the Linux/ppc64 case.
+ Similarly, Solaris 10 doesn't have MAP_32BIT,
+ and it doesn't respect a plain map_hint. */
+ ptr = (char*)(512*1024*1024); /* 0.5GB */
+
+# if defined(__FreeBSD__) || defined(__sun__)
+ flags |= MAP_FIXED;
+# endif
+# endif /* !MAP_32BIT */
+ }
+#else /* !ERTS_ALC_A_EXEC */
+ ASSERT(!exec);
+#endif
+ res = mmap((void *) ptr, (size_t) size, ERTS_MMAP_VIRTUAL_PROT,
+ flags, ERTS_MMAP_FD, 0);
if (res == (void *) MAP_FAILED)
return NULL;
return res;
@@ -1353,7 +1412,7 @@ os_mmap_virtual(char *ptr, UWord size)
#endif /* ERTS_HAVE_OS_MMAP */
-static int reserve_noop(char *ptr, UWord size)
+static int reserve_noop(char *ptr, UWord size, int exec)
{
#ifdef ERTS_MMAP_DEBUG_FILL_AREAS
Uint32 *uip, *end = (Uint32 *) (ptr + size);
@@ -1377,11 +1436,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;
@@ -1394,13 +1454,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, 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;
@@ -1411,20 +1471,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, 0))
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, 0))
ERTS_MMAP_SIZE_SC_SA_INC(ERTS_PAGEALIGNED_SIZE);
else
desc = NULL;
@@ -1432,15 +1492,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;
@@ -1453,10 +1513,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);
}
@@ -1465,46 +1525,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, mm->executable))
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,
- asize))
+ if (asize <= mm->sua.bot - mm->sa.top) {
+ if (!mm->reserve_physical(mm->sua.bot - asize, asize,
+ mm->executable))
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;
}
@@ -1512,84 +1572,87 @@ 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),
+ mm->executable))
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),
+ mm->executable))
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),
+ mm->executable))
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;
@@ -1597,20 +1660,20 @@ 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);
+ seg = os_mmap(NULL, asize, 0, mm->executable);
if (!seg)
goto failure;
}
else {
asize = ERTS_SUPERALIGNED_CEILING(*sizep);
- seg = os_mmap(NULL, asize, 1);
+ seg = os_mmap(NULL, asize, 1, mm->executable);
if (!seg)
goto failure;
@@ -1620,7 +1683,8 @@ erts_mmap(Uint32 flags, UWord *sizep)
os_munmap(seg, asize);
- ptr = os_mmap(NULL, asize + ERTS_SUPERALIGNED_SIZE, 1);
+ ptr = os_mmap(NULL, asize + ERTS_SUPERALIGNED_SIZE, 1,
+ mm->executable);
if (!ptr)
goto failure;
@@ -1660,25 +1724,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);
@@ -1691,45 +1755,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;
}
}
@@ -1741,7 +1805,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;
@@ -1755,7 +1819,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;
@@ -1763,30 +1827,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;
@@ -1798,11 +1864,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;
}
@@ -1812,7 +1878,7 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
return NULL;
}
-#if ERTS_HAVE_OS_MREMAP || ERTS_HAVE_GENUINE_OS_MMAP
+#if defined(ERTS_HAVE_OS_MREMAP) || defined(ERTS_HAVE_GENUINE_OS_MMAP)
superaligned = (ERTS_MMAPFLG_SUPERALIGNED & flags);
if (superaligned) {
@@ -1832,7 +1898,7 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
}
}
-#if ERTS_HAVE_GENUINE_OS_MMAP
+#ifdef ERTS_HAVE_GENUINE_OS_MMAP
if (asize < old_size
&& (!superaligned
|| ERTS_IS_SUPERALIGNED(ptr))) {
@@ -1847,9 +1913,9 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
return ptr;
}
#endif
-#if ERTS_HAVE_OS_MREMAP
+#ifdef 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)
@@ -1871,10 +1937,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);
@@ -1882,19 +1948,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);
@@ -1916,18 +1982,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);
@@ -1935,11 +2001,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;
}
@@ -1949,17 +2015,18 @@ 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,
- asize - old_size))
+ if (!mm->reserve_physical(((char *) ptr) + old_size,
+ asize - old_size,
+ mm->executable))
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);
@@ -1968,28 +2035,30 @@ 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,
- asize - old_size))
+ if (end == mm->sa.top) {
+ if (new_end <= mm->sua.bot) {
+ if (!mm->reserve_physical(((char *) ptr) + old_size,
+ asize - old_size,
+ mm->executable))
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,
- asize - old_size))
+ if (!mm->reserve_physical(((char *) ptr) + old_size,
+ asize - old_size,
+ mm->executable))
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);
@@ -1999,12 +2068,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:
@@ -2021,26 +2090,26 @@ 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 options;
Eterm total;
Eterm total_sa;
Eterm total_sua;
@@ -2074,6 +2143,7 @@ static void init_atoms(void)
erts_mtx_lock(&am.init_mutex);
if (!am.is_initialized) {
+ AM_INIT(options);
AM_INIT(total);
AM_INIT(total_sa);
AM_INIT(total_sua);
@@ -2102,8 +2172,9 @@ static void hard_dbg_mseg_init(void);
#endif
void
-erts_mmap_init(ErtsMMapInit *init)
+erts_mmap_init(ErtsMemMapper* mm, ErtsMMapInit *init, int executable)
{
+ static int is_first_call = 1;
int virtual_map = 0;
char *start = NULL, *end = NULL;
UWord pagesize;
@@ -2125,25 +2196,28 @@ 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;
+ mm->executable = executable;
#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", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
+ if (is_first_call) {
+ erts_mtx_init(&am.init_mutex, "mmap_init_atoms", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
+ }
#ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION
if (init->virtual_range.start) {
@@ -2152,15 +2226,15 @@ erts_mmap_init(ErtsMMapInit *init)
ptr = (char *) ERTS_PAGEALIGNED_CEILING(init->virtual_range.start);
end = (char *) ERTS_PAGEALIGNED_FLOOR(init->virtual_range.end);
sz = end - ptr;
- start = os_mmap_virtual(ptr, sz);
+ start = os_mmap_virtual(ptr, sz, executable);
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
@@ -2177,9 +2251,9 @@ erts_mmap_init(ErtsMMapInit *init)
sz = ERTS_PAGEALIGNED_CEILING(init->scs);
#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;
+ start = os_mmap_virtual(NULL, sz, executable);
+ mm->reserve_physical = os_reserve_physical;
+ mm->unreserve_physical = os_unreserve_physical;
virtual_map = 1;
}
else
@@ -2189,10 +2263,10 @@ erts_mmap_init(ErtsMMapInit *init)
* The whole supercarrier will by physically
* reserved all the time.
*/
- start = os_mmap(NULL, sz, 1);
+ start = os_mmap(NULL, sz, 1, executable);
}
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;
@@ -2205,34 +2279,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)
@@ -2241,68 +2313,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, 0))
#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, 0))
+ 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;
}
@@ -2312,7 +2391,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,
+ fmtfn_t *print_to_p,
void *print_to_arg,
Eterm** hpp, Uint* szp,
struct erts_mmap_info_struct* emis)
@@ -2321,35 +2401,41 @@ Eterm erts_mmap_info(int *print_to_p,
Eterm seg_tags[] = { am.used, am.max, am.allocated, am.reserved, am.used_sa, am.used_sua };
Eterm group[2];
Eterm group_tags[] = { am.sizes, am.free_segs };
- Eterm list[2];
- Eterm list_tags[2]; /* { am.supercarrier, am.os } */
- int lix;
+ Eterm list[3];
+ Eterm list_tags[3]; /* { am.options, am.supercarrier, am.os } */
+ int lix = 0;
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);
}
+ list[lix] = erts_mmap_info_options(mm, "option ", print_to_p, print_to_arg,
+ hpp, szp);
+ list_tags[lix] = am.options;
+ lix++;
+
+
if (print_to_p) {
- int to = *print_to_p;
+ fmtfn_t 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]);
@@ -2364,7 +2450,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);
}
}
@@ -2375,8 +2461,7 @@ Eterm erts_mmap_info(int *print_to_p,
init_atoms();
}
- 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);
@@ -2388,7 +2473,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);
@@ -2400,25 +2485,26 @@ Eterm erts_mmap_info(int *print_to_p,
return res;
}
-Eterm erts_mmap_info_options(char *prefix,
- int *print_to_p,
+Eterm erts_mmap_info_options(ErtsMemMapper* mm,
+ char *prefix,
+ fmtfn_t *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;
+ fmtfn_t 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);
}
}
@@ -2428,9 +2514,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);
}
@@ -2439,10 +2525,14 @@ Eterm erts_mmap_info_options(char *prefix,
return res;
}
+#endif /* HAVE_ERTS_MMAP */
Eterm erts_mmap_debug_info(Process* p)
{
- if (mmap_state.supercarrier) {
+#if HAVE_ERTS_MMAP
+ ErtsMemMapper* mm = &erts_dflt_mmapper;
+
+ if (mm->supercarrier) {
ERTS_DECL_AM(sabot);
ERTS_DECL_AM(satop);
ERTS_DECL_AM(suabot);
@@ -2452,18 +2542,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;
@@ -2480,9 +2569,8 @@ Eterm erts_mmap_debug_info(Process* p)
HRelease(p, hp_end, hp);
return list;
}
- else {
- return am_undefined;
- }
+#endif
+ return am_undefined;
}
@@ -2730,7 +2818,8 @@ static void hard_dbg_mseg_init(void)
{
ErtsFreeSegDesc_fake* p;
- erts_mtx_init(&hard_dbg_mseg_mtx, "hard_dbg_mseg");
+ erts_mtx_init(&hard_dbg_mseg_mtx, "hard_dbg_mseg", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
hard_dbg_mseg_tree.root = NULL;
hard_dbg_mseg_tree.order = ADDR_ORDER;
diff --git a/erts/emulator/sys/common/erl_mmap.h b/erts/emulator/sys/common/erl_mmap.h
index 778a8e0e80..2a07d93c8c 100644
--- a/erts/emulator/sys/common/erl_mmap.h
+++ b/erts/emulator/sys/common/erl_mmap.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2013. All Rights Reserved.
+ * Copyright Ericsson AB 2013-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -21,17 +22,52 @@
#define ERL_MMAP_H__
#include "sys.h"
+#include "erl_printf.h"
#define ERTS_MMAP_SUPERALIGNED_BITS (18)
/* Affects hard limits for sbct and lmbcs documented in erts_alloc.xml */
-#define ERTS_MMAPFLG_OS_ONLY (((Uint32) 1) << 0)
-#define ERTS_MMAPFLG_SUPERCARRIER_ONLY (((Uint32) 1) << 1)
-#define ERTS_MMAPFLG_SUPERALIGNED (((Uint32) 1) << 2)
+#ifndef HAVE_MMAP
+# define HAVE_MMAP 0
+#endif
+#ifndef HAVE_MREMAP
+# define HAVE_MREMAP 0
+#endif
+#if HAVE_MMAP
+# define ERTS_HAVE_OS_MMAP 1
+# define ERTS_HAVE_GENUINE_OS_MMAP 1
+# if HAVE_MREMAP
+# define ERTS_HAVE_OS_MREMAP 1
+# endif
+/*
+ * MAP_NORESERVE is undefined in FreeBSD 10.x and later.
+ * This is to enable 64bit HiPE experimentally on FreeBSD.
+ * Note that on FreeBSD MAP_NORESERVE was "never implemented"
+ * even before 11.x (and the flag does not exist in /usr/src/sys/vm/mmap.c
+ * of 10.3-STABLE r301478 either), and HiPE was working on OTP 18.3.3,
+ * so mandating MAP_NORESERVE on FreeBSD might not be needed.
+ * See the following message on how MAP_NORESERVE was treated on FreeBSD:
+ * <http://lists.llvm.org/pipermail/cfe-commits/Week-of-Mon-20150202/122958.html>
+ */
+# if defined(MAP_FIXED) && (defined(MAP_NORESERVE) || defined(__FreeBSD__))
+# define ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION 1
+# endif
+#endif
+
+#ifndef HAVE_VIRTUALALLOC
+# define HAVE_VIRTUALALLOC 0
+#endif
+#if HAVE_VIRTUALALLOC
+# define ERTS_HAVE_OS_MMAP 1
+#endif
+
+#ifdef ERTS_HAVE_GENUINE_OS_MMAP
+# define HAVE_ERTS_MMAP 1
+#else
+# define HAVE_ERTS_MMAP 0
+#endif
+
-#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 {
@@ -52,23 +88,16 @@ 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*);
-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** hpp, Uint* szp, struct erts_mmap_info_struct*);
-Eterm erts_mmap_info_options(char *prefix, int *print_to_p, void *print_to_arg,
- Uint **hpp, Uint *szp);
-struct process;
-Eterm erts_mmap_debug_info(struct process*);
+#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 << 10), 0}
+
+#define ERTS_HIPE_EXEC_VIRTUAL_AREA_SIZE (UWORD_CONSTANT(512)*1024*1024)
+
+#define ERTS_MMAP_INIT_HIPE_EXEC_INITER \
+ {{NULL, NULL}, {NULL, NULL}, ERTS_HIPE_EXEC_VIRTUAL_AREA_SIZE, 1, (1 << 10), 0}
+
#define ERTS_SUPERALIGNED_SIZE \
(1 << ERTS_MMAP_SUPERALIGNED_BITS)
@@ -96,29 +125,57 @@ Eterm erts_mmap_debug_info(struct process*);
#define ERTS_PAGEALIGNED_SIZE \
(ERTS_INV_PAGEALIGNED_MASK + 1)
-#ifndef HAVE_MMAP
-# define HAVE_MMAP 0
-#endif
-#ifndef HAVE_MREMAP
-# define HAVE_MREMAP 0
-#endif
-#if HAVE_MMAP
-# define ERTS_HAVE_OS_MMAP 1
-# define ERTS_HAVE_GENUINE_OS_MMAP 1
-# if HAVE_MREMAP
-# define ERTS_HAVE_OS_MREMAP 1
+struct process;
+Eterm erts_mmap_debug_info(struct process*);
+
+#if HAVE_ERTS_MMAP
+
+typedef struct ErtsMemMapper_ ErtsMemMapper;
+
+#define ERTS_MMAPFLG_OS_ONLY (((Uint32) 1) << 0)
+#define ERTS_MMAPFLG_SUPERCARRIER_ONLY (((Uint32) 1) << 1)
+#define ERTS_MMAPFLG_SUPERALIGNED (((Uint32) 1) << 2)
+
+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*, int executable);
+struct erts_mmap_info_struct
+{
+ UWord sizes[6];
+ UWord segs[6];
+ UWord os_used;
+};
+Eterm erts_mmap_info(ErtsMemMapper*, fmtfn_t *print_to_p, void *print_to_arg,
+ Eterm** hpp, Uint* szp, struct erts_mmap_info_struct*);
+Eterm erts_mmap_info_options(ErtsMemMapper*,
+ char *prefix, fmtfn_t *print_to_p, void *print_to_arg,
+ Uint **hpp, Uint *szp);
+
+
+#ifdef ERTS_WANT_MEM_MAPPERS
+# include "erl_alloc_types.h"
+
+extern ErtsMemMapper erts_dflt_mmapper;
+
+# if defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
+
+# if defined(ARCH_64)
+extern ErtsMemMapper erts_literal_mmapper;
# endif
-# if defined(MAP_FIXED) && defined(MAP_NORESERVE)
-# define ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION 1
+
+# if defined(ERTS_ALC_A_EXEC) && defined(__x86_64__)
+ /*
+ * On x86_64, exec_alloc employs its own super carrier 'erts_exec_mmaper'
+ * to ensure low memory for HiPE AMD64 small code model.
+ */
+# define ERTS_HAVE_EXEC_MMAPPER
+extern ErtsMemMapper erts_exec_mmapper;
# endif
-#endif
-#ifndef HAVE_VIRTUALALLOC
-# define HAVE_VIRTUALALLOC 0
-#endif
-#if HAVE_VIRTUALALLOC
-# define ERTS_HAVE_OS_MMAP 1
-#endif
+# endif /* ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION */
+#endif /* ERTS_WANT_MEM_MAPPERS */
/*#define HARD_DEBUG_MSEG*/
#ifdef HARD_DEBUG_MSEG
@@ -131,4 +188,6 @@ void hard_dbg_remove_mseg(void* seg, UWord sz);
# define HARD_DBG_REMOVE_MSEG(SEG,SZ)
#endif
+#endif /* HAVE_ERTS_MMAP */
+
#endif /* ERL_MMAP_H__ */
diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c
index 94a381e168..d69a79dc2a 100644
--- a/erts/emulator/sys/common/erl_mseg.c
+++ b/erts/emulator/sys/common/erl_mseg.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2002-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2002-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -30,6 +31,7 @@
# include "config.h"
#endif
+#define ERTS_WANT_MEM_MAPPERS
#include "sys.h"
#include "erl_mseg.h"
#include "global.h"
@@ -81,11 +83,13 @@ static const int debruijn[32] = {
31, 27, 13, 23, 21, 19, 16, 7, 26, 12, 18, 6, 11, 5, 10, 9
};
-#define LOG2(X) (debruijn[((Uint32)(((X) & -(X)) * 0x077CB531U)) >> 27])
+#define LSB(X) (debruijn[((Uint32)(((X) & -(X)) * 0x077CB531U)) >> 27])
#define CACHE_AREAS (32 - MSEG_ALIGN_BITS)
-#define SIZE_TO_CACHE_AREA_IDX(S) (LOG2((S)) - MSEG_ALIGN_BITS)
+/* FIXME: segment sizes > 2 GB result in bogus negative indices */
+/* NOTE: using LSB instead of proper log2 only works if S is a power of 2 */
+#define SIZE_TO_CACHE_AREA_IDX(S) (LSB((S)) - MSEG_ALIGN_BITS)
#define MAX_CACHE_SIZE (30)
#define MSEG_FLG_IS_2POW(X) ((X) & ERTS_MSEG_FLG_2POW)
@@ -98,17 +102,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
};
@@ -141,7 +140,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;
@@ -167,29 +173,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;
@@ -301,22 +284,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,
@@ -330,18 +308,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",
@@ -352,22 +325,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",
@@ -391,11 +359,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 */
@@ -408,23 +373,23 @@ 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)));
- /* The idea is that sbc caching is prefered over mbc caching.
+ /* The idea is that sbc caching is preferred over mbc caching.
* Blocks are normally allocated in mb carriers and thus cached there.
* 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;
@@ -433,32 +398,34 @@ static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, UWord size, U
if (MSEG_FLG_IS_2POW(flags)) {
int ix = SIZE_TO_CACHE_AREA_IDX(size);
+ if (ix < 0)
+ return 0;
+
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)) {
@@ -472,20 +439,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;
}
@@ -494,11 +461,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)) {
@@ -509,12 +476,15 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flag
ASSERT(IS_2POW(size));
+ if (ix < 0)
+ return NULL;
+
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));
@@ -523,31 +493,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 ) {
@@ -556,11 +526,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;
@@ -583,7 +553,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 */
@@ -607,7 +577,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);
@@ -616,19 +586,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)) {
@@ -639,58 +609,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
@@ -708,7 +672,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.
*/
@@ -718,42 +682,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));
+ if (!erts_circleq_is_empty(&(ma->cache_unpowered_node)))
+ mseg_drop_cache_size(ma, ERTS_MSEG_FLG_NONE, &(ma->cache_unpowered_node));
- ASSERT(erts_circleq_is_empty(&(mk->cache_unpowered_node)));
- ASSERT(mk->cache_size == 0);
-}
-
-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);
}
@@ -762,25 +716,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);
@@ -794,10 +735,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;
@@ -807,7 +748,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;
@@ -818,11 +759,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;
}
@@ -830,7 +769,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:
@@ -841,7 +780,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;
@@ -860,7 +798,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))
@@ -875,7 +812,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;
}
@@ -895,7 +832,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;
}
@@ -909,7 +846,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;
}
@@ -1062,17 +999,15 @@ add_4tup(Uint **hpp, Uint *szp, Eterm *lp,
static Eterm
info_options(ErtsMsegAllctr_t *ma,
char *prefix,
- int *print_to_p,
+ fmtfn_t *print_to_p,
void *print_to_arg,
Uint **hpp,
Uint *szp)
{
- Eterm res;
-
- res = erts_mmap_info_options(prefix, print_to_p, print_to_arg, hpp, szp);
+ Eterm res = NIL;
if (print_to_p) {
- int to = *print_to_p;
+ fmtfn_t to = *print_to_p;
void *arg = print_to_arg;
erts_print(to, arg, "%samcbf: %beu\n", prefix, ma->abs_max_cache_bad_fit);
erts_print(to, arg, "%srmcbf: %beu\n", prefix, ma->rel_max_cache_bad_fit);
@@ -1100,7 +1035,7 @@ info_options(ErtsMsegAllctr_t *ma,
}
static Eterm
-info_calls(ErtsMsegAllctr_t *ma, int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp)
+info_calls(ErtsMsegAllctr_t *ma, fmtfn_t *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp)
{
Eterm res = THE_NON_VALUE;
@@ -1113,7 +1048,7 @@ info_calls(ErtsMsegAllctr_t *ma, int *print_to_p, void *print_to_arg, Uint **hpp
erts_print(TO, TOA, "mseg_%s calls: %b32u%09b32u\n", #CC, \
ma->calls.CC.giga_no, ma->calls.CC.no)
- int to = *print_to_p;
+ fmtfn_t to = *print_to_p;
void *arg = print_to_arg;
PRINT_CC(to, arg, alloc);
@@ -1179,90 +1114,97 @@ 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,
- int begin_new_max_period, Uint **hpp, Uint *szp)
+info_status(ErtsMsegAllctr_t *ma, fmtfn_t *print_to_p, void *print_to_arg,
+ int begin_new_max_period, int only_sz, 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;
+ fmtfn_t 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, "segments: %beu %beu %beu\n",
- mk->segments.current.no, mk->segments.max.no, mk->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);
- erts_print(to, arg, "segments_watermark: %beu\n",
- mk->segments.current.watermark);
+ if (!only_sz) {
+ 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",
+ ma->segments.current.no, ma->segments.max.no, ma->segments.max_ever.no);
+ erts_print(to, arg, "segments_watermark: %beu\n",
+ ma->segments.current.watermark);
+ }
+ erts_print(to, arg, "segments_size: %beu %beu %beu\n",
+ ma->segments.current.sz, ma->segments.max.sz, ma->segments.max_ever.sz);
}
if (hpp || szp) {
res = NIL;
- add_2tup(hpp, szp, &res,
- am.segments_watermark,
- bld_unstable_uint(hpp, szp, mk->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));
- 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));
- add_2tup(hpp, szp, &res,
- am.cache_hits,
- bld_unstable_uint(hpp, szp, mk->cache_hits));
- add_2tup(hpp, szp, &res,
- am.cached_segments,
- bld_unstable_uint(hpp, szp, mk->cache_size));
-
+ add_4tup(hpp, szp, &res,
+ am.segments_size,
+ 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));
+ if (!only_sz) {
+ add_2tup(hpp, szp, &res,
+ am.segments_watermark,
+ bld_unstable_uint(hpp, szp, ma->segments.current.watermark));
+ add_4tup(hpp, szp, &res,
+ am.segments,
+ 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, ma->cache_hits));
+ add_2tup(hpp, szp, &res,
+ am.cached_segments,
+ 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,
- int begin_max_per, Uint **hpp, Uint *szp)
+static Eterm info_memkind(ErtsMsegAllctr_t *ma, fmtfn_t *print_to_p, void *print_to_arg,
+ int begin_max_per, int only_sz, Uint **hpp, Uint *szp)
{
Eterm res = THE_NON_VALUE;
Eterm atoms[3];
Eterm values[3];
- if (print_to_p) {
- erts_print(*print_to_p, print_to_arg, "memory kind: %s\n", mk->name);
- }
- if (hpp || szp) {
- atoms[0] = am.name;
- atoms[1] = am.status;
- atoms[2] = am.calls;
- values[0] = erts_bld_string(hpp, szp, mk->name);
+ if (!only_sz) {
+ if (print_to_p) {
+ 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, "all memory");
+ }
}
- values[1] = info_status(ma, mk, print_to_p, print_to_arg, begin_max_per, hpp, szp);
- values[2] = info_calls(ma, print_to_p, print_to_arg, hpp, szp);
+ res = info_status(ma, print_to_p, print_to_arg, begin_max_per, only_sz, hpp, szp);
+ if (!only_sz) {
+ values[1] = res;
+ values[2] = info_calls(ma, print_to_p, print_to_arg, hpp, szp);
- if (hpp || szp)
- res = bld_2tup_list(hpp, szp, 3, atoms, values);
+ if (hpp || szp)
+ res = bld_2tup_list(hpp, szp, 3, atoms, values);
+ }
return res;
}
-
static Eterm
-info_version(ErtsMsegAllctr_t *ma, int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp)
+info_version(ErtsMsegAllctr_t *ma, fmtfn_t *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp)
{
Eterm res = THE_NON_VALUE;
@@ -1284,7 +1226,7 @@ info_version(ErtsMsegAllctr_t *ma, int *print_to_p, void *print_to_arg, Uint **h
Eterm
erts_mseg_info_options(int ix,
- int *print_to_p, void *print_to_arg,
+ fmtfn_t *print_to_p, void *print_to_arg,
Uint **hpp, Uint *szp)
{
ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_IX(ix);
@@ -1297,9 +1239,10 @@ erts_mseg_info_options(int ix,
Eterm
erts_mseg_info(int ix,
- int *print_to_p,
+ fmtfn_t *print_to_p,
void *print_to_arg,
int begin_max_per,
+ int only_sz,
Uint **hpp,
Uint *szp)
{
@@ -1310,29 +1253,29 @@ erts_mseg_info(int ix,
Uint n = 0;
if (hpp || szp) {
-
- if (!atoms_initialized)
- init_atoms(ma);
-
- atoms[0] = am.version;
- atoms[1] = am.options;
- atoms[2] = am.memkind;
- atoms[3] = am.memkind;
+ if (!atoms_initialized)
+ init_atoms(ma);
+ }
+ if (!only_sz) {
+ if (hpp || szp) {
+ atoms[0] = am.version;
+ atoms[1] = am.options;
+ atoms[2] = am.memkind;
+ }
+ values[n++] = info_version(ma, print_to_p, print_to_arg, hpp, szp);
+ values[n++] = info_options(ma, "option ", print_to_p, print_to_arg, hpp, szp);
}
- values[n++] = info_version(ma, print_to_p, print_to_arg, hpp, szp);
- values[n++] = info_options(ma, "option ", print_to_p, print_to_arg, hpp, szp);
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
- if (hpp || szp)
- res = bld_2tup_list(hpp, szp, n, atoms, values);
+ res = info_memkind(ma, print_to_p, print_to_arg, begin_max_per, only_sz, hpp, szp);
+
+ if (!only_sz) {
+ values[n++] = res;
+ if (hpp || szp)
+ res = bld_2tup_list(hpp, szp, n, atoms, values);
+ }
ERTS_MSEG_UNLOCK(ma);
@@ -1407,13 +1350,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;
}
@@ -1425,16 +1365,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 */
@@ -1442,25 +1382,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
@@ -1485,21 +1420,22 @@ erts_mseg_init(ErtsMsegInit_t *init)
atoms_initialized = 0;
- 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");
+ erts_mtx_init(&init_atoms_mutex, "mseg_init_atoms", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
- init->mmap.virtual_range.start = (char *) sbrk(0);
- init->mmap.virtual_range.end = (char *) 0x100000000UL;
- init->mmap.sco = 0;
+#ifdef ERTS_HAVE_EXEC_MMAPPER
+ /* Initialize erts_exec_mapper *FIRST*, to increase probability
+ * of getting low memory for HiPE AMD64's small code model.
+ */
+ erts_mmap_init(&erts_exec_mmapper, &init->exec_mmap, 1);
+#endif
+ erts_mmap_init(&erts_dflt_mmapper, &init->dflt_mmap, 0);
+#if defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
+ erts_mmap_init(&erts_literal_mmapper, &init->literal_mmap, 0);
#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);
@@ -1514,7 +1450,8 @@ erts_mseg_init(ErtsMsegInit_t *init)
ma->is_thread_safe = 0;
else {
ma->is_thread_safe = 1;
- erts_mtx_init(&ma->mtx, "mseg");
+ erts_mtx_init(&ma->mtx, "mseg", make_small(i),
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_ALLOCATOR);
}
ma->is_cache_check_scheduled = 0;
@@ -1528,14 +1465,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));
}
@@ -1544,13 +1474,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 2284b3f8f1..bba0dec499 100644
--- a/erts/emulator/sys/common/erl_mseg.h
+++ b/erts/emulator/sys/common/erl_mseg.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2002-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2002-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -41,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
@@ -68,7 +59,9 @@ typedef struct {
Uint rmcbf;
Uint mcs;
Uint nos;
- ErtsMMapInit mmap;
+ ErtsMMapInit dflt_mmap;
+ ErtsMMapInit literal_mmap;
+ ErtsMMapInit exec_mmap;
} ErtsMsegInit_t;
#define ERTS_MSEG_INIT_DEFAULT_INITIALIZER \
@@ -77,7 +70,9 @@ 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, \
+ ERTS_MMAP_INIT_HIPE_EXEC_INITER \
}
typedef struct {
@@ -86,9 +81,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;
@@ -106,8 +98,8 @@ Uint erts_mseg_unit_size(void);
void erts_mseg_init(ErtsMsegInit_t *init);
void erts_mseg_late_init(void); /* Have to be called after all allocators,
threads and timers have been initialized. */
-Eterm erts_mseg_info_options(int, int *, void*, Uint **, Uint *);
-Eterm erts_mseg_info(int, int *, void*, int, Uint **, Uint *);
+Eterm erts_mseg_info_options(int, fmtfn_t*, void*, Uint **, Uint *);
+Eterm erts_mseg_info(int, fmtfn_t *, void*, int, int, Uint **, Uint *);
#endif /* #if HAVE_ERTS_MSEG */
diff --git a/erts/emulator/sys/common/erl_mtrace_sys_wrap.c b/erts/emulator/sys/common/erl_mtrace_sys_wrap.c
index 408aa7e016..fc871f94f1 100644
--- a/erts/emulator/sys/common/erl_mtrace_sys_wrap.c
+++ b/erts/emulator/sys/common/erl_mtrace_sys_wrap.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2004-2009. All Rights Reserved.
+ * Copyright Ericsson AB 2004-2016. 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.
+ * 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%
*/
diff --git a/erts/emulator/sys/common/erl_os_monotonic_time_extender.c b/erts/emulator/sys/common/erl_os_monotonic_time_extender.c
new file mode 100644
index 0000000000..d53190fdd5
--- /dev/null
+++ b/erts/emulator/sys/common/erl_os_monotonic_time_extender.c
@@ -0,0 +1,89 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2015-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%
+ */
+
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+#include "erl_os_monotonic_time_extender.h"
+
+#ifdef USE_THREADS
+
+static void *os_monotonic_time_extender(void *vstatep)
+{
+ ErtsOsMonotonicTimeExtendState *state = (ErtsOsMonotonicTimeExtendState *) vstatep;
+ long sleep_time = state->check_interval*1000;
+ Uint32 (*raw_os_mtime)(void) = state->raw_os_monotonic_time;
+ Uint32 last_msb = 0;
+
+ while (1) {
+ Uint32 msb = (*raw_os_mtime)() & (((Uint32) 1) << 31);
+
+ if (msb != last_msb) {
+ int ix = ((int) (last_msb >> 31)) & 1;
+ Uint32 xtnd = (Uint32) erts_atomic32_read_nob(&state->extend[ix]);
+ erts_atomic32_set_nob(&state->extend[ix], (erts_aint32_t) (xtnd + 1));
+ last_msb = msb;
+ }
+ erts_milli_sleep(sleep_time);
+ }
+
+ erts_exit(ERTS_ABORT_EXIT, "os_monotonic_time_extender thread terminating");
+ return NULL;
+}
+
+static erts_tid_t os_monotonic_extender_tid;
+#endif
+
+void
+erts_init_os_monotonic_time_extender(ErtsOsMonotonicTimeExtendState *statep,
+ Uint32 (*raw_os_monotonic_time)(void),
+ int check_seconds)
+{
+#ifdef USE_THREADS
+ statep->raw_os_monotonic_time = raw_os_monotonic_time;
+ erts_atomic32_init_nob(&statep->extend[0], (erts_aint32_t) 0);
+ erts_atomic32_init_nob(&statep->extend[1], (erts_aint32_t) 0);
+ statep->check_interval = check_seconds;
+
+#else
+ statep->extend[0] = (Uint32) 0;
+ statep->extend[1] = (Uint32) 0;
+ statep->last_msb = (ErtsMonotonicTime) 0;
+#endif
+}
+
+void
+erts_late_init_os_monotonic_time_extender(ErtsOsMonotonicTimeExtendState *statep)
+{
+#ifdef USE_THREADS
+ erts_thr_opts_t thr_opts = ERTS_THR_OPTS_DEFAULT_INITER;
+ thr_opts.detached = 1;
+ thr_opts.suggested_stack_size = 4;
+
+#if 0
+ thr_opts.name = "os_monotonic_time_extender";
+#endif
+
+ erts_thr_create(&os_monotonic_extender_tid,
+ os_monotonic_time_extender,
+ (void*) statep,
+ &thr_opts);
+#endif
+}
diff --git a/erts/emulator/sys/common/erl_os_monotonic_time_extender.h b/erts/emulator/sys/common/erl_os_monotonic_time_extender.h
new file mode 100644
index 0000000000..8089c9aed9
--- /dev/null
+++ b/erts/emulator/sys/common/erl_os_monotonic_time_extender.h
@@ -0,0 +1,66 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 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_OS_MONOTONIC_TIME_EXTENDER_H__
+#define ERL_OS_MONOTONIC_TIME_EXTENDER_H__
+
+#include "sys.h"
+#include "erl_threads.h"
+
+typedef struct {
+#ifdef USE_THREADS
+ Uint32 (*raw_os_monotonic_time)(void);
+ erts_atomic32_t extend[2];
+ int check_interval;
+#else
+ Uint32 extend[2];
+ ErtsMonotonicTime last_msb;
+#endif
+} ErtsOsMonotonicTimeExtendState;
+
+#ifdef USE_THREADS
+# define ERTS_CHK_EXTEND_OS_MONOTONIC_TIME(S, RT) ((void) 1)
+# define ERTS_EXTEND_OS_MONOTONIC_TIME(S, RT) \
+ ((((ErtsMonotonicTime) \
+ erts_atomic32_read_nob(&((S)->extend[((int) ((RT) >> 31)) & 1]))) \
+ << 32) \
+ + (RT))
+#else
+# define ERTS_CHK_EXTEND_OS_MONOTONIC_TIME(S, RT) \
+ do { \
+ Uint32 msb__ = (RT) & (((Uint32) 1) << 31); \
+ if (msb__ != (S)->last_msb) { \
+ int ix__ = ((int) ((S)->last_msb >> 31)) & 1; \
+ (S)->extend[ix__]++; \
+ (S)->last_msb = msb; \
+ } \
+ } while (0)
+# define ERTS_EXTEND_OS_MONOTONIC_TIME(S, RT) \
+ ((((ErtsMonotonicTime) (S)->extend[((int) ((RT) >> 31)) & 1]) << 32) + (RT))
+#endif
+
+void
+erts_init_os_monotonic_time_extender(ErtsOsMonotonicTimeExtendState *statep,
+ Uint32 (*raw_os_monotonic_time)(void),
+ int check_seconds);
+void
+erts_late_init_os_monotonic_time_extender(ErtsOsMonotonicTimeExtendState *statep);
+
+#endif
diff --git a/erts/emulator/sys/common/erl_poll.c b/erts/emulator/sys/common/erl_poll.c
index 0a58a625b2..52a8b6a53f 100644
--- a/erts/emulator/sys/common/erl_poll.c
+++ b/erts/emulator/sys/common/erl_poll.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2006-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2006-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -50,7 +51,6 @@
#ifndef WANT_NONBLOCKING
# define WANT_NONBLOCKING
#endif
-#define ERTS_WANT_GOT_SIGUSR1
#include "erl_poll.h"
#if ERTS_POLL_USE_KQUEUE
@@ -73,6 +73,8 @@
#include "erl_thr_progress.h"
#include "erl_driver.h"
#include "erl_alloc.h"
+#include "erl_msacc.h"
+#include "erl_misc_utils.h"
#if !defined(ERTS_POLL_USE_EPOLL) \
&& !defined(ERTS_POLL_USE_DEVPOLL) \
@@ -153,9 +155,6 @@ int ERTS_SELECT(int nfds, ERTS_fd_set *readfds, ERTS_fd_set *writefds,
#define ERTS_POLL_COALESCE_KP_RES (ERTS_POLL_USE_KQUEUE || ERTS_POLL_USE_EPOLL)
-#define ERTS_EV_TABLE_MIN_LENGTH 1024
-#define ERTS_EV_TABLE_EXP_THRESHOLD (2048*1024)
-
#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
# define ERTS_POLL_ASYNC_INTERRUPT_SUPPORT 1
#else
@@ -314,13 +313,16 @@ struct ErtsPollSet_ {
#if ERTS_POLL_USE_WAKEUP_PIPE
int wake_fds[2];
#endif
+#if ERTS_POLL_USE_TIMERFD
+ int timer_fd;
+#endif
#if ERTS_POLL_USE_FALLBACK
int fallback_used;
#endif
#if defined(USE_THREADS) || ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
erts_atomic32_t wakeup_state;
#endif
- erts_smp_atomic32_t timeout;
+ erts_atomic64_t timeout_time;
#ifdef ERTS_POLL_COUNT_AVOIDED_WAKEUPS
erts_smp_atomic_t no_avoided_wakeups;
erts_smp_atomic_t no_avoided_interrupts;
@@ -334,7 +336,7 @@ static void fatal_error_async_signal_safe(char *error_str);
static int max_fds = -1;
static ErtsPollSet pollsets;
-static erts_smp_spinlock_t pollsets_lock;
+static erts_smp_mtx_t pollsets_lock;
#if ERTS_POLL_USE_POLL
@@ -384,6 +386,26 @@ static void check_poll_status(ErtsPollSet ps);
static void print_misc_debug_info(void);
#endif
+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 0
#define ERTS_POLL_WOKEN -1
#define ERTS_POLL_WOKEN_INTR 1
@@ -410,7 +432,7 @@ static ERTS_INLINE int
is_interrupted_reset(ErtsPollSet ps)
{
#if defined(USE_THREADS) || ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
- return (erts_atomic32_xchg_nob(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN)
+ return (erts_atomic32_xchg_acqb(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN)
== ERTS_POLL_WOKEN_INTR);
#else
return 0;
@@ -421,7 +443,7 @@ static ERTS_INLINE void
woke_up(ErtsPollSet ps)
{
#if defined(USE_THREADS) || ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
- erts_aint32_t wakeup_state = erts_atomic32_read_nob(&ps->wakeup_state);
+ erts_aint32_t wakeup_state = erts_atomic32_read_acqb(&ps->wakeup_state);
if (wakeup_state == ERTS_POLL_NOT_WOKEN)
(void) erts_atomic32_cmpxchg_nob(&ps->wakeup_state,
ERTS_POLL_WOKEN,
@@ -448,14 +470,9 @@ wake_poller(ErtsPollSet ps, int interrupted, int async_signal_safe)
wakeup_state = erts_atomic32_cmpxchg_relb(&ps->wakeup_state,
ERTS_POLL_WOKEN,
ERTS_POLL_NOT_WOKEN);
- else {
- /*
- * We might unnecessarily write to the pipe, however,
- * that isn't problematic.
- */
- wakeup_state = erts_atomic32_read_nob(&ps->wakeup_state);
- erts_atomic32_set_relb(&ps->wakeup_state, ERTS_POLL_WOKEN_INTR);
- }
+ else
+ wakeup_state = erts_atomic32_xchg_relb(&ps->wakeup_state,
+ ERTS_POLL_WOKEN_INTR);
wake = wakeup_state == ERTS_POLL_NOT_WOKEN;
}
/*
@@ -560,6 +577,75 @@ create_wakeup_pipe(ErtsPollSet ps)
#endif /* ERTS_POLL_USE_WAKEUP_PIPE */
/*
+ * --- timer fd -----------------------------------------------------------
+ */
+
+#if ERTS_POLL_USE_TIMERFD
+
+/* We use the timerfd when using epoll_wait to get high accuracy
+ timeouts, i.e. we want to sleep with < ms accuracy. */
+
+static void
+create_timerfd(ErtsPollSet ps)
+{
+ int do_wake = 0;
+ int timer_fd;
+ timer_fd = timerfd_create(CLOCK_MONOTONIC,0);
+ ERTS_POLL_EXPORT(erts_poll_control)(ps,
+ timer_fd,
+ ERTS_POLL_EV_IN,
+ 1, &do_wake);
+#if ERTS_POLL_USE_FALLBACK
+ /* We depend on the wakeup pipe being handled by kernel poll */
+ if (ps->fds_status[timer_fd].flags & ERTS_POLL_FD_FLG_INFLBCK)
+ fatal_error("%s:%d:create_wakeup_pipe(): Internal error\n",
+ __FILE__, __LINE__);
+#endif
+ if (ps->internal_fd_limit <= timer_fd)
+ ps->internal_fd_limit = timer_fd + 1;
+ ps->timer_fd = timer_fd;
+}
+
+static ERTS_INLINE void
+timerfd_set(ErtsPollSet ps, struct itimerspec *its)
+{
+#ifdef DEBUG
+ struct itimerspec old_its;
+ int res;
+ res = timerfd_settime(ps->timer_fd, 0, its, &old_its);
+ ASSERT(res == 0);
+ ASSERT(old_its.it_interval.tv_sec == 0 &&
+ old_its.it_interval.tv_nsec == 0 &&
+ old_its.it_value.tv_sec == 0 &&
+ old_its.it_value.tv_nsec == 0);
+
+#else
+ timerfd_settime(ps->timer_fd, 0, its, NULL);
+#endif
+}
+
+static ERTS_INLINE int
+timerfd_clear(ErtsPollSet ps, int res, int max_res) {
+
+ struct itimerspec its;
+ /* we always have to clear the timer */
+ its.it_interval.tv_sec = 0;
+ its.it_interval.tv_nsec = 0;
+ its.it_value.tv_sec = 0;
+ its.it_value.tv_nsec = 0;
+ timerfd_settime(ps->timer_fd, 0, &its, NULL);
+
+ /* only timeout fd triggered */
+ if (res == 1 && ps->res_events[0].data.fd == ps->timer_fd)
+ return 0;
+
+ return res;
+}
+
+#endif /* ERTS_POLL_USE_TIMERFD */
+
+
+/*
* --- Poll set update requests ----------------------------------------------
*/
#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE
@@ -611,27 +697,33 @@ free_update_requests_block(ErtsPollSet ps,
* --- Growing poll set structures -------------------------------------------
*/
-int
-ERTS_POLL_EXPORT(erts_poll_get_table_len) (int new_len)
+#ifndef ERTS_KERNEL_POLL_VERSION /* only one shared implementation */
+
+#define ERTS_FD_TABLE_MIN_LENGTH 1024
+#define ERTS_FD_TABLE_EXP_THRESHOLD (2048*1024)
+
+int erts_poll_new_table_len (int old_len, int need_len)
{
- if (new_len < ERTS_EV_TABLE_MIN_LENGTH) {
- new_len = ERTS_EV_TABLE_MIN_LENGTH;
- } else if (new_len < ERTS_EV_TABLE_EXP_THRESHOLD) {
- /* find next power of 2 */
- --new_len;
- new_len |= new_len >> 1;
- new_len |= new_len >> 2;
- new_len |= new_len >> 4;
- new_len |= new_len >> 8;
- new_len |= new_len >> 16;
- ++new_len;
- } else {
- /* grow incrementally */
- new_len += ERTS_EV_TABLE_EXP_THRESHOLD;
+ int new_len;
+
+ ASSERT(need_len > old_len);
+ if (need_len < ERTS_FD_TABLE_MIN_LENGTH) {
+ new_len = ERTS_FD_TABLE_MIN_LENGTH;
+ }
+ else {
+ new_len = old_len;
+ do {
+ if (new_len < ERTS_FD_TABLE_EXP_THRESHOLD)
+ new_len *= 2;
+ else
+ new_len += ERTS_FD_TABLE_EXP_THRESHOLD;
+
+ } while (new_len < need_len);
}
+ ASSERT(new_len >= need_len);
return new_len;
}
-
+#endif
#if ERTS_POLL_USE_KERNEL_POLL
static void
@@ -645,7 +737,7 @@ grow_res_events(ErtsPollSet ps, int new_len)
#elif ERTS_POLL_USE_KQUEUE
struct kevent
#endif
- ) * ERTS_POLL_EXPORT(erts_poll_get_table_len)(new_len);
+ ) * erts_poll_new_table_len(ps->res_events_len, new_len);
/* We do not need to save previously stored data */
if (ps->res_events)
erts_free(ERTS_ALC_T_POLL_RES_EVS, ps->res_events);
@@ -659,7 +751,7 @@ static void
grow_poll_fds(ErtsPollSet ps, int min_ix)
{
int i;
- int new_len = ERTS_POLL_EXPORT(erts_poll_get_table_len)(min_ix + 1);
+ int new_len = erts_poll_new_table_len(ps->poll_fds_len, min_ix + 1);
if (new_len > max_fds)
new_len = max_fds;
ps->poll_fds = (ps->poll_fds_len
@@ -681,7 +773,7 @@ grow_poll_fds(ErtsPollSet ps, int min_ix)
static void
grow_select_fds(int fd, ERTS_fd_set* fds)
{
- int new_len = ERTS_POLL_EXPORT(erts_poll_get_table_len)(fd + 1);
+ int new_len = erts_poll_new_table_len(fds->sz, fd + 1);
if (new_len > max_fds)
new_len = max_fds;
new_len = ERTS_FD_SIZE(new_len);
@@ -708,7 +800,7 @@ static void
grow_fds_status(ErtsPollSet ps, int min_fd)
{
int i;
- int new_len = ERTS_POLL_EXPORT(erts_poll_get_table_len)(min_fd + 1);
+ int new_len = erts_poll_new_table_len(ps->fds_status_len, min_fd + 1);
ASSERT(min_fd < max_fds);
if (new_len > max_fds)
new_len = max_fds;
@@ -1497,6 +1589,12 @@ poll_control(ErtsPollSet ps, int fd, ErtsPollEvents events, int on, int *do_wake
goto done;
}
#endif
+#if ERTS_POLL_USE_TIMERFD
+ if (fd == ps->timer_fd) {
+ new_events = ERTS_POLL_EV_NVAL;
+ goto done;
+ }
+#endif
}
if (fd >= ps->fds_status_len)
@@ -1644,6 +1742,9 @@ save_kp_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res, int chk_fds_res)
#if ERTS_POLL_USE_WAKEUP_PIPE
int wake_fd = ps->wake_fds[0];
#endif
+#if ERTS_POLL_USE_TIMERFD
+ int timer_fd = ps->timer_fd;
+#endif
for (i = 0; i < n; i++) {
@@ -1659,6 +1760,11 @@ save_kp_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res, int chk_fds_res)
continue;
}
#endif
+#if ERTS_POLL_USE_TIMERFD
+ if (fd == timer_fd) {
+ continue;
+ }
+#endif
ASSERT(!(ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INFLBCK));
/* epoll_wait() can repeat the same fd in result array... */
ix = (int) ps->fds_status[fd].res_ev_ix;
@@ -1733,6 +1839,11 @@ save_kp_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res, int chk_fds_res)
continue;
}
#endif
+#if ERTS_POLL_USE_TIMERFD
+ if (fd == timer_fd) {
+ continue;
+ }
+#endif
revents = ERTS_POLL_EV_N2E(ps->res_events[i].events);
pr[res].fd = fd;
pr[res].events = revents;
@@ -1993,44 +2104,195 @@ save_poll_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res,
}
}
+static ERTS_INLINE ErtsMonotonicTime
+get_timeout(ErtsPollSet ps,
+ int resolution,
+ ErtsMonotonicTime timeout_time)
+{
+ ErtsMonotonicTime timeout, save_timeout_time;
+
+ if (timeout_time == ERTS_POLL_NO_TIMEOUT) {
+ save_timeout_time = ERTS_MONOTONIC_TIME_MIN;
+ timeout = 0;
+ }
+ else {
+ ErtsMonotonicTime diff_time, current_time;
+ current_time = erts_get_monotonic_time(NULL);
+ diff_time = timeout_time - current_time;
+ if (diff_time <= 0) {
+ save_timeout_time = ERTS_MONOTONIC_TIME_MIN;
+ timeout = 0;
+ }
+ else {
+ save_timeout_time = current_time;
+ switch (resolution) {
+ case 1000:
+ /* Round up to nearest even milli second */
+ timeout = ERTS_MONOTONIC_TO_MSEC(diff_time - 1) + 1;
+ if (timeout > (ErtsMonotonicTime) INT_MAX)
+ timeout = (ErtsMonotonicTime) INT_MAX;
+ save_timeout_time += ERTS_MSEC_TO_MONOTONIC(timeout);
+ timeout -= ERTS_PREMATURE_TIMEOUT(timeout, 1000);
+ break;
+ case 1000000:
+ /* Round up to nearest even micro second */
+ timeout = ERTS_MONOTONIC_TO_USEC(diff_time - 1) + 1;
+ save_timeout_time += ERTS_USEC_TO_MONOTONIC(timeout);
+ timeout -= ERTS_PREMATURE_TIMEOUT(timeout, 1000*1000);
+ break;
+ case 1000000000:
+ /* Round up to nearest even nano second */
+ timeout = ERTS_MONOTONIC_TO_NSEC(diff_time - 1) + 1;
+ save_timeout_time += ERTS_NSEC_TO_MONOTONIC(timeout);
+ timeout -= ERTS_PREMATURE_TIMEOUT(timeout, 1000*1000*1000);
+ break;
+ default:
+ ERTS_INTERNAL_ERROR("Invalid resolution");
+ timeout = 0;
+ save_timeout_time = 0;
+ break;
+ }
+ }
+ }
+ set_timeout_time(ps, save_timeout_time);
+ return timeout;
+}
+
+#if ERTS_POLL_USE_SELECT
+
+static ERTS_INLINE int
+get_timeout_timeval(ErtsPollSet ps,
+ SysTimeval *tvp,
+ ErtsMonotonicTime timeout_time)
+{
+ ErtsMonotonicTime timeout = get_timeout(ps,
+ 1000*1000,
+ timeout_time);
+
+ if (!timeout) {
+ tvp->tv_sec = 0;
+ tvp->tv_usec = 0;
+
+ return 0;
+ }
+ else {
+ ErtsMonotonicTime sec = timeout/(1000*1000);
+ tvp->tv_sec = sec;
+ tvp->tv_usec = timeout - sec*(1000*1000);
+
+ ASSERT(tvp->tv_sec >= 0);
+ ASSERT(tvp->tv_usec >= 0);
+ ASSERT(tvp->tv_usec < 1000*1000);
+
+ return !0;
+ }
+
+}
+
+#endif
+
+#if ERTS_POLL_USE_KQUEUE || (ERTS_POLL_USE_POLL && defined(HAVE_PPOLL)) || ERTS_POLL_USE_TIMERFD
+
+static ERTS_INLINE int
+get_timeout_timespec(ErtsPollSet ps,
+ struct timespec *tsp,
+ ErtsMonotonicTime timeout_time)
+{
+ ErtsMonotonicTime timeout = get_timeout(ps,
+ 1000*1000*1000,
+ timeout_time);
+
+ if (!timeout) {
+ tsp->tv_sec = 0;
+ tsp->tv_nsec = 0;
+ return 0;
+ }
+ else {
+ ErtsMonotonicTime sec = timeout/(1000*1000*1000);
+ tsp->tv_sec = sec;
+ tsp->tv_nsec = timeout - sec*(1000*1000*1000);
+
+ ASSERT(tsp->tv_sec >= 0);
+ ASSERT(tsp->tv_nsec >= 0);
+ ASSERT(tsp->tv_nsec < 1000*1000*1000);
+
+ return !0;
+ }
+}
+
+#endif
+
+#if ERTS_POLL_USE_TIMERFD
+
static ERTS_INLINE int
-check_fd_events(ErtsPollSet ps, SysTimeval *tv, int max_res)
+get_timeout_itimerspec(ErtsPollSet ps,
+ struct itimerspec *itsp,
+ ErtsMonotonicTime timeout_time)
+{
+
+ itsp->it_interval.tv_sec = 0;
+ itsp->it_interval.tv_nsec = 0;
+
+ return get_timeout_timespec(ps, &itsp->it_value, timeout_time);
+}
+
+#endif
+
+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
- && tv->tv_usec == 0 && tv->tv_sec == 0) {
+ && timeout_time == ERTS_POLL_NO_TIMEOUT) {
/* Nothing to poll and zero timeout; done... */
return 0;
}
else {
- long timeout = tv->tv_sec*1000 + tv->tv_usec/1000;
- if (timeout > ERTS_AINT32_T_MAX)
- timeout = ERTS_AINT32_T_MAX;
- ASSERT(timeout >= 0);
- erts_smp_atomic32_set_relb(&ps->timeout, (erts_aint32_t) timeout);
+ int timeout;
#if ERTS_POLL_USE_FALLBACK
if (!(ps->fallback_used = ERTS_POLL_NEED_FALLBACK(ps))) {
#if ERTS_POLL_USE_EPOLL /* --- epoll ------------------------------- */
- if (timeout > INT_MAX)
- timeout = INT_MAX;
if (max_res > ps->res_events_len)
grow_res_events(ps, max_res);
+#if ERTS_POLL_USE_TIMERFD
+ {
+ struct itimerspec its;
+ timeout = get_timeout_itimerspec(ps, &its, timeout_time);
+ if (timeout) {
+#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);
+ } else {
+ res = epoll_wait(ps->kp_fd, ps->res_events, max_res, 0);
+ }
+ }
+#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
- res = epoll_wait(ps->kp_fd, ps->res_events, max_res, (int)timeout);
+ 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 ------------------------------ */
struct timespec ts;
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
- ts.tv_sec = tv->tv_sec;
- ts.tv_nsec = tv->tv_usec*1000;
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP);
+ }
res = kevent(ps->kp_fd, NULL, 0, ps->res_events, max_res, &ts);
#endif /* ----------------------------------------- */
}
@@ -2049,44 +2311,62 @@ check_fd_events(ErtsPollSet ps, SysTimeval *tv, int max_res)
#if ERTS_POLL_USE_WAKEUP_PIPE
nfds++; /* Wakeup pipe */
#endif
- if (timeout > INT_MAX)
- timeout = INT_MAX;
+ timeout = (int) get_timeout(ps, 1000, timeout_time);
poll_res.dp_nfds = nfds < max_res ? nfds : 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
- poll_res.dp_timeout = (int) timeout;
+ 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 /* --- poll -------------------------------- */
- if (timeout > INT_MAX)
- timeout = INT_MAX;
+#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
+ 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
- res = poll(ps->poll_fds, ps->no_poll_fds, (int) timeout);
+ 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 = *tv;
+ SysTimeval to;
+ timeout = get_timeout_timeval(ps, &to, timeout_time);
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 (to.tv_sec || to.tv_usec)
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);
+ &ps->res_input_fds,
+ &ps->res_output_fds,
+ NULL,
+ &to);
#ifdef ERTS_SMP
- if (to.tv_sec || to.tv_usec)
+ if (timeout) {
erts_thr_progress_finalize_wait(NULL);
+ ERTS_MSACC_POP_STATE_M();
+ }
if (res < 0
&& errno == EBADF
&& ERTS_POLLSET_HAVE_UPDATE_REQUESTS(ps)) {
@@ -2108,10 +2388,10 @@ check_fd_events(ErtsPollSet ps, SysTimeval *tv, int max_res)
handle_update_requests(ps);
ERTS_POLLSET_UNLOCK(ps);
res = ERTS_SELECT(ps->max_fd + 1,
- &ps->res_input_fds,
- &ps->res_output_fds,
- NULL,
- &to);
+ &ps->res_input_fds,
+ &ps->res_output_fds,
+ NULL,
+ &to);
if (res == 0) {
errno = EAGAIN;
res = -1;
@@ -2121,10 +2401,12 @@ check_fd_events(ErtsPollSet ps, SysTimeval *tv, 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;
}
}
@@ -2133,15 +2415,14 @@ int
ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps,
ErtsPollResFd pr[],
int *len,
- SysTimeval *utvp)
+ ErtsMonotonicTime timeout_time)
{
+ ErtsMonotonicTime to;
int res, no_fds;
int ebadf = 0;
#ifdef ERTS_SMP
int ps_locked = 0;
#endif
- SysTimeval *tvp;
- SysTimeval itv;
no_fds = *len;
#ifdef ERTS_POLL_MAX_RES
@@ -2151,13 +2432,9 @@ ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps,
*len = 0;
- ASSERT(utvp);
-
- tvp = utvp;
-
#ifdef ERTS_POLL_DEBUG_PRINT
- erts_printf("Entering erts_poll_wait(), timeout=%d\n",
- (int) tv->tv_sec*1000 + tv->tv_usec/1000);
+ erts_printf("Entering erts_poll_wait(), timeout_time=%bps\n",
+ timeout_time);
#endif
if (ERTS_POLLSET_SET_POLLED_CHK(ps)) {
@@ -2166,12 +2443,9 @@ ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps,
goto done;
}
- if (is_woken(ps)) {
- /* Use zero timeout */
- itv.tv_sec = 0;
- itv.tv_usec = 0;
- tvp = &itv;
- }
+ to = (is_woken(ps)
+ ? ERTS_POLL_NO_TIMEOUT /* Use zero timeout */
+ : timeout_time);
#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE
if (ERTS_POLLSET_HAVE_UPDATE_REQUESTS(ps)) {
@@ -2181,7 +2455,15 @@ ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps,
}
#endif
- res = check_fd_events(ps, tvp, no_fds);
+ while (1) {
+ res = check_fd_events(ps, to, no_fds);
+ if (res != 0)
+ break;
+ if (to == ERTS_POLL_NO_TIMEOUT)
+ break;
+ if (erts_get_monotonic_time(NULL) >= timeout_time)
+ break;
+ }
woke_up(ps);
@@ -2224,7 +2506,7 @@ ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps,
#endif
done:
- erts_smp_atomic32_set_relb(&ps->timeout, ERTS_AINT32_T_MAX);
+ set_timeout_time(ps, ERTS_MONOTONIC_TIME_MAX);
#ifdef ERTS_POLL_DEBUG_PRINT
erts_printf("Leaving %s = erts_poll_wait()\n",
res == 0 ? "0" : erl_errno_id(res));
@@ -2268,13 +2550,14 @@ ERTS_POLL_EXPORT(erts_poll_async_sig_interrupt)(ErtsPollSet ps)
void
ERTS_POLL_EXPORT(erts_poll_interrupt_timed)(ErtsPollSet ps,
int set,
- erts_short_time_t msec)
+ ErtsMonotonicTime timeout_time)
{
#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT || defined(ERTS_SMP)
if (!set)
reset_wakeup_state(ps);
else {
- if (erts_smp_atomic32_read_acqb(&ps->timeout) > (erts_aint32_t) msec)
+ ErtsMonotonicTime max_wait_time = get_timeout_time(ps);
+ if (max_wait_time > timeout_time)
wake_poller(ps, 1, 0);
#ifdef ERTS_POLL_COUNT_AVOIDED_WAKEUPS
else {
@@ -2300,7 +2583,8 @@ ERTS_POLL_EXPORT(erts_poll_max_fds)(void)
void
ERTS_POLL_EXPORT(erts_poll_init)(void)
{
- erts_smp_spinlock_init(&pollsets_lock, "pollsets_lock");
+ erts_smp_mtx_init(&pollsets_lock, "pollsets_lock", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_IO);
pollsets = NULL;
errno = 0;
@@ -2406,7 +2690,7 @@ ERTS_POLL_EXPORT(erts_poll_create_pollset)(void)
#endif
#ifdef ERTS_SMP
erts_atomic32_init_nob(&ps->polled, 0);
- erts_smp_mtx_init(&ps->mtx, "pollset");
+ erts_smp_mtx_init(&ps->mtx, "pollset", NIL, ERTS_LOCK_FLAGS_CATEGORY_IO);
#endif
#if defined(USE_THREADS) || ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
erts_atomic32_init_nob(&ps->wakeup_state, (erts_aint32_t) 0);
@@ -2414,6 +2698,9 @@ ERTS_POLL_EXPORT(erts_poll_create_pollset)(void)
#if ERTS_POLL_USE_WAKEUP_PIPE
create_wakeup_pipe(ps);
#endif
+#if ERTS_POLL_USE_TIMERFD
+ create_timerfd(ps);
+#endif
#if ERTS_POLL_USE_FALLBACK
if (kp_fd >= ps->fds_status_len)
grow_fds_status(ps, kp_fd);
@@ -2431,7 +2718,7 @@ ERTS_POLL_EXPORT(erts_poll_create_pollset)(void)
ps->internal_fd_limit = kp_fd + 1;
ps->kp_fd = kp_fd;
#endif
- erts_smp_atomic32_init_nob(&ps->timeout, ERTS_AINT32_T_MAX);
+ init_timeout_time(ps);
#ifdef ERTS_POLL_COUNT_AVOIDED_WAKEUPS
erts_smp_atomic_init_nob(&ps->no_avoided_wakeups, 0);
erts_smp_atomic_init_nob(&ps->no_avoided_interrupts, 0);
@@ -2445,10 +2732,10 @@ ERTS_POLL_EXPORT(erts_poll_create_pollset)(void)
#endif
erts_smp_atomic_set_nob(&ps->no_of_user_fds, 0); /* Don't count wakeup pipe and fallback fd */
- erts_smp_spin_lock(&pollsets_lock);
+ erts_smp_mtx_lock(&pollsets_lock);
ps->next = pollsets;
pollsets = ps;
- erts_smp_spin_unlock(&pollsets_lock);
+ erts_smp_mtx_unlock(&pollsets_lock);
return ps;
}
@@ -2504,8 +2791,12 @@ ERTS_POLL_EXPORT(erts_poll_destroy_pollset)(ErtsPollSet ps)
if (ps->wake_fds[1] >= 0)
close(ps->wake_fds[1]);
#endif
+#if ERTS_POLL_USE_TIMERFD
+ if (ps->timer_fd >= 0)
+ close(ps->timer_fd);
+#endif
- erts_smp_spin_lock(&pollsets_lock);
+ erts_smp_mtx_lock(&pollsets_lock);
if (ps == pollsets)
pollsets = pollsets->next;
else {
@@ -2515,7 +2806,7 @@ ERTS_POLL_EXPORT(erts_poll_destroy_pollset)(ErtsPollSet ps)
ASSERT(ps == prev_ps->next);
prev_ps->next = ps->next;
}
- erts_smp_spin_unlock(&pollsets_lock);
+ erts_smp_mtx_unlock(&pollsets_lock);
erts_free(ERTS_ALC_T_POLLSET, (void *) ps);
}
@@ -2608,6 +2899,9 @@ ERTS_POLL_EXPORT(erts_poll_info)(ErtsPollSet ps, ErtsPollInfo *pip)
#if ERTS_POLL_USE_WAKEUP_PIPE
pip->poll_set_size++; /* Wakeup pipe */
#endif
+#if ERTS_POLL_USE_TIMERFD
+ pip->poll_set_size++; /* timerfd */
+#endif
pip->fallback_poll_set_size =
#if !ERTS_POLL_USE_FALLBACK
@@ -2736,14 +3030,18 @@ ERTS_POLL_EXPORT(erts_poll_get_selected_events)(ErtsPollSet ps,
ev[fd] = 0;
else {
ev[fd] = ps->fds_status[fd].events;
+ if (
#if ERTS_POLL_USE_WAKEUP_PIPE
- if (fd == ps->wake_fds[0] || fd == ps->wake_fds[1])
- ev[fd] |= ERTS_POLL_EV_NVAL;
+ fd == ps->wake_fds[0] || fd == ps->wake_fds[1] ||
+#endif
+#if ERTS_POLL_USE_TIMERFD
+ fd == ps->timer_fd ||
#endif
#if ERTS_POLL_USE_KERNEL_POLL
- if (fd == ps->kp_fd)
- ev[fd] |= ERTS_POLL_EV_NVAL;
+ fd == ps->kp_fd ||
#endif
+ 0)
+ ev[fd] |= ERTS_POLL_EV_NVAL;
}
}
ERTS_POLLSET_UNLOCK(ps);
@@ -2851,3 +3149,26 @@ print_misc_debug_info(void)
}
#endif
+
+#ifdef ERTS_ENABLE_LOCK_COUNT
+static void erts_lcnt_enable_pollset_lock_count(ErtsPollSet pollset, int enable) {
+ if(enable) {
+ erts_lcnt_install_new_lock_info(&pollset->mtx.lcnt, "pollset_rm", NIL,
+ ERTS_LOCK_TYPE_MUTEX | ERTS_LOCK_FLAGS_CATEGORY_IO);
+ } else {
+ erts_lcnt_uninstall(&pollset->mtx.lcnt);
+ }
+}
+
+void ERTS_POLL_EXPORT(erts_lcnt_update_pollset_locks)(int enable) {
+ ErtsPollSet iterator;
+
+ erts_smp_mtx_lock(&pollsets_lock);
+
+ for(iterator = pollsets; iterator != NULL; iterator = iterator->next) {
+ erts_lcnt_enable_pollset_lock_count(iterator, enable);
+ }
+
+ erts_smp_mtx_unlock(&pollsets_lock);
+}
+#endif
diff --git a/erts/emulator/sys/common/erl_poll.h b/erts/emulator/sys/common/erl_poll.h
index 2f1c05f401..b3b4d79984 100644
--- a/erts/emulator/sys/common/erl_poll.h
+++ b/erts/emulator/sys/common/erl_poll.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2006-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2006-2016. 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.
+ * 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%
*/
@@ -29,6 +30,8 @@
#include "sys.h"
+#define ERTS_POLL_NO_TIMEOUT ERTS_MONOTONIC_TIME_MIN
+
#if 0
#define ERTS_POLL_COUNT_AVOIDED_WAKEUPS
#endif
@@ -90,46 +93,36 @@
# 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
#endif
+#define ERTS_POLL_USE_TIMERFD 0
+
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>
+#ifdef HAVE_SYS_TIMERFD_H
+#include <sys/timerfd.h>
+#undef ERTS_POLL_USE_TIMERFD
+#define ERTS_POLL_USE_TIMERFD 1
+#endif
+
#define ERTS_POLL_EV_E2N(EV) \
- ((__uint32_t) (EV))
+ ((uint32_t) (EV))
#define ERTS_POLL_EV_N2E(EV) \
((ErtsPollEvents) (EV))
@@ -241,7 +234,7 @@ void ERTS_POLL_EXPORT(erts_poll_interrupt)(ErtsPollSet,
int);
void ERTS_POLL_EXPORT(erts_poll_interrupt_timed)(ErtsPollSet,
int,
- erts_short_time_t);
+ ErtsMonotonicTime);
ErtsPollEvents ERTS_POLL_EXPORT(erts_poll_control)(ErtsPollSet,
ErtsSysFdType,
ErtsPollEvents,
@@ -254,7 +247,7 @@ void ERTS_POLL_EXPORT(erts_poll_controlv)(ErtsPollSet,
int ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet,
ErtsPollResFd [],
int *,
- SysTimeval *);
+ ErtsMonotonicTime);
int ERTS_POLL_EXPORT(erts_poll_max_fds)(void);
void ERTS_POLL_EXPORT(erts_poll_info)(ErtsPollSet,
ErtsPollInfo *);
@@ -265,6 +258,10 @@ void ERTS_POLL_EXPORT(erts_poll_get_selected_events)(ErtsPollSet,
ErtsPollEvents [],
int);
-int ERTS_POLL_EXPORT(erts_poll_get_table_len)(int);
+int erts_poll_new_table_len(int old_len, int need_len);
+
+#ifdef ERTS_ENABLE_LOCK_COUNT
+void ERTS_POLL_EXPORT(erts_lcnt_update_pollset_locks)(int enable);
+#endif
#endif /* #ifndef ERL_POLL_H__ */
diff --git a/erts/emulator/sys/common/erl_sys_common_misc.c b/erts/emulator/sys/common/erl_sys_common_misc.c
index e3ba741058..79f87eb3a9 100644
--- a/erts/emulator/sys/common/erl_sys_common_misc.c
+++ b/erts/emulator/sys/common/erl_sys_common_misc.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2006-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2006-2016. 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.
+ * 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%
*/
@@ -44,6 +45,14 @@
#endif
#endif
+/*
+ * erts_check_io_time is used by the erl_check_io implementation. The
+ * global erts_check_io_time variable is declared here since there
+ * (often) exist two versions of erl_check_io (kernel-poll and
+ * non-kernel-poll), and we dont want two versions of this variable.
+ */
+erts_smp_atomic_t erts_check_io_time;
+
/* Written once and only once */
static int filename_encoding = ERL_FILENAME_UNKNOWN;
diff --git a/erts/emulator/sys/common/erl_util_queue.h b/erts/emulator/sys/common/erl_util_queue.h
index 47925e2264..73293e0225 100644
--- a/erts/emulator/sys/common/erl_util_queue.h
+++ b/erts/emulator/sys/common/erl_util_queue.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2013. All Rights Reserved.
+ * Copyright Ericsson AB 2013-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
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/erl_main.c b/erts/emulator/sys/ose/erl_main.c
deleted file mode 100644
index 23a9bc93a4..0000000000
--- a/erts/emulator/sys/ose/erl_main.c
+++ /dev/null
@@ -1,53 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2000-2009. 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%
- */
-
-#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 cd66d95c26..0000000000
--- a/erts/emulator/sys/ose/erl_ose_sys.h
+++ /dev/null
@@ -1,353 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1997-2011. 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%
- *
- * 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
-
-#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 ebd80deeaf..0000000000
--- a/erts/emulator/sys/ose/erl_ose_sys_ddll.c
+++ /dev/null
@@ -1,126 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2006-2013. 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%
- */
-
-/*
- * 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 7d2a3d1e0b..0000000000
--- a/erts/emulator/sys/ose/erl_poll.c
+++ /dev/null
@@ -1,780 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2006-2012. 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%
- */
-
-/*
- * 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_smp_atomic32_t timeout;
-#ifdef ERTS_SMP
- erts_smp_mtx_t mtx;
-#endif
-};
-
-static int max_fds = -1;
-
-#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,erts_short_time_t msec) {
- HARDTRACEF("erts_poll_interrupt_timed called!\n");
-
- if (!set)
- reset_interrupt(ps);
- else if (erts_smp_atomic32_read_acqb(&ps->timeout) > (erts_aint32_t) msec)
- 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,
- SysTimeval *utvp) {
- int res = ETIMEDOUT, no_fds, currid = 0;
- OSTIME timeout;
- union SIGNAL *sig;
- // 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;
-
- ASSERT(utvp);
-
- /* erts_printf("Entering erts_poll_wait(), timeout=%d\n",
- (int) utvp->tv_sec*1000 + utvp->tv_usec/1000); */
-
- timeout = utvp->tv_sec*1000 + utvp->tv_usec/1000;
-
- if (timeout > ((time_t) ERTS_AINT32_T_MAX))
- timeout = ERTS_AINT32_T_MAX;
- erts_smp_atomic32_set_relb(&ps->timeout, (erts_aint32_t) timeout);
-
- 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);
- erts_smp_atomic32_set_nob(&ps->timeout, ERTS_AINT32_T_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);
- erts_smp_atomic32_init_nob(&ps->timeout, ERTS_AINT32_T_MAX);
-#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 5b950a7dae..0000000000
--- a/erts/emulator/sys/ose/sys.c
+++ /dev/null
@@ -1,1846 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1996-2013. 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%
- */
-
-#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, erts_short_time_t msec)
-{
- ERTS_CHK_IO_INTR_TMD(set, msec);
-}
-#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 d9d6bb7c04..0000000000
--- a/erts/emulator/sys/ose/sys_float.c
+++ /dev/null
@@ -1,844 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2001-2013. 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%
- */
-
-#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 7e96f68424..0000000000
--- a/erts/emulator/sys/ose/sys_time.c
+++ /dev/null
@@ -1,56 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2005-2009. 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%
- */
-
-#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/driver_int.h b/erts/emulator/sys/unix/driver_int.h
index a7ee8087ab..840b832878 100644
--- a/erts/emulator/sys/unix/driver_int.h
+++ b/erts/emulator/sys/unix/driver_int.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1997-2009. All Rights Reserved.
+ * Copyright Ericsson AB 1997-2016. 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.
+ * 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%
*/
diff --git a/erts/emulator/sys/unix/erl_child_setup.c b/erts/emulator/sys/unix/erl_child_setup.c
index 94eb6b1547..69fc6c2879 100644
--- a/erts/emulator/sys/unix/erl_child_setup.c
+++ b/erts/emulator/sys/unix/erl_child_setup.c
@@ -1,126 +1,302 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2002-2009. All Rights Reserved.
+ * Copyright Ericsson AB 2002-2016. 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.
+ * 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%
*/
/*
- * 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 <stdarg.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, "%d:" fmt "\r\n", getpid(), ##__VA_ARGS__)
+#else
+#define DEBUG_PRINT(fmt, ...)
+#endif
+
+static char abort_reason[200]; /* for core dump inspection */
+
+static void ABORT(const char* fmt, ...)
{
- sigrelse(sig);
+ va_list arglist;
+ va_start(arglist, fmt);
+ vsprintf(abort_reason, fmt, arglist);
+ fprintf(stderr, "erl_child_setup: %s\r\n", abort_reason);
+ va_end(arglist);
+ abort();
}
-#else /* !SIG_SIGSET */
-#ifdef SIG_SIGNAL /* Old BSD */
-sys_sigrelease(int sig)
+
+#ifdef DEBUG
+void
+erl_assert_error(const char* expr, const char* func, const char* file, int line)
{
- sigsetmask(sigblock(0) & ~sigmask(sig));
+ fflush(stdout);
+ fprintf(stderr, "%s:%d:%s() Assertion failed: %s\n",
+ file, line, func, expr);
+ fflush(stderr);
+ abort();
}
-#else /* !SIG_SIGNAL */ /* The True Way - POSIX!:-) */
-void sys_sigrelease(int sig)
+#endif
+
+void sys_sigblock(int sig)
{
sigset_t mask;
sigemptyset(&mask);
sigaddset(&mask, sig);
+ sigprocmask(SIG_BLOCK, &mask, (sigset_t *)NULL);
+}
+
+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__)
-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 errln = -1;
+ int size, res, i, pos = 0;
+ char *buff, *o_buff;
+
+ char *cmd, *cwd, *wd, **new_environ, **args = NULL;
+
+ Sint32 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) {
+ errln = __LINE__;
+ 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;
+ errln = __LINE__;
+ goto child_error;
+ }
+ if (res == 0) {
+ errno = EPIPE;
+ errln = __LINE__;
+ goto child_error;
+ }
+ pos += res;
+ } while(size - pos != 0);
+
+ o_buff = buff;
+
+ flags = get_int32(buff);
+ buff += sizeof(flags);
- 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;
+
+ cwd = 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(__ANDROID__)
- for (i = from; i <= to; i++) {
- if (i!=__system_properties_fd)
- (void) close(i);
+ cnt = get_int32(buff);
+ buff += sizeof(cnt);
+ new_environ = malloc(sizeof(char*)*(cnt + 1));
+
+ DEBUG_PRINT("env_len = %d", cnt);
+ for (i = 0; i < cnt; i++, buff++) {
+ new_environ[i] = buff;
+ while(*buff != '\0') buff++;
}
-#else
- for (i = from; i <= to; i++)
- (void) close(i);
-#endif /* __ANDROID__ */
+ new_environ[cnt] = NULL;
-#if defined(HAVE_CLOSEFROM)
- closefrom(from);
-#else
- for (i = from; i <= to; i++)
- (void) close(i);
-#endif
+ if (o_buff + size != buff) {
+ /* This is a spawn executable call */
+ cnt = get_int32(buff);
+ buff += sizeof(cnt);
+ args = malloc(sizeof(char*)*(cnt + 1));
+ for (i = 0; i < cnt; i++, buff++) {
+ args[i] = buff;
+ while(*buff != '\0') buff++;
+ }
+ args[cnt] = NULL;
+ }
+
+ if (o_buff + size != buff) {
+ errno = EINVAL;
+ errln = __LINE__;
+ fprintf(stderr,"erl_child_setup: failed with protocol "
+ "error %d on line %d", errno, errln);
+ /* we abort here as it is most likely a symptom of an
+ emulator/erl_child_setup bug */
+ abort();
+ }
- if (!(argv[CS_ARGV_WD_IX][0] == '.' && argv[CS_ARGV_WD_IX][1] == '\0')
- && chdir(argv[CS_ARGV_WD_IX]) < 0)
- return 1;
+ 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;
+ errln = __LINE__;
+ goto child_error;
+ }
+
+ DEBUG_PRINT("Set cwd to: '%s'",cwd);
+
+ if (chdir(cwd) < 0) {
+ /* This is not good, it probably means that the cwd of
+ beam is invalid. We ignore it and try anyways as
+ the child might now need a cwd or the chdir below
+ could take us to a valid directory.
+ */
+ }
+
+ DEBUG_PRINT("Set wd to: '%s'",wd);
+
+ if (wd && chdir(wd) < 0) {
+ int err = errno;
+ fprintf(stderr,"spawn: Could not cd to %s\r\n", wd);
+ _exit(err);
+ }
+
+ DEBUG_PRINT("Do that forking business: '%s'",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) {
+ errln = __LINE__;
+ goto child_error;
+ }
+ /* stdout for process */
+ if (flags & FORKER_FLAG_DO_READ &&
+ dup2(pipes[1], 1) < 0) {
+ errln = __LINE__;
+ goto child_error;
+ }
+ }
+ else { /* XXX will fail if pipes[0] == 4 (unlikely..) */
+ if (flags & FORKER_FLAG_DO_READ && dup2(pipes[1], 4) < 0) {
+ errln = __LINE__;
+ goto child_error;
+ }
+ if (flags & FORKER_FLAG_DO_WRITE && dup2(pipes[0], 3) < 0) {
+ errln = __LINE__;
+ goto child_error;
+ }
+ }
+
+ /* we do the dup2 of stderr last so that errors
+ in child_error will be printed to stderr */
+ if (dup2(pipes[2], 2) < 0) {
+ errln = __LINE__;
+ goto child_error;
+ }
#if defined(USE_SETPGRP_NOARGS) /* SysV */
(void) setpgrp();
@@ -130,33 +306,84 @@ 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;
+
+ DEBUG_PRINT("exec error: %d",errno);
+ _exit(errno);
+
+child_error:
+ fprintf(stderr,"erl_child_setup: failed with error %d on line %d\r\n",
+ errno, errln);
+ _exit(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, __preverrno = errno;
+
+ 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);
+
+ /* We save and restore the original errno as otherwise
+ the thread we are running in may end up with an
+ unexpected errno. An example of when this happened
+ was when the select in main had gotten an EINTR but
+ before the errno was checked the signal handler
+ was called and set errno to ECHILD from waitpid
+ which caused erl_child_setup to abort as it does
+ not expect ECHILD to be set after select */
+ errno = __preverrno;
+}
#if defined(__ANDROID__)
-int __system_properties_fd(void)
+static int system_properties_fd(void)
{
- int s, 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);
@@ -164,3 +391,231 @@ int __system_properties_fd(void)
}
#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(NULL);
+ 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 sigchld to %d (errno = %d)", uds_fd, ibuff[1]);
+ 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..0058b92344
--- /dev/null
+++ b/erts/emulator/sys/unix/erl_child_setup.h
@@ -0,0 +1,77 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2015-2017. 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 between 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_main.c b/erts/emulator/sys/unix/erl_main.c
index b26f93f77e..972b93a505 100644
--- a/erts/emulator/sys/unix/erl_main.c
+++ b/erts/emulator/sys/unix/erl_main.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2000-2009. All Rights Reserved.
+ * Copyright Ericsson AB 2000-2016. 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.
+ * 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%
*/
diff --git a/erts/emulator/sys/unix/erl_unix_sys.h b/erts/emulator/sys/unix/erl_unix_sys.h
index 176fc049a7..b83837a7d2 100644
--- a/erts/emulator/sys/unix/erl_unix_sys.h
+++ b/erts/emulator/sys/unix/erl_unix_sys.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1997-2011. All Rights Reserved.
+ * Copyright Ericsson AB 1997-2017. 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.
+ * 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%
*
@@ -29,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__
@@ -45,12 +44,12 @@
#include <fcntl.h>
#include "erl_errno.h"
#include <signal.h>
+#include <setjmp.h>
-
-#if HAVE_SYS_SOCKETIO_H
+#ifdef HAVE_SYS_SOCKETIO_H
# include <sys/socketio.h>
#endif
-#if HAVE_SYS_SOCKIO_H
+#ifdef HAVE_SYS_SOCKIO_H
# include <sys/sockio.h>
#endif
@@ -87,13 +86,12 @@
#include <sys/times.h>
-#ifdef HAVE_IEEEFP_H
-#include <ieeefp.h>
+#ifdef HAVE_SYS_RESOURCE_H
+# include <sys/resource.h>
#endif
-#ifdef QNX
-#include <process.h>
-#include <sys/qnx_glob.h>
+#ifdef HAVE_IEEEFP_H
+#include <ieeefp.h>
#endif
#include <pwd.h>
@@ -107,6 +105,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
@@ -114,11 +116,6 @@
/*
* Make sure that MAXPATHLEN is defined.
*/
-#ifdef GETHRTIME_WITH_CLOCK_GETTIME
-#undef HAVE_GETHRTIME
-#define HAVE_GETHRTIME 1
-#endif
-
#ifndef MAXPATHLEN
# ifdef PATH_MAX
# define MAXPATHLEN PATH_MAX
@@ -135,21 +132,11 @@
/* File descriptors are numbers anc consecutively allocated on Unix */
#define ERTS_SYS_CONTINOUS_FD_NUMBERS
-#define HAVE_ERTS_CHECK_IO_DEBUG
-int erts_check_io_debug(void);
-
#ifndef ERTS_SMP
# undef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
# 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;
/*
@@ -163,35 +150,155 @@ typedef struct timeval SysTimeval;
typedef struct tms SysTimes;
-extern int erts_ticks_per_sec;
-
-#define SYS_CLK_TCK (erts_ticks_per_sec)
+#define SYS_CLK_TCK (erts_sys_time_data__.r.o.ticks_per_sec)
#define sys_times(Arg) times(Arg)
-#define ERTS_WRAP_SYS_TIMES 1
-extern int erts_ticks_per_sec_wrap;
-#define SYS_CLK_TCK_WRAP (erts_ticks_per_sec_wrap)
-extern clock_t sys_times_wrap(void);
+#if SIZEOF_LONG == 8
+typedef long ErtsMonotonicTime;
+typedef long ErtsSysHrTime;
+#elif SIZEOF_LONG_LONG == 8
+typedef long long ErtsMonotonicTime;
+typedef long long ErtsSysHrTime;
+#else
+#error No signed 64-bit type found...
+#endif
+
+typedef ErtsMonotonicTime ErtsSystemTime;
+typedef ErtsSysHrTime ErtsSysPerfCounter;
+
+#define ERTS_MONOTONIC_TIME_MIN ((ErtsMonotonicTime) (1ULL << 63))
+#define ERTS_MONOTONIC_TIME_MAX (~ERTS_MONOTONIC_TIME_MIN)
+
+/*
+ * OS monotonic time and OS system time
+ */
+#undef ERTS_OS_TIMES_INLINE_FUNC_PTR_CALL__
+
+#if defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME) \
+ && defined(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME)
+# if defined(__linux__)
+# define ERTS_OS_TIMES_INLINE_FUNC_PTR_CALL__ 1
+# endif
+#endif
+
+ErtsSystemTime erts_os_system_time(void);
+
+#undef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT
+#undef ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT
+#undef ERTS_OS_MONOTONIC_INLINE_FUNC_PTR_CALL__
+
+#if defined(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME)
+# define ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT 1
+# define ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT (1000*1000*1000)
+# if defined(__linux__)
+# define ERTS_OS_MONOTONIC_INLINE_FUNC_PTR_CALL__ 1
+# endif
+#elif defined(OS_MONOTONIC_TIME_USING_MACH_CLOCK_GET_TIME)
+# define ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT 1
+# define ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT (1000*1000*1000)
+#elif defined(OS_MONOTONIC_TIME_USING_GETHRTIME)
+# define ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT 1
+# define ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT (1000*1000*1000)
+#elif defined(OS_MONOTONIC_TIME_USING_TIMES)
+# define ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT 1
+/* Time unit determined at runtime... */
+# define ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT 0
+#else /* No OS monotonic available... */
+# define ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT (1000*1000)
+#endif
+
+/*
+ * erts_sys_hrtime() is the highest resolution
+ * time function found. Time unit is nano-seconds.
+ * 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__
+ ErtsMonotonicTime (*os_monotonic_time)(void);
+#endif
+#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;
+};
+
+typedef struct {
+ union {
+ struct erts_sys_time_read_only_data__ o;
+ char align__[(((sizeof(struct erts_sys_time_read_only_data__) - 1)
+ / ASSUMED_CACHE_LINE_SIZE) + 1)
+ * ASSUMED_CACHE_LINE_SIZE];
+ } r;
+} ErtsSysTimeData__;
+
+extern ErtsSysTimeData__ erts_sys_time_data__;
+
+#ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT
+
+#ifdef ERTS_OS_MONOTONIC_INLINE_FUNC_PTR_CALL__
+ERTS_GLB_INLINE
+#endif
+ErtsMonotonicTime erts_os_monotonic_time(void);
+
+#ifdef ERTS_OS_TIMES_INLINE_FUNC_PTR_CALL__
+ERTS_GLB_INLINE
+#endif
+void erts_os_times(ErtsMonotonicTime *, ErtsSystemTime *);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+#ifdef ERTS_OS_MONOTONIC_INLINE_FUNC_PTR_CALL__
+
+ERTS_GLB_INLINE ErtsMonotonicTime
+erts_os_monotonic_time(void)
+{
+ return (*erts_sys_time_data__.r.o.os_monotonic_time)();
+}
+
+#endif /* ERTS_OS_MONOTONIC_INLINE_FUNC_PTR_CALL__ */
+
+#ifdef ERTS_OS_TIMES_INLINE_FUNC_PTR_CALL__
+
+ERTS_GLB_INLINE void
+erts_os_times(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep)
+{
+ return (*erts_sys_time_data__.r.o.os_times)(mtimep, stimep);
+}
+
+#endif /* ERTS_OS_TIMES_INLINE_FUNC_PTR_CALL__ */
+
+#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
-#ifdef HAVE_GETHRTIME
-#ifdef GETHRTIME_WITH_CLOCK_GETTIME
-typedef long long SysHrTime;
+#endif /* ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT */
-extern SysHrTime sys_gethrtime(void);
-#define sys_init_hrtime() /* Nothing */
+/*
+ * Functions for getting the performance counter
+ */
-#else /* Real gethrtime (Solaris) */
+ERTS_GLB_INLINE ErtsSysPerfCounter erts_sys_perf_counter(void);
+#define erts_sys_perf_counter_unit() erts_sys_time_data__.r.o.perf_counter_unit
-typedef hrtime_t SysHrTime;
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
-#define sys_gethrtime() gethrtime()
-#define sys_init_hrtime() /* Nothing */
+ERTS_GLB_FORCE_INLINE ErtsSysPerfCounter
+erts_sys_perf_counter()
+{
+ return (*erts_sys_time_data__.r.o.perf_counter)();
+}
-#endif /* GETHRTIME_WITH_CLOCK_GETTIME */
-#endif /* HAVE_GETHRTIME */
+#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
-#if (defined(HAVE_GETHRVTIME) || defined(HAVE_CLOCK_GETTIME))
+/*
+ * Functions for measuring CPU time
+ */
+
+#if (defined(HAVE_GETHRVTIME) || defined(HAVE_CLOCK_GETTIME_CPU_TIME))
typedef long long SysCpuTime;
typedef struct timespec SysTimespec;
@@ -203,7 +310,7 @@ typedef struct timespec SysTimespec;
int sys_start_hrvtime(void);
int sys_stop_hrvtime(void);
-#elif defined(HAVE_CLOCK_GETTIME)
+#elif defined(HAVE_CLOCK_GETTIME_CPU_TIME)
#define sys_clock_gettime(cid,tp) clock_gettime((cid),&(tp))
#define sys_get_proc_cputime(t,tp) sys_clock_gettime(CLOCK_PROCESS_CPUTIME_ID,(tp))
@@ -214,26 +321,40 @@ int sys_stop_hrvtime(void);
#define SYS_CLOCK_RESOLUTION 1
/* These are defined in sys.c */
-#if defined(SIG_SIGSET) /* Old SysV */
-RETSIGTYPE (*sys_sigset())();
-#elif defined(SIG_SIGNAL) /* Old BSD */
-RETSIGTYPE (*sys_sigset())();
-#else
-RETSIGTYPE (*sys_sigset(int, RETSIGTYPE (*func)(int)))(int);
-#endif
+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);
+extern void erts_sys_unix_later_init(void);
/*
* Handling of floating point exceptions.
*/
#ifdef USE_ISINF_ISNAN /* simulate finite() */
-# define finite(f) (!isinf(f) && !isnan(f))
-# define HAVE_FINITE
+# define isfinite(f) (!isinf(f) && !isnan(f))
+# define HAVE_ISFINITE
+#elif (defined(__GNUC__) && !defined(__llvm__)) && defined(HAVE_FINITE)
+/* We use finite in gcc as it emits assembler instead of
+ the function call that isfinite emits. The assembler is
+ significantly faster. */
+# ifdef isfinite
+# undef isfinite
+# endif
+# define isfinite finite
+# ifndef HAVE_ISFINITE
+# define HAVE_ISFINITE
+# endif
+#elif defined(isfinite) && !defined(HAVE_ISFINITE)
+# define HAVE_ISFINITE
+#elif !defined(HAVE_ISFINITE) && defined(HAVE_FINITE)
+# define isfinite finite
+# define HAVE_ISFINITE
#endif
+#define erts_isfinite isfinite
+
#ifdef NO_FPE_SIGNALS
#define erts_get_current_fp_exception() NULL
@@ -241,7 +362,7 @@ extern void sys_stop_cat(void);
#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(fpexnp, f, Action) if (!isfinite(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)
@@ -305,7 +426,7 @@ static __inline__ void __ERTS_FP_CHECK_INIT(volatile unsigned long *fp_exception
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);
+ return erts_check_fpe(fp_exception, f) || !isfinite(f);
}
# define __ERTS_FP_ERROR_THOROUGH(fpexnp, f, Action) \
do { if (erts_check_fpe_thorough((fpexnp),(f))) { Action; } } while (0)
@@ -320,19 +441,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);
@@ -341,4 +449,28 @@ extern int exit_async(void);
#define ERTS_EXIT_AFTER_DUMP _exit
+#if !defined(__APPLE__) && !defined(__MACH__)
+/* Some OS X versions do not allow (ab)using signal handlers like this */
+#define ERTS_HAVE_TRY_CATCH 1
+
+/* We try to simulate a try catch in C with the help of signal handlers.
+ * Only use this as a very last resort, as it is not very portable and
+ * quite unstable. It is also not thread safe, so make sure that only
+ * one thread can call this at a time!
+ */
+extern void erts_sys_sigsegv_handler(int);
+extern jmp_buf erts_sys_sigsegv_jmp;
+#define ERTS_SYS_TRY_CATCH(EXPR,CATCH) \
+ do { \
+ SIGFUNC prev_handler = sys_signal(SIGSEGV, \
+ erts_sys_sigsegv_handler); \
+ if (!setjmp(erts_sys_sigsegv_jmp)) { \
+ EXPR; \
+ } else { \
+ CATCH; \
+ } \
+ sys_signal(SIGSEGV,prev_handler); \
+ } while(0)
+#endif
+
#endif /* #ifndef _ERL_UNIX_SYS_H */
diff --git a/erts/emulator/sys/unix/erl_unix_sys_ddll.c b/erts/emulator/sys/unix/erl_unix_sys_ddll.c
index 2659d623c7..8f1ceac883 100644
--- a/erts/emulator/sys/unix/erl_unix_sys_ddll.c
+++ b/erts/emulator/sys/unix/erl_unix_sys_ddll.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2006-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2006-2016. 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.
+ * 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%
*/
diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c
index c3d7440409..c1fa660cf9 100644
--- a/erts/emulator/sys/unix/sys.c
+++ b/erts/emulator/sys/unix/sys.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2014. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -34,6 +35,7 @@
#include <termios.h>
#include <ctype.h>
#include <sys/utsname.h>
+#include <sys/select.h>
#ifdef ISC32
#include <sys/bsdtypes.h>
@@ -47,9 +49,7 @@
#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 */
#include "sys.h"
#include "erl_thr_progress.h"
@@ -65,7 +65,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().
@@ -74,68 +74,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
-
-#ifdef USE_THREADS
-# ifdef ENABLE_CHILD_WAITER_THREAD
-# define CHLDWTHR ENABLE_CHILD_WAITER_THREAD
-# else
-# define CHLDWTHR 0
-# endif
-#else
-# define CHLDWTHR 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
-};
-
-/* 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;
-} *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);
@@ -145,106 +89,36 @@ extern void erl_sys_args(int*, char**);
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;
#endif
#ifdef ERTS_SMP
-erts_smp_atomic32_t erts_got_sigusr1;
-#define ERTS_SET_GOT_SIGUSR1 \
- erts_smp_atomic32_set_mb(&erts_got_sigusr1, 1)
-#define ERTS_UNSET_GOT_SIGUSR1 \
- erts_smp_atomic32_set_mb(&erts_got_sigusr1, 0)
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
-volatile int erts_got_sigusr1;
-#define ERTS_SET_GOT_SIGUSR1 (erts_got_sigusr1 = 1)
-#define ERTS_UNSET_GOT_SIGUSR1 (erts_got_sigusr1 = 0)
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;
+erts_smp_atomic_t sys_misc_mem_sz;
#if defined(ERTS_SMP)
-static void smp_sig_notify(char c);
+static void smp_sig_notify(int signum);
static int sig_notify_fds[2] = {-1, -1};
-#elif defined(USE_THREADS)
-static int async_fd[2];
-#endif
-#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;
+#ifdef ERTS_SYS_SUSPEND_SIGNAL
+static int sig_suspend_fds[2] = {-1, -1};
#endif
+#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);
+jmp_buf erts_sys_sigsegv_jmp;
-#if CHLDWTHR
-static void* child_waiter(void *);
-#endif
+static int crashdump_companion_cube_fd = -1;
/********************* General functions ****************************/
@@ -265,11 +139,33 @@ 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
+
+#ifndef ERTS_SMP
+static Eterm signalstate_sigterm[] = {
+ am_sigint, /* 0 */
+ am_sighup, /* 1 */
+ am_sigquit, /* 2 */
+ am_sigabrt, /* 3 */
+ am_sigalrm, /* 4 */
+ am_sigterm, /* 5 */
+ am_sigusr1, /* 6 */
+ am_sigusr2, /* 7 */
+ am_sigchld, /* 8 */
+ am_sigstop, /* 9 */
+ am_sigtstp /* 10 */
+};
+
+volatile Uint erts_signal_state = 0;
+#define ERTS_SET_SIGNAL_STATE(S) (erts_signal_state |= signum_to_signalstate(S))
+#define ERTS_CLEAR_SIGNAL_STATE (erts_signal_state = 0)
+static ERTS_INLINE Uint signum_to_signalstate(int signum);
+#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;
+int using_oldshell = 1;
#ifdef ERTS_ENABLE_KERNEL_POLL
@@ -277,14 +173,15 @@ int erts_use_kernel_poll = 0;
struct {
int (*select)(ErlDrvPort, ErlDrvEvent, int, int);
+ int (*enif_select)(ErlNifEnv*, ErlNifEvent, enum ErlNifSelectFlags, void*, const ErlNifPid*, Eterm);
int (*event)(ErlDrvPort, ErlDrvEvent, ErlDrvEventData);
void (*check_io_as_interrupt)(void);
void (*check_io_interrupt)(int);
- void (*check_io_interrupt_tmd)(int, erts_short_time_t);
+ void (*check_io_interrupt_tmd)(int, ErtsMonotonicTime);
void (*check_io)(int);
Uint (*size)(void);
Eterm (*info)(void *);
- int (*check_io_debug)(void);
+ int (*check_io_debug)(ErtsCheckIoDebugInfo *);
} io_func = {0};
@@ -300,15 +197,22 @@ driver_event(ErlDrvPort port, ErlDrvEvent event, ErlDrvEventData event_data)
return (*io_func.event)(port, event, event_data);
}
+int enif_select(ErlNifEnv* env, ErlNifEvent event,
+ enum ErlNifSelectFlags flags, void* obj, const ErlNifPid* pid, Eterm ref)
+{
+ return (*io_func.enif_select)(env, event, flags, obj, pid, ref);
+}
+
+
Eterm erts_check_io_info(void *p)
{
return (*io_func.info)(p);
}
int
-erts_check_io_debug(void)
+erts_check_io_debug(ErtsCheckIoDebugInfo *ip)
{
- return (*io_func.check_io_debug)();
+ return (*io_func.check_io_debug)(ip);
}
@@ -317,6 +221,7 @@ init_check_io(void)
{
if (erts_use_kernel_poll) {
io_func.select = driver_select_kp;
+ io_func.enif_select = enif_select_kp;
io_func.event = driver_event_kp;
#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
io_func.check_io_as_interrupt = erts_check_io_async_sig_interrupt_kp;
@@ -332,6 +237,7 @@ init_check_io(void)
}
else {
io_func.select = driver_select_nkp;
+ io_func.enif_select = enif_select_nkp;
io_func.event = driver_event_nkp;
#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
io_func.check_io_as_interrupt = erts_check_io_async_sig_interrupt_nkp;
@@ -386,12 +292,24 @@ erts_sys_schedule_interrupt(int set)
#ifdef ERTS_SMP
void
-erts_sys_schedule_interrupt_timed(int set, erts_short_time_t msec)
+erts_sys_schedule_interrupt_timed(int set, ErtsMonotonicTime timeout_time)
{
- ERTS_CHK_IO_INTR_TMD(set, msec);
+ ERTS_CHK_IO_INTR_TMD(set, timeout_time);
}
#endif
+UWord
+erts_sys_get_page_size(void)
+{
+#if defined(_SC_PAGESIZE)
+ return (UWord) sysconf(_SC_PAGESIZE);
+#elif defined(HAVE_GETPAGESIZE)
+ return (UWord) getpagesize();
+#else
+ return (UWord) 4*1024; /* Guess 4 KB */
+#endif
+}
+
Uint
erts_sys_misc_mem_sz(void)
{
@@ -424,9 +342,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.
*/
@@ -504,11 +423,14 @@ thr_create_prepare_child(void *vtcdp)
void
erts_sys_pre_init(void)
{
+#ifdef USE_THREADS
+ erts_thr_init_data_t eid = ERTS_THR_INIT_DATA_DEF_INITER;
+#endif
+
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 */
@@ -516,45 +438,36 @@ erts_sys_pre_init(void)
/* After creation in parent */
eid.thread_create_parent_func = thr_create_cleanup,
-#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 */
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ erts_lcnt_pre_thr_init();
#endif
erts_thr_init(&eid);
- report_exit_list = NULL;
-
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_init();
+ erts_lcnt_post_thr_init();
#endif
-#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;
+#ifdef ERTS_ENABLE_LOCK_CHECK
+ erts_lc_init();
#endif
- }
+
+#endif /* USE_THREADS */
+
+ erts_init_sys_time_sup();
+
+#ifdef USE_THREADS
+
#ifdef ERTS_SMP
erts_smp_atomic32_init_nob(&erts_break_requested, 0);
- erts_smp_atomic32_init_nob(&erts_got_sigusr1, 0);
erts_smp_atomic32_init_nob(&have_prepared_crash_dump, 0);
#else
erts_break_requested = 0;
- erts_got_sigusr1 = 0;
have_prepared_crash_dump = 0;
#endif
-#if !CHLDWTHR && !defined(ERTS_SMP)
- children_died = 0;
-#endif
+
#endif /* USE_THREADS */
+
erts_smp_atomic_init_nob(&sys_misc_mem_sz, 0);
{
@@ -575,44 +488,19 @@ erts_sys_pre_init(void)
close(fd);
}
+ /* We need a file descriptor to close in the crashdump creation.
+ * We close this one to be sure we can get a fd for our real file ...
+ * so, we create one here ... a stone to carry all the way home.
+ */
+
+ crashdump_companion_cube_fd = open("/dev/null", O_RDONLY);
+
+ /* don't lose it, there will be cake */
}
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);
@@ -632,39 +520,7 @@ erl_sys_init(void)
/* signal handling */
-#ifdef SIG_SIGSET /* Old SysV */
-RETSIGTYPE (*sys_sigset(sig, func))()
-int sig;
-RETSIGTYPE (*func)();
-{
- return(sigset(sig, func));
-}
-void sys_sigblock(int sig)
-{
- sighold(sig);
-}
-void sys_sigrelease(int sig)
-{
- sigrelse(sig);
-}
-#else /* !SIG_SIGSET */
-#ifdef SIG_SIGNAL /* Old BSD */
-RETSIGTYPE (*sys_sigset(sig, func))(int, int)
-int sig;
-RETSIGTYPE (*func)();
-{
- return(signal(sig, func));
-}
-sys_sigblock(int sig)
-{
- sigblock(sig);
-}
-sys_sigrelease(int sig)
-{
- sigsetmask(sigblock(0) & ~sigmask(sig));
-}
-#else /* !SIG_SIGNAL */ /* The True Way - POSIX!:-) */
-RETSIGTYPE (*sys_sigset(int sig, RETSIGTYPE (*func)(int)))(int)
+SIGFUNC sys_signal(int sig, SIGFUNC func)
{
struct sigaction act, oact;
@@ -697,36 +553,49 @@ void sys_sigrelease(int sig)
sigaddset(&mask, sig);
sigprocmask(SIG_UNBLOCK, &mask, (sigset_t *)NULL);
}
-#endif /* !SIG_SIGNAL */
-#endif /* !SIG_SIGSET */
-#if (0) /* not used? -- gordon */
-static void (*break_func)();
-static RETSIGTYPE break_handler(int sig)
-{
-#ifdef QNX
- /* Turn off SIGCHLD during break processing */
- sys_sigblock(SIGCHLD);
-#endif
- (*break_func)();
-#ifdef QNX
- sys_sigrelease(SIGCHLD);
+#ifdef ERTS_HAVE_TRY_CATCH
+void erts_sys_sigsegv_handler(int signo) {
+ if (signo == SIGSEGV) {
+ longjmp(erts_sys_sigsegv_jmp, 1);
+ }
+}
#endif
+
+/*
+ * Function returns 1 if we can read from all values in between
+ * start and stop.
+ */
+int
+erts_sys_is_area_readable(char *start, char *stop) {
+ int fds[2];
+ if (!pipe(fds)) {
+ /* We let write try to figure out if the pointers are readable */
+ int res = write(fds[1], start, (char*)stop - (char*)start);
+ if (res == -1) {
+ close(fds[0]);
+ close(fds[1]);
+ return 0;
+ }
+ close(fds[0]);
+ close(fds[1]);
+ return 1;
+ }
+ return 0;
+
}
-#endif /* 0 */
static ERTS_INLINE int
prepare_crash_dump(int secs)
{
#define NUFBUF (3)
- int i, max;
+ int i;
char env[21]; /* enough to hold any 64-bit integer */
size_t envsz;
DeclareTmpHeapNoproc(heap,NUFBUF);
Port *heart_port;
Eterm *hp = heap;
Eterm list = NIL;
- int heart_fd[2] = {-1,-1};
int has_heart = 0;
UseTmpHeapNoproc(NUFBUF);
@@ -749,43 +618,22 @@ prepare_crash_dump(int secs)
alarm((unsigned int)secs);
}
- if (heart_port) {
- /* hearts input fd
- * We "know" drv_data is the in_fd since the port is started with read|write
- */
- heart_fd[0] = (int)heart_port->drv_data;
- heart_fd[1] = (int)driver_data[heart_fd[0]].ofd;
- has_heart = 1;
+ /* close all viable sockets via emergency close callbacks.
+ * Specifically we want to close epmd sockets.
+ */
- list = CONS(hp, make_small(8), list); hp += 2;
+ erts_emergency_close_ports();
+ if (heart_port) {
+ has_heart = 1;
+ list = CONS(hp, make_small(8), list); hp += 2;
/* send to heart port, CMD = 8, i.e. prepare crash dump =o */
erts_port_output(NULL, ERTS_PORT_SIG_FLG_FORCE_IMM_CALL, heart_port,
heart_port->common.id, list, NULL);
}
- /* 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++) {
-#if defined(ERTS_SMP)
- /* We don't want to close the signal notification pipe... */
- if (i == sig_notify_fds[0] || i == sig_notify_fds[1])
- continue;
-#elif defined(USE_THREADS)
- /* We don't want to close the async notification pipe... */
- if (i == async_fd[0] || i == async_fd[1])
- continue;
-#endif
- /* We don't want to close our heart yet ... */
- if (i == heart_fd[0] || i == heart_fd[1])
- continue;
-
- close(i);
- }
+ /* Make sure we have a fd for our crashdump file. */
+ close(crashdump_companion_cube_fd);
envsz = sizeof(env);
i = erts_sys_getenv__("ERL_CRASH_DUMP_NICE", env, &envsz);
@@ -808,6 +656,28 @@ int erts_sys_prepare_crash_dump(int secs)
return prepare_crash_dump(secs);
}
+static void signal_notify_requested(Eterm type) {
+ Process* p = NULL;
+ Eterm msg, *hp;
+ ErtsProcLocks locks = 0;
+ ErlOffHeap *ohp;
+
+ Eterm id = erts_whereis_name_to_id(NULL, am_erl_signal_server);
+
+ if ((p = (erts_pid2proc_opt(NULL, 0, id, 0, ERTS_P2P_FLG_INC_REFC))) != NULL) {
+ ErtsMessage *msgp = erts_alloc_message_heap(p, &locks, 3, &hp, &ohp);
+
+ /* erl_signal_server ! {notify, sighup} */
+ msg = TUPLE2(hp, am_notify, type);
+ erts_queue_message(p, locks, msgp, msg, am_system);
+
+ if (locks)
+ erts_smp_proc_unlock(p, locks);
+ erts_proc_dec_refc(p);
+ }
+}
+
+
static ERTS_INLINE void
break_requested(void)
{
@@ -819,108 +689,187 @@ 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 */
}
-/* set up signal handlers for break and quit */
-#if (defined(SIG_SIGSET) || defined(SIG_SIGNAL))
-static RETSIGTYPE request_break(void)
-#else
static RETSIGTYPE request_break(int signum)
-#endif
{
#ifdef ERTS_SMP
- smp_sig_notify('I');
+ smp_sig_notify(signum);
#else
break_requested();
#endif
}
-static ERTS_INLINE void
-sigusr1_exit(void)
-{
- char env[21]; /* enough to hold any 64-bit integer */
- size_t envsz;
- int i, secs = -1;
-
- /* We do this at interrupt level, since the main reason for
- * wanting to generate a crash dump in this way is that the emulator
- * is hung somewhere, so it won't be able to poll any flag we set here.
- */
- ERTS_SET_GOT_SIGUSR1;
+#ifdef ETHR_UNUSABLE_SIGUSRX
+#warning "Unusable SIGUSR1 & SIGUSR2. Disabling use of these signals"
- envsz = sizeof(env);
- if ((i = erts_sys_getenv_raw("ERL_CRASH_DUMP_SECONDS", env, &envsz)) >= 0) {
- secs = i != 0 ? 0 : atoi(env);
- }
+#else
- prepare_crash_dump(secs);
- erl_exit(1, "Received SIGUSR1\n");
+#ifdef ERTS_SYS_SUSPEND_SIGNAL
+void
+sys_thr_suspend(erts_tid_t tid) {
+ erts_thr_kill(tid, ERTS_SYS_SUSPEND_SIGNAL);
}
-#ifdef ETHR_UNUSABLE_SIGUSRX
-#warning "Unusable SIGUSR1 & SIGUSR2. Disabling use of these signals"
+void
+sys_thr_resume(erts_tid_t tid) {
+ int i = 0, res;
+ do {
+ res = write(sig_suspend_fds[1],&i,sizeof(i));
+ } while (res < 0 && errno == EAGAIN);
+}
#endif
-#ifndef ETHR_UNUSABLE_SIGUSRX
-
+#ifdef ERTS_SYS_SUSPEND_SIGNAL
#if (defined(SIG_SIGSET) || defined(SIG_SIGNAL))
-static RETSIGTYPE user_signal1(void)
+static RETSIGTYPE suspend_signal(void)
#else
-static RETSIGTYPE user_signal1(int signum)
+static RETSIGTYPE suspend_signal(int signum)
#endif
{
-#ifdef ERTS_SMP
- smp_sig_notify('1');
-#else
- sigusr1_exit();
-#endif
-}
+ int res, buf[1], tmp_errno = errno;
+ do {
+ res = read(sig_suspend_fds[0], buf, sizeof(int));
+ } while (res < 0 && errno == EINTR);
-#ifdef QUANTIFY
-#if (defined(SIG_SIGSET) || defined(SIG_SIGNAL))
-static RETSIGTYPE user_signal2(void)
-#else
-static RETSIGTYPE user_signal2(int signum)
-#endif
-{
-#ifdef ERTS_SMP
- smp_sig_notify('2');
-#else
- quantify_save_data();
-#endif
+ /* restore previous errno in case read changed it */
+ errno = tmp_errno;
}
-#endif
+#endif /* #ifdef ERTS_SYS_SUSPEND_SIGNAL */
#endif /* #ifndef ETHR_UNUSABLE_SIGUSRX */
-static void
-quit_requested(void)
+/*
+ Signal Action Comment
+ ─────────────────────────────────────────────────────────────
+ SIGHUP Term Hangup detected on controlling terminal or death of controlling process
+ !SIGINT Term Interrupt from keyboard
+ SIGQUIT Core Quit from keyboard
+ !SIGILL Core Illegal Instruction
+ SIGABRT Core Abort signal from abort(3)
+ !SIGFPE Core Floating point exception
+ !SIGKILL Term Kill signal
+ !SIGSEGV Core Invalid memory reference
+ !SIGPIPE Term Broken pipe: write to pipe with no readers
+ SIGALRM Term Timer signal from alarm(2)
+ SIGTERM Term Termination signal
+ SIGUSR1 Term User-defined signal 1
+ SIGUSR2 Term User-defined signal 2
+ !SIGCHLD Ign Child stopped or terminated
+ !SIGCONT Cont Continue if stopped
+ SIGSTOP Stop Stop process
+ SIGTSTP Stop Stop typed at terminal
+ !SIGTTIN Stop Terminal input for background process
+ !SIGTTOU Stop Terminal output for background process
+*/
+
+
+static ERTS_INLINE int
+signalterm_to_signum(Eterm signal)
+{
+ switch (signal) {
+ case am_sighup: return SIGHUP;
+ /* case am_sigint: return SIGINT; */
+ case am_sigquit: return SIGQUIT;
+ /* case am_sigill: return SIGILL; */
+ case am_sigabrt: return SIGABRT;
+ /* case am_sigsegv: return SIGSEGV; */
+ case am_sigalrm: return SIGALRM;
+ case am_sigterm: return SIGTERM;
+ case am_sigusr1: return SIGUSR1;
+ case am_sigusr2: return SIGUSR2;
+ case am_sigchld: return SIGCHLD;
+ case am_sigstop: return SIGSTOP;
+ case am_sigtstp: return SIGTSTP;
+ default: return 0;
+ }
+}
+
+#ifdef ERTS_SMP
+
+static ERTS_INLINE Eterm
+signum_to_signalterm(int signum)
{
- erl_exit(ERTS_INTR_EXIT, "");
+ switch (signum) {
+ case SIGHUP: return am_sighup;
+ /* case SIGINT: return am_sigint; */ /* ^c */
+ case SIGQUIT: return am_sigquit; /* ^\ */
+ /* case SIGILL: return am_sigill; */
+ case SIGABRT: return am_sigabrt;
+ /* case SIGSEGV: return am_sigsegv; */
+ case SIGALRM: return am_sigalrm;
+ case SIGTERM: return am_sigterm;
+ case SIGUSR1: return am_sigusr1;
+ case SIGUSR2: return am_sigusr2;
+ case SIGCHLD: return am_sigchld;
+ case SIGSTOP: return am_sigstop;
+ case SIGTSTP: return am_sigtstp; /* ^z */
+ default: return am_error;
+ }
}
-#if (defined(SIG_SIGSET) || defined(SIG_SIGNAL))
-static RETSIGTYPE do_quit(void)
-#else
-static RETSIGTYPE do_quit(int signum)
#endif
+
+#ifndef ERTS_SMP
+static ERTS_INLINE Uint
+signum_to_signalstate(int signum)
+{
+ switch (signum) {
+ case SIGINT: return (1 << 0);
+ case SIGHUP: return (1 << 1);
+ case SIGQUIT: return (1 << 2);
+ case SIGABRT: return (1 << 3);
+ case SIGALRM: return (1 << 4);
+ case SIGTERM: return (1 << 5);
+ case SIGUSR1: return (1 << 6);
+ case SIGUSR2: return (1 << 7);
+ case SIGCHLD: return (1 << 8);
+ case SIGSTOP: return (1 << 9);
+ case SIGTSTP: return (1 << 10);
+ default: return 0;
+ }
+}
+#endif
+
+static RETSIGTYPE generic_signal_handler(int signum)
{
#ifdef ERTS_SMP
- smp_sig_notify('Q');
+ smp_sig_notify(signum);
#else
- quit_requested();
+ ERTS_SET_SIGNAL_STATE(signum);
+ ERTS_CHK_IO_AS_INTR(); /* Make sure we don't sleep in poll */
#endif
}
+int erts_set_signal(Eterm signal, Eterm type) {
+ int signum;
+ if ((signum = signalterm_to_signum(signal)) > 0) {
+ if (type == am_ignore) {
+ sys_signal(signum, SIG_IGN);
+ } else if (type == am_default) {
+ sys_signal(signum, SIG_DFL);
+ } else {
+ sys_signal(signum, generic_signal_handler);
+ }
+ return 1;
+ }
+ return 0;
+}
+
/* Disable break */
void erts_set_ignore_break(void) {
- sys_sigset(SIGINT, SIG_IGN);
- sys_sigset(SIGQUIT, SIG_IGN);
- sys_sigset(SIGTSTP, SIG_IGN);
+ /*
+ * Ignore signals that can be sent to the VM by
+ * typing certain key combinations at the
+ * controlling terminal...
+ */
+ sys_signal(SIGINT, SIG_IGN); /* Ctrl-C */
+ sys_signal(SIGQUIT, SIG_IGN); /* Ctrl-\ */
+ sys_signal(SIGTSTP, SIG_IGN); /* Ctrl-Z */
}
/* Don't use ctrl-c for break handler but let it be
@@ -930,11 +879,11 @@ void erts_replace_intr(void) {
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;
@@ -943,65 +892,30 @@ void erts_replace_intr(void) {
void init_break_handler(void)
{
- sys_sigset(SIGINT, request_break);
+ sys_signal(SIGINT, request_break);
#ifndef ETHR_UNUSABLE_SIGUSRX
- sys_sigset(SIGUSR1, user_signal1);
-#ifdef QUANTIFY
- sys_sigset(SIGUSR2, user_signal2);
-#endif
+ sys_signal(SIGUSR1, generic_signal_handler);
#endif /* #ifndef ETHR_UNUSABLE_SIGUSRX */
- sys_sigset(SIGQUIT, do_quit);
-}
-
-int sys_max_files(void)
-{
- return(max_files);
+ sys_signal(SIGQUIT, generic_signal_handler);
}
-static void block_signals(void)
+void sys_init_suspend_handler(void)
{
-#if !CHLDWTHR
- sys_sigblock(SIGCHLD);
-#endif
-#ifndef ERTS_SMP
- sys_sigblock(SIGINT);
-#ifndef ETHR_UNUSABLE_SIGUSRX
- sys_sigblock(SIGUSR1);
-#endif
+#ifdef ERTS_SYS_SUSPEND_SIGNAL
+ sys_signal(ERTS_SYS_SUSPEND_SIGNAL, suspend_signal);
#endif
}
-static void unblock_signals(void)
+void
+erts_sys_unix_later_init(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
+ sys_signal(SIGTERM, generic_signal_handler);
}
-/************************** Time stuff **************************/
-#ifdef HAVE_GETHRTIME
-#ifdef GETHRTIME_WITH_CLOCK_GETTIME
-SysHrTime sys_gethrtime(void)
+int sys_max_files(void)
{
- struct timespec ts;
- long long result;
- if (clock_gettime(CLOCK_MONOTONIC,&ts) != 0) {
- erl_exit(1,"Fatal, could not get clock_monotonic value!, "
- "errno = %d\n", errno);
- }
- result = ((long long) ts.tv_sec) * 1000000000LL +
- ((long long) ts.tv_nsec);
- return (SysHrTime) result;
+ return(max_files);
}
-#endif
-#endif
/************************** OS info *******************************/
@@ -1028,10 +942,7 @@ get_number(char **str_ptr)
}
}
-void
-os_flavor(char* namebuf, /* Where to return the name. */
- unsigned size) /* Size of name buffer. */
-{
+void os_flavor(char* namebuf, unsigned size) {
struct utsname uts; /* Information about the system. */
char* s;
@@ -1044,22 +955,16 @@ os_flavor(char* namebuf, /* Where to return the name. */
strcpy(namebuf, uts.sysname);
}
-void
-os_version(pMajor, pMinor, pBuild)
-int* pMajor; /* Pointer to major version. */
-int* pMinor; /* Pointer to minor version. */
-int* pBuild; /* Pointer to build number. */
-{
+void os_version(int *pMajor, int *pMinor, int *pBuild) {
struct utsname uts; /* Information about the system. */
char* release; /* Pointer to the release string:
- * X.Y or X.Y.Z.
- */
+ * X.Y or X.Y.Z. */
(void) uname(&uts);
release = uts.release;
- *pMajor = get_number(&release);
- *pMinor = get_number(&release);
- *pBuild = get_number(&release);
+ *pMajor = get_number(&release); /* Pointer to major version. */
+ *pMinor = get_number(&release); /* Pointer to minor version. */
+ *pBuild = get_number(&release); /* Pointer to build number. */
}
void init_getenv_state(GETENV_STATE *state)
@@ -1090,1311 +995,11 @@ 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*);
-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 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,
- 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
-};
-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_driver_data(ErlDrvPort port_num,
- int ifd,
- int ofd,
- int packet_bytes,
- int read_write,
- int exit_status,
- int pid)
-{
- 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;
- if (read_write & DO_WRITE) {
- driver_data[ifd].ofd = ofd;
- 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;
- 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 */
-#endif
-
- sys_sigset(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_sigset(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;
- }
-
- for (i = opts->use_stdio ? 3 : 5; i < max_files; i++)
- (void) close(i);
-
- 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);
- /* 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;
-
- 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...
- */
-
- 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. */
-
- 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);
- 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);
- 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 fd) /* Does not close the fds */
-{
- int ofd;
-
- nbio_stop_fd(driver_data[(int)(long)fd].port_num, (int)(long)fd);
- ofd = driver_data[(int)(long)fd].ofd;
- if (ofd != (int)(long)fd && ofd != -1)
- nbio_stop_fd(driver_data[(int)(long)fd].port_num, (int)(long)ofd);
-}
-
-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);
- 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); */
- }
-}
-
-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 ((sz = driver_sizeq(ix)) > 0) {
- driver_enqv(ix, ev, 0);
- if (sz + ev->size >= (1 << 13))
- set_busy_port(ix, 1);
- }
- else {
- 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);
- }
- /* return 0;*/
-}
-
-
-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 (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);
- 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);
-}
-
-
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
@@ -2412,14 +1017,14 @@ void erts_do_break_handling(void)
tcsetattr(0,TCSANOW,&initial_tty_mode);
saved = 1;
}
-
+
/* call the break handling function, reset the flag */
do_break();
ERTS_UNSET_BREAK_REQUESTED;
fflush(stdout);
-
+
/* after break we go back to saved settings */
if (using_oldshell && !replace_intr) {
SET_NONBLOCKING(1);
@@ -2431,6 +1036,23 @@ void erts_do_break_handling(void)
erts_smp_thr_progress_unblock();
}
+#ifdef ERTS_SIGNAL_STATE
+void erts_handle_signal_state(void) {
+ Uint signal_state = ERTS_SIGNAL_STATE;
+ Uint i = 0;
+
+ ERTS_CLEAR_SIGNAL_STATE;
+
+ while (signal_state) {
+ if (signal_state & 0x1) {
+ signal_notify_requested(signalstate_sigterm[i]);
+ }
+ i++;
+ signal_state = signal_state >> 1;
+ }
+}
+#endif
+
/* 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
@@ -2527,41 +1149,12 @@ erts_sys_unsetenv(char *key)
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));
-}
-
-#if (0) /* unused? */
-static int write_fill(fd, buf, len)
-int fd, len;
-char *buf;
-{
- int i, done = 0;
-
- do {
- if ((i = write(fd, buf+done, len-done)) < 0) {
- if (errno != EINTR)
- return (i);
- i = 0;
- }
- done += i;
- } while (done < len);
- return (len);
-}
-#endif
+void sys_init_io(void) { }
+void erts_sys_alloc_init(void) { }
extern const char pre_loaded_code[];
extern Preload pre_loaded[];
-void erts_sys_alloc_init(void)
-{
-}
-
#if ERTS_HAVE_ERTS_SYS_ALIGNED_ALLOC
void *erts_sys_aligned_alloc(UWord alignment, UWord size)
{
@@ -2658,28 +1251,37 @@ void sys_preload_end(Preload* p)
/* Nothing */
}
-/* Read a key from console (?) */
-
-int sys_get_key(fd)
-int fd;
-{
- int c;
+/* Read a key from console, used by break.c
+ Here we assume that all schedulers are stopped so that erl_poll
+ does not interfere with the select below.
+*/
+int sys_get_key(int fd) {
+ int c, ret;
unsigned char rbuf[64];
+ fd_set fds;
fflush(stdout); /* Flush query ??? */
- if ((c = read(fd,rbuf,64)) <= 0) {
- return c;
- }
+ FD_ZERO(&fds);
+ FD_SET(fd,&fds);
+
+ ret = select(fd+1, &fds, NULL, NULL, NULL);
- return rbuf[0];
+ if (ret == 1) {
+ do {
+ c = read(fd,rbuf,64);
+ } while (c < 0 && errno == EAGAIN);
+ if (c <= 0)
+ return c;
+ }
+ return rbuf[0];
}
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);
@@ -2704,7 +1306,7 @@ erl_debug(char* fmt, ...)
{
char sbuf[1024]; /* Temporary buffer. */
va_list va;
-
+
if (debug_log) {
va_start(va, fmt);
vsprintf(sbuf, fmt, va);
@@ -2715,179 +1317,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
@@ -2896,13 +1325,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();
}
@@ -2911,14 +1335,14 @@ erl_sys_schedule(int runnable)
static erts_smp_tid_t sig_dispatcher_tid;
static void
-smp_sig_notify(char c)
+smp_sig_notify(int signum)
{
int res;
do {
/* write() is async-signal safe (according to posix) */
- res = write(sig_notify_fds[1], &c, 1);
+ res = write(sig_notify_fds[1], &signum, sizeof(int));
} while (res < 0 && errno == EINTR);
- if (res != 1) {
+ if (res != sizeof(int)) {
char msg[] =
"smp_sig_notify(): Failed to notify signal-dispatcher thread "
"about received signal";
@@ -2930,84 +1354,59 @@ 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
while (1) {
- char buf[32];
- int res, i;
+ union {int signum; char buf[4];} sb;
+ Eterm signal;
+ int res, i = 0;
/* Block on read() waiting for a signal notification to arrive... */
- res = read(sig_notify_fds[0], (void *) &buf[0], 32);
+
+ do {
+ res = read(sig_notify_fds[0], (void *) &sb.buf[i], sizeof(int) - i);
+ i += res > 0 ? res : 0;
+ } while ((i < sizeof(int) && res >= 0) || (res < 0 && errno == EINTR));
+
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);
}
- for (i = 0; i < res; i++) {
- /*
- * NOTE 1: The signal dispatcher thread should not do work
- * that takes a substantial amount of time (except
- * perhaps in test and debug builds). It needs to
- * be responsive, i.e, it should only dispatch work
- * to other threads.
- *
- * NOTE 2: The signal dispatcher thread is not a blockable
- * thread (i.e., not a thread managed by the
- * erl_thr_progress module). This is intentional.
- * We want to be able to interrupt writing of a crash
- * dump by hitting C-c twice. Since it isn't a
- * blockable thread it is important that it doesn't
- * change the state of any data that a blocking thread
- * expects to have exclusive access to (unless the
- * signal dispatcher itself explicitly is blocking all
- * blockable threads).
- */
- 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
- case 'I': /* SIGINT */
- break_requested();
- break;
- case 'Q': /* SIGQUIT */
- quit_requested();
- break;
- case '1': /* SIGUSR1 */
- sigusr1_exit();
- break;
-#ifdef QUANTIFY
- case '2': /* SIGUSR2 */
- quantify_save_data(); /* Might take a substantial amount of
- time, but this is a test/debug
- build */
- break;
-#endif
- default:
- erl_exit(ERTS_ABORT_EXIT,
- "signal-dispatcher thread received unknown "
- "signal notification: '%c'\n",
- buf[i]);
- }
- }
- ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking());
+ /*
+ * NOTE 1: The signal dispatcher thread should not do work
+ * that takes a substantial amount of time (except
+ * perhaps in test and debug builds). It needs to
+ * be responsive, i.e, it should only dispatch work
+ * to other threads.
+ *
+ * NOTE 2: The signal dispatcher thread is not a blockable
+ * thread (i.e., not a thread managed by the
+ * erl_thr_progress module). This is intentional.
+ * We want to be able to interrupt writing of a crash
+ * dump by hitting C-c twice. Since it isn't a
+ * blockable thread it is important that it doesn't
+ * change the state of any data that a blocking thread
+ * expects to have exclusive access to (unless the
+ * signal dispatcher itself explicitly is blocking all
+ * blockable threads).
+ */
+ switch (sb.signum) {
+ case 0: continue;
+ case SIGINT:
+ break_requested();
+ break;
+ default:
+ if ((signal = signum_to_signalterm(sb.signum)) == am_error) {
+ erts_exit(ERTS_ABORT_EXIT,
+ "signal-dispatcher thread received unknown "
+ "signal notification: '%d'\n",
+ sb.signum);
+ }
+ signal_notify_requested(signal);
+ }
+ ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking());
}
return NULL;
}
@@ -3017,9 +1416,10 @@ init_smp_sig_notify(void)
{
erts_smp_thr_opts_t thr_opts = ERTS_SMP_THR_OPTS_DEFAULT_INITER;
thr_opts.detached = 1;
+ 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);
@@ -3031,16 +1431,29 @@ init_smp_sig_notify(void)
NULL,
&thr_opts);
}
+
+static void
+init_smp_sig_suspend(void) {
+#ifdef ERTS_SYS_SUSPEND_SIGNAL
+ if (pipe(sig_suspend_fds) < 0) {
+ erts_exit(ERTS_ABORT_EXIT,
+ "Failed to create sig_suspend pipe: %s (%d)\n",
+ erl_errno_id(errno),
+ errno);
+ }
+#endif
+}
+
#ifdef __DARWIN__
int erts_darwin_main_thread_pipe[2];
int erts_darwin_main_thread_result_pipe[2];
-static void initialize_darwin_main_thread_pipes(void)
+static void initialize_darwin_main_thread_pipes(void)
{
- if (pipe(erts_darwin_main_thread_pipe) < 0 ||
+ 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");
}
}
@@ -3051,16 +1464,18 @@ erts_sys_main_thread(void)
erts_thread_disable_fpe();
#ifdef __DARWIN__
initialize_darwin_main_thread_pipes();
-#endif
+#else
/* Become signal receiver thread... */
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_set_thread_name("signal_receiver");
#endif
-
+#endif
smp_sig_notify(0); /* Notify initialized */
- while (1) {
- /* Wait for a signal to arrive... */
+
+ /* Wait for a signal to arrive... */
+
#ifdef __DARWIN__
+ while (1) {
/*
* The wx driver needs to be able to steal the main thread for Cocoa to
* work properly.
@@ -3075,12 +1490,24 @@ erts_sys_main_thread(void)
void* (*func)(void*);
void* arg;
void *resp;
- read(erts_darwin_main_thread_pipe[0],&func,sizeof(void* (*)(void*)));
- read(erts_darwin_main_thread_pipe[0],&arg, sizeof(void*));
+ res = read(erts_darwin_main_thread_pipe[0],&func,sizeof(void* (*)(void*)));
+ if (res != sizeof(void* (*)(void*)))
+ break;
+ res = read(erts_darwin_main_thread_pipe[0],&arg,sizeof(void*));
+ if (res != sizeof(void*))
+ break;
resp = (*func)(arg);
write(erts_darwin_main_thread_result_pipe[1],&resp,sizeof(void *));
}
-#else
+
+ if (res == -1 && errno != EINTR)
+ break;
+ }
+ /* Something broke with the main thread pipe, so we ignore it for now.
+ Most probably erts has closed this pipe and is about to exit. */
+#endif /* #ifdef __DARWIN__ */
+
+ while (1) {
#ifdef DEBUG
int res =
#else
@@ -3089,7 +1516,6 @@ erts_sys_main_thread(void)
select(0, NULL, NULL, NULL, NULL);
ASSERT(res < 0);
ASSERT(errno == EINTR);
-#endif
}
}
@@ -3127,7 +1553,8 @@ erl_sys_args(int* argc, char** argv)
{
int i, j;
- erts_smp_rwmtx_init(&environ_rwmtx, "environ");
+ erts_smp_rwmtx_init(&environ_rwmtx, "environ", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
i = 1;
@@ -3181,6 +1608,7 @@ erl_sys_args(int* argc, char** argv)
#ifdef ERTS_SMP
init_smp_sig_notify();
+ init_smp_sig_suspend();
#endif
/* Handled arguments have been marked with NULL. Slide arguments
@@ -3190,5 +1618,4 @@ erl_sys_args(int* argc, char** argv)
argv[j++] = argv[i];
}
*argc = j;
-
}
diff --git a/erts/emulator/sys/unix/sys_drivers.c b/erts/emulator/sys/unix/sys_drivers.c
new file mode 100644
index 0000000000..834706d86f
--- /dev/null
+++ b/erts/emulator/sys/unix/sys_drivers.c
@@ -0,0 +1,1878 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 1996-2017. 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
+ erts_sys_unix_later_init(); /* Need to be called after forker has been started */
+}
+
+/* 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, *cwd;
+ 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 ((cwd = 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;
+ }
+
+ 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);
+
+ if (wd) iov_len++;
+
+ /* 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;
+ }
+
+ /*
+ * Whitebox test port_SUITE:pipe_limit_env
+ * assumes this command payload format.
+ */
+ 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 = cwd;
+ io_vector[i].iov_len = strlen(io_vector[i].iov_base) + 1;
+ buffsz += io_vector[i++].iov_len;
+
+ if (wd) {
+ 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 + sizeof(buffsz))) {
+ /* we only wrote part of the command payload. Enqueue the rest. */
+ for (i = 0; i < iov_len; i++) {
+ if (res >= io_vector[i].iov_len)
+ res -= io_vector[i].iov_len;
+ else {
+ driver_enq(port_num, io_vector[i].iov_base + res,
+ io_vector[i].iov_len - res);
+ res = 0;
+ }
+ }
+ 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 cafeab547e..6435da086f 100644
--- a/erts/emulator/sys/unix/sys_float.c
+++ b/erts/emulator/sys/unix/sys_float.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -32,7 +33,7 @@ void
erts_sys_init_float(void)
{
# ifdef SIGFPE
- sys_sigset(SIGFPE, SIG_IGN); /* Ignore so we can test for NaN and Inf */
+ sys_signal(SIGFPE, SIG_IGN); /* Ignore so we can test for NaN and Inf */
# endif
}
@@ -52,7 +53,7 @@ static void erts_init_fp_exception(void)
void erts_thread_init_fp_exception(void)
{
unsigned long *fpe = erts_alloc(ERTS_ALC_T_FP_EXCEPTION, sizeof(*fpe));
- *fpe = 0L;
+ *fpe = 0;
erts_tsd_set(fpe_key, fpe);
}
@@ -85,11 +86,11 @@ static void set_current_fp_exception(unsigned long pc)
void erts_fp_check_init_error(volatile unsigned long *fpexnp)
{
- char buf[64];
+ char buf[128];
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();
@@ -101,6 +102,17 @@ void erts_fp_check_init_error(volatile unsigned long *fpexnp)
#define __DARWIN__ 1
#endif
+/*
+ * Define two processor and possibly OS-specific primitives:
+ *
+ * static void unmask_fpe(void);
+ * -- unmask invalid, overflow, and divide-by-zero exceptions
+ *
+ * static int mask_fpe(void);
+ * -- mask invalid, overflow, and divide-by-zero exceptions
+ * -- return non-zero if the previous state was unmasked
+ */
+
#if (defined(__i386__) || defined(__x86_64__)) && defined(__GNUC__)
static void unmask_x87(void)
@@ -112,7 +124,6 @@ static void unmask_x87(void)
__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;
@@ -135,7 +146,6 @@ static void unmask_sse2(void)
__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;
@@ -256,21 +266,19 @@ static int cpu_has_sse2(void)
}
#endif /* !__x86_64__ */
-static void unmask_fpe(void)
+static void unmask_fpe_internal(void)
{
- __asm__ __volatile__("fnclex");
unmask_x87();
if (cpu_has_sse2())
unmask_sse2();
}
-static void unmask_fpe_conditional(int unmasked)
+static void unmask_fpe(void)
{
- if (unmasked)
- unmask_fpe();
+ __asm__ __volatile__("fnclex");
+ unmask_fpe_internal();
}
-/* mask x86 FPE, return true if the previous state was unmasked */
static int mask_fpe(void)
{
int unmasked;
@@ -284,9 +292,7 @@ static int mask_fpe(void)
void erts_restore_fpu(void)
{
__asm__ __volatile__("fninit");
- unmask_x87();
- if (cpu_has_sse2())
- unmask_sse2();
+ unmask_fpe_internal();
}
#elif defined(__sparc__) && defined(__linux__)
@@ -309,13 +315,6 @@ static void unmask_fpe(void)
__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;
@@ -430,13 +429,6 @@ static void unmask_fpe(void)
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;
@@ -446,20 +438,13 @@ static int mask_fpe(void)
return unmasked;
}
-#else
+#else /* !(x86 || (sparc && linux) || (powerpc && (linux || darwin))) */
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;
@@ -471,6 +456,16 @@ static int mask_fpe(void)
#endif
+/*
+ * Define a processor and OS-specific SIGFPE handler.
+ *
+ * The effect of receiving a SIGFPE should be:
+ * 1. Update the processor context:
+ * a) on x86: mask FP exceptions, do not skip faulting instruction
+ * b) on SPARC and PowerPC: unmask FP exceptions, skip faulting instruction
+ * 2. call set_current_fp_exception with the PC of the faulting instruction
+ */
+
#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__)
@@ -498,18 +493,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__)
@@ -529,8 +514,7 @@ 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__)
+#if defined(__linux__) && defined(__x86_64__)
mcontext_t *mc = &uc->uc_mcontext;
fpregset_t fpstate = mc->fpregs;
pc = mc_pc(mc);
@@ -542,26 +526,26 @@ static void fpe_sig_action(int sig, siginfo_t *si, void *puc)
set encoding makes that a poor solution here. */
fpstate->mxcsr = 0x1F80;
fpstate->swd &= ~0xFF;
-#elif defined(__i386__)
+#elif defined(__linux__) && 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__)
+#elif defined(__linux__) && 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__)
+#elif defined(__linux__) && 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__)
+#elif defined(__linux__) && defined(__powerpc__)
#if defined(__powerpc64__)
mcontext_t *mc = &uc->uc_mcontext;
unsigned long *regs = &mc->gp_regs[0];
@@ -572,19 +556,8 @@ static void fpe_sig_action(int sig, siginfo_t *si, void *puc)
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 */
+# error "Floating-point exceptions not supported on MacOS X"
#elif defined(__DARWIN__) && defined(__ppc__)
mcontext_t mc = uc->uc_mcontext;
pc = mc->ss.srr0;
@@ -640,7 +613,7 @@ static void fpe_sig_action(int sig, siginfo_t *si, void *puc)
#endif
#if 0
{
- char buf[64];
+ char buf[128];
snprintf(buf, sizeof buf, "%s: FPE at %p\r\n", __FUNCTION__, (void*)pc);
write(2, buf, strlen(buf));
}
@@ -667,7 +640,7 @@ static void fpe_sig_handler(int sig)
static void erts_thread_catch_fp_exceptions(void)
{
- sys_sigset(SIGFPE, fpe_sig_handler);
+ sys_signal(SIGFPE, fpe_sig_handler);
unmask_fpe();
}
@@ -725,7 +698,8 @@ int erts_sys_block_fpe(void)
void erts_sys_unblock_fpe(int unmasked)
{
- unmask_fpe_conditional(unmasked);
+ if (unmasked)
+ unmask_fpe();
}
#endif
@@ -837,11 +811,6 @@ sys_chars_to_double(char* buf, double* fp)
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/unix/sys_time.c b/erts/emulator/sys/unix/sys_time.c
index fcce54a2c4..102ef7bebf 100644
--- a/erts/emulator/sys/unix/sys_time.c
+++ b/erts/emulator/sys/unix/sys_time.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2005-2009. All Rights Reserved.
+ * Copyright Ericsson AB 2005-2016. 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.
+ * 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%
*/
@@ -31,8 +32,21 @@
# undef _FILE_OFFSET_BITS
#endif
+#include <stdlib.h>
#include "sys.h"
#include "global.h"
+#include "erl_os_monotonic_time_extender.h"
+
+#undef ERTS_HAVE_ERTS_OS_TIMES_IMPL__
+#undef ERTS_HAVE_ERTS_SYS_HRTIME_IMPL__
+
+#if defined(OS_MONOTONIC_TIME_USING_MACH_CLOCK_GET_TIME) \
+ || defined(OS_SYSTEM_TIME_USING_MACH_CLOCK_GET_TIME) \
+ || defined(SYS_HRTIME_USING_MACH_CLOCK_GET_TIME)
+# include <mach/clock.h>
+# include <mach/mach.h>
+# define ERTS_MACH_CLOCKS
+#endif
#ifdef NO_SYSCONF
# define TICKS_PER_SEC() HZ
@@ -51,11 +65,27 @@
# include <fcntl.h>
#endif
+static void init_perf_counter(void);
+
/******************* Routines for time measurement *********************/
-int erts_ticks_per_sec = 0; /* Will be SYS_CLK_TCK in erl_unix_sys.h */
-int erts_ticks_per_sec_wrap = 0; /* Will be SYS_CLK_TCK_WRAP */
-static int ticks_bsr = 0; /* Shift wrapped tick value this much to the right */
+#undef ERTS_SYS_TIME_INTERNAL_STATE_WRITE_FREQ__
+#undef ERTS_SYS_TIME_INTERNAL_STATE_READ_ONLY__
+#undef ERTS_SYS_TIME_INTERNAL_STATE_READ_MOSTLY__
+
+#if defined(OS_MONOTONIC_TIME_USING_TIMES)
+
+static Uint32
+get_tick_count(void)
+{
+ struct tms unused;
+ return (Uint32) times(&unused);
+}
+
+#define ERTS_SYS_TIME_INTERNAL_STATE_READ_ONLY__
+#define ERTS_SYS_TIME_INTERNAL_STATE_READ_MOSTLY__
+
+#endif
/*
* init timers, chose a tick length, and return it.
@@ -63,40 +93,939 @@ static int ticks_bsr = 0; /* Shift wrapped tick value this much to the right */
* does almost everything. Other platforms have to
* emulate Unix in this sense.
*/
-int sys_init_time(void)
+
+ErtsSysTimeData__ erts_sys_time_data__ erts_align_attribute(ERTS_CACHE_LINE_SIZE);
+
+#if defined(__linux__) && defined(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME)
+
+#define ERTS_SYS_TIME_INTERNAL_STATE_WRITE_FREQ__
+
+static ErtsMonotonicTime clock_gettime_monotonic(void);
+static ErtsMonotonicTime clock_gettime_monotonic_verified(void);
+#if defined(HAVE_CLOCK_GETTIME_MONOTONIC_RAW)
+static ErtsMonotonicTime clock_gettime_monotonic_raw(void);
+#endif
+#if defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME)
+static void clock_gettime_times(ErtsMonotonicTime *, ErtsSystemTime *);
+static void clock_gettime_times_verified(ErtsMonotonicTime *, ErtsSystemTime *);
+#if defined(HAVE_CLOCK_GETTIME_MONOTONIC_RAW)
+static void clock_gettime_times_raw(ErtsMonotonicTime *, ErtsSystemTime *);
+#endif
+#endif
+
+#endif /* defined(__linux__) && defined(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME) */
+
+#ifdef ERTS_MACH_CLOCKS
+# define ERTS_SYS_TIME_INTERNAL_STATE_READ_ONLY__
+typedef struct {
+ clock_id_t id;
+ clock_serv_t srv;
+ char *name;
+} ErtsMachClock;
+
+typedef struct {
+ host_name_port_t host;
+ struct {
+ ErtsMachClock monotonic;
+ ErtsMachClock wall;
+ } clock;
+} ErtsMachClocks;
+static void mach_clocks_init(void);
+static void mach_clocks_fini(void);
+# ifdef HAVE_CLOCK_GET_ATTRIBUTES
+# define ERTS_HAVE_MACH_CLOCK_GETRES
+static Sint64
+mach_clock_getres(ErtsMachClock *clk);
+# endif
+#endif /* ERTS_MACH_CLOCKS */
+
+#ifdef ERTS_SYS_TIME_INTERNAL_STATE_READ_ONLY__
+struct sys_time_internal_state_read_only__ {
+#if defined(OS_MONOTONIC_TIME_USING_TIMES)
+ int times_shift;
+#endif
+#ifdef ERTS_MACH_CLOCKS
+ ErtsMachClocks mach;
+#endif
+};
+#endif
+
+#ifdef ERTS_SYS_TIME_INTERNAL_STATE_READ_MOSTLY__
+struct sys_time_internal_state_read_mostly__ {
+#if defined(OS_MONOTONIC_TIME_USING_TIMES)
+ ErtsOsMonotonicTimeExtendState os_mtime_xtnd;
+#endif
+};
+#endif
+
+#ifdef ERTS_SYS_TIME_INTERNAL_STATE_WRITE_FREQ__
+struct sys_time_internal_state_write_freq__ {
+ erts_smp_mtx_t mtx;
+#if defined(__linux__) && defined(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME)
+ ErtsMonotonicTime last_delivered;
+#endif
+};
+#endif
+
+#if defined(ERTS_SYS_TIME_INTERNAL_STATE_READ_ONLY__) \
+ || defined(ERTS_SYS_TIME_INTERNAL_STATE_WRITE_FREQ__)
+static struct {
+#ifdef ERTS_SYS_TIME_INTERNAL_STATE_READ_ONLY__
+ union {
+ struct sys_time_internal_state_read_only__ o;
+ char align__[(((sizeof(struct sys_time_internal_state_read_only__) - 1)
+ / ASSUMED_CACHE_LINE_SIZE) + 1)
+ * ASSUMED_CACHE_LINE_SIZE];
+ } r;
+#endif
+#ifdef ERTS_SYS_TIME_INTERNAL_STATE_READ_MOSTLY__
+ union {
+ struct sys_time_internal_state_read_mostly__ m;
+ char align__[(((sizeof(struct sys_time_internal_state_read_mostly__) - 1)
+ / ASSUMED_CACHE_LINE_SIZE) + 1)
+ * ASSUMED_CACHE_LINE_SIZE];
+ } wr;
+#endif
+#ifdef ERTS_SYS_TIME_INTERNAL_STATE_WRITE_FREQ__
+ union {
+ struct sys_time_internal_state_write_freq__ f;
+ char align__[(((sizeof(struct sys_time_internal_state_write_freq__) - 1)
+ / ASSUMED_CACHE_LINE_SIZE) + 1)
+ * ASSUMED_CACHE_LINE_SIZE];
+ } w;
+#endif
+} internal_state erts_align_attribute(ERTS_CACHE_LINE_SIZE);
+#endif
+
+void
+sys_init_time(ErtsSysInitTimeResult *init_resp)
{
+#if defined(ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT)
+ int major, minor, build, vsn;
+#endif
+#if defined(ERTS_MACH_CLOCKS)
+ mach_clocks_init();
+#endif
+#if !defined(ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT)
+
+ init_resp->have_os_monotonic_time = 0;
+
+#else /* defined(ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT) */
+
+#ifdef ERTS_HAVE_CORRECTED_OS_MONOTONIC_TIME
+ init_resp->have_corrected_os_monotonic_time = 1;
+#else
+ init_resp->have_corrected_os_monotonic_time = 0;
+#endif
+
+ init_resp->os_monotonic_time_info.resolution = (Uint64) 1000*1000*1000;
+#if defined(ERTS_HAVE_MACH_CLOCK_GETRES) && defined(MONOTONIC_CLOCK_ID)
+ init_resp->os_monotonic_time_info.resolution
+ = mach_clock_getres(&internal_state.r.o.mach.clock.monotonic);
+#elif defined(HAVE_CLOCK_GETRES) && defined(MONOTONIC_CLOCK_ID)
+ {
+ struct timespec ts;
+ if (clock_getres(MONOTONIC_CLOCK_ID, &ts) == 0) {
+ if (ts.tv_sec == 0 && ts.tv_nsec != 0)
+ init_resp->os_monotonic_time_info.resolution /= ts.tv_nsec;
+ else if (ts.tv_sec >= 1)
+ init_resp->os_monotonic_time_info.resolution = 1;
+ }
+ }
+#endif
+
+#ifdef MONOTONIC_CLOCK_ID_STR
+ init_resp->os_monotonic_time_info.clock_id = MONOTONIC_CLOCK_ID_STR;
+#else
+ init_resp->os_monotonic_time_info.clock_id = NULL;
+#endif
+
+ init_resp->os_monotonic_time_info.locked_use = 0;
+
+#if defined(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME)
+ init_resp->os_monotonic_time_info.func = "clock_gettime";
+#elif defined(OS_MONOTONIC_TIME_USING_MACH_CLOCK_GET_TIME)
+ init_resp->os_monotonic_time_info.func = "clock_get_time";
+#elif defined(OS_MONOTONIC_TIME_USING_GETHRTIME)
+ init_resp->os_monotonic_time_info.func = "gethrtime";
+#elif defined(OS_MONOTONIC_TIME_USING_TIMES)
+ init_resp->os_monotonic_time_info.func = "times";
+#else
+# error Unknown erts_os_monotonic_time() implementation
+#endif
+
+ init_resp->have_os_monotonic_time = 1;
+
+ os_version(&major, &minor, &build);
+
+ vsn = ERTS_MK_VSN_INT(major, minor, build);
+
+
+#if defined(__linux__) && defined(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME)
+ if (vsn >= ERTS_MK_VSN_INT(2, 6, 33)) {
+ erts_sys_time_data__.r.o.os_monotonic_time =
+ clock_gettime_monotonic;
+#if defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME)
+ erts_sys_time_data__.r.o.os_times =
+ clock_gettime_times;
+#endif
+ }
+ else {
+ /*
+ * Linux versions prior to 2.6.33 have a
+ * known bug that sometimes cause the NTP
+ * adjusted monotonic clock to take small
+ * steps backwards. Use raw monotonic clock
+ * if it is present; otherwise, fall back
+ * on locked verification of values.
+ */
+ init_resp->have_corrected_os_monotonic_time = 0;
+#if defined(HAVE_CLOCK_GETTIME_MONOTONIC_RAW)
+ /* We know that CLOCK_MONOTONIC_RAW is defined,
+ but we don't know if we got a kernel that
+ supports it. Support for CLOCK_MONOTONIC_RAW
+ appeared in kernel 2.6.28... */
+ if (vsn >= ERTS_MK_VSN_INT(2, 6, 28)) {
+ erts_sys_time_data__.r.o.os_monotonic_time =
+ clock_gettime_monotonic_raw;
+#if defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME)
+ erts_sys_time_data__.r.o.os_times =
+ clock_gettime_times_raw;
+#endif
+ init_resp->os_monotonic_time_info.clock_id =
+ "CLOCK_MONOTONIC_RAW";
+ }
+ else
+#endif /* defined(HAVE_CLOCK_GETTIME_MONOTONIC_RAW) */
+ {
+ erts_sys_time_data__.r.o.os_monotonic_time =
+ clock_gettime_monotonic_verified;
+#if defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME)
+ erts_sys_time_data__.r.o.os_times =
+ clock_gettime_times_verified;
+#endif
+ erts_smp_mtx_init(&internal_state.w.f.mtx, "os_monotonic_time", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_IO);
+ internal_state.w.f.last_delivered
+ = clock_gettime_monotonic();
+ init_resp->os_monotonic_time_info.locked_use = 1;
+ }
+ }
+#else /* !(defined(__linux__) && defined(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME)) */
+ {
+ char flavor[1024];
+
+ os_flavor(flavor, sizeof(flavor));
+
+ if (sys_strcmp(flavor, "sunos") == 0) {
+ /*
+ * Don't trust hrtime on multi processors
+ * on SunOS prior to SunOS 5.8
+ */
+ if (vsn < ERTS_MK_VSN_INT(5, 8, 0)) {
+#if defined(HAVE_SYSCONF) && defined(_SC_NPROCESSORS_CONF)
+ if (sysconf(_SC_NPROCESSORS_CONF) > 1)
+#endif
+ init_resp->have_os_monotonic_time = 0;
+ }
+ }
+ }
+#endif /* !(defined(__linux__) && defined(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME)) */
+
+#endif /* defined(ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT) */
+
+#ifdef ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT
+ init_resp->os_monotonic_time_unit = ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT;
+#endif
+ init_resp->sys_clock_resolution = SYS_CLOCK_RESOLUTION;
+
/*
- * This (erts_ticks_per_sec) is only for times() (CLK_TCK),
- * the resolution is always one millisecond..
+ * This (erts_sys_time_data__.r.o.ticks_per_sec) is only for
+ * times() (CLK_TCK), the resolution is always one millisecond..
*/
- if ((erts_ticks_per_sec = TICKS_PER_SEC()) < 0)
- erl_exit(1, "Can't get clock ticks/sec\n");
- if (erts_ticks_per_sec >= 1000) {
- /* Workaround for beta linux kernels, need to be done in runtime
- to make erlang run on both 2.4 and 2.5 kernels. In the future,
- the kernel ticks might as
- well be used as a high res timer instead, but that's for when the
- majority uses kernels with HZ == 1024 */
- ticks_bsr = 3;
- } else {
- ticks_bsr = 0;
+ if ((erts_sys_time_data__.r.o.ticks_per_sec = TICKS_PER_SEC()) < 0)
+ 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
+# error Time unit is supposed to be determined at runtime...
+#endif
+ {
+ ErtsMonotonicTime resolution = erts_sys_time_data__.r.o.ticks_per_sec;
+ ErtsMonotonicTime time_unit = resolution;
+ int shift = 0;
+
+ while (time_unit < 1000*1000) {
+ time_unit <<= 1;
+ shift++;
+ }
+
+ init_resp->os_monotonic_time_info.resolution = resolution;
+ init_resp->os_monotonic_time_unit = time_unit;
+ init_resp->os_monotonic_time_info.extended = 1;
+ internal_state.r.o.times_shift = shift;
+
+ erts_init_os_monotonic_time_extender(&internal_state.wr.m.os_mtime_xtnd,
+ get_tick_count,
+ (1 << 29) / resolution);
+ }
+#endif /* defined(OS_MONOTONIC_TIME_USING_TIMES) */
+
+#ifdef WALL_CLOCK_ID_STR
+ init_resp->os_system_time_info.clock_id = WALL_CLOCK_ID_STR;
+#else
+ init_resp->os_system_time_info.clock_id = NULL;
+#endif
+
+ init_resp->os_system_time_info.locked_use = 0;
+ init_resp->os_system_time_info.resolution = (Uint64) 1000*1000*1000;
+#if defined(ERTS_HAVE_MACH_CLOCK_GETRES) && defined(WALL_CLOCK_ID)
+ init_resp->os_system_time_info.resolution
+ = mach_clock_getres(&internal_state.r.o.mach.clock.wall);
+#elif defined(HAVE_CLOCK_GETRES) && defined(WALL_CLOCK_ID)
+ {
+ struct timespec ts;
+ if (clock_getres(WALL_CLOCK_ID, &ts) == 0) {
+ if (ts.tv_sec == 0 && ts.tv_nsec != 0)
+ init_resp->os_system_time_info.resolution /= ts.tv_nsec;
+ else if (ts.tv_sec >= 1)
+ init_resp->os_system_time_info.resolution = 1;
+ }
+ }
+#endif
+
+#if defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME)
+ init_resp->os_system_time_info.func = "clock_gettime";
+#elif defined(OS_SYSTEM_TIME_USING_MACH_CLOCK_GET_TIME)
+ init_resp->os_system_time_info.func = "clock_get_time";
+#elif defined(OS_SYSTEM_TIME_GETTIMEOFDAY)
+ init_resp->os_system_time_info.func = "gettimeofday";
+ init_resp->os_system_time_info.resolution = 1000*1000;
+ init_resp->os_system_time_info.clock_id = NULL;
+#else
+# error Missing erts_os_system_time() implementation
+#endif
+
+ init_perf_counter();
+
+}
+
+void
+erts_late_sys_init_time(void)
+{
+#if defined(OS_MONOTONIC_TIME_USING_TIMES)
+ erts_late_init_os_monotonic_time_extender(&internal_state.wr.m.os_mtime_xtnd);
+#endif
+}
+
+static ERTS_INLINE ErtsSystemTime
+adj_stime_time_unit(ErtsSystemTime stime, Uint32 res)
+{
+ if (res == ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT)
+ return stime;
+ if (res == (Uint32) 1000*1000*1000
+ && ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT == 1000*1000)
+ return stime/1000;
+ if (res == (Uint32) 1000*1000
+ && ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT == 1000*1000*1000)
+ return stime*1000;
+ return ((ErtsSystemTime)
+ erts_time_unit_conversion(stime,
+ (Uint32) res,
+ (Uint32) ERTS_MONOTONIC_TIME_UNIT));
+}
+
+#define ERTS_TimeSpec2Sint64(TS) \
+ ((((Sint64) (TS)->tv_sec) * ((Sint64) 1000*1000*1000)) \
+ + ((Sint64) (TS)->tv_nsec))
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
+ * POSIX clock_gettime() *
+\* */
+
+#if defined(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME) \
+ || defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME)
+
+static ERTS_INLINE Sint64
+posix_clock_gettime(clockid_t id, char *name)
+{
+ struct timespec ts;
+
+ if (clock_gettime(id, &ts) != 0) {
+ int err = errno;
+ char *errstr = err ? strerror(err) : "unknown";
+ erts_exit(ERTS_ABORT_EXIT,
+ "clock_gettime(%s, _) failed: %s (%d)\n",
+ name, errstr, err);
+ }
+ return ERTS_TimeSpec2Sint64(&ts);
+}
+
+#endif /* defined(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME) \
+ || defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME) */
+
+#if defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME)
+
+ErtsSystemTime
+erts_os_system_time(void)
+{
+ Sint64 stime = posix_clock_gettime(WALL_CLOCK_ID,
+ WALL_CLOCK_ID_STR);
+ return adj_stime_time_unit((ErtsSystemTime) stime,
+ (Uint32) 1000*1000*1000);
+}
+
+#endif /* defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME) */
+
+#if defined(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME)
+
+#if defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME)
+
+#define ERTS_HAVE_ERTS_OS_TIMES_IMPL__
+
+static ERTS_INLINE void
+posix_clock_gettime_times(clockid_t mid, char *mname,
+ ErtsMonotonicTime *mtimep,
+ clockid_t sid, char *sname,
+ ErtsSystemTime *stimep)
+{
+ struct timespec mts, sts;
+ int mres, sres, merr, serr;
+
+ mres = clock_gettime(mid, &mts);
+ merr = errno;
+ sres = clock_gettime(sid, &sts);
+ serr = errno;
+
+ if (mres != 0) {
+ char *errstr = merr ? strerror(merr) : "unknown";
+ erts_exit(ERTS_ABORT_EXIT,
+ "clock_gettime(%s, _) failed: %s (%d)\n",
+ mname, errstr, merr);
+ }
+ if (sres != 0) {
+ char *errstr = serr ? strerror(serr) : "unknown";
+ erts_exit(ERTS_ABORT_EXIT,
+ "clock_gettime(%s, _) failed: %s (%d)\n",
+ sname, errstr, serr);
+ }
+
+ *mtimep = (ErtsMonotonicTime) ERTS_TimeSpec2Sint64(&mts);
+ *stimep = (ErtsSystemTime) ERTS_TimeSpec2Sint64(&sts);
+}
+
+#endif /* defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME) */
+
+#if defined(__linux__)
+
+static ErtsMonotonicTime clock_gettime_monotonic_verified(void)
+{
+ ErtsMonotonicTime mtime;
+
+ mtime = (ErtsMonotonicTime) posix_clock_gettime(MONOTONIC_CLOCK_ID,
+ MONOTONIC_CLOCK_ID_STR);
+
+ erts_smp_mtx_lock(&internal_state.w.f.mtx);
+ if (mtime < internal_state.w.f.last_delivered)
+ mtime = internal_state.w.f.last_delivered;
+ else
+ internal_state.w.f.last_delivered = mtime;
+ erts_smp_mtx_unlock(&internal_state.w.f.mtx);
+
+ return mtime;
+}
+
+#if defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME)
+
+static void clock_gettime_times_verified(ErtsMonotonicTime *mtimep,
+ ErtsSystemTime *stimep)
+{
+ posix_clock_gettime_times(MONOTONIC_CLOCK_ID,
+ MONOTONIC_CLOCK_ID_STR,
+ mtimep,
+ WALL_CLOCK_ID,
+ WALL_CLOCK_ID_STR,
+ stimep);
+
+ erts_smp_mtx_lock(&internal_state.w.f.mtx);
+ if (*mtimep < internal_state.w.f.last_delivered)
+ *mtimep = internal_state.w.f.last_delivered;
+ else
+ internal_state.w.f.last_delivered = *mtimep;
+ erts_smp_mtx_unlock(&internal_state.w.f.mtx);
+}
+
+#endif /* defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME) */
+
+static ErtsMonotonicTime clock_gettime_monotonic(void)
+{
+ return (ErtsMonotonicTime) posix_clock_gettime(MONOTONIC_CLOCK_ID,
+ MONOTONIC_CLOCK_ID_STR);
+}
+
+#if defined(HAVE_CLOCK_GETTIME_MONOTONIC_RAW)
+
+static ErtsMonotonicTime clock_gettime_monotonic_raw(void)
+{
+ return (ErtsMonotonicTime) posix_clock_gettime(CLOCK_MONOTONIC_RAW,
+ "CLOCK_MONOTONIC_RAW");
+}
+
+#endif /* defined(HAVE_CLOCK_GETTIME_MONOTONIC_RAW) */
+
+#if defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME)
+
+static void clock_gettime_times(ErtsMonotonicTime *mtimep,
+ ErtsSystemTime *stimep)
+{
+ posix_clock_gettime_times(MONOTONIC_CLOCK_ID,
+ MONOTONIC_CLOCK_ID_STR,
+ mtimep,
+ WALL_CLOCK_ID,
+ WALL_CLOCK_ID_STR,
+ stimep);
+}
+
+#if defined(HAVE_CLOCK_GETTIME_MONOTONIC_RAW)
+
+static void clock_gettime_times_raw(ErtsMonotonicTime *mtimep,
+ ErtsSystemTime *stimep)
+{
+ posix_clock_gettime_times(CLOCK_MONOTONIC_RAW,
+ "CLOCK_MONOTONIC_RAW",
+ mtimep,
+ WALL_CLOCK_ID,
+ WALL_CLOCK_ID_STR,
+ stimep);
+}
+
+#endif /* defined(HAVE_CLOCK_GETTIME_MONOTONIC_RAW) */
+
+#endif /* defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME) */
+
+#else /* !defined(__linux__) */
+
+ErtsMonotonicTime erts_os_monotonic_time(void)
+{
+ return posix_clock_gettime(MONOTONIC_CLOCK_ID,
+ MONOTONIC_CLOCK_ID_STR);
+}
+
+#if defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME)
+
+void erts_os_times(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep)
+{
+ posix_clock_gettime_times(MONOTONIC_CLOCK_ID,
+ MONOTONIC_CLOCK_ID_STR,
+ mtimep,
+ WALL_CLOCK_ID,
+ WALL_CLOCK_ID_STR,
+ stimep);
+}
+
+#endif /* defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME) */
+
+#endif /* !defined(__linux__) */
+
+#endif /* defined(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME) */
+
+#if defined(SYS_HRTIME_USING_CLOCK_GETTIME)
+# define ERTS_HAVE_ERTS_SYS_HRTIME_IMPL__
+
+ErtsSysHrTime
+erts_sys_hrtime(void)
+{
+ return (ErtsSysHrTime) posix_clock_gettime(HRTIME_CLOCK_ID,
+ HRTIME_CLOCK_ID_STR);
+}
+
+#endif /* defined(SYS_HRTIME_USING_CLOCK_GETTIME) */
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
+ * MACH clock_get_time() *
+\* */
+
+#if defined(ERTS_MACH_CLOCKS)
+
+static void
+mach_clocks_fini(void)
+{
+ mach_port_t task = mach_task_self();
+ mach_port_deallocate(task, internal_state.r.o.mach.host);
+#if defined(OS_MONOTONIC_TIME_USING_MACH_CLOCK_GET_TIME)
+ mach_port_deallocate(task, internal_state.r.o.mach.clock.monotonic.srv);
+#endif
+#if defined(OS_SYSTEM_TIME_USING_MACH_CLOCK_GET_TIME)
+ mach_port_deallocate(task, internal_state.r.o.mach.clock.wall.srv);
+#endif
+}
+
+static void
+mach_clocks_init(void)
+{
+ kern_return_t kret;
+ host_name_port_t host;
+ clock_id_t id;
+ clock_serv_t *clck_srv_p;
+ char *name;
+
+ host = internal_state.r.o.mach.host = mach_host_self();
+
+#if defined(OS_MONOTONIC_TIME_USING_MACH_CLOCK_GET_TIME) \
+ || defined(SYS_HRTIME_USING_MACH_CLOCK_GET_TIME)
+ id = internal_state.r.o.mach.clock.monotonic.id = MONOTONIC_CLOCK_ID;
+ name = internal_state.r.o.mach.clock.monotonic.name = MONOTONIC_CLOCK_ID_STR;
+ 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) {
+ erts_exit(ERTS_ABORT_EXIT,
+ "host_get_clock_service(_, %s, _) failed\n",
+ name);
+ }
+#endif
+
+#if defined(OS_SYSTEM_TIME_USING_MACH_CLOCK_GET_TIME)
+ id = internal_state.r.o.mach.clock.wall.id = WALL_CLOCK_ID;
+ name = internal_state.r.o.mach.clock.wall.name = WALL_CLOCK_ID_STR;
+ 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) {
+ erts_exit(ERTS_ABORT_EXIT,
+ "host_get_clock_service(_, %s, _) failed\n",
+ name);
+ }
+#endif
+
+ if (atexit(mach_clocks_fini) != 0) {
+ int err = errno;
+ char *errstr = err ? strerror(err) : "unknown";
+ erts_exit(ERTS_ABORT_EXIT,
+ "Failed to register mach_clocks_fini() "
+ "for call at exit: %s (%d)\n",
+ errstr, err);
+ }
+}
+
+#ifdef ERTS_HAVE_MACH_CLOCK_GETRES
+
+static Sint64
+mach_clock_getres(ErtsMachClock *clk)
+{
+ kern_return_t kret;
+ natural_t attr[1];
+ mach_msg_type_number_t cnt;
+
+ cnt = sizeof(attr);
+ kret = clock_get_attributes(clk->srv,
+ CLOCK_GET_TIME_RES,
+ (clock_attr_t) attr,
+ &cnt);
+ if (kret != KERN_SUCCESS || cnt != 1) {
+ erts_exit(ERTS_ABORT_EXIT,
+ "clock_get_attributes(%s, _) failed\n",
+ clk->name);
+ }
+
+ return (Sint64) attr[0];
+}
+
+#endif /* ERTS_HAVE_MACH_CLOCK_GETRES */
+
+static ERTS_INLINE Sint64
+mach_clock_get_time(ErtsMachClock *clk)
+{
+ kern_return_t kret;
+ mach_timespec_t time_spec;
+
+ kret = clock_get_time(clk->srv, &time_spec);
+ if (kret != KERN_SUCCESS)
+ erts_exit(ERTS_ABORT_EXIT, "clock_get_time(%s, _) failed\n", clk->name);
+
+ return ERTS_TimeSpec2Sint64(&time_spec);
+}
+
+#endif /* defined(ERTS_MACH_CLOCKS) */
+
+#if defined(OS_SYSTEM_TIME_USING_MACH_CLOCK_GET_TIME)
+
+#define ERTS_HAVE_ERTS_OS_TIMES_IMPL__
+
+ErtsSystemTime
+erts_os_system_time(void)
+{
+ Sint64 stime = mach_clock_get_time(&internal_state.r.o.mach.clock.wall);
+ return adj_stime_time_unit((ErtsSystemTime) stime,
+ (Uint32) 1000*1000*1000);
+}
+
+#endif /* defined(OS_SYSTEM_TIME_USING_MACH_CLOCK_GET_TIME) */
+
+#if defined(OS_MONOTONIC_TIME_USING_MACH_CLOCK_GET_TIME)
+
+ErtsMonotonicTime
+erts_os_monotonic_time(void)
+{
+ return (ErtsMonotonicTime)
+ mach_clock_get_time(&internal_state.r.o.mach.clock.monotonic);
+}
+
+#if defined(OS_SYSTEM_TIME_USING_MACH_CLOCK_GET_TIME)
+
+#define ERTS_HAVE_ERTS_OS_TIMES_IMPL__
+
+void
+erts_os_times(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep)
+{
+ kern_return_t mkret, skret;
+ mach_timespec_t mon_time_spec, sys_time_spec;
+
+ mkret = clock_get_time(internal_state.r.o.mach.clock.monotonic.srv,
+ &mon_time_spec);
+ skret = clock_get_time(internal_state.r.o.mach.clock.wall.srv,
+ &sys_time_spec);
+
+ if (mkret != KERN_SUCCESS)
+ erts_exit(ERTS_ABORT_EXIT,
+ "clock_get_time(%s, _) failed\n",
+ internal_state.r.o.mach.clock.monotonic.name);
+ if (skret != KERN_SUCCESS)
+ erts_exit(ERTS_ABORT_EXIT,
+ "clock_get_time(%s, _) failed\n",
+ internal_state.r.o.mach.clock.wall.name);
+
+ *mtimep = (ErtsMonotonicTime) ERTS_TimeSpec2Sint64(&mon_time_spec);
+ *stimep = (ErtsSystemTime) ERTS_TimeSpec2Sint64(&sys_time_spec);
+}
+
+#endif /* defined(OS_SYSTEM_TIME_USING_MACH_CLOCK_GET_TIME) */
+
+#endif /* defined(OS_MONOTONIC_TIME_USING_MACH_CLOCK_GET_TIME) */
+
+#if defined(SYS_HRTIME_USING_MACH_CLOCK_GET_TIME)
+
+#define ERTS_HAVE_ERTS_SYS_HRTIME_IMPL__
+
+ErtsSysHrTime
+erts_sys_hrtime(void)
+{
+ return (ErtsSysHrTime)
+ mach_clock_get_time(&internal_state.r.o.mach.clock.monotonic);
+}
+
+#endif /* defined(SYS_HRTIME_USING_MACH_CLOCK_GET_TIME) */
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
+ * Solaris gethrtime() - OS monotonic time *
+\* */
+
+#if defined(OS_MONOTONIC_TIME_USING_GETHRTIME)
+
+ErtsMonotonicTime erts_os_monotonic_time(void)
+{
+ return (ErtsMonotonicTime) gethrtime();
+}
+
+#endif /* defined(OS_MONOTONIC_TIME_USING_GETHRTIME) */
+
+#if defined(SYS_HRTIME_USING_GETHRTIME)
+
+#define ERTS_HAVE_ERTS_SYS_HRTIME_IMPL__
+
+ErtsSysHrTime
+erts_sys_hrtime(void)
+{
+ return (ErtsSysHrTime) gethrtime();
+}
+
+#endif /* defined(SYS_HRTIME_USING_GETHRTIME) */
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
+ * gettimeofday() - OS system time *
+\* */
+
+#if defined(OS_SYSTEM_TIME_GETTIMEOFDAY)
+
+ErtsSystemTime
+erts_os_system_time(void)
+{
+ ErtsSystemTime stime;
+ struct timeval tv;
+
+ if (gettimeofday(&tv, NULL) != 0) {
+ int err = errno;
+ char *errstr = err ? strerror(err) : "unknown";
+ erts_exit(ERTS_ABORT_EXIT,
+ "gettimeofday(_, NULL) failed: %s (%d)\n",
+ errstr, err);
+ }
+
+ stime = (ErtsSystemTime) tv.tv_sec;
+ stime *= (ErtsSystemTime) 1000*1000;
+ stime += (ErtsSystemTime) tv.tv_usec;
+
+ return adj_stime_time_unit(stime, (Uint32) 1000*1000);
+}
+
+#endif /* defined(OS_SYSTEM_TIME_GETTIMEOFDAY) */
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
+ * times() - OS monotonic time *
+\* */
+
+#if defined(OS_MONOTONIC_TIME_USING_TIMES)
+
+ErtsMonotonicTime
+erts_os_monotonic_time(void)
+{
+ Uint32 ticks = get_tick_count();
+ ERTS_CHK_EXTEND_OS_MONOTONIC_TIME(&internal_state.wr.m.os_mtime_xtnd,
+ ticks);
+ return ERTS_EXTEND_OS_MONOTONIC_TIME(&internal_state.wr.m.os_mtime_xtnd,
+ ticks) << internal_state.r.o.times_shift;
+}
+
+#endif
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
+ * Fallbacks *
+\* */
+
+#ifndef ERTS_HAVE_ERTS_SYS_HRTIME_IMPL__
+
+ErtsSysHrTime
+erts_sys_hrtime(void)
+{
+ return (ErtsSysHrTime) ERTS_MONOTONIC_TO_NSEC(erts_os_system_time());
+}
+
+#endif
+
+#if !defined(ERTS_HAVE_ERTS_OS_TIMES_IMPL__) \
+ && defined(ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT)
+
+void
+erts_os_times(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep)
+{
+ *mtimep = erts_os_monotonic_time();
+ *stimep = erts_os_system_time();
+}
+
+#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;
}
- erts_ticks_per_sec_wrap = (erts_ticks_per_sec >> ticks_bsr);
- return SYS_CLOCK_RESOLUTION;
+ /* 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;
}
-clock_t sys_times_wrap(void)
+static int have_rdtscp(void)
{
- SysTimes dummy;
- clock_t result = (sys_times(&dummy) >> ticks_bsr);
- return result;
+#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..dd0a3b03ff
--- /dev/null
+++ b/erts/emulator/sys/unix/sys_uds.c
@@ -0,0 +1,155 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2002-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%
+ */
+
+#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..a598102d5c
--- /dev/null
+++ b/erts/emulator/sys/unix/sys_uds.h
@@ -0,0 +1,57 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2002-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%
+ */
+
+#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/dosmap.c b/erts/emulator/sys/win32/dosmap.c
index 15416a66c5..95fbba384b 100644
--- a/erts/emulator/sys/win32/dosmap.c
+++ b/erts/emulator/sys/win32/dosmap.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1998-2009. All Rights Reserved.
+ * Copyright Ericsson AB 1998-2016. 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.
+ * 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%
*/
diff --git a/erts/emulator/sys/win32/driver_int.h b/erts/emulator/sys/win32/driver_int.h
index 97e188816e..50097d3fd2 100644
--- a/erts/emulator/sys/win32/driver_int.h
+++ b/erts/emulator/sys/win32/driver_int.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1997-2009. All Rights Reserved.
+ * Copyright Ericsson AB 1997-2016. 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.
+ * 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%
*/
diff --git a/erts/emulator/sys/win32/erl_main.c b/erts/emulator/sys/win32/erl_main.c
index 5471bffb52..9eee300f48 100644
--- a/erts/emulator/sys/win32/erl_main.c
+++ b/erts/emulator/sys/win32/erl_main.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2000-2009. All Rights Reserved.
+ * Copyright Ericsson AB 2000-2016. 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.
+ * 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%
*/
diff --git a/erts/emulator/sys/win32/erl_poll.c b/erts/emulator/sys/win32/erl_poll.c
index 7a1d129cd5..8743f83a50 100644
--- a/erts/emulator/sys/win32/erl_poll.c
+++ b/erts/emulator/sys/win32/erl_poll.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2007-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2007-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -25,6 +26,8 @@
#include "sys.h"
#include "erl_alloc.h"
#include "erl_poll.h"
+#include "erl_time.h"
+#include "erl_msacc.h"
/*
* Some debug macros
@@ -139,7 +142,8 @@ static erts_mtx_t save_ops_mtx;
static void poll_debug_init(void)
{
- erts_mtx_init(&save_ops_mtx, "save_ops_lock");
+ erts_mtx_init(&save_ops_mtx, "save_ops_lock", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
}
void poll_debug_set_active_fd(ErtsSysFdType fd)
@@ -285,7 +289,7 @@ struct ErtsPollSet_ {
#ifdef ERTS_SMP
erts_smp_mtx_t mtx;
#endif
- erts_smp_atomic32_t timeout;
+ erts_atomic64_t timeout_time;
};
#ifdef ERTS_SMP
@@ -363,6 +367,26 @@ do { \
wait_standby(PS); \
} while(0)
+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) 0)
#define ERTS_POLL_WOKEN_IO_READY ((erts_aint32_t) 1)
#define ERTS_POLL_WOKEN_INTR ((erts_aint32_t) 2)
@@ -401,7 +425,7 @@ static ERTS_INLINE int
wakeup_cause(ErtsPollSet ps)
{
int res;
- erts_aint32_t wakeup_state = erts_atomic32_read_nob(&ps->wakeup_state);
+ erts_aint32_t wakeup_state = erts_atomic32_read_acqb(&ps->wakeup_state);
switch (wakeup_state) {
case ERTS_POLL_WOKEN_IO_READY:
res = 0;
@@ -414,7 +438,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);
}
@@ -422,15 +446,29 @@ wakeup_cause(ErtsPollSet ps)
}
static ERTS_INLINE DWORD
-poll_wait_timeout(ErtsPollSet ps, SysTimeval *tvp)
+poll_wait_timeout(ErtsPollSet ps, ErtsMonotonicTime timeout_time)
{
- time_t timeout = tvp->tv_sec * 1000 + tvp->tv_usec / 1000;
+ ErtsMonotonicTime current_time, diff_time, timeout;
- if (timeout <= 0) {
+ if (timeout_time == ERTS_POLL_NO_TIMEOUT) {
+ no_timeout:
+ set_timeout_time(ps, ERTS_MONOTONIC_TIME_MIN);
woke_up(ps);
return (DWORD) 0;
}
+ current_time = erts_get_monotonic_time(NULL);
+ diff_time = timeout_time - current_time;
+ if (diff_time <= 0)
+ goto no_timeout;
+
+ /* Round up to nearest milli second */
+ timeout = (ERTS_MONOTONIC_TO_MSEC(diff_time - 1) + 1);
+ if (timeout > INT_MAX)
+ timeout = INT_MAX; /* Also prevents DWORD overflow */
+
+ set_timeout_time(ps, current_time + ERTS_MSEC_TO_MONOTONIC(timeout));
+
ResetEvent(ps->event_io_ready);
/*
* Since we don't know the internals of ResetEvent() we issue
@@ -442,10 +480,6 @@ poll_wait_timeout(ErtsPollSet ps, SysTimeval *tvp)
if (erts_atomic32_read_nob(&ps->wakeup_state) != ERTS_POLL_NOT_WOKEN)
return (DWORD) 0;
- if (timeout > ((time_t) ERTS_AINT32_T_MAX))
- timeout = ERTS_AINT32_T_MAX; /* Also prevents DWORD overflow */
-
- erts_smp_atomic32_set_relb(&ps->timeout, (erts_aint32_t) timeout);
return (DWORD) timeout;
}
@@ -454,9 +488,8 @@ wake_poller(ErtsPollSet ps, int io_ready)
{
erts_aint32_t wakeup_state;
if (io_ready) {
- /* We may set the event multiple times. This is, however, harmless. */
- wakeup_state = erts_atomic32_read_nob(&ps->wakeup_state);
- erts_atomic32_set_relb(&ps->wakeup_state, ERTS_POLL_WOKEN_IO_READY);
+ wakeup_state = erts_atomic32_xchg_relb(&ps->wakeup_state,
+ ERTS_POLL_WOKEN_IO_READY);
}
else {
ERTS_THR_MEMORY_BARRIER;
@@ -544,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);
@@ -645,7 +678,7 @@ static void new_waiter(ErtsPollSet ps)
w->active_events = 1;
w->highwater = 1;
w->total_events = 1;
- erts_mtx_init(&w->mtx, "pollwaiter");
+ erts_mtx_init(&w->mtx, "pollwaiter", NIL, ERTS_LOCK_FLAGS_CATEGORY_IO);
/*
@@ -706,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");
}
}
}
@@ -810,9 +843,9 @@ event_happened:
ASSERT(WAIT_OBJECT_0 < i && i < WAIT_OBJECT_0+w->active_events);
notify_io_ready(ps);
- /*
- * The main thread wont start working on our arrays untill we're
- * stopped, so we can work in peace although the main thread runs
+ /*
+ * The main thread wont start working on our arrays until we're
+ * stopped, so we can work in peace although the main thread runs
*/
ASSERT(i >= WAIT_OBJECT_0+1);
i -= WAIT_OBJECT_0;
@@ -1012,12 +1045,12 @@ void erts_poll_interrupt(ErtsPollSet ps, int set /* bool */)
void erts_poll_interrupt_timed(ErtsPollSet ps,
int set /* bool */,
- erts_short_time_t msec)
+ ErtsMonotonicTime timeout_time)
{
- HARDTRACEF(("In erts_poll_interrupt_timed(%d,%ld)",set,msec));
+ HARDTRACEF(("In erts_poll_interrupt_timed(%d,%ld)",set,timeout_time));
if (!set)
reset_interrupt(ps);
- else if (erts_smp_atomic32_read_acqb(&ps->timeout) > (erts_aint32_t) msec)
+ else if (get_timeout_time(ps) > timeout_time)
set_interrupt(ps);
HARDTRACEF(("Out erts_poll_interrupt_timed"));
}
@@ -1085,14 +1118,14 @@ void erts_poll_controlv(ErtsPollSet ps,
pcev[i].events,
pcev[i].on);
}
- ERTS_POLLSET_LOCK(ps);
+ ERTS_POLLSET_UNLOCK(ps);
HARDTRACEF(("Out erts_poll_controlv"));
}
int erts_poll_wait(ErtsPollSet ps,
ErtsPollResFd pr[],
int *len,
- SysTimeval *tvp)
+ ErtsMonotonicTime timeout_time)
{
int no_fds;
DWORD timeout;
@@ -1125,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);
@@ -1149,23 +1182,26 @@ int erts_poll_wait(ErtsPollSet ps,
no_fds = ERTS_POLL_MAX_RES;
#endif
- timeout = poll_wait_timeout(ps, tvp);
+ timeout = poll_wait_timeout(ps, timeout_time);
/*HARDDEBUGF(("timeout = %ld",(long) timeout));*/
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);
@@ -1183,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;
@@ -1242,7 +1278,7 @@ int erts_poll_wait(ErtsPollSet ps,
erts_mtx_unlock(&w->mtx);
}
done:
- erts_smp_atomic32_set_nob(&ps->timeout, ERTS_AINT32_T_MAX);
+ set_timeout_time(ps, ERTS_MONOTONIC_TIME_MAX);
*len = num;
ERTS_POLLSET_UNLOCK(ps);
HARDTRACEF(("Out erts_poll_wait"));
@@ -1324,9 +1360,9 @@ ErtsPollSet erts_poll_create_pollset(void)
erts_atomic32_init_nob(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN);
#ifdef ERTS_SMP
- erts_smp_mtx_init(&ps->mtx, "pollset");
+ erts_smp_mtx_init(&ps->mtx, "pollset", NIL, ERTS_LOCK_FLAGS_CATEGORY_IO);
#endif
- erts_smp_atomic32_init_nob(&ps->timeout, ERTS_AINT32_T_MAX);
+ init_timeout_time(ps);
HARDTRACEF(("Out erts_poll_create_pollset"));
return ps;
@@ -1376,7 +1412,8 @@ void erts_poll_init(void)
HARDTRACEF(("In erts_poll_init"));
erts_sys_break_event = CreateManualEvent(FALSE);
- erts_mtx_init(&break_waiter_lock,"break_waiter_lock");
+ erts_mtx_init(&break_waiter_lock, "break_waiter_lock", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_IO);
break_happened_event = CreateManualEvent(FALSE);
erts_atomic32_init_nob(&break_waiter_state, 0);
diff --git a/erts/emulator/sys/win32/erl_win32_sys_ddll.c b/erts/emulator/sys/win32/erl_win32_sys_ddll.c
index 338f0d7386..274133a346 100644
--- a/erts/emulator/sys/win32/erl_win32_sys_ddll.c
+++ b/erts/emulator/sys/win32/erl_win32_sys_ddll.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2006-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2006-2016. 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.
+ * 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%
*/
@@ -51,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 4010d939e5..6f28d513c2 100644
--- a/erts/emulator/sys/win32/erl_win_dyn_driver.h
+++ b/erts/emulator/sys/win32/erl_win_dyn_driver.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2003-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2003-2016. 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.
+ * 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%
*/
@@ -102,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));
@@ -144,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;
@@ -216,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;
@@ -327,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 \
@@ -462,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 a78dbf64af..78005aada9 100644
--- a/erts/emulator/sys/win32/erl_win_sys.h
+++ b/erts/emulator/sys/win32/erl_win_sys.h
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1997-2014. All Rights Reserved.
+ * Copyright Ericsson AB 1997-2016. 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.
+ * 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%
*/
@@ -113,18 +114,13 @@
/*
* Our own type of "FD's"
*/
+#define ERTS_SYS_FD_INVALID INVALID_HANDLE_VALUE
#define ERTS_SYS_FD_TYPE HANDLE
#define NO_FSTAT_ON_SYS_FD_TYPE 1 /* They are events, not files */
-#define HAVE_ERTS_CHECK_IO_DEBUG
-int erts_check_io_debug(void);
-
/*
* For erl_time_sup
*/
-#define HAVE_GETHRTIME
-
-#define sys_init_hrtime() /* Nothing */
#define SYS_CLK_TCK 1000
#define SYS_CLOCK_RESOLUTION 1
@@ -166,18 +162,97 @@ typedef struct {
#if defined (__GNUC__)
typedef unsigned long long Uint64;
typedef long long Sint64;
-
-typedef long long SysHrTime;
+# ifdef ULLONG_MAX
+# define ERTS_UINT64_MAX ULLONG_MAX
+# endif
+# ifdef LLONG_MAX
+# define ERTS_SINT64_MAX LLONG_MAX
+# endif
+# ifdef LLONG_MIN
+# define ERTS_SINT64_MIN LLONG_MIN
+# endif
+
+typedef long long ErtsMonotonicTime;
+typedef long long ErtsSysHrTime;
#else
typedef ULONGLONG Uint64;
typedef LONGLONG Sint64;
-typedef LONGLONG SysHrTime;
+typedef LONGLONG ErtsMonotonicTime;
+typedef LONGLONG ErtsSysHrTime;
#endif
-extern int sys_init_time(void);
+#define ErtsStrToSint64 _strtoi64
+
+typedef ErtsMonotonicTime ErtsSystemTime;
+typedef ErtsMonotonicTime ErtsSysPerfCounter;
+
+ErtsSystemTime erts_os_system_time(void);
+
+#define ERTS_MONOTONIC_TIME_MIN ((ErtsMonotonicTime) (1ULL << 63))
+#define ERTS_MONOTONIC_TIME_MAX (~ERTS_MONOTONIC_TIME_MIN)
+
+#define ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT 1
+#define ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT 0
+
+struct erts_sys_time_read_only_data__ {
+ ErtsMonotonicTime (*os_monotonic_time)(void);
+ void (*os_times)(ErtsMonotonicTime *, ErtsSystemTime*);
+ ErtsSysHrTime (*sys_hrtime)(void);
+};
+
+typedef struct {
+ union {
+ struct erts_sys_time_read_only_data__ o;
+ char align__[(((sizeof(struct erts_sys_time_read_only_data__) - 1)
+ / ASSUMED_CACHE_LINE_SIZE) + 1)
+ * ASSUMED_CACHE_LINE_SIZE];
+ } r;
+} ErtsSysTimeData__;
+
+extern ErtsSysTimeData__ erts_sys_time_data__;
+
+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
+
+ERTS_GLB_INLINE ErtsMonotonicTime
+erts_os_monotonic_time(void)
+{
+ return (*erts_sys_time_data__.r.o.os_monotonic_time)();
+}
+
+ERTS_GLB_INLINE void
+erts_os_times(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep)
+{
+ (*erts_sys_time_data__.r.o.os_times)(mtimep, stimep);
+}
+
+ERTS_GLB_INLINE ErtsSysHrTime
+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);
-extern SysHrTime sys_gethrtime(void);
extern clock_t sys_times(SysTimes *buffer);
extern char *win_build_environment(char *);
@@ -209,6 +284,8 @@ extern volatile int erl_fp_exception;
int _finite(double x);
#endif
+#define erts_isfinite _finite
+
/*#define NO_FPE_SIGNALS*/
#define erts_get_current_fp_exception() NULL
#define __ERTS_FP_CHECK_INIT(fpexnp) do {} while (0)
@@ -238,4 +315,16 @@ typedef long ssize_t;
int init_async(int);
int exit_async(void);
#endif
+
+#define ERTS_HAVE_TRY_CATCH 1
+
+#define ERTS_SYS_TRY_CATCH(EXPR,CATCH) \
+ __try { \
+ EXPR; \
+ } \
+ __except(GetExceptionCode() == EXCEPTION_ACCESS_VIOLATION ? EXCEPTION_EXECUTE_HANDLER : EXCEPTION_CONTINUE_SEARCH) \
+ { \
+ CATCH; \
+ }
+
#endif
diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c
index 0ded6b274e..15c59109b1 100755..100644
--- a/erts/emulator/sys/win32/sys.c
+++ b/erts/emulator/sys/win32/sys.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2014. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2017. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -37,9 +38,8 @@
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*, ...);
/*
* Microsoft-specific function to map a WIN32 error code to a Posix errno.
@@ -186,6 +186,12 @@ void sys_primitive_init(HMODULE beam)
beam_module = (HMODULE) beam;
}
+UWord
+erts_sys_get_page_size(void)
+{
+ return (UWord) 4*1024; /* Guess 4 KB */
+}
+
Uint
erts_sys_misc_mem_sz(void)
{
@@ -199,7 +205,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();
@@ -247,6 +253,27 @@ void erl_sys_args(int* argc, char** argv)
#endif
}
+/*
+ * Function returns 1 if we can read from all values in between
+ * start and stop.
+ */
+int
+erts_sys_is_area_readable(char *start, char *stop) {
+ volatile char tmp;
+ __try
+ {
+ while(start < stop) {
+ tmp = *start;
+ start++;
+ }
+ }
+ __except(EXCEPTION_EXECUTE_HANDLER)
+ {
+ return 0;
+ }
+ return 1;
+}
+
int erts_sys_prepare_crash_dump(int secs)
{
Port *heart_port;
@@ -273,6 +300,10 @@ int erts_sys_prepare_crash_dump(int secs)
return 0;
}
+int erts_set_signal(Eterm signal, Eterm type) {
+ return 0;
+}
+
static void
init_console(void)
{
@@ -471,7 +502,7 @@ struct driver_data {
int outBufSize; /* Size of output buffer. */
byte *outbuf; /* Buffer to use for overlapped write. */
ErlDrvPort port_num; /* The port handle. */
- int packet_bytes; /* 0: continous stream, 1, 2, or 4: the number
+ int packet_bytes; /* 0: continuous stream, 1, 2, or 4: the number
* of bytes in the packet header.
*/
HANDLE port_pid; /* PID of the port process. */
@@ -1312,10 +1343,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);
}
}
@@ -1392,39 +1421,46 @@ int parse_command(wchar_t* cmd){
return i;
}
-static BOOL need_quotes(wchar_t *str)
-{
- int in_quote = 0;
- int backslashed = 0;
- int naked_space = 0;
- while (*str != L'\0') {
- switch (*str) {
- case L'\\' :
- backslashed = !backslashed;
- break;
- case L'"':
- if (backslashed) {
- backslashed=0;
- } else {
- in_quote = !in_quote;
- }
- break;
- case L' ':
- backslashed = 0;
- if (!(backslashed || in_quote)) {
- naked_space++;
- }
- break;
- default:
- backslashed = 0;
+/*
+ * Translating of command line arguments to correct format. In the examples
+ * below the '' are not part of the actual string.
+ * 'io:format("hello").' -> 'io:format(\"hello\").'
+ * 'io:format("is anybody in there?").' -> '"io:format(\"is anybody in there?\")."'
+ * 'Just nod if you can hear me.' -> '"Just nod if you can hear me."'
+ * 'Is there ""anyone at home?' -> '"Is there \"\"anyone at home?"'
+ * 'Relax."' -> 'Relax.\"'
+ *
+ * If new == NULL we just calculate the length.
+ *
+ * The reason for having to quote all of the is because CreateProcessW removes
+ * one level of escaping since it takes a single long command line rather
+ * than the argument chunks that unix uses.
+ */
+static int escape_and_quote(wchar_t *str, wchar_t *new, BOOL *quoted) {
+ int i, j = 0;
+ if (new == NULL)
+ *quoted = FALSE;
+ else if (*quoted)
+ new[j++] = L'"';
+ for ( i = 0; str[i] != L'\0'; i++,j++) {
+ if (str[i] == L' ' && new == NULL && *quoted == FALSE) {
+ *quoted = TRUE;
+ j++;
}
- ++str;
+ /* check if we have to escape quotes */
+ if (str[i] == L'"') {
+ if (new) new[j] = L'\\';
+ j++;
+ }
+ if (new) new[j] = str[i];
+ }
+ if (*quoted) {
+ if (new) new[j] = L'"';
+ j++;
}
- return (naked_space > 0);
+ return j;
}
-
-
/*
*----------------------------------------------------------------------
@@ -1499,8 +1535,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';
@@ -1585,31 +1621,24 @@ create_child_process
wcscpy(appname, execPath);
}
if (argv == NULL) {
- BOOL orig_need_q = need_quotes(execPath);
+ BOOL orig_need_q;
wchar_t *ptr;
- int ocl = wcslen(execPath);
+ int ocl = escape_and_quote(execPath, NULL, &orig_need_q);
if (run_cmd) {
newcmdline = (wchar_t *) erts_alloc(ERTS_ALC_T_TMP,
- (ocl + ((orig_need_q) ? 3 : 1)
- + 11)*sizeof(wchar_t));
+ (ocl + 1 + 11)*sizeof(wchar_t));
memcpy(newcmdline,L"cmd.exe /c ",11*sizeof(wchar_t));
ptr = newcmdline + 11;
} else {
newcmdline = (wchar_t *) erts_alloc(ERTS_ALC_T_TMP,
- (ocl + ((orig_need_q) ? 3 : 1))*sizeof(wchar_t));
+ (ocl + 1)*sizeof(wchar_t));
ptr = (wchar_t *) newcmdline;
}
- if (orig_need_q) {
- *ptr++ = L'"';
- }
- memcpy(ptr,execPath,ocl*sizeof(wchar_t));
- ptr += ocl;
- if (orig_need_q) {
- *ptr++ = L'"';
- }
- *ptr = L'\0';
+ ptr += escape_and_quote(execPath, ptr, &orig_need_q);
+ ptr[0] = L'\0';
} else {
- int sum = 1; /* '\0' */
+ int sum = 0;
+ BOOL *qte = NULL;
wchar_t **ar = argv;
wchar_t *n;
wchar_t *save_arg0 = NULL;
@@ -1620,11 +1649,13 @@ create_child_process
if (run_cmd) {
sum += 11; /* cmd.exe /c */
}
+
+ while (*ar != NULL) ar++;
+ qte = erts_alloc(ERTS_ALC_T_TMP, (ar - argv)*sizeof(BOOL));
+
+ ar = argv;
while (*ar != NULL) {
- sum += wcslen(*ar);
- if (need_quotes(*ar)) {
- sum += 2; /* quotes */
- }
+ sum += escape_and_quote(*ar,NULL,qte+(ar - argv));
sum++; /* space */
++ar;
}
@@ -1636,26 +1667,18 @@ create_child_process
n += 11;
}
while (*ar != NULL) {
- int q = need_quotes(*ar);
- sum = wcslen(*ar);
- if (q) {
- *n++ = L'"';
- }
- memcpy(n,*ar,sum*sizeof(wchar_t));
- n += sum;
- if (q) {
- *n++ = L'"';
- }
+ n += escape_and_quote(*ar,n,qte+(ar - argv));
*n++ = L' ';
++ar;
}
- *(n-1) = L'\0';
+ *(n-1) = L'\0'; /* overwrite last space with '\0' */
if (save_arg0 != NULL) {
argv[0] = save_arg0;
}
+ erts_free(ERTS_ALC_T_TMP, qte);
}
- DEBUGF(("Creating child process: %s, createFlags = %d\n", newcmdline, createFlags));
+ DEBUGF((stderr,"Creating child process: %S, createFlags = %d\n", newcmdline, createFlags));
ok = CreateProcessW((wchar_t *) appname,
(wchar_t *) newcmdline,
NULL,
@@ -2190,7 +2213,7 @@ static void fd_stop(ErlDrvData data)
ASSERT(dp->out.flushEvent);
SetEvent(dp->out.flushEvent);
} while (WaitForSingleObject(dp->out.flushReplyEvent, 10) == WAIT_TIMEOUT
- || !(dp->out.flags & DF_THREAD_FLUSHED));
+ && !(dp->out.flags & DF_THREAD_FLUSHED));
}
}
@@ -2469,7 +2492,7 @@ output(ErlDrvData drv_data, char* buf, ErlDrvSizeT len)
* event object has been signaled, indicating that there is
* something to read on the corresponding file handle.
*
- * If the port is working in the continous stream mode (packet_bytes == 0),
+ * If the port is working in the continuous stream mode (packet_bytes == 0),
* whatever data read will be sent straight to Erlang.
*
* Results:
@@ -2510,7 +2533,7 @@ ready_input(ErlDrvData drv_data, ErlDrvEvent ready_event)
#endif
if (error == NO_ERROR) {
- if (pb == 0) { /* Continous stream. */
+ if (pb == 0) { /* Continuous stream. */
#ifdef DEBUG
DEBUGF(("ready_input: %d: ", bytesRead));
erl_bin_write(dp->inbuf, 16, bytesRead);
@@ -3065,6 +3088,8 @@ erl_bin_write(buf, sz, max)
}
}
+#endif /* DEBUG */
+
void
erl_assert_error(const char* expr, const char* func, const char* file, int line)
{
@@ -3080,7 +3105,6 @@ erl_assert_error(const char* expr, const char* func, const char* file, int line)
DebugBreak();
}
-#endif /* DEBUG */
static void
check_supported_os_version(void)
@@ -3094,13 +3118,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);
@@ -3157,25 +3181,38 @@ thr_create_prepare_child(void *vtcdp)
void
erts_sys_pre_init(void)
{
+#ifdef USE_THREADS
+ erts_thr_init_data_t eid = ERTS_THR_INIT_DATA_DEF_INITER;
+#endif
int_os_version.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
GetVersionEx(&int_os_version);
check_supported_os_version();
+
#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;
+
+#ifdef ERTS_ENABLE_LOCK_COUNT
+ erts_lcnt_pre_thr_init();
+#endif
- 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);
- erts_thr_init(&eid);
#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_init();
+ erts_lcnt_post_thr_init();
#endif
- }
+
+#ifdef ERTS_ENABLE_LOCK_CHECK
+ erts_lc_init();
#endif
+
+#endif /* USE_THREADS */
+
+ erts_init_sys_time_sup();
+
erts_smp_atomic_init_nob(&sys_misc_mem_sz, 0);
}
@@ -3251,6 +3288,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);
@@ -3258,9 +3301,9 @@ erts_sys_schedule_interrupt(int set)
#ifdef ERTS_SMP
void
-erts_sys_schedule_interrupt_timed(int set, erts_short_time_t msec)
+erts_sys_schedule_interrupt_timed(int set, ErtsMonotonicTime timeout_time)
{
- erts_check_io_interrupt_timed(set, msec);
+ erts_check_io_interrupt_timed(set, timeout_time);
}
#endif
diff --git a/erts/emulator/sys/win32/sys_env.c b/erts/emulator/sys/win32/sys_env.c
index 9f977ad6c8..8fcee1cbb6 100644
--- a/erts/emulator/sys/win32/sys_env.c
+++ b/erts/emulator/sys/win32/sys_env.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2002-2012. All Rights Reserved.
+ * Copyright Ericsson AB 2002-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -36,7 +37,8 @@ static erts_smp_rwmtx_t environ_rwmtx;
void
erts_sys_env_init(void)
{
- erts_smp_rwmtx_init(&environ_rwmtx, "environ");
+ erts_smp_rwmtx_init(&environ_rwmtx, "environ", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
}
int
diff --git a/erts/emulator/sys/win32/sys_float.c b/erts/emulator/sys/win32/sys_float.c
index 0e19746cf5..2b2d6ab7d3 100644
--- a/erts/emulator/sys/win32/sys_float.c
+++ b/erts/emulator/sys/win32/sys_float.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1997-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1997-2016. 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.
+ * 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%
*/
@@ -138,8 +139,7 @@ sys_double_to_chars_ext(double fp, char *buffer, size_t buffer_size, size_t deci
int
matherr(struct _exception *exc)
{
- erl_fp_exception = 1;
- DEBUGF(("FP exception (matherr) (0x%x) (%d)\n", exc->type, erl_fp_exception));
+ DEBUGF(("FP exception (matherr) (0x%x)\n", exc->type));
return 1;
}
diff --git a/erts/emulator/sys/win32/sys_interrupt.c b/erts/emulator/sys/win32/sys_interrupt.c
index 36c43e93da..df838960eb 100644
--- a/erts/emulator/sys/win32/sys_interrupt.c
+++ b/erts/emulator/sys/win32/sys_interrupt.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1997-2012. All Rights Reserved.
+ * Copyright Ericsson AB 1997-2016. 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.
+ * 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%
*/
@@ -80,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;
@@ -105,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;
@@ -132,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 b84c8f85ce..88131aaa6a 100644
--- a/erts/emulator/sys/win32/sys_time.c
+++ b/erts/emulator/sys/win32/sys_time.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1997-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1997-2016. 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.
+ * 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%
*/
@@ -25,6 +26,11 @@
#endif
#include "sys.h"
#include "assert.h"
+#include "erl_os_monotonic_time_extender.h"
+#include "erl_time.h"
+
+/* Need to look more closely at qpc before use... */
+#define ERTS_DISABLE_USE_OF_QPC_FOR_MONOTONIC_TIME 1
#define LL_LITERAL(X) ERTS_I64_LITERAL(X)
@@ -61,11 +67,6 @@
(epoch) = ((ull.QuadPart / TICKS_PER_SECOND) - EPOCH_JULIAN_DIFF); \
} while(0)
-static SysHrTime wrap = 0;
-static DWORD last_tick_count = 0;
-static erts_smp_mtx_t wrap_lock;
-static ULONGLONG (WINAPI *pGetTickCount64)(void) = NULL;
-
/* Getting timezone information is a heavy operation, so we want to do this
only once */
@@ -76,27 +77,349 @@ static int days_in_month[2][13] = {
{0,31,28,31,30,31,30,31,31,30,31,30,31},
{0,31,29,31,30,31,30,31,31,30,31,30,31}};
-int
-sys_init_time(void)
+#define ERTS_GET_TICK_COUNT_TIME_UNIT_SHIFT 10
+
+/*
+ * erts_os_monotonic_time()
+ */
+
+struct sys_time_internal_state_read_only__ {
+ ULONGLONG (WINAPI *pGetTickCount64)(void);
+ BOOL (WINAPI *pQueryPerformanceCounter)(LARGE_INTEGER *);
+ Sint32 pcf;
+ int using_get_tick_count_time_unit;
+};
+
+struct sys_time_internal_state_read_mostly__ {
+ ErtsOsMonotonicTimeExtendState os_mtime_xtnd;
+};
+
+struct sys_time_internal_state_write_freq__ {
+ erts_smp_mtx_t mtime_mtx;
+ ULONGLONG wrap;
+ ULONGLONG last_tick_count;
+};
+
+__declspec(align(ASSUMED_CACHE_LINE_SIZE)) struct {
+ union {
+ struct sys_time_internal_state_read_only__ o;
+ char align__[(((sizeof(struct sys_time_internal_state_read_only__) - 1)
+ / ASSUMED_CACHE_LINE_SIZE) + 1)
+ * ASSUMED_CACHE_LINE_SIZE];
+ } r;
+ union {
+ struct sys_time_internal_state_read_mostly__ m;
+ char align__[(((sizeof(struct sys_time_internal_state_read_mostly__) - 1)
+ / ASSUMED_CACHE_LINE_SIZE) + 1)
+ * ASSUMED_CACHE_LINE_SIZE];
+ } wr;
+ union {
+ struct sys_time_internal_state_write_freq__ f;
+ char align__[(((sizeof(struct sys_time_internal_state_write_freq__) - 1)
+ / ASSUMED_CACHE_LINE_SIZE) + 1)
+ * ASSUMED_CACHE_LINE_SIZE];
+ } w;
+} internal_state;
+
+__declspec(align(ASSUMED_CACHE_LINE_SIZE)) ErtsSysTimeData__ erts_sys_time_data__;
+
+
+static ERTS_INLINE ErtsSystemTime
+SystemTime2MilliSec(SYSTEMTIME *stp)
+{
+ ErtsSystemTime stime;
+ FILETIME ft;
+ ULARGE_INTEGER ull;
+
+ SystemTimeToFileTime(stp, &ft);
+ FILETIME_TO_ULI(ull,ft);
+ /* now in 100 ns units */
+ stime = (ErtsSystemTime) ull.QuadPart;
+ stime -= (((ErtsSystemTime) EPOCH_JULIAN_DIFF)
+ * ((ErtsSystemTime) (10*1000*1000)));
+ stime /= (ErtsSystemTime) (10*1000); /* ms */
+ return stime;
+}
+
+static ErtsMonotonicTime
+os_monotonic_time_qpc(void)
{
+ LARGE_INTEGER pc;
+
+ if (!(*internal_state.r.o.pQueryPerformanceCounter)(&pc))
+ erts_exit(ERTS_ABORT_EXIT, "QueryPerformanceCounter() failed\n");
+
+ return (ErtsMonotonicTime) pc.QuadPart;
+}
+
+static void
+os_times_qpc(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep)
+{
+ LARGE_INTEGER pc;
+ SYSTEMTIME st;
+ ErtsSystemTime stime;
+ BOOL qpcr;
+
+ qpcr = (*internal_state.r.o.pQueryPerformanceCounter)(&pc);
+ GetSystemTime(&st);
+
+ if (!qpcr)
+ erts_exit(ERTS_ABORT_EXIT, "QueryPerformanceCounter() failed\n");
+
+ *mtimep = (ErtsMonotonicTime) pc.QuadPart;
+
+ stime = SystemTime2MilliSec(&st);
+
+ *stimep = ((ErtsSystemTime)
+ erts_time_unit_conversion((Uint64) stime,
+ (Uint32) 1000,
+ internal_state.r.o.pcf));
+}
+
+static Uint32
+get_tick_count(void)
+{
+ return (Uint32) GetTickCount();
+}
+
+static ErtsMonotonicTime
+os_monotonic_time_gtc32(void)
+{
+ ErtsMonotonicTime mtime;
+ Uint32 ticks = (Uint32) GetTickCount();
+ ERTS_CHK_EXTEND_OS_MONOTONIC_TIME(&internal_state.wr.m.os_mtime_xtnd,
+ ticks);
+ mtime = ERTS_EXTEND_OS_MONOTONIC_TIME(&internal_state.wr.m.os_mtime_xtnd,
+ ticks);
+ mtime <<= ERTS_GET_TICK_COUNT_TIME_UNIT_SHIFT;
+ return mtime;
+}
+
+static void
+os_times_gtc32(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep)
+{
+ SYSTEMTIME st;
+ ErtsSystemTime stime, mtime;
+ Uint32 ticks;
+
+ ticks = (Uint32) GetTickCount();
+ GetSystemTime(&st);
+
+ ERTS_CHK_EXTEND_OS_MONOTONIC_TIME(&internal_state.wr.m.os_mtime_xtnd,
+ ticks);
+ mtime = ERTS_EXTEND_OS_MONOTONIC_TIME(&internal_state.wr.m.os_mtime_xtnd,
+ ticks);
+ mtime <<= ERTS_GET_TICK_COUNT_TIME_UNIT_SHIFT;
+ *mtimep = mtime;
+
+ stime = SystemTime2MilliSec(&st);
+ stime <<= ERTS_GET_TICK_COUNT_TIME_UNIT_SHIFT;
+ *stimep = stime;
+
+}
+
+static ErtsMonotonicTime
+os_monotonic_time_gtc64(void)
+{
+ ULONGLONG ticks = (*internal_state.r.o.pGetTickCount64)();
+ ErtsMonotonicTime mtime = (ErtsMonotonicTime) ticks;
+ return mtime << ERTS_GET_TICK_COUNT_TIME_UNIT_SHIFT;
+}
+
+static void
+os_times_gtc64(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep)
+{
+ SYSTEMTIME st;
+ ErtsSystemTime stime, mtime;
+ ULONGLONG ticks;
+
+ ticks = (*internal_state.r.o.pGetTickCount64)();
+ GetSystemTime(&st);
+
+ mtime = (ErtsMonotonicTime) ticks;
+ mtime <<= ERTS_GET_TICK_COUNT_TIME_UNIT_SHIFT;
+ *mtimep = mtime;
+
+ stime = SystemTime2MilliSec(&st);
+ stime <<= ERTS_GET_TICK_COUNT_TIME_UNIT_SHIFT;
+ *stimep = stime;
+}
+
+static ErtsSysHrTime
+sys_hrtime_qpc(void)
+{
+ LARGE_INTEGER pc;
+
+ if (!(*internal_state.r.o.pQueryPerformanceCounter)(&pc))
+ erts_exit(ERTS_ABORT_EXIT, "QueryPerformanceCounter() failed\n");
+
+ ASSERT(pc.QuadPart > 0);
+
+ return (ErtsSysHrTime) erts_time_unit_conversion((Uint64) pc.QuadPart,
+ internal_state.r.o.pcf,
+ (Uint32) 1000*1000*1000);
+}
+
+static ErtsSysHrTime
+sys_hrtime_gtc32(void)
+{
+ ErtsSysHrTime time;
+ Uint32 ticks = (Uint32) GetTickCount();
+ ERTS_CHK_EXTEND_OS_MONOTONIC_TIME(&internal_state.wr.m.os_mtime_xtnd,
+ tick_count);
+ time = (ErtsSysHrTime) ERTS_EXTEND_OS_MONOTONIC_TIME(&internal_state.wr.m.os_mtime_xtnd,
+ ticks);
+ time *= (ErtsSysHrTime) (1000 * 1000);
+ return time;
+}
+
+static ErtsSysHrTime
+sys_hrtime_gtc64(void)
+{
+ ErtsSysHrTime time = (*internal_state.r.o.pGetTickCount64)();
+ time *= (ErtsSysHrTime) (1000*1000);
+ return time;
+}
+
+/*
+ * Init
+ */
+
+void
+sys_init_time(ErtsSysInitTimeResult *init_resp)
+{
+ ErtsMonotonicTime (*os_mtime_func)(void);
+ void (*os_times_func)(ErtsMonotonicTime *, ErtsSystemTime *);
+ ErtsSysHrTime (*sys_hrtime_func)(void) = NULL;
+ ErtsMonotonicTime time_unit;
char kernel_dll_name[] = "kernel32";
HMODULE module;
+ init_resp->os_monotonic_time_info.clock_id = NULL;
+
module = GetModuleHandle(kernel_dll_name);
- pGetTickCount64 = (module != NULL) ?
- (ULONGLONG (WINAPI *)(void))
- GetProcAddress(module,"GetTickCount64") :
- NULL;
+ if (!module) {
+ get_tick_count:
+ erts_smp_mtx_init(&internal_state.w.f.mtime_mtx, "os_monotonic_time", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
+ internal_state.w.f.wrap = 0;
+ internal_state.w.f.last_tick_count = 0;
+
+ init_resp->os_monotonic_time_info.func = "GetTickCount";
+ init_resp->os_monotonic_time_info.locked_use = 0;
+ /* 10-16 ms resolution according to MicroSoft documentation */
+ init_resp->os_monotonic_time_info.resolution = 100; /* 10 ms */
+ time_unit = (ErtsMonotonicTime) 1000;
+ time_unit <<= ERTS_GET_TICK_COUNT_TIME_UNIT_SHIFT;
+ internal_state.r.o.using_get_tick_count_time_unit = 1;
+ os_mtime_func = os_monotonic_time_gtc32;
+ os_times_func = os_times_gtc32;
+ init_resp->os_monotonic_time_info.extended = 1;
+ erts_init_os_monotonic_time_extender(&internal_state.wr.m.os_mtime_xtnd,
+ get_tick_count,
+ 60*60*24*7); /* Check once a week */
+ if (!sys_hrtime_func)
+ sys_hrtime_func = sys_hrtime_gtc32;
+ }
+ else {
+ int major, minor, build;
+
+ os_version(&major, &minor, &build);
+
+ if (major < 6) {
+
+ get_tick_count64:
+
+ internal_state.r.o.pGetTickCount64
+ = ((ULONGLONG (WINAPI *)(void))
+ GetProcAddress(module, "GetTickCount64"));
+ if (!internal_state.r.o.pGetTickCount64)
+ goto get_tick_count;
+
+ init_resp->os_monotonic_time_info.func = "GetTickCount64";
+ init_resp->os_monotonic_time_info.locked_use = 0;
+ /* 10-16 ms resolution according to MicroSoft documentation */
+ init_resp->os_monotonic_time_info.resolution = 100; /* 10 ms */
+ time_unit = (ErtsMonotonicTime) 1000;
+ time_unit <<= ERTS_GET_TICK_COUNT_TIME_UNIT_SHIFT;
+ internal_state.r.o.using_get_tick_count_time_unit = 1;
+ os_mtime_func = os_monotonic_time_gtc64;
+ os_times_func = os_times_gtc64;
+ if (!sys_hrtime_func)
+ sys_hrtime_func = sys_hrtime_gtc64;
+ }
+ else { /* Vista or newer... */
+
+ LARGE_INTEGER pf;
+ BOOL (WINAPI *QPF)(LARGE_INTEGER *);
+
+ QPF = ((BOOL (WINAPI *)(LARGE_INTEGER *))
+ GetProcAddress(module, "QueryPerformanceFrequency"));
+ if (!QPF)
+ goto get_tick_count64;
+ if (!(*QPF)(&pf))
+ goto get_tick_count64;
+
+ internal_state.r.o.pQueryPerformanceCounter
+ = ((BOOL (WINAPI *)(LARGE_INTEGER *))
+ GetProcAddress(module, "QueryPerformanceCounter"));
+ if (!internal_state.r.o.pQueryPerformanceCounter)
+ goto get_tick_count64;
+
+ if (pf.QuadPart > (((LONGLONG) 1) << 32))
+ goto get_tick_count64;
+
+ internal_state.r.o.pcf = (Uint32) pf.QuadPart;
+ sys_hrtime_func = sys_hrtime_qpc;
+
+ /*
+ * We only use QueryPerformanceCounter() for
+ * os-monotonic-time if its frequency is equal
+ * to, or larger than GHz in order to ensure
+ * that the user wont be able to observe faulty
+ * order between values retrieved on different threads.
+ */
+ if (pf.QuadPart < (LONGLONG) 1000*1000*1000)
+ goto get_tick_count64;
+
+ if (ERTS_DISABLE_USE_OF_QPC_FOR_MONOTONIC_TIME)
+ goto get_tick_count64;
+
+ init_resp->os_monotonic_time_info.func = "QueryPerformanceCounter";
+ init_resp->os_monotonic_time_info.locked_use = 0;
+ time_unit = (ErtsMonotonicTime) pf.QuadPart;
+ internal_state.r.o.using_get_tick_count_time_unit = 0;
+ init_resp->os_monotonic_time_info.resolution = time_unit;
+ os_mtime_func = os_monotonic_time_qpc;
+ os_times_func = os_times_qpc;
+ }
+ }
+
+ 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;
+ init_resp->sys_clock_resolution = 1;
+
+ init_resp->os_system_time_info.func = "GetSystemTime";
+ init_resp->os_system_time_info.clock_id = NULL;
+ init_resp->os_system_time_info.resolution = 100;
+ init_resp->os_system_time_info.locked_use = 0;
if(GetTimeZoneInformation(&static_tzi) &&
static_tzi.StandardDate.wMonth != 0 &&
static_tzi.DaylightDate.wMonth != 0) {
have_static_tzi = 1;
}
+}
- erts_smp_mtx_init(&wrap_lock, "sys_gethrtime");
-
- return 1;
+void
+erts_late_sys_init_time(void)
+{
+ if (erts_sys_time_data__.r.o.os_monotonic_time == os_monotonic_time_gtc32)
+ erts_late_init_os_monotonic_time_extender(&internal_state.wr.m.os_mtime_xtnd);
}
/* Returns a switchtimes for DST as UTC filetimes given data from a
@@ -377,41 +700,27 @@ sys_gettimeofday(SysTimeval *tv)
EPOCH_JULIAN_DIFF);
}
-extern int erts_initialized;
-SysHrTime
-sys_gethrtime(void)
+ErtsSystemTime
+erts_os_system_time(void)
{
- if (pGetTickCount64 != NULL) {
- return ((SysHrTime) pGetTickCount64()) * LL_LITERAL(1000000);
- } else {
- DWORD ticks;
- SysHrTime res;
- erts_smp_mtx_lock(&wrap_lock);
- ticks = (SysHrTime) (GetTickCount() & 0x7FFFFFFF);
- if (ticks < (SysHrTime) last_tick_count) {
- /* Detect a race that should no longer be here... */
- if ((((SysHrTime) last_tick_count) - ((SysHrTime) ticks)) > 1000) {
- wrap += LL_LITERAL(1) << 31;
- } else {
- /*
- * XXX Debug: Violates locking order, remove all this,
- * after testing!
- */
- erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
- erts_dsprintf(dsbufp, "Did not wrap when last_tick %d "
- "and tick %d",
- last_tick_count, ticks);
- erts_send_error_to_logger_nogl(dsbufp);
- ticks = last_tick_count;
- }
- }
- last_tick_count = ticks;
- res = ((((LONGLONG) ticks) + wrap) * LL_LITERAL(1000000));
- erts_smp_mtx_unlock(&wrap_lock);
- return res;
+ SYSTEMTIME st;
+ ErtsSystemTime stime;
+
+ GetSystemTime(&st);
+ stime = SystemTime2MilliSec(&st);
+
+ if (internal_state.r.o.using_get_tick_count_time_unit) {
+ stime <<= ERTS_GET_TICK_COUNT_TIME_UNIT_SHIFT;
+ return stime;
}
+
+ return ((ErtsSystemTime)
+ erts_time_unit_conversion((Uint64) stime,
+ (Uint32) 1000,
+ internal_state.r.o.pcf));
}
+
clock_t
sys_times(SysTimes *buffer) {
clock_t kernel_ticks = (GetTickCount() /
diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile
index 0b0568c31a..b17170c8b8 100644
--- a/erts/emulator/test/Makefile
+++ b/erts/emulator/test/Makefile
@@ -1,18 +1,19 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1997-2012. All Rights Reserved.
+# Copyright Ericsson AB 1997-2017. 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/.
+# 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
#
-# 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.
+# 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%
#
@@ -31,6 +32,7 @@ MODULES= \
a_SUITE \
after_SUITE \
alloc_SUITE \
+ async_ports_SUITE \
beam_SUITE \
beam_literals_SUITE \
bif_SUITE \
@@ -51,6 +53,8 @@ MODULES= \
crypto_SUITE \
ddll_SUITE \
decode_packet_SUITE \
+ dirty_bif_SUITE \
+ dirty_nif_SUITE \
distribution_SUITE \
driver_SUITE \
efile_SUITE \
@@ -62,24 +66,31 @@ MODULES= \
exception_SUITE \
float_SUITE \
fun_SUITE \
- fun_r13_SUITE \
gc_SUITE \
guard_SUITE \
hash_SUITE \
hibernate_SUITE \
+ hipe_SUITE \
+ iovec_SUITE \
list_bif_SUITE \
+ lttng_SUITE \
+ lcnt_SUITE \
map_SUITE \
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 \
+ os_signal_SUITE \
port_SUITE \
port_bif_SUITE \
+ prim_eval_SUITE \
process_SUITE \
pseudoknot_SUITE \
receive_SUITE \
@@ -105,10 +116,12 @@ MODULES= \
trace_meta_SUITE \
trace_call_count_SUITE \
trace_call_time_SUITE \
+ tracer_SUITE \
+ tracer_test \
scheduler_SUITE \
- old_scheduler_SUITE \
+ port_trace_SUITE \
+ unique_SUITE \
z_SUITE \
- old_mod \
long_timers_test \
ignore_cores \
dgawd_handler \
@@ -123,7 +136,8 @@ NO_OPT= bs_bincomp \
bs_match_tail \
bs_match_misc \
bs_utf \
- guard
+ guard \
+ map
NATIVE= hibernate
@@ -142,7 +156,8 @@ EMAKEFILE=Emakefile
TEST_SPEC_FILES= emulator.spec \
emulator.spec.win \
emulator_bench.spec \
- emulator_smoke.spec
+ emulator_smoke.spec \
+ emulator_node_container_SUITE.spec
# ----------------------------------------------------
# Release directory specification
@@ -153,7 +168,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 195c9c0a5f..5b04a15b85 100644
--- a/erts/emulator/test/a_SUITE.erl
+++ b/erts/emulator/test/a_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2017. 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.
+%% 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%
%%
@@ -26,94 +27,77 @@
%%%-------------------------------------------------------------------
-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, init_per_suite/1, end_per_suite/1,
+ leaked_processes/1, long_timers/1, pollset_size/1]).
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]}].
-all() ->
- [long_timers, pollset_size].
+all() ->
+ [leaked_processes, long_timers, pollset_size].
-groups() ->
- [].
+%% Start some system servers now to avoid having them
+%% reported as leaks.
-init_per_suite(Config) ->
- Config.
+init_per_suite(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"),
-end_per_suite(_Config) ->
- ok.
+ %% Start the timer server.
+ timer:start(),
-init_per_group(_GroupName, Config) ->
Config.
-end_per_group(_GroupName, Config) ->
+end_per_suite(Config) when is_list(Config) ->
Config.
+leaked_processes(Config) when is_list(Config) ->
+ Parent = self(),
+ Go = make_ref(),
+ spawn(fun () ->
+ Name = leaked_processes__process_holder,
+ true = register(Name, self()),
+ Ps = processes(),
+ Parent ! Go,
+ receive
+ {get_initial_processes, Pid} ->
+ Pid ! {initial_processes, Ps}
+ 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:leaked_processes/1 testcase."}.
-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/1 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/1 testcase."}.
%%
%% Internal functions...
%%
-display_check_io(ChkIo) ->
- catch erlang:display('--- CHECK IO INFO ---'),
- catch erlang:display(ChkIo),
- catch erts_debug:set_internal_state(available_internal_state, true),
- NoOfErrorFds = (catch erts_debug:get_internal_state(check_io_debug)),
- catch erlang:display({'NoOfErrorFds', NoOfErrorFds}),
- catch erts_debug:set_internal_state(available_internal_state, false),
- catch erlang:display('--- CHECK IO INFO ---'),
- ok.
-
get_check_io_info() ->
- ChkIo = erlang:system_info(check_io),
- case lists:keysearch(pending_updates, 1, ChkIo) of
- {value, {pending_updates, 0}} ->
- display_check_io(ChkIo),
- ChkIo;
- false ->
- ChkIo;
- _ ->
- receive after 10 -> ok end,
- get_check_io_info()
- end.
-
-
+ z_SUITE:get_check_io_info().
diff --git a/erts/emulator/test/after_SUITE.erl b/erts/emulator/test/after_SUITE.erl
index 7cc329cc69..8a34195e8d 100644
--- a/erts/emulator/test/after_SUITE.erl
+++ b/erts/emulator/test/after_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2011. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2017. 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.
+%% 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%
%%
@@ -21,98 +22,68 @@
%% 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]).
-
--export([init_per_testcase/2, end_per_testcase/2]).
+ multi_timeout/1, receive_after_32bit/1,
+ receive_after_blast/1]).
%% 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].
-
-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).
+ multi_timeout, receive_after_32bit, receive_after_blast].
%% 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:now(),
+ Frequent = spawn_link(fun frequent_process/0),
+ Period = test_server:minutes(1),
+ Before = erlang:monotonic_time(),
receive
- after Period ->
- ?line After = erlang:now(),
- ?line report(Period, Before, After)
- end.
-
+ after Period ->
+ After = erlang:monotonic_time(),
+ unlink(Frequent),
+ exit(Frequent, die),
+ report(Period, Before, After)
+ end.
report(Period, Before, After) ->
- ?line Elapsed = (element(1, After)*1000000000
- +element(2, After)*1000
- +element(3, After) div 1000) -
- (element(1,Before)*1000000000
- + element(2,Before)*1000 + element(3,Before) div 1000),
- ?line case Elapsed*100 / Period of
- Percent when Percent > 100.10 ->
- ?line test_server:fail({too_inaccurate, Percent});
- Percent when Percent < 100.0 ->
- ?line test_server:fail({too_early, Percent});
- Percent ->
- ?line Comment = io_lib:format("Elapsed/expected: ~.2f %",
- [Percent]),
- {comment, lists:flatten(Comment)}
- end.
+ case erlang:convert_time_unit(After - Before, native, 100*1000) / Period of
+ 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.
@@ -124,14 +95,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(),
@@ -152,38 +123,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.
@@ -193,44 +164,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
@@ -251,4 +221,26 @@ recv_after_32bit(I, T) when I rem 2 =:= 0 ->
receive after T -> exit(timeout) end;
recv_after_32bit(_, _) ->
receive after 16#ffffFFFF -> exit(timeout) end.
-
+
+blaster() ->
+ receive
+ {go, TimeoutTime} ->
+ Tmo = TimeoutTime - erlang:monotonic_time(millisecond),
+ receive after Tmo -> ok end
+ end.
+
+spawn_blasters(0) ->
+ [];
+spawn_blasters(N) ->
+ [spawn_monitor(fun () -> blaster() end)|spawn_blasters(N-1)].
+
+receive_after_blast(Config) when is_list(Config) ->
+ PMs = spawn_blasters(10000),
+ TimeoutTime = erlang:monotonic_time(millisecond) + 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).
diff --git a/erts/emulator/test/alloc_SUITE.erl b/erts/emulator/test/alloc_SUITE.erl
index 35c44c229a..3a721095e2 100644
--- a/erts/emulator/test/alloc_SUITE.erl
+++ b/erts/emulator/test/alloc_SUITE.erl
@@ -1,25 +1,25 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2003-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2003-2016. 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.
+%% 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(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,
@@ -30,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.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -75,56 +54,51 @@ end_per_testcase(_Case, Config) when is_list(Config) ->
%% Testcases %%
%% %%
-basic(suite) -> [];
-basic(doc) -> [];
-basic(Cfg) -> ?line drv_case(Cfg).
-
-coalesce(suite) -> [];
-coalesce(doc) -> [];
-coalesce(Cfg) -> ?line drv_case(Cfg).
-
-threads(suite) -> [];
-threads(doc) -> [];
-threads(Cfg) -> ?line drv_case(Cfg).
-
-realloc_copy(suite) -> [];
-realloc_copy(doc) -> [];
-realloc_copy(Cfg) -> ?line drv_case(Cfg).
-
-bucket_index(suite) -> [];
-bucket_index(doc) -> [];
-bucket_index(Cfg) -> ?line drv_case(Cfg).
-
-bucket_mask(suite) -> [];
-bucket_mask(doc) -> [];
-bucket_mask(Cfg) -> ?line drv_case(Cfg).
-
-rbtree(suite) -> [];
-rbtree(doc) -> [];
-rbtree(Cfg) -> ?line drv_case(Cfg).
-
-mseg_clear_cache(suite) -> [];
-mseg_clear_cache(doc) -> [];
-mseg_clear_cache(Cfg) -> ?line drv_case(Cfg).
-
-cpool(suite) -> [];
-cpool(doc) -> [];
-cpool(Cfg) -> ?line drv_case(Cfg).
+basic(Cfg) -> drv_case(Cfg).
+coalesce(Cfg) -> drv_case(Cfg).
+threads(Cfg) -> drv_case(Cfg).
+realloc_copy(Cfg) -> drv_case(Cfg).
+bucket_index(Cfg) -> drv_case(Cfg).
+bucket_mask(Cfg) -> drv_case(Cfg).
+rbtree(Cfg) -> drv_case(Cfg).
+mseg_clear_cache(Cfg) -> 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 {os:type(), mmsc_flags()} of
+ {{unix,_}, false} ->
[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,
+ {{unix,_}, Flags} ->
+ {skipped, Flags};
+ {{SkipOs,_},_} ->
+ {skipped,
lists:flatten(["Not run on "
| io_lib:format("~p",[SkipOs])])}
end.
+%% Check if there are ERL_FLAGS set that will mess up this test case
+mmsc_flags() ->
+ case mmsc_flags("ERL_FLAGS") of
+ false -> mmsc_flags("ERL_ZFLAGS");
+ Flags -> Flags
+ end.
+mmsc_flags(Env) ->
+ case os:getenv(Env) of
+ false -> false;
+ V -> case string:str(V, "+MMsc") of
+ 0 -> false;
+ P -> Env ++ "=" ++ string:substr(V, P)
+ end
+ end.
erts_mmap_do(Config, SCO, SCRPM, SCRFSD) ->
%% We use the number of schedulers + 1 * approx main carriers size
@@ -143,25 +117,26 @@ erts_mmap_do(Config, SCO, SCRPM, SCRFSD) ->
{ok, Node} = start_node(Config, Opts),
Self = self(),
Ref = make_ref(),
- F = fun () ->
- SI = erlang:system_info({allocator,mseg_alloc}),
- {erts_mmap,EM} = lists:keyfind(erts_mmap, 1, SI),
- {supercarrier,SC} = lists:keyfind(supercarrier, 1, EM),
- {sizes,Sizes} = lists:keyfind(sizes, 1, SC),
- {free_segs,Segs} = lists:keyfind(free_segs,1,SC),
- {total,Total} = lists:keyfind(total,1,Sizes),
- Total = SCS*1024*1024,
-
- {reserved,Reserved} = lists:keyfind(reserved,1,Segs),
- true = (Reserved >= SCRFSD),
-
- case {SCO,lists:keyfind(os,1,EM)} of
- {true, false} -> ok;
- {false, {os,_}} -> ok
- end,
-
- Self ! {Ref, ok}
- end,
+ F = fun() ->
+ SI = erlang:system_info({allocator,erts_mmap}),
+ {default_mmap,EM} = lists:keyfind(default_mmap, 1, SI),
+ {supercarrier,SC} = lists:keyfind(supercarrier, 1, EM),
+ {sizes,Sizes} = lists:keyfind(sizes, 1, SC),
+ {free_segs,Segs} = lists:keyfind(free_segs,1,SC),
+ {total,Total} = lists:keyfind(total,1,Sizes),
+ io:format("Expecting total ~w, got ~w~n", [SCS*1024*1024,Total]),
+ Total = SCS*1024*1024,
+
+ {reserved,Reserved} = lists:keyfind(reserved,1,Segs),
+ true = (Reserved >= SCRFSD),
+
+ case {SCO,lists:keyfind(os,1,EM)} of
+ {true, false} -> ok;
+ {false, {os,_}} -> ok
+ end,
+
+ Self ! {Ref, ok}
+ end,
spawn_link(Node, F),
Result = receive {Ref, Rslt} -> Rslt end,
@@ -175,91 +150,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 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) ->
- ?line Pa = filename:dirname(code:which(?MODULE)),
- ?line {A, B, C} = now(),
- ?line Name = list_to_atom(atom_to_list(?MODULE)
- ++ "-"
- ++ atom_to_list(?config(testcase, Config))
- ++ "-"
- ++ integer_to_list(A)
- ++ "-"
- ++ integer_to_list(B)
- ++ "-"
- ++ integer_to_list(C)),
- ?line ?t:start_node(Name, slave, [{args, Opts++" -pa "++Pa}]).
+ 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(proplists:get_value(testcase, Config))
+ ++ "-"
+ ++ integer_to_list(erlang:system_time(second))
+ ++ "-"
+ ++ integer_to_list(erlang:unique_integer([positive]))),
+ 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 1d4286e671..e31de54e1b 100644
--- a/erts/emulator/test/alloc_SUITE_data/Makefile.src
+++ b/erts/emulator/test/alloc_SUITE_data/Makefile.src
@@ -1,13 +1,14 @@
-# ``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 via the world wide web 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.
+# ``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.
#
# The Initial Developer of the Original Code is Ericsson Utvecklings AB.
# Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
@@ -24,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 2d6c5f9dc7..97ee58cdad 100644
--- a/erts/emulator/test/alloc_SUITE_data/allocator_test.h
+++ b/erts/emulator/test/alloc_SUITE_data/allocator_test.h
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
@@ -19,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
@@ -84,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)))
@@ -141,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 0c27665712..debb3d7ebe 100644
--- a/erts/emulator/test/alloc_SUITE_data/basic.c
+++ b/erts/emulator/test/alloc_SUITE_data/basic.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
@@ -59,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 32fd16fc10..45cb53fbf7 100644
--- a/erts/emulator/test/alloc_SUITE_data/bucket_index.c
+++ b/erts/emulator/test/alloc_SUITE_data/bucket_index.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
@@ -112,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 34979cacf1..c94c265f4e 100644
--- a/erts/emulator/test/alloc_SUITE_data/bucket_mask.c
+++ b/erts/emulator/test/alloc_SUITE_data/bucket_mask.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
@@ -51,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;
@@ -182,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 9da49a0d14..7791409a34 100644
--- a/erts/emulator/test/alloc_SUITE_data/coalesce.c
+++ b/erts/emulator/test/alloc_SUITE_data/coalesce.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
@@ -316,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 276ed7be04..0c41f4d747 100644
--- a/erts/emulator/test/alloc_SUITE_data/cpool.c
+++ b/erts/emulator/test/alloc_SUITE_data/cpool.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2013. All Rights Reserved.
+ * Copyright Ericsson AB 2013-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -85,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]));
}
@@ -128,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;
}
}
@@ -155,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..b9a4de03b3
--- /dev/null
+++ b/erts/emulator/test/alloc_SUITE_data/migration.c
@@ -0,0 +1,343 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2014-2016. 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 7d5608f890..e5df3d647f 100644
--- a/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.c
+++ b/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
@@ -100,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 49df2f0245..38bbbdf90c 100644
--- a/erts/emulator/test/alloc_SUITE_data/rbtree.c
+++ b/erts/emulator/test/alloc_SUITE_data/rbtree.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
@@ -19,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)
@@ -264,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;
}
@@ -467,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");
@@ -576,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 12454c75e4..c4147eb00d 100644
--- a/erts/emulator/test/alloc_SUITE_data/realloc_copy.c
+++ b/erts/emulator/test/alloc_SUITE_data/realloc_copy.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
@@ -277,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 5c4b11454f..7dcca544e5 100644
--- a/erts/emulator/test/alloc_SUITE_data/testcase_driver.c
+++ b/erts/emulator/test/alloc_SUITE_data/testcase_driver.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
@@ -22,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;
- itcs->visible.command = buf;
- itcs->visible.command_len = len;
+ if (!enif_get_resource(env, argv[0], testcase_rt, (void**)&itcs))
+ return enif_make_badarg(env);
- if (setjmp(itcs->done_jmp_buf) == 0) {
- testcase_run((TestCaseState_t *) itcs);
+ itcs->visible.curr_env = env;
+
+ /* 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
@@ -171,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[2] = ERL_DRV_PORT;
- msg[3] = itcs->port_id;
-
- msg[4] = ERL_DRV_ATOM;
- msg[5] = driver_mk_atom(itcs->visible.testcase_name);
+ msg = enif_make_tuple2(msg_env, print_atom,
+ enif_make_string(msg_env, itcs->comment_buf, ERL_NIF_LATIN1));
- msg[6] = ERL_DRV_STRING;
- msg[7] = (ErlDrvTermData) itcs->comment_buf;
- msg[8] = (ErlDrvTermData) strlen(itcs->comment_buf);
+ enif_send(itcs->visible.curr_env, enif_self(itcs->visible.curr_env, &pid),
+ msg_env, msg);
- msg[9] = ERL_DRV_TUPLE;
- msg[10] = (ErlDrvTermData) 4;
-
- erl_drv_output_term(itcs->port_id, msg, 11);
+ enif_free_env(msg_env);
}
@@ -207,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, ...)
@@ -225,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, ...)
@@ -245,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 66d567cb44..2b742dd7e3 100644
--- a/erts/emulator/test/alloc_SUITE_data/testcase_driver.h
+++ b/erts/emulator/test/alloc_SUITE_data/testcase_driver.h
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
@@ -19,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;
@@ -33,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);
@@ -44,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 1247e5d7dd..44d982b6c7 100644
--- a/erts/emulator/test/alloc_SUITE_data/threads.c
+++ b/erts/emulator/test/alloc_SUITE_data/threads.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
@@ -85,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);
@@ -95,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;
@@ -154,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;
@@ -163,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));
@@ -186,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;
}
@@ -396,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]);
@@ -406,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);
@@ -445,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
new file mode 100644
index 0000000000..f0f5fb5687
--- /dev/null
+++ b/erts/emulator/test/async_ports_SUITE.erl
@@ -0,0 +1,117 @@
+-module(async_ports_SUITE).
+
+-export([all/0, suite/0]).
+-export([permanent_busy_test/1]).
+-export([run_loop/5]).
+
+-include_lib("common_test/include/ct.hrl").
+
+-define(PACKET_SIZE, (10 * 1024 * 8)).
+-define(CPORT_DELAY, 100).
+-define(TEST_LOOPS_COUNT, 100000).
+-define(SLEEP_BEFORE_CHECK, 1000).
+-define(TEST_PROCS_COUNT, 2).
+-define(TC_TIMETRAP_SECONDS, 10).
+
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {seconds, ?TC_TIMETRAP_SECONDS}}].
+
+all() ->
+ [permanent_busy_test].
+
+permanent_busy_test(Config) ->
+ ExePath = filename:join(proplists:get_value(data_dir, Config), "cport"),
+ Self = self(),
+ spawn_link(
+ fun() ->
+ Block = <<0:?PACKET_SIZE>>,
+
+ Port = open_port(ExePath),
+
+ 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),
+
+ receive
+ {test_info, Port, Testers} ->
+ MaxWaitTime = round(0.7 * ?TC_TIMETRAP_SECONDS * 1000),
+ ct:log("wait testers, maximum ~w mcsec~n", [MaxWaitTime]),
+ ok = wait_testers(MaxWaitTime, Testers),
+ timer:sleep(?SLEEP_BEFORE_CHECK),
+ case erlang:port_command(Port, <<"test">>, [nosuspend]) of
+ false ->
+ exit(port_dead);
+ true ->
+ ok
+ end
+ end.
+
+wait_testers(Timeout, Testers) ->
+ lists:foldl(
+ fun(Pid, AccIn) ->
+ StartWait = os:timestamp(),
+ receive
+ {Pid, port_dead} ->
+ recalc_timeout(AccIn, StartWait)
+ after AccIn ->
+ Pid ! stop,
+ recalc_timeout(AccIn, StartWait)
+ end
+ end, Timeout, Testers),
+ ok.
+
+recalc_timeout(TimeoutIn, WaitStart) ->
+ erlang:max(0, TimeoutIn - round(timer:now_diff(os:timestamp(), WaitStart)) div 1000).
+
+open_port(ExePath) ->
+ erlang:open_port({spawn, ExePath ++ " 100"}, [{packet, 4}, eof, exit_status, use_stdio, binary]).
+
+run_loop(RootProc, Port, Block, CheckLimit, BusyCnt) ->
+ receive
+ stop ->
+ ok
+ after 0 ->
+ case erlang:port_command(Port, Block, [nosuspend]) of
+ true ->
+ run_loop(RootProc, Port, Block, CheckLimit, 0);
+ false ->
+ if
+ BusyCnt + 1 > CheckLimit ->
+ check_dead(RootProc, Port, Block, CheckLimit);
+ true ->
+ run_loop(RootProc, Port, Block, CheckLimit, BusyCnt + 1)
+ end
+ end
+ end.
+
+check_dead(RootProc, Port, Block, CheckLimit) ->
+ ct:log("~p: check port dead~n", [self()]),
+ timer:sleep(?SLEEP_BEFORE_CHECK),
+ case erlang:port_command(Port, Block, [nosuspend]) of
+ true ->
+ ct:log("not dead~n"),
+ run_loop(RootProc, Port, Block, CheckLimit, 0);
+ false ->
+ ct:log("port dead: ~p~n", [Port]),
+ RootProc ! {self(), port_dead},
+ ok
+ end.
+
+endless_flush(Port) ->
+ receive
+ {Port, {data, _}} ->
+ endless_flush(Port);
+ {Port, SomethingWrong} ->
+ erlang:error({someting_wrong, SomethingWrong})
+ end.
diff --git a/erts/emulator/test/async_ports_SUITE_data/Makefile.src b/erts/emulator/test/async_ports_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..56da3fbe12
--- /dev/null
+++ b/erts/emulator/test/async_ports_SUITE_data/Makefile.src
@@ -0,0 +1,15 @@
+CC = @CC@
+LD = @LD@
+CFLAGS = @CFLAGS@ @DEFS@
+CROSSLDFLAGS = @CROSSLDFLAGS@
+
+PROGS = cport@exe@
+
+
+all: $(PROGS)
+
+cport@exe@: cport@obj@
+ $(LD) $(CROSSLDFLAGS) -o cport cport@obj@ @LIBS@
+
+cport@obj@: cport.c
+ $(CC) -c -o cport@obj@ $(CFLAGS) cport.c
diff --git a/erts/emulator/test/async_ports_SUITE_data/cport.c b/erts/emulator/test/async_ports_SUITE_data/cport.c
new file mode 100644
index 0000000000..033aff382a
--- /dev/null
+++ b/erts/emulator/test/async_ports_SUITE_data/cport.c
@@ -0,0 +1,81 @@
+#include <stdlib.h>
+#include <stdio.h>
+#include <errno.h>
+#include <string.h>
+#ifdef __WIN32__
+# include "windows.h"
+# include "winbase.h"
+#else
+# include <unistd.h>
+#endif
+
+typedef unsigned char byte;
+
+int read_cmd(byte *buf)
+{
+ int len;
+ if (read_exact(buf, 4) != 4)
+ return(-1);
+
+ len = (buf[0] << 24) | (buf[1] << 16) | (buf[2] << 8) | buf[3];
+ return read_exact(buf, len);
+}
+
+int write_cmd(byte *buf, int len)
+{
+ byte li[4];
+ li[0] = (len >> 24) & 0xff;
+ li[1] = (len >> 16) & 0xff;
+ li[2] = (len >> 8) & 0xff;
+ li[3] = len & 0xff;
+ write_exact(&li, 4);
+
+ return write_exact(buf, len);
+}
+
+int read_exact(byte *buf, int len)
+{
+ int i, got=0;
+ do {
+ if ((i = read(0, buf+got, len-got)) <= 0)
+ {
+ return(i);
+ }
+ got += i;
+ } while (got<len);
+ return len;
+}
+
+int write_exact(byte *buf, int len)
+{
+ int i, wrote = 0;
+ do {
+ if ((i = write(1, buf+wrote, len-wrote)) < 0)
+ return (i);
+ wrote += i;
+ } while (wrote<len);
+ return len;
+}
+
+byte static_buf[31457280]; // 30 mb
+
+int main(int argc, char **argv) {
+ int sleep_time = atoi(argv[1]);
+ int fn, arg, res;
+ byte *buf = &static_buf[0];
+ int len = 0;
+ if (sleep_time <= 0)
+ sleep_time = 0;
+#ifdef __WIN32__
+ else
+ sleep_time = ((sleep_time - 1) / 1000) + 1; /* Milli seconds */
+#endif
+ while ((len = read_cmd(buf)) > 0) {
+#ifdef __WIN32__
+ Sleep((DWORD) sleep_time);
+#else
+ usleep(sleep_time);
+#endif
+ write_cmd(buf, len);
+ }
+}
diff --git a/erts/emulator/test/beam_SUITE.erl b/erts/emulator/test/beam_SUITE.erl
index 60339ea422..6a54fa87e0 100644
--- a/erts/emulator/test/beam_SUITE.erl
+++ b/erts/emulator/test/beam_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1998-2016. 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/.
+%% 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
%%
-%% 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.
+%% 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%
%%
@@ -23,17 +24,19 @@
init_per_group/2,end_per_group/2,
packed_registers/1, apply_last/1, apply_last_bif/1,
buildo_mucho/1, heap_sizes/1, big_lists/1, fconv/1,
- select_val/1]).
+ select_val/1, swap_temp_apply/1]).
--export([applied/2]).
+-export([applied/2,swap_temp_applied/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
+-include_lib("syntax_tools/include/merl.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
[packed_registers, apply_last, apply_last_bif,
- buildo_mucho, heap_sizes, big_lists, select_val].
+ buildo_mucho, heap_sizes, big_lists, select_val,
+ swap_temp_apply].
groups() ->
[].
@@ -60,15 +63,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.
@@ -91,49 +94,46 @@ applied(Starter, N) ->
apply_last_bif(Config) when is_list(Config) ->
apply(erlang, abs, [1]).
-%% Test three high register numbers in a put_list instruction
-%% (to test whether packing works properly).
+%% Test whether packing works properly.
packed_registers(Config) when is_list(Config) ->
- PrivDir = ?config(priv_dir, Config),
- Mod = packed_regs,
- Name = filename:join(PrivDir, atom_to_list(Mod) ++ ".erl"),
-
- %% Generate a module which generates a list of tuples.
- %% put_list(A) -> [{A, 600}, {A, 999}, ... {A, 0}].
- Code = gen_packed_regs(600, ["-module("++atom_to_list(Mod)++").\n",
- "-export([put_list/1]).\n",
- "put_list(A) ->\n["]),
- ok = file:write_file(Name, Code),
-
- %% Compile the module.
- io:format("Compiling: ~s\n", [Name]),
- CompRc = compile:file(Name, [{outdir, PrivDir}, report]),
- io:format("Result: ~p\n",[CompRc]),
- {ok, Mod} = CompRc,
-
- %% Load it.
- io:format("Loading...\n",[]),
- LoadRc = code:load_abs(filename:join(PrivDir, atom_to_list(Mod))),
- {module,_Module} = LoadRc,
-
- %% Call it and verify result.
- Term = {a, b},
- L = Mod:put_list(Term),
- verify_packed_regs(L, Term, 600),
+ Mod = ?FUNCTION_NAME,
+
+ %% Generate scrambled sequence.
+ Seq0 = [{erlang:phash2(I),I} || I <- lists:seq(0, 260)],
+ Seq = [I || {_,I} <- lists:sort(Seq0)],
+
+ %% Generate a test modules that uses get_list/3 instructions
+ %% with high register numbers.
+ S0 = [begin
+ VarName = list_to_atom("V"++integer_to_list(V)),
+ {merl:var(VarName),V}
+ end || V <- Seq],
+ Vars = [V || {V,_} <- S0],
+ NewVars = [begin
+ VarName = list_to_atom("M"++integer_to_list(V)),
+ merl:var(VarName)
+ end || V <- Seq],
+ S = [?Q("_@Var = id(_@Value@)") || {Var,Value} <- S0],
+ Code = ?Q(["-module('@Mod@').\n"
+ "-export([f/0]).\n"
+ "f() ->\n"
+ "_@S,\n"
+ "_ = id(0),\n"
+ "L = [_@Vars],\n"
+ "_ = id(1),\n"
+ "[_@NewVars] = L,\n" %Test get_list/3.
+ "_ = id(2),\n"
+ "id([_@Vars,_@NewVars]).\n"
+ "id(I) -> I.\n"]),
+ merl:compile_and_load(Code),
+ CombinedSeq = Seq ++ Seq,
+ CombinedSeq = Mod:f(),
+
+ %% Clean up.
+ true = code:delete(Mod),
+ false = code:purge(Mod),
ok.
-gen_packed_regs(0, Acc) ->
- [Acc|"{A,0}].\n"];
-gen_packed_regs(N, Acc) ->
- gen_packed_regs(N-1, [Acc,"{A,",integer_to_list(N)|"},\n"]).
-
-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().
-
buildo_mucho(Config) when is_list(Config) ->
buildo_mucho_1(),
ok.
@@ -318,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
@@ -346,3 +346,41 @@ do_select_val(X) ->
Int when is_integer(Int) ->
integer
end.
+
+swap_temp_apply(_Config) ->
+ {swap_temp_applied,42} = do_swap_temp_apply(41),
+ not_an_integer = do_swap_temp_apply(not_an_integer),
+ ok.
+
+do_swap_temp_apply(Msg) ->
+ case swap_temp_apply_function(Msg) of
+ undefined -> Msg;
+ Type ->
+ %% The following sequence:
+ %% move {x,0} {x,2}
+ %% move {y,0} {x,0}
+ %% move {x,2} {y,0}
+ %% apply 1
+ %%
+ %% Would be incorrectly transformed to:
+ %% swap {x,0} {y,0}
+ %% apply 1
+ %%
+ %% ({x,1} is the module, {x,2} the function to be applied).
+ %%
+ %% If the instructions are to be transformed, the correct
+ %% transformation is:
+ %%
+ %% swap_temp {x,0} {y,0} {x,2}
+ %% apply 1
+ Fields = ?MODULE:Type(Msg),
+ {Type,Fields}
+ end.
+
+swap_temp_apply_function(Int) when is_integer(Int) ->
+ swap_temp_applied;
+swap_temp_apply_function(_) ->
+ undefined.
+
+swap_temp_applied(Int) ->
+ Int+1.
diff --git a/erts/emulator/test/beam_literals_SUITE.erl b/erts/emulator/test/beam_literals_SUITE.erl
index 85236e4203..09761263e2 100644
--- a/erts/emulator/test/beam_literals_SUITE.erl
+++ b/erts/emulator/test/beam_literals_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2011. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2016. 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.
+%% 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%
%%
@@ -27,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]}].
@@ -54,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)).
@@ -63,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;
@@ -89,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;
@@ -116,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),
@@ -136,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),
@@ -158,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.
@@ -209,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),
@@ -221,33 +217,34 @@ 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,
- ?line Func = {function, 0, test, 0, [{clause,0,[],[],Tests}]},
- ?line Form = [{attribute,0,module,Mod},
- {attribute,0,compile,export_all},
- Func, {eof,0}],
+ 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},
+ {attribute,Anno,compile,export_all},
+ 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]) ->
@@ -261,7 +258,8 @@ test(T, L) ->
{ok,Toks,_Line} = erl_scan:string(S),
{ok,E} = erl_parse:parse_exprs(Toks),
{value,Val,_Bs} = erl_eval:exprs(E, []),
- {match,0,{atom,0,Val},hd(E)}.
+ Anno = erl_anno:new(0),
+ {match,Anno,{atom,Anno,Val},hd(E)}.
test(T, A, L) ->
S = lists:flatten(io_lib:format("begin io:format(\"~~p~n\", [{~p,~p,~p}]), if ~w(~w, ~w) -> true; true -> false end end. ",
@@ -269,7 +267,8 @@ test(T, A, L) ->
{ok,Toks,_Line} = erl_scan:string(S),
{ok,E} = erl_parse:parse_exprs(Toks),
{value,Val,_Bs} = erl_eval:exprs(E, []),
- {match,0,{atom,0,Val},hd(E)}.
+ Anno = erl_anno:new(0),
+ {match,Anno,{atom,Anno,Val},hd(E)}.
literals() ->
[42,
@@ -295,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.
@@ -413,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) ->
@@ -424,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.
@@ -448,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 fbc229bc53..04b7f2de15 100644
--- a/erts/emulator/test/bif_SUITE.erl
+++ b/erts/emulator/test/bif_SUITE.erl
@@ -1,76 +1,54 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2005-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2005-2016. 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/.
+%% 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
%%
-%% 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.
+%% 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(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,
- display/1, display_huge/0,
+-export([all/0, suite/0,
+ display/1, display_huge/0, display_string/1,
erl_bif_types/1,guard_bifs_in_erl_bif_types/1,
- shadow_comments/1,
+ shadow_comments/1,list_to_utf8_atom/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,
+ erl_crash_dump_bytes/1,
+ is_builtin/1, error_stacktrace/1,
+ error_stacktrace_during_call_trace/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,
specs, improper_bif_stubs, auto_imports,
t_list_to_existing_atom, os_env, otp_7526,
- display,
+ display, display_string, list_to_utf8_atom,
atom_to_binary, binary_to_atom, binary_to_existing_atom,
- min_max, erlang_halt].
-
-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].
+ erl_crash_dump_bytes, min_max, erlang_halt, is_builtin,
+ error_stacktrace, error_stacktrace_during_call_trace].
-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,
@@ -90,6 +68,28 @@ deeep(N,Acc) ->
deeep(N) ->
deeep(N,[hello]).
+display_string(Config) when is_list(Config) ->
+ true = erlang:display_string("hej"),
+ true = erlang:display_string(""),
+ true = erlang:display_string("hopp"),
+ true = erlang:display_string("\n"),
+ true = erlang:display_string(lists:seq(1100,1200)),
+ {error,badarg} = try
+ erlang:display_string(atom),
+ ok
+ catch
+ T0:E0 ->
+ {T0, E0}
+ end,
+ {error,badarg} = try
+ erlang:display_string(make_ref()),
+ ok
+ catch
+ T1:E1 ->
+ {T1, E1}
+ end,
+ ok.
+
erl_bif_types(Config) when is_list(Config) ->
ensure_erl_bif_types_compiled(),
@@ -115,7 +115,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) ->
@@ -139,7 +139,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) ->
@@ -160,15 +160,17 @@ 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) ->
ensure_erl_bif_types_compiled(),
+ ErlangList = [{erlang,F,A} || {F,A} <- erlang:module_info(exports),
+ not is_operator(F,A)],
List0 = erlang:system_info(snifs),
- List1 = [MFA || {M,_,_}=MFA <- List0, M =/= hipe_bifs],
- List = [MFA || MFA <- List1, not is_operator(MFA)],
+ List1 = [MFA || {M,_,_}=MFA <- List0, M =/= hipe_bifs, M =/= erlang],
+ List = List1 ++ ErlangList,
HasTypes = [MFA || {M,F,A}=MFA <- List,
erl_bif_types:is_known(M, F, A)],
Path = get_code_path(),
@@ -200,7 +202,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
@@ -214,7 +216,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) ->
@@ -236,7 +238,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.
@@ -274,16 +276,19 @@ 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}) ->
+ is_operator(F,A);
+is_operator(_) -> false.
+
+is_operator(F,A) ->
erl_internal:arith_op(F, A) orelse
erl_internal:bool_op(F, A) orelse
erl_internal:comp_op(F, A) orelse
erl_internal:list_op(F, A) orelse
- erl_internal:send_op(F, A);
-is_operator(_) -> false.
+ erl_internal:send_op(F, A).
extract_specs(M, Abstr) ->
[{make_mfa(M, Name),Spec} || {attribute,_,spec,{Name,Spec}} <- Abstr].
@@ -334,7 +339,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].
@@ -353,40 +358,68 @@ 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.
+list_to_utf8_atom(Config) when is_list(Config) ->
+ 'hello' = atom_roundtrip("hello"),
+ 'こんにちは' = atom_roundtrip("こんにちは"),
+
+ %% Test all edge cases.
+ _ = atom_roundtrip([16#80]),
+ _ = atom_roundtrip([16#7F]),
+ _ = atom_roundtrip([16#FF]),
+ _ = atom_roundtrip([16#100]),
+ _ = atom_roundtrip([16#7FF]),
+ _ = atom_roundtrip([16#800]),
+ _ = atom_roundtrip([16#D7FF]),
+ atom_badarg([16#D800]),
+ atom_badarg([16#DFFF]),
+ _ = atom_roundtrip([16#E000]),
+ _ = atom_roundtrip([16#FFFF]),
+ _ = atom_roundtrip([16#1000]),
+ _ = atom_roundtrip([16#10FFFF]),
+ atom_badarg([16#110000]),
+ ok.
+
+atom_roundtrip(String) ->
+ Atom = list_to_atom(String),
+ Atom = list_to_existing_atom(String),
+ String = atom_to_list(Atom),
+ Atom.
+
+atom_badarg(String) ->
+ {'EXIT',{badarg,_}} = (catch list_to_atom(String)),
+ {'EXIT',{badarg,_}} = (catch list_to_existing_atom(String)),
+ ok.
+
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),
@@ -394,19 +427,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).
@@ -421,15 +453,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) ->
@@ -451,59 +483,60 @@ binary_to_atom(Config) when is_list(Config) ->
Long = lists:seq(0, 254),
LongAtom = list_to_atom(Long),
LongBin = list_to_binary(Long),
+ UnicodeLongAtom = list_to_atom([$é || _ <- lists:seq(0, 254)]),
+ UnicodeLongBin = << <<"é"/utf8>> || _ <- lists:seq(0, 254)>>,
%% 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),
+ UnicodeLongAtom = test_binary_to_atom(UnicodeLongBin, utf8),
+ UnicodeLongAtom = test_binary_to_atom(UnicodeLongBin, unicode),
+ [] = [C || C <- lists:seq(128, 255),
begin
list_to_atom([C]) =/=
test_binary_to_atom(<<C/utf8>>, utf8)
end],
+ <<"こんにちは"/utf8>> =
+ atom_to_binary(test_binary_to_atom(<<"こんにちは"/utf8>>, utf8), utf8),
+
%% 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.
+ <<B:1/binary, _/binary>> = id(<<194, 163>>), %Truncated character ERL-474
+ ?BADARG(binary_to_atom(B, utf8)),
%% 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) ->
@@ -516,49 +549,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.
@@ -571,32 +604,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) ->
@@ -605,74 +638,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),
@@ -681,8 +713,248 @@ erlang_halt(Config) when is_list(Config) ->
{badrpc,nodedown} = rpc:call(N2, erlang, halt, [0]),
{ok,N3} = slave:start(H, halt_node3),
{badrpc,nodedown} = rpc:call(N3, erlang, halt, [0,[]]),
+ {ok,N4} = slave:start(H, halt_node4),
+ {badrpc,nodedown} = rpc:call(N4, erlang, halt, [lists:duplicate(300,$x)]),
+ %% Test unicode slogan
+ {ok,N4} = slave:start(H, halt_node4),
+ {badrpc,nodedown} = rpc:call(N4, erlang, halt, [[339,338,254,230,198,295,167,223,32,12507,12531,12480]]),
+
+ % This test triggers a segfault when dumping a crash dump
+ % to make sure that we can handle it properly.
+ {ok,N4} = slave:start(H, halt_node4),
+ CrashDump = filename:join(proplists:get_value(priv_dir,Config),
+ "segfault_erl_crash.dump"),
+ true = rpc:call(N4, os, putenv, ["ERL_CRASH_DUMP",CrashDump]),
+ false = rpc:call(N4, erts_debug, set_internal_state,
+ [available_internal_state, true]),
+ {badrpc,nodedown} = rpc:call(N4, erts_debug, set_internal_state,
+ [broken_halt, "Validate correct crash dump"]),
+ {ok,_} = wait_until_stable_size(CrashDump,-1),
+ {ok, Bin} = file:read_file(CrashDump),
+ case {string:str(binary_to_list(Bin),"\n=end\n"),
+ string:str(binary_to_list(Bin),"\r\n=end\r\n")} of
+ {0,0} -> ct:fail("Could not find end marker in crash dump");
+ _ -> ok
+ end.
+
+wait_until_stable_size(_File,-10) ->
+ {error,enoent};
+wait_until_stable_size(File,PrevSz) ->
+ timer:sleep(250),
+ case file:read_file_info(File) of
+ {error,enoent} ->
+ wait_until_stable_size(File,PrevSz-1);
+ {ok,#file_info{size = PrevSz }} when PrevSz /= -1 ->
+ io:format("Crashdump file size was: ~p (~s)~n",[PrevSz,File]),
+ {ok,PrevSz};
+ {ok,#file_info{size = NewSz }} ->
+ wait_until_stable_size(File,NewSz)
+ end.
+
+% Test erlang:halt with ERL_CRASH_DUMP_BYTES
+erl_crash_dump_bytes(Config) when is_list(Config) ->
+ Bytes = 1000,
+ CrashDump = do_limited_crash_dump(Config, Bytes),
+ {ok,ActualBytes} = wait_until_stable_size(CrashDump,-1),
+ true = ActualBytes < (Bytes + 100),
+
+ NoDump = do_limited_crash_dump(Config,0),
+ {error,enoent} = wait_until_stable_size(NoDump,-8),
+ ok.
+
+do_limited_crash_dump(Config, Bytes) ->
+ H = hostname(),
+ {ok,N} = slave:start(H, halt_node),
+ BytesStr = integer_to_list(Bytes),
+ CrashDump = filename:join(proplists:get_value(priv_dir,Config),
+ "erl_crash." ++ BytesStr ++ ".dump"),
+ true = rpc:call(N, os, putenv, ["ERL_CRASH_DUMP",CrashDump]),
+ true = rpc:call(N, os, putenv, ["ERL_CRASH_DUMP_BYTES",BytesStr]),
+ {badrpc,nodedown} = rpc:call(N, erlang, halt, ["Testing ERL_CRASH_DUMP_BYTES"]),
+ CrashDump.
+
+
+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.
+
+error_stacktrace(Config) when is_list(Config) ->
+ error_stacktrace_test().
+
+error_stacktrace_during_call_trace(Config) when is_list(Config) ->
+ Tracer = spawn_link(fun () ->
+ receive after infinity -> ok end
+ end),
+ Mprog = [{'_',[],[{exception_trace}]}],
+ erlang:trace_pattern({?MODULE,'_','_'}, Mprog, [local]),
+ 1 = erlang:trace_pattern({erlang,error,2}, Mprog, [local]),
+ 1 = erlang:trace_pattern({erlang,error,1}, Mprog, [local]),
+ erlang:trace(all, true, [call,return_to,timestamp,{tracer, Tracer}]),
+ try
+ error_stacktrace_test()
+ after
+ erlang:trace(all, false, [call,return_to,timestamp,{tracer, Tracer}]),
+ erlang:trace_pattern({erlang,error,2}, false, [local]),
+ erlang:trace_pattern({erlang,error,1}, false, [local]),
+ erlang:trace_pattern({?MODULE,'_','_'}, false, [local]),
+ unlink(Tracer),
+ exit(Tracer, kill),
+ Mon = erlang:monitor(process, Tracer),
+ receive
+ {'DOWN', Mon, process, Tracer, _} -> ok
+ end
+ end,
+ ok.
+
+
+error_stacktrace_test() ->
+ Types = [apply_const_last, apply_const, apply_last,
+ apply, double_apply_const_last, double_apply_const,
+ double_apply_last, double_apply, multi_apply_const_last,
+ multi_apply_const, multi_apply_last, multi_apply,
+ call_const_last, call_last, call_const, call],
+ lists:foreach(fun (Type) ->
+ {Pid, Mon} = spawn_monitor(
+ fun () ->
+ stk([a,b,c,d], Type, error_2)
+ end),
+ receive
+ {'DOWN', Mon, process, Pid, Reason} ->
+ {oops, Stack} = Reason,
+%% io:format("Type: ~p Stack: ~p~n",
+%% [Type, Stack]),
+ [{?MODULE, do_error_2, [Type], _},
+ {?MODULE, stk, 3, _},
+ {?MODULE, stk, 3, _}] = Stack
+ end
+ end,
+ Types),
+ lists:foreach(fun (Type) ->
+ {Pid, Mon} = spawn_monitor(
+ fun () ->
+ stk([a,b,c,d], Type, error_1)
+ end),
+ receive
+ {'DOWN', Mon, process, Pid, Reason} ->
+ {oops, Stack} = Reason,
+%% io:format("Type: ~p Stack: ~p~n",
+%% [Type, Stack]),
+ [{?MODULE, do_error_1, 1, _},
+ {?MODULE, stk, 3, _},
+ {?MODULE, stk, 3, _}] = Stack
+ end
+ end,
+ Types),
ok.
+stk([], Type, Func) ->
+ tail(Type, Func, jump),
+ ok;
+stk([_|L], Type, Func) ->
+ stk(L, Type, Func),
+ ok.
+
+tail(Type, Func, jump) ->
+ tail(Type, Func, do);
+tail(Type, error_1, do) ->
+ do_error_1(Type);
+tail(Type, error_2, do) ->
+ do_error_2(Type).
+
+do_error_2(apply_const_last) ->
+ erlang:apply(erlang, error, [oops, [apply_const_last]]);
+do_error_2(apply_const) ->
+ erlang:apply(erlang, error, [oops, [apply_const]]),
+ ok;
+do_error_2(apply_last) ->
+ erlang:apply(id(erlang), id(error), id([oops, [apply_last]]));
+do_error_2(apply) ->
+ erlang:apply(id(erlang), id(error), id([oops, [apply]])),
+ ok;
+do_error_2(double_apply_const_last) ->
+ erlang:apply(erlang, apply, [erlang, error, [oops, [double_apply_const_last]]]);
+do_error_2(double_apply_const) ->
+ erlang:apply(erlang, apply, [erlang, error, [oops, [double_apply_const]]]),
+ ok;
+do_error_2(double_apply_last) ->
+ erlang:apply(id(erlang), id(apply), [id(erlang), id(error), id([oops, [double_apply_last]])]);
+do_error_2(double_apply) ->
+ erlang:apply(id(erlang), id(apply), [id(erlang), id(error), id([oops, [double_apply]])]),
+ ok;
+do_error_2(multi_apply_const_last) ->
+ erlang:apply(erlang, apply, [erlang, apply, [erlang, apply, [erlang, error, [oops, [multi_apply_const_last]]]]]);
+do_error_2(multi_apply_const) ->
+ erlang:apply(erlang, apply, [erlang, apply, [erlang, apply, [erlang, error, [oops, [multi_apply_const]]]]]),
+ ok;
+do_error_2(multi_apply_last) ->
+ erlang:apply(id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(error), id([oops, [multi_apply_last]])]]]);
+do_error_2(multi_apply) ->
+ erlang:apply(id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(error), id([oops, [multi_apply]])]]]),
+ ok;
+do_error_2(call_const_last) ->
+ erlang:error(oops, [call_const_last]);
+do_error_2(call_last) ->
+ erlang:error(id(oops), id([call_last]));
+do_error_2(call_const) ->
+ erlang:error(oops, [call_const]),
+ ok;
+do_error_2(call) ->
+ erlang:error(id(oops), id([call])).
+
+
+do_error_1(apply_const_last) ->
+ erlang:apply(erlang, error, [oops]);
+do_error_1(apply_const) ->
+ erlang:apply(erlang, error, [oops]),
+ ok;
+do_error_1(apply_last) ->
+ erlang:apply(id(erlang), id(error), id([oops]));
+do_error_1(apply) ->
+ erlang:apply(id(erlang), id(error), id([oops])),
+ ok;
+do_error_1(double_apply_const_last) ->
+ erlang:apply(erlang, apply, [erlang, error, [oops]]);
+do_error_1(double_apply_const) ->
+ erlang:apply(erlang, apply, [erlang, error, [oops]]),
+ ok;
+do_error_1(double_apply_last) ->
+ erlang:apply(id(erlang), id(apply), [id(erlang), id(error), id([oops])]);
+do_error_1(double_apply) ->
+ erlang:apply(id(erlang), id(apply), [id(erlang), id(error), id([oops])]),
+ ok;
+do_error_1(multi_apply_const_last) ->
+ erlang:apply(erlang, apply, [erlang, apply, [erlang, apply, [erlang, error, [oops]]]]);
+do_error_1(multi_apply_const) ->
+ erlang:apply(erlang, apply, [erlang, apply, [erlang, apply, [erlang, error, [oops]]]]),
+ ok;
+do_error_1(multi_apply_last) ->
+ erlang:apply(id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(error), id([oops])]]]);
+do_error_1(multi_apply) ->
+ erlang:apply(id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(error), id([oops])]]]),
+ ok;
+do_error_1(call_const_last) ->
+ erlang:error(oops);
+do_error_1(call_last) ->
+ erlang:error(id(oops));
+do_error_1(call_const) ->
+ erlang:error(oops),
+ ok;
+do_error_1(call) ->
+ erlang:error(id(oops)).
+
+
%% Helpers
diff --git a/erts/emulator/test/big_SUITE.erl b/erts/emulator/test/big_SUITE.erl
index 413bd3bcae..c308760211 100644
--- a/erts/emulator/test/big_SUITE.erl
+++ b/erts/emulator/test/big_SUITE.erl
@@ -1,29 +1,31 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2011. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2016. 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.
+%% 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(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, otp_6692/1]).
+ bxor_2pow/1,
+ shift_limit_1/1, powmod/1, system_limit/1, toobig/1, otp_6692/1]).
%% Internal exports.
-export([eval/1]).
@@ -31,41 +33,22 @@
-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,
borders, negative, {group, big_float}, shift_limit_1,
- powmod, system_limit, otp_6692].
+ bxor_2pow,
+ powmod, system_limit, toobig, otp_6692].
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.
@@ -94,7 +77,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).
@@ -106,7 +89,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).
%%
@@ -118,12 +101,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) ->
@@ -155,7 +138,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;
@@ -247,10 +230,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) ->
@@ -264,65 +247,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,
@@ -351,16 +329,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() ->
@@ -370,12 +348,19 @@ maxbig() ->
id(I) -> I.
-otp_6692(suite) ->
- [];
-otp_6692(doc) ->
- ["Tests for DIV/REM bug reported in OTP-6692"];
+toobig(Config) when is_list(Config) ->
+ {'EXIT',{{badmatch,_},_}} = (catch toobig()),
+ ok.
+
+toobig() ->
+ A = erlang:term_to_binary(lists:seq(1000000, 2200000)),
+ ASize = erlang:bit_size(A),
+ <<ANr:ASize>> = A, % should fail
+ ANr band ANr.
+
+%% 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).
@@ -413,3 +398,54 @@ loop2(X,Y,N,M) ->
end,
loop2(X,Y,N+1,M).
+
+%% ERL-450
+bxor_2pow(_Config) ->
+ IL = lists:seq(8*3, 8*16, 4),
+ JL = lists:seq(0, 64),
+ [bxor_2pow_1((1 bsl I), (1 bsl J))
+ || I <- IL, J <- JL],
+ ok.
+
+bxor_2pow_1(A, B) ->
+ for(-1,1, fun(Ad) ->
+ for(-1,1, fun(Bd) ->
+ bxor_2pow_2(A+Ad, B+Bd),
+ bxor_2pow_2(-A+Ad, B+Bd),
+ bxor_2pow_2(A+Ad, -B+Bd),
+ bxor_2pow_2(-A+Ad, -B+Bd)
+ end)
+ end).
+
+for(From, To, _Fun) when From > To ->
+ ok;
+for(From, To, Fun) ->
+ Fun(From),
+ for(From+1, To, Fun).
+
+bxor_2pow_2(A, B) ->
+ Correct = my_bxor(A, B),
+ case A bxor B of
+ Correct -> ok;
+ Wrong ->
+ io:format("~.16b bxor ~.16b\n", [A,B]),
+ io:format("Expected ~.16b\n", [Correct]),
+ io:format("Got ~.16b\n", [Wrong]),
+ ct:fail({failed, 'bxor'})
+
+ end.
+
+%% Implement bxor without bxor
+my_bxor(A, B) ->
+ my_bxor(A, B, 0, 0).
+
+my_bxor(0, 0, _, Acc) -> Acc;
+my_bxor(-1, -1, _, Acc) -> Acc;
+my_bxor(-1, 0, N, Acc) -> (-1 bsl N) bor Acc; % sign extension
+my_bxor(0, -1, N, Acc) -> (-1 bsl N) bor Acc; % sign extension
+my_bxor(A, B, N, Acc0) ->
+ Acc1 = case (A band 1) =:= (B band 1) of
+ true -> Acc0;
+ false -> Acc0 bor (1 bsl N)
+ end,
+ my_bxor(A bsr 1, B bsr 1, N+1, Acc1).
diff --git a/erts/emulator/test/big_SUITE_data/borders.dat b/erts/emulator/test/big_SUITE_data/borders.dat
index 52e4f35861..c38ff93383 100644
--- a/erts/emulator/test/big_SUITE_data/borders.dat
+++ b/erts/emulator/test/big_SUITE_data/borders.dat
@@ -1114,3 +1114,38 @@
1 = 16#800000000000001 rem (-16#800000000000000).
0 = 16#FFFFFFFFFFFFFFF800000000 rem 16#FFFFFFFFFFFFFFF80.
+% ERL-450 bxor of big negative 2-pow
+-(1 bsl 8) bxor -1 = 16#ff.
+-(1 bsl 16) bxor -1 = 16#ffff.
+-(1 bsl 24) bxor -1 = 16#ffffff.
+-(1 bsl 32) bxor -1 = 16#ffffffff.
+-(1 bsl 40) bxor -1 = 16#ffffffffff.
+-(1 bsl 48) bxor -1 = 16#ffffffffffff.
+-(1 bsl 56) bxor -1 = 16#ffffffffffffff.
+-(1 bsl 64) bxor -1 = 16#ffffffffffffffff.
+-(1 bsl 72) bxor -1 = 16#ffffffffffffffffff.
+-(1 bsl 80) bxor -1 = 16#ffffffffffffffffffff.
+-(1 bsl 88) bxor -1 = 16#ffffffffffffffffffffff.
+-(1 bsl 96) bxor -1 = 16#ffffffffffffffffffffffff.
+-(1 bsl 104) bxor -1 = 16#ffffffffffffffffffffffffff.
+-(1 bsl 112) bxor -1 = 16#ffffffffffffffffffffffffffff.
+-(1 bsl 120) bxor -1 = 16#ffffffffffffffffffffffffffffff.
+-(1 bsl 128) bxor -1 = 16#ffffffffffffffffffffffffffffffff.
+-(1 bsl 136) bxor -1 = 16#ffffffffffffffffffffffffffffffffff.
+-(1 bsl 8) bxor 1 = -16#ff.
+-(1 bsl 16) bxor 1 = -16#ffff.
+-(1 bsl 24) bxor 1 = -16#ffffff.
+-(1 bsl 32) bxor 1 = -16#ffffffff.
+-(1 bsl 40) bxor 1 = -16#ffffffffff.
+-(1 bsl 48) bxor 1 = -16#ffffffffffff.
+-(1 bsl 56) bxor 1 = -16#ffffffffffffff.
+-(1 bsl 64) bxor 1 = -16#ffffffffffffffff.
+-(1 bsl 72) bxor 1 = -16#ffffffffffffffffff.
+-(1 bsl 80) bxor 1 = -16#ffffffffffffffffffff.
+-(1 bsl 88) bxor 1 = -16#ffffffffffffffffffffff.
+-(1 bsl 96) bxor 1 = -16#ffffffffffffffffffffffff.
+-(1 bsl 104) bxor 1 = -16#ffffffffffffffffffffffffff.
+-(1 bsl 112) bxor 1 = -16#ffffffffffffffffffffffffffff.
+-(1 bsl 120) bxor 1 = -16#ffffffffffffffffffffffffffffff.
+-(1 bsl 128) bxor 1 = -16#ffffffffffffffffffffffffffffffff.
+-(1 bsl 136) bxor 1 = -16#ffffffffffffffffffffffffffffffffff.
diff --git a/erts/emulator/test/big_SUITE_data/literal_test.erl b/erts/emulator/test/big_SUITE_data/literal_test.erl
index dc0adeb1ca..17c4db467a 100644
--- a/erts/emulator/test/big_SUITE_data/literal_test.erl
+++ b/erts/emulator/test/big_SUITE_data/literal_test.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1998-2016. 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.
+%% 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%
%%
diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl
index 7aba367e33..61536bacd7 100644
--- a/erts/emulator/test/binary_SUITE.erl
+++ b/erts/emulator/test/binary_SUITE.erl
@@ -1,24 +1,24 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2014. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2017. 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/.
+%% 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
%%
-%% 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.
+%% 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(binary_SUITE).
--compile({nowarn_deprecated_function, {erlang,hash,2}}).
%% Tests binaries and the BIFs:
%% list_to_binary/1
@@ -39,7 +39,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,
@@ -58,7 +58,8 @@
ordering/1,unaligned_order/1,gc_test/1,
bit_sized_binary_sizes/1,
otp_6817/1,deep/1,obsolete_funs/1,robustness/1,otp_8117/1,
- otp_8180/1, trapping/1]).
+ otp_8180/1, trapping/1, large/1,
+ error_after_yield/1, cmp_old_impl/1]).
%% Internal exports.
-export([sleeper/0,trapping_loop/4]).
@@ -76,7 +77,8 @@ all() ->
bad_term_to_binary, more_bad_terms, otp_5484, otp_5933,
ordering, unaligned_order, gc_test,
bit_sized_binary_sizes, otp_6817, otp_8117, deep,
- obsolete_funs, robustness, otp_8180, trapping].
+ obsolete_funs, robustness, otp_8180, trapping, large,
+ error_after_yield, cmp_old_impl].
groups() ->
[].
@@ -103,17 +105,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) ->
@@ -126,154 +128,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.
@@ -284,15 +284,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.
@@ -302,15 +302,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.
@@ -324,63 +324,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]),
@@ -393,36 +391,33 @@ 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: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.
@@ -461,7 +456,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 ->
@@ -473,7 +468,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),
@@ -489,22 +484,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}])).
@@ -518,28 +512,29 @@ external_size_1(Term, Size0, Limit) when Size0 < Limit ->
external_size_1(_, _, _) -> ok.
t_iolist_size(Config) when is_list(Config) ->
- ?line Seed = now(),
- ?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;
@@ -547,7 +542,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;
@@ -565,7 +560,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
@@ -578,33 +573,35 @@ 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>>),
+
+ %% Truncated UTF8 character (ERL-474)
+ bad_bin_to_term(<<131,119,1,194,163>>),
ok.
bad_bin_to_term(BadBin) ->
@@ -613,25 +610,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>>)),
@@ -664,7 +660,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
@@ -672,42 +668,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,
@@ -720,7 +715,7 @@ otp_5484(Config) when is_list(Config) ->
255,
106>>)),
- ?line {'EXIT',_} =
+ {'EXIT',_} =
(catch
binary_to_term_stress(
<<131,
@@ -732,13 +727,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.
@@ -750,7 +745,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.
@@ -761,7 +756,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.
@@ -773,7 +768,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.
@@ -787,46 +782,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
@@ -835,7 +830,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) ->
@@ -858,9 +853,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) ->
@@ -879,7 +874,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
@@ -899,7 +894,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 =
@@ -907,14 +902,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) ->
@@ -932,8 +927,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)],
@@ -942,23 +936,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]),
@@ -967,58 +960,58 @@ 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.
-%% Test that comparisions between binaries with different alignment work.
+%% Test that comparison between binaries with different alignment work.
unaligned_order(Config) when is_list(Config) ->
L = lists:seq(0, 7),
[test_unaligned_order(I, J) || I <- L, J <- L],
@@ -1027,153 +1020,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.
@@ -1213,7 +1206,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.
@@ -1232,7 +1225,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) ->
@@ -1274,13 +1267,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.
@@ -1307,41 +1300,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.
@@ -1351,7 +1344,16 @@ trapping(Config) when is_list(Config)->
do_trapping(5, term_to_binary,
fun() -> [lists:duplicate(2000000,2000000)] end),
do_trapping(5, binary_to_term,
- fun() -> [term_to_binary(lists:duplicate(2000000,2000000))] end).
+ fun() -> [term_to_binary(lists:duplicate(2000000,2000000))] end),
+ do_trapping(5, binary_to_list,
+ fun() -> [list_to_binary(lists:duplicate(2000000,$x))] end),
+ do_trapping(5, list_to_binary,
+ fun() -> [lists:duplicate(2000000,$x)] end),
+ do_trapping(5, bitstring_to_list,
+ fun() -> [list_to_bitstring([lists:duplicate(2000000,$x),<<7:4>>])] end),
+ do_trapping(5, list_to_bitstring,
+ fun() -> [[lists:duplicate(2000000,$x),<<7:4>>]] end)
+ .
do_trapping(0, _, _) ->
ok;
@@ -1359,17 +1361,19 @@ do_trapping(N, Bif, ArgFun) ->
io:format("N=~p: Do ~p ~s gc.\n", [N, Bif, case N rem 2 of 0 -> "with"; 1 -> "without" end]),
Pid = spawn(?MODULE,trapping_loop,[Bif, ArgFun, 1000, self()]),
receive ok -> ok end,
- receive after 100 -> ok end,
Ref = make_ref(),
case N rem 2 of
- 0 -> erlang:garbage_collect(Pid, [{async,Ref}]),
- receive after 100 -> ok end;
+ 0 ->
+ erlang:garbage_collect(Pid, [{async,Ref}]),
+ receive after 1 -> ok end;
1 -> void
end,
- exit(Pid,kill),
+ exit(Pid, kill),
case N rem 2 of
- 0 -> receive {garbage_collect, Ref, _} -> ok end;
- 1 -> void
+ 0 ->
+ receive {garbage_collect, Ref, _} -> ok end;
+ 1 ->
+ void
end,
receive after 1 -> ok end,
do_trapping(N-1, Bif, ArgFun).
@@ -1384,9 +1388,189 @@ trapping_loop2(Bif,Args,N) ->
apply(erlang,Bif,Args),
trapping_loop2(Bif, Args, N-1).
+large(Config) when is_list(Config) ->
+ List = lists:flatten(lists:map(fun (_) ->
+ [0,1,2,3,4,5,6,7,8]
+ end,
+ lists:seq(1, 131072))),
+ Bin = list_to_binary(List),
+ List = binary_to_list(Bin),
+ PartList = lists:reverse(tl(tl(lists:reverse(tl(tl(List)))))),
+ PartList = binary_to_list(Bin, 3, length(List)-2),
+ ListBS = List ++ [<<7:4>>],
+ ListBS = bitstring_to_list(list_to_bitstring(ListBS)),
+ BitStr1 = list_to_bitstring(lists:duplicate(1024*1024, [<<1,5:3>>])),
+ BitStr1 = list_to_bitstring(bitstring_to_list(BitStr1)),
+ BitStr2 = list_to_bitstring([lists:duplicate(512*1024, [<<1,5:3>>]),
+ Bin]),
+ BitStr2 = list_to_bitstring(bitstring_to_list(BitStr2)),
+ ok.
+
+error_after_yield(Config) when is_list(Config) ->
+ L2BTrap = {erts_internal, list_to_binary_continue, 1},
+ error_after_yield(badarg, erlang, list_to_binary, 1, fun () -> [[mk_list(1000000), oops]] end, L2BTrap),
+ error_after_yield(badarg, erlang, iolist_to_binary, 1, fun () -> [[list2iolist(mk_list(1000000)), oops]] end, L2BTrap),
+ error_after_yield(badarg, erlang, list_to_bitstring, 1, fun () -> [[list2bitstrlist(mk_list(1000000)), oops]] end, L2BTrap),
+ error_after_yield(badarg, binary, list_to_bin, 1, fun () -> [[mk_list(1000000), oops]] end, L2BTrap),
+
+ B2TTrap = {erts_internal, binary_to_term_trap, 1},
+
+ error_after_yield(badarg, erlang, binary_to_term, 1, fun () -> [error_after_yield_bad_ext_term()] end, B2TTrap),
+ error_after_yield(badarg, erlang, binary_to_term, 2, fun () -> [error_after_yield_bad_ext_term(), [safe]] end, B2TTrap),
+
+ case erlang:system_info(wordsize) of
+ 4 ->
+ SysLimitSz = 1 bsl 32,
+ error_after_yield(system_limit, erlang, list_to_binary, 1, fun () -> [[huge_iolist(SysLimitSz), $x]] end, L2BTrap),
+ error_after_yield(system_limit, erlang, iolist_to_binary, 1, fun () -> [[huge_iolist(SysLimitSz), $x]] end, L2BTrap),
+ error_after_yield(system_limit, erlang, list_to_bitstring, 1, fun () -> [[huge_iolist(SysLimitSz), $x]] end, L2BTrap),
+ error_after_yield(system_limit, binary, list_to_bin, 1, fun () -> [[huge_iolist(SysLimitSz), $x]] end, L2BTrap);
+ 8 ->
+ % Takes waaaay to long time to test system_limit on 64-bit archs...
+ ok
+ end,
+ ok.
+
+error_after_yield(Type, M, F, AN, AFun, TrapFunc) ->
+ io:format("Testing ~p for ~p:~p/~p~n", [Type, M, F, AN]),
+ Tracer = self(),
+ {Pid, Mon} = spawn_monitor(fun () ->
+ A = AFun(),
+ try
+ erlang:yield(),
+ erlang:trace(self(),true,[running,{tracer,Tracer}]),
+ apply(M, F, A),
+ exit({unexpected_success, {M, F, A}})
+ catch
+ error:Type ->
+ erlang:trace(self(),false,[running,{tracer,Tracer}]),
+ %% We threw the exception from the native
+ %% function we trapped to, but we want
+ %% the BIF that originally was called
+ %% to appear in the stack trace.
+ [{M, F, A, _} | _] = erlang:get_stacktrace()
+ end
+ end),
+ receive
+ {'DOWN', Mon, process, Pid, Reason} ->
+ normal = Reason
+ end,
+ TD = erlang:trace_delivered(Pid),
+ receive
+ {trace_delivered, Pid, TD} ->
+ NoYields = error_after_yield_sched(Pid, TrapFunc, 0),
+ io:format("No of yields: ~p~n", [NoYields]),
+ true = NoYields > 2
+ end,
+ ok.
+
+error_after_yield_sched(P, TrapFunc, N) ->
+ receive
+ {trace, P, out, TrapFunc} ->
+ receive
+ {trace, P, in, TrapFunc} ->
+ error_after_yield_sched(P, TrapFunc, N+1)
+ after 0 ->
+ exit(trap_sched_mismatch)
+ end;
+ {trace, P, out, Func} ->
+ receive
+ {trace, P, in, Func} ->
+ error_after_yield_sched(P, TrapFunc, N)
+ after 0 ->
+ exit(other_sched_mismatch)
+ end
+ after 0 ->
+ N
+ end.
+
+error_after_yield_bad_ext_term() ->
+ TupleSz = 2000000,
+ <<131, % Version magic
+ AtomExt/binary>> = term_to_binary(an_atom_we_use_for_this),
+ BadAtomExt = [100, %% ATOM_EXT
+ 255, 255, % Invalid size of 65535 bytes
+ "oops"],
+
+ %% Produce a large tuple where the last element is invalid
+ list_to_binary([131, %% Version magic
+ 105, %% LARGE_TUPLE_EXT
+ <<TupleSz:32/big>>, %% Tuple size
+ lists:duplicate(TupleSz-1, AtomExt), %% Valid atoms
+ BadAtomExt]). %% Invalid atom at the end
+
+cmp_old_impl(Config) when is_list(Config) ->
+ %% Compare results from new yielding implementations with
+ %% old non yielding implementations
+ Cookie = atom_to_list(erlang:get_cookie()),
+ Rel = "r16b_latest",
+ case test_server:is_release_available(Rel) of
+ false ->
+ {skipped, "No "++Rel++" available"};
+ true ->
+ {ok, Node} = test_server:start_node(list_to_atom(atom_to_list(?MODULE)++"_"++Rel),
+ peer,
+ [{args, " -setcookie "++Cookie},
+ {erl, [{release, Rel}]}]),
+
+ cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list(1))]}),
+ cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list(10))]}),
+ cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list(100))]}),
+ cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list(1000))]}),
+ cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list(10000))]}),
+ cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list(100000))]}),
+ cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list(1000000))]}),
+ cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list(10000000))]}),
+ cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list_lb(10000000))]}),
+
+ cmp_node(Node, {erlang, binary_to_list, [list_to_binary(mk_list(1))]}),
+ cmp_node(Node, {erlang, binary_to_list, [list_to_binary(mk_list(10))]}),
+ cmp_node(Node, {erlang, binary_to_list, [list_to_binary(mk_list(100))]}),
+ cmp_node(Node, {erlang, binary_to_list, [list_to_binary(mk_list(1000))]}),
+ cmp_node(Node, {erlang, binary_to_list, [list_to_binary(mk_list(10000))]}),
+ cmp_node(Node, {erlang, binary_to_list, [list_to_binary(mk_list(100000))]}),
+ cmp_node(Node, {erlang, binary_to_list, [list_to_binary(mk_list(1000000))]}),
+ cmp_node(Node, {erlang, binary_to_list, [list_to_binary(mk_list(10000000))]}),
+
+ cmp_node(Node, {erlang, list_to_bitstring, [list2bitstrlist(mk_list(1))]}),
+ cmp_node(Node, {erlang, list_to_bitstring, [list2bitstrlist(mk_list(10))]}),
+ cmp_node(Node, {erlang, list_to_bitstring, [list2bitstrlist(mk_list(100))]}),
+ cmp_node(Node, {erlang, list_to_bitstring, [list2bitstrlist(mk_list(1000))]}),
+ cmp_node(Node, {erlang, list_to_bitstring, [list2bitstrlist(mk_list(10000))]}),
+ cmp_node(Node, {erlang, list_to_bitstring, [list2bitstrlist(mk_list(100000))]}),
+ cmp_node(Node, {erlang, list_to_bitstring, [list2bitstrlist(mk_list(1000000))]}),
+ cmp_node(Node, {erlang, list_to_bitstring, [list2bitstrlist(mk_list(10000000))]}),
+
+ cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(1)))]}),
+ cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(10)))]}),
+ cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(100)))]}),
+ cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(1000)))]}),
+ cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(10000)))]}),
+ cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(100000)))]}),
+ 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)))]}),
+
+ test_server:stop_node(Node),
+
+ ok
+ end.
%% Utilities.
+huge_iolist(Lim) ->
+ Sz = 1024,
+ huge_iolist(list_to_binary(mk_list(Sz)), Sz, Lim).
+
+huge_iolist(X, Sz, Lim) when Sz >= Lim ->
+ X;
+huge_iolist(X, Sz, Lim) ->
+ huge_iolist([X, X], Sz*2, Lim).
+
+cmp_node(Node, {M, F, A}) ->
+ Res = rpc:call(Node, M, F, A),
+ Res = apply(M, F, A),
+ ok.
+
make_sub_binary(Bin) when is_binary(Bin) ->
{_,B} = split_binary(list_to_binary([0,1,3,Bin]), 3),
B;
@@ -1410,7 +1594,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),
@@ -1467,3 +1651,78 @@ get_reds() ->
erts_debug:set_internal_state(available_internal_state, true),
get_reds()
end.
+
+-define(LARGE_BIN, (512*1024+10)).
+-define(LARGE_BIN_LIM, (1024*1024)).
+
+mk_list(0, Acc) ->
+ Acc;
+mk_list(Sz, Acc) ->
+ mk_list(Sz-1, [$A+(Sz band 63) | Acc]).
+
+mk_list(Sz) when Sz >= ?LARGE_BIN_LIM ->
+ SzLeft = Sz - ?LARGE_BIN,
+ SzHd = SzLeft div 2,
+ SzTl = SzLeft - SzHd,
+ [mk_list(SzHd, []), erlang:list_to_binary(mk_list(?LARGE_BIN, [])), mk_list(SzTl, [])];
+mk_list(Sz) ->
+ mk_list(Sz, []).
+
+mk_list_lb(Sz) when Sz >= ?LARGE_BIN_LIM ->
+ SzLeft = Sz - ?LARGE_BIN,
+ SzHd = SzLeft div 2,
+ SzTl = SzLeft - SzHd,
+ [mk_list(SzHd, []), erlang:list_to_binary(mk_list(?LARGE_BIN, [])), mk_list(SzTl, [])];
+mk_list_lb(Sz) ->
+ mk_list(Sz, []).
+
+
+list2iolist(List) ->
+ list2iolist(List, []).
+
+list2iolist([], Acc) ->
+ Acc;
+list2iolist([X0, X1, X2, X3, X4, X5 | Xs], Acc) when is_integer(X0), 0 =< X0, X0 < 256,
+ is_integer(X1), 0 =< X1, X1 < 256,
+ is_integer(X2), 0 =< X2, X2 < 256,
+ is_integer(X3), 0 =< X3, X3 < 256,
+ is_integer(X4), 0 =< X4, X4 < 256,
+ is_integer(X5), 0 =< X5, X5 < 256 ->
+ NewAcc = case (X0+X1+X2+X3+X4+X5) band 3 of
+ 0 ->
+ [Acc, [[[[[[[[[[[[X0,[],<<"">>,X1]]]]]]]]],[X2,X3]],[],[],[],[],X4],X5]];
+ 1 ->
+ [Acc, [], erlang:list_to_binary([X0, X1, X2, X3, X4, X5])];
+ 2 ->
+ [Acc, [[[[X0|erlang:list_to_binary([X1])],[X2|erlang:list_to_binary([X3])],[X4|erlang:list_to_binary([X5])]]]|<<"">>]];
+ 3 ->
+ [Acc, X0, X1, X2, <<"">>, [], X3, X4 | erlang:list_to_binary([X5])]
+ end,
+ list2iolist(Xs, NewAcc);
+list2iolist([X | Xs], Acc) ->
+ list2iolist(Xs, [Acc,X]).
+
+list2bitstrlist(List) ->
+ [list2bitstrlist(List, []), <<4:7>>].
+
+list2bitstrlist([], Acc) ->
+ Acc;
+list2bitstrlist([X0, X1, X2, X3, X4, X5 | Xs], Acc) when is_integer(X0), 0 =< X0, X0 < 256,
+ is_integer(X1), 0 =< X1, X1 < 256,
+ is_integer(X2), 0 =< X2, X2 < 256,
+ is_integer(X3), 0 =< X3, X3 < 256,
+ is_integer(X4), 0 =< X4, X4 < 256,
+ is_integer(X5), 0 =< X5, X5 < 256 ->
+ NewAcc = case (X0+X1+X2+X3+X4+X5) band 3 of
+ 0 ->
+ [Acc, [[[[[[[[[[[[X0,[],<<"">>,X1]]]]]]]]],[X2,X3]],[],[],[],[],X4],X5]];
+ 1 ->
+ [Acc, [], <<X0:X1>>, <<X2:X3>>, <<X4:X5>>];
+ 2 ->
+ [Acc, [[[[X0|<<X1:X2>>],X3]],[X4|erlang:list_to_binary([X5])]|<<"">>]];
+ 3 ->
+ [Acc, X0, X1, X2, <<"">>, [], X3, X4 | erlang:list_to_binary([X5])]
+ end,
+ list2bitstrlist(Xs, NewAcc);
+list2bitstrlist([X | Xs], Acc) ->
+ list2bitstrlist(Xs, [Acc,X]).
diff --git a/erts/emulator/test/bs_bincomp_SUITE.erl b/erts/emulator/test/bs_bincomp_SUITE.erl
index f1c2dff560..c481e93e41 100644
--- a/erts/emulator/test/bs_bincomp_SUITE.erl
+++ b/erts/emulator/test/bs_bincomp_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2016. 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.
+%% 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%
%%
@@ -130,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 7f2cd1e881..d393bc5b91 100644
--- a/erts/emulator/test/bs_bit_binaries_SUITE.erl
+++ b/erts/emulator/test/bs_bit_binaries_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2016. 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.
+%% 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%
%%
@@ -29,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]}].
@@ -56,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.
@@ -75,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.
@@ -175,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 1a8724d63b..ce50bcdd86 100644
--- a/erts/emulator/test/bs_construct_SUITE.erl
+++ b/erts/emulator/test/bs_construct_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2012. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2017. 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.
+%% 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%
%%
@@ -21,40 +22,33 @@
-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,
+ init_per_suite/1, end_per_suite/1,
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, {minutes, 1}}].
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() ->
- [].
+ bad_append, bs_add_overflow].
init_per_suite(Config) ->
Config.
end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
+ application:stop(os_mon).
big(1) ->
57285702734876389752897683.
@@ -67,9 +61,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) ->
[
@@ -188,7 +182,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 ->
@@ -196,7 +190,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]),
@@ -217,7 +211,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
@@ -252,23 +246,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
@@ -284,10 +277,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;
@@ -312,10 +304,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)>>)].
@@ -323,10 +314,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;
@@ -344,11 +334,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;
@@ -362,47 +351,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.
@@ -412,14 +400,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) ->
@@ -435,11 +422,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),
@@ -453,16 +440,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) ->
@@ -476,18 +463,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.
@@ -506,7 +493,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() ->
@@ -534,76 +521,81 @@ 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, 60}),
+ 16777216 = size(<<0:(id(1 bsl 26)),(-1):(id(1 bsl 26))>>),
+ garbage_collect(),
+ FreeMem = free_mem(),
+ io:format("Free memory (Mb): ~p\n", [FreeMem]),
{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"};
+ Mb when Mb > 200 ->
+ garbage_collect(),
+ id(<<0:((1 bsl 30)-1)>>),
+ {30,"Limit huge binary to 128 Mb"};
+ _ ->
+ garbage_collect(),
+ id(<<0:((1 bsl 29)-1)>>),
+ {29,"Limit huge binary to 64 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}
end.
+%% Return the amount of free memory in Mb.
free_mem() ->
- Cmd = "uname; free",
- Output = string:tokens(os:cmd(Cmd), "\n"),
- io:format("Output from command ~p\n~p\n",[Cmd,Output]),
- case Output of
- [OS, ColumnNames, Values | _] ->
- case string:str(OS,"Linux") of
- 0 ->
- io:format("Unknown OS\n",[]),
- undefined;
- _ ->
- case {string:tokens(ColumnNames, " \t"),
- string:tokens(Values, " \t")} of
- {[_,_,"free"|_],["Mem:",_,_,FreeKb|_]} ->
- list_to_integer(FreeKb) div 1024;
- _ ->
- io:format("Failed to parse output from 'free':\n",[]),
- undefined
- end
- end;
- _ ->
- io:format("Too few lines in output\n",[]),
- undefined
+ {ok,Apps} = application:ensure_all_started(os_mon),
+ Mem = memsup:get_system_memory_data(),
+ [ok = application:stop(App)||App <- Apps],
+ case proplists:get_value(free_memory,Mem) of
+ undefined -> undefined;
+ Val -> Val div (1024*1024)
end.
-
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 ->
@@ -613,60 +605,52 @@ 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,_}} =
- (catch <<0:(id(8)),42:(id(536870912))/unit:8>>),
+ {'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,_}} =
- (catch <<0:(id(1 bsl 100)),0:(id(-1))>>),
- ?line {'EXIT',{badarg,_}} =
- (catch <<0:(id(1 bsl 100)),0:(id(-(1 bsl 70)))>>),
- ?line {'EXIT',{badarg,_}} =
- (catch <<0:(id(-(1 bsl 70))),0:(id(1 bsl 100))>>),
-
- ?line {'EXIT',{badarg,_}} =
- (catch <<(id(<<>>))/binary,0:(id(-(1 bsl 100)))>>),
-
+ {'EXIT',{badarg,_}} = (catch <<0:(id(1 bsl 100)),0:(id(-1))>>),
+ {'EXIT',{badarg,_}} = (catch <<0:(id(1 bsl 100)),0:(id(-(1 bsl 70)))>>),
+ {'EXIT',{badarg,_}} = (catch <<0:(id(-(1 bsl 70))),0:(id(1 bsl 100))>>),
+ {'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.
@@ -707,8 +691,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) ->
@@ -787,32 +771,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.
@@ -853,17 +837,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.
@@ -910,5 +894,42 @@ 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) ->
+ Memsize = memsize(),
+ io:format("Memsize = ~w Bytes~n", [Memsize]),
+ case erlang:system_info(wordsize) of
+ 8 ->
+ {skip, "64-bit architecture"};
+ _ when Memsize < (2 bsl 30) ->
+ {skip, "Less then 2 GB of memory"};
+ 4 ->
+ {'EXIT', {system_limit, _}} = (catch bs_add_overflow_signed()),
+ {'EXIT', {system_limit, _}} = (catch bs_add_overflow_unsigned()),
+ ok
+ end.
+
+bs_add_overflow_signed() ->
+ %% Produce a large result of bs_add that, if cast to signed int, would
+ %% overflow into a negative number that fits a smallnum.
+ Large = <<0:((1 bsl 30)-1)>>,
+ <<Large/bits, Large/bits, Large/bits, Large/bits,
+ Large/bits, Large/bits, Large/bits, Large/bits,
+ Large/bits>>.
+
+bs_add_overflow_unsigned() ->
+ %% Produce a large result of bs_add that goes beyond the limit of an
+ %% unsigned word. This used to succeed but produced an incorrect result
+ %% where B =:= C!
+ A = <<0:((1 bsl 32)-8)>>,
+ B = <<2, 3>>,
+ C = <<A/binary,1,B/binary>>,
+ true = byte_size(B) < byte_size(C).
+
id(I) -> I.
+
+memsize() ->
+ application:ensure_all_started(os_mon),
+ {Tot,_Used,_} = memsup:get_memory_data(),
+ Tot.
diff --git a/erts/emulator/test/bs_match_bin_SUITE.erl b/erts/emulator/test/bs_match_bin_SUITE.erl
index 96e69dbc0b..f5c996ae9e 100644
--- a/erts/emulator/test/bs_match_bin_SUITE.erl
+++ b/erts/emulator/test/bs_match_bin_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2011. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2016. 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.
+%% 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%
%%
@@ -23,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]}].
@@ -46,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.
@@ -118,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 ce03ecb548..e913dc98b0 100644
--- a/erts/emulator/test/bs_match_int_SUITE.erl
+++ b/erts/emulator/test/bs_match_int_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2011. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2017. 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.
+%% 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%
@@ -23,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]).
@@ -50,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) ->
@@ -88,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
@@ -129,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.
@@ -138,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) ->
@@ -150,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) ->
@@ -161,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) ->
@@ -170,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.
@@ -226,39 +227,39 @@ 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
- %% allocation succeds will the matching fail because
+ %% allocation succeeds will the matching fail because
%% 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.
@@ -325,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 b0904acbe9..17759d78f3 100644
--- a/erts/emulator/test/bs_match_misc_SUITE.erl
+++ b/erts/emulator/test/bs_match_misc_SUITE.erl
@@ -1,34 +1,36 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2016. 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.
+%% 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(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,
@@ -36,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;
@@ -78,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.
@@ -114,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.
@@ -150,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;
@@ -291,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) ->
@@ -333,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.
@@ -358,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->
@@ -395,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
@@ -454,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.
@@ -472,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() ->
@@ -501,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) ->
@@ -511,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(_) ->
@@ -539,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 1397f2069c..cbebc554c7 100644
--- a/erts/emulator/test/bs_match_tail_SUITE.erl
+++ b/erts/emulator/test/bs_match_tail_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2011. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2016. 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.
+%% 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%
%%
@@ -20,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}.
@@ -89,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.
@@ -101,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 4ab7d674a6..a344f5c456 100644
--- a/erts/emulator/test/bs_utf_SUITE.erl
+++ b/erts/emulator/test/bs_utf_SUITE.erl
@@ -1,70 +1,47 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2016. 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.
+%% 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(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").
-
--define(FAIL(Expr), ?line fail_check(catch Expr, ??Expr, [])).
+-include_lib("common_test/include/ct.hrl").
-init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- Dog = ?t:timetrap(?t:minutes(6)),
- [{watchdog,Dog}|Config].
+-define(FAIL(Expr), fail_check(catch Expr, ??Expr, [])).
-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 ->
@@ -82,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) ->
@@ -153,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 ->
@@ -186,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 ->
@@ -227,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);
@@ -240,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.
@@ -264,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,
@@ -283,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,
@@ -293,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.
@@ -386,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,_} =
@@ -405,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 4b4af0babe..4e7004a424 100644
--- a/erts/emulator/test/busy_port_SUITE.erl
+++ b/erts/emulator/test/busy_port_SUITE.erl
@@ -1,39 +1,42 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2017. 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/.
+%% 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
%%
-%% 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.
+%% 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(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, init_per_testcase/2, 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,
- hard_busy_driver/1, soft_busy_driver/1]).
-
--compile(export_all).
+ hard_busy_driver/1, soft_busy_driver/1,
+ scheduling_delay_busy/1,
+ scheduling_delay_busy_nosuspend/1,
+ scheduling_busy_link/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% Internal exports.
--export([init/2]).
+-export([init/2,process_init/2,ack/2,call/2,cast/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,
@@ -42,19 +45,9 @@ 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) ->
+init_per_testcase(_Case, Config) when is_list(Config) ->
+ Killer = spawn(fun() -> killer_loop([]) end),
+ register(killer_process, Killer),
Config.
end_per_testcase(_Case, Config) when is_list(Config) ->
@@ -70,22 +63,49 @@ end_per_testcase(_Case, Config) when is_list(Config) ->
ok
end
end,
+ kill_processes(),
Config.
+kill_processes() ->
+ killer_process ! {get_pids,self()},
+ receive
+ {pids_to_kill,Pids} -> ok
+ end,
+ _ = [begin
+ case erlang:is_process_alive(P) of
+ true ->
+ io:format("Killing ~p\n", [P]);
+ false ->
+ ok
+ end,
+ unlink(P),
+ exit(P, kill)
+ end || P <- Pids],
+ ok.
+
+killer_loop(Pids) ->
+ receive
+ {add_pid,Pid} ->
+ killer_loop([Pid|Pids]);
+ {get_pids,To} ->
+ To ! {pids_to_kill,Pids}
+ end.
+
+kill_me(Pid) ->
+ killer_process ! {add_pid,Pid},
+ Pid.
+
%% 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) ->
@@ -98,8 +118,10 @@ generator(0, Writer, _Data) ->
%% Calling process_info(Pid, current_function) on a suspended process
%% used to crash Beam.
- {current_function, {erlang, send, 2}} =
- process_info(Writer, current_function),
+ case process_info(Writer, [status,current_function]) of
+ [{status,suspended},{current_function,{erlang,send,2}}] -> ok;
+ [{status,suspended},{current_function,{erlang,bif_return_trap,_}}] -> ok
+ end,
unlock_slave();
generator(N, Writer, Data) ->
Writer ! {exec, Data},
@@ -127,31 +149,28 @@ 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) ->
- {Owner, Slave} = get_slave(),
+ {_Owner, Slave} = get_slave(),
(catch port_command(Slave, "set_me_busy")),
(catch port_command(Slave, "hello")),
(catch port_command(Slave, "hello again")),
@@ -161,80 +180,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(),
- %%
- ?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),
+ ct:timetrap({seconds, 10}),
+ Self = self(),
%%
- ?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,
%%
%% +---------------+ +-----------+
@@ -245,65 +248,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,
@@ -317,36 +314,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};
@@ -359,19 +354,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),
@@ -380,14 +374,12 @@ 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() ->
- {Owner, Port} = get_slave(),
+ {_Owner, Port} = get_slave(),
(catch port_command(Port, "port to busy")),
(catch port_command(Port, "lock me")),
ok.
@@ -399,205 +391,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 = now(),
- Res = try {return,
- port_command(Prt, [], Opts)}
- catch Exception:Error -> {Exception, Error}
- end,
- End = now(),
- Time = round(timer:now_diff(End, Start)/1000),
- Tester ! {self(), port_command_result, Res, Time}
- end),
+ erlang:yield(),
+ Tester ! {self(), doing_port_command},
+ Start = erlang:monotonic_time(microsecond),
+ Res = try {return,
+ port_command(Prt, [], Opts)}
+ catch Exception:Error -> {Exception, Error}
+ end,
+ End = erlang:monotonic_time(microsecond),
+ 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),
@@ -696,11 +676,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",[]),
@@ -750,8 +730,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}]),
@@ -769,12 +748,13 @@ run_scenario([],Vars) ->
run_command(_M,spawn,{Args,Opts}) ->
Pid = spawn_opt(fun() -> apply(?MODULE,process_init,Args) end,[link|Opts]),
+ kill_me(Pid),
pal("spawn(~p): ~p",[Args,Pid]),
Pid;
run_command(M,spawn,Args) ->
run_command(M,spawn,{Args,[]});
run_command(Mod,Func,Args) ->
- erlang:display({{Mod,Func,Args},now()}),
+ erlang:display({{Mod,Func,Args}, erlang:system_time(microsecond)}),
apply(Mod,Func,Args).
validate_scenario(Data,[{print,Var}|T]) ->
@@ -857,14 +837,16 @@ 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) ->
fun_spawn(Fun, []).
fun_spawn(Fun, Args) ->
- spawn_link(erlang, apply, [Fun, Args]).
+ Pid = spawn_link(erlang, apply, [Fun, Args]),
+ kill_me(Pid),
+ Pid.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% These routines provide a port which will become busy when the
@@ -893,39 +875,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/busy_port_SUITE_data/Makefile.src b/erts/emulator/test/busy_port_SUITE_data/Makefile.src
index f7937bc8d3..ae6378a6ff 100644
--- a/erts/emulator/test/busy_port_SUITE_data/Makefile.src
+++ b/erts/emulator/test/busy_port_SUITE_data/Makefile.src
@@ -1,18 +1,19 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1997-2013. All Rights Reserved.
+# Copyright Ericsson AB 1997-2016. 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.
+# 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%
#
diff --git a/erts/emulator/test/busy_port_SUITE_data/hard_busy_drv.c b/erts/emulator/test/busy_port_SUITE_data/hard_busy_drv.c
index 52c41f8ca5..c4e0f13f06 100644
--- a/erts/emulator/test/busy_port_SUITE_data/hard_busy_drv.c
+++ b/erts/emulator/test/busy_port_SUITE_data/hard_busy_drv.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2009. All Rights Reserved.
+ * Copyright Ericsson AB 2009-2016. 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.
+ * 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%
*/
diff --git a/erts/emulator/test/busy_port_SUITE_data/hs_busy_drv.c b/erts/emulator/test/busy_port_SUITE_data/hs_busy_drv.c
index 7807b47e3d..ffaca18e90 100644
--- a/erts/emulator/test/busy_port_SUITE_data/hs_busy_drv.c
+++ b/erts/emulator/test/busy_port_SUITE_data/hs_busy_drv.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2009-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2009-2016. 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.
+ * 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%
*/
diff --git a/erts/emulator/test/busy_port_SUITE_data/scheduling_drv.c b/erts/emulator/test/busy_port_SUITE_data/scheduling_drv.c
index 2008b33a72..296b3f21de 100644
--- a/erts/emulator/test/busy_port_SUITE_data/scheduling_drv.c
+++ b/erts/emulator/test/busy_port_SUITE_data/scheduling_drv.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2009-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2009-2016. 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.
+ * 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%
*/
diff --git a/erts/emulator/test/busy_port_SUITE_data/soft_busy_drv.c b/erts/emulator/test/busy_port_SUITE_data/soft_busy_drv.c
index 30bcd86d1d..8a98f050f1 100644
--- a/erts/emulator/test/busy_port_SUITE_data/soft_busy_drv.c
+++ b/erts/emulator/test/busy_port_SUITE_data/soft_busy_drv.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2009. All Rights Reserved.
+ * Copyright Ericsson AB 2009-2016. 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.
+ * 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%
*/
diff --git a/erts/emulator/test/call_trace_SUITE.erl b/erts/emulator/test/call_trace_SUITE.erl
index ef1f2aa04c..1251d644ae 100644
--- a/erts/emulator/test/call_trace_SUITE.erl
+++ b/erts/emulator/test/call_trace_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2012. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2017. 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.
+%% 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%
@@ -20,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, {minutes, 2}}].
-all() ->
+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].
-
-end_per_testcase(_Func, Config) ->
- Dog = ?config(watchdog, Config),
- ?t:timetrap_cancel(Dog),
+ Config.
+end_per_testcase(_Func, _Config) ->
%% 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.
@@ -87,51 +68,63 @@ 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}, []),
-
- %% Test the 'new' flag.
-
- ?line {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),
- receive
- {'DOWN',Mref,_,_,_} -> ok
- end,
- ?line undefined = trace_info(Work1B, flags),
- ?line {flags,[]} = trace_info(new, flags),
- ?line {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]}}),
-
- %% 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]}}),
-
+ Tracer = start_tracer(),
+ {flags,[call]} = trace_info(self(), flags),
+ {tracer,Tracer} = trace_info(self(), tracer),
+ trace_func({?MODULE,worker_foo,1}, []),
+
+ %% Test the 'new' and 'new_processes' flags.
+
+ New = fun(Flag) ->
+ {Work1A,Work1B} = start_and_trace(Flag, [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),
+ expect({trace,Work1B,call,{?MODULE,worker_foo,[A1B]}}),
+ unlink(Work1B),
+ Mref = erlang:monitor(process, Work1B),
+ exit(Work1B, kill),
+ receive
+ {'DOWN',Mref,_,_,_} -> ok
+ end,
+ undefined = trace_info(Work1B, flags),
+ {flags,[]} = trace_info(Flag, flags),
+ {tracer,[]} = trace_info(Flag, tracer)
+ end,
+ New(new),
+ New(new_processes),
+
+ %% Test the 'existing' and 'existing_processes' flags.
+ Existing =
+ fun(Flag) ->
+ {Work2A,_Work2B} = start_and_trace(Flag, A2A=[5,6,7], [7,6,5]),
+ expect({trace,Work2A,call,{?MODULE,worker_foo,[A2A]}})
+ end,
+ Existing(existing),
+ Existing(existing_processes),
+
+ %% Test the 'all' and 'processes' flags.
+ All =
+ fun(Flag) ->
+ {Work3A,Work3B} = start_and_trace(Flag, A3A=[12,13], A3B=[13,12]),
+ expect({trace,Work3A,call,{?MODULE,worker_foo,[A3A]}}),
+ expect({trace,Work3B,call,{?MODULE,worker_foo,[A3B]}})
+ end,
+ All(all),
+ All(processes),
+
ok.
start_and_trace(Flag, A1, A2) ->
@@ -141,33 +134,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) ->
@@ -176,98 +169,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.
+ %% Read out the remaining 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.
@@ -286,8 +279,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),
@@ -303,8 +296,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(),
@@ -319,15 +312,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),
@@ -349,8 +342,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(),
@@ -362,13 +355,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),
@@ -384,10 +377,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.
@@ -396,162 +389,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) ->
@@ -566,38 +554,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.
@@ -610,71 +598,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() ->
@@ -682,396 +670,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().
@@ -1081,78 +1066,76 @@ 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},[{?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,[{?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
@@ -1160,22 +1143,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.
@@ -1190,7 +1173,7 @@ bs_sum_a(<<>>, Acc) -> Acc.
bs_sum_b(Acc, <<H,T/binary>>) -> bs_sum_b(H+Acc, T);
bs_sum_b(Acc, <<>>) -> Acc.
-
+
@@ -1198,98 +1181,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.
@@ -1309,19 +1292,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.
@@ -1338,30 +1321,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) ->
@@ -1369,9 +1352,9 @@ deep_5(A) when is_integer(A) ->
flush() ->
receive X ->
- [X|flush()]
+ [X|flush()]
after 1000 ->
- []
+ []
end.
%% Abbreviate large complex terms
@@ -1394,10 +1377,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 b0408cabe1..77321aa50f 100644
--- a/erts/emulator/test/code_SUITE.erl
+++ b/erts/emulator/test/code_SUITE.erl
@@ -1,46 +1,45 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2012. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2017. 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.
+%% 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(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, call_purged_fun_code_gone/1,
+ call_purged_fun_code_reload/1, call_purged_fun_code_there/1,
+ multi_proc_purge/1, t_check_old_code/1,
+ external_fun/1,get_chunk/1,module_md5/1,
+ constant_pools/1,constant_refc_binaries/1,
+ false_dependency/1,coverage/1,fun_confusion/1,
+ t_copy_literals/1, t_copy_literals_frags/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]}].
all() ->
- [versions, new_binary_types, t_check_process_code,
- t_check_process_code_ets, t_check_old_code, external_fun, get_chunk,
- module_md5, make_stub, make_stub_many_funs,
+ [versions, new_binary_types, call_purged_fun_code_gone,
+ call_purged_fun_code_reload, call_purged_fun_code_there,
+ multi_proc_purge, t_check_old_code, external_fun, get_chunk,
+ module_md5,
constant_pools, constant_refc_binaries, false_dependency,
- coverage, fun_confusion].
-
-groups() ->
- [].
+ coverage, fun_confusion, t_copy_literals, t_copy_literals_frags].
init_per_suite(Config) ->
erts_debug:set_internal_state(available_internal_state, true),
@@ -50,12 +49,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),
@@ -72,14 +65,14 @@ versions(Config) when is_list(Config) ->
2 = versions:version(),
%% Kill processes, unload code.
- P1 ! P2 ! done,
_ = monitor(process, P1),
_ = monitor(process, P2),
+ P1 ! P2 ! done,
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),
@@ -87,409 +80,318 @@ 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"),
-
- ?line {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),
-
- %% 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)),
-
- %% The fun should still be there, preventing purge.
- ?line 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),
-
- %% 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),
-
- %% Kill all funs.
- t_check_process_code1(Code, []).
-
-%% 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),
- 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),
-
- %% 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),
-
- %% 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),
-
- %% Some fake funs in the same module should not do any difference.
- ?line 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),
-
- ?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),
- 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),
+call_purged_fun_code_gone(Config) when is_list(Config) ->
+ Priv = proplists:get_value(priv_dir, Config),
+ Data = proplists:get_value(data_dir, Config),
+ call_purged_fun_test(Priv, Data, code_gone),
ok.
-body(F, Fakes) ->
- receive
- jog ->
- 40 = F(3),
- erlang:garbage_collect(),
- body(F, Fakes);
- drop_funs ->
- dropped_body()
- end.
+call_purged_fun_code_reload(Config) when is_list(Config) ->
+ Priv = proplists:get_value(priv_dir, Config),
+ Data = proplists:get_value(data_dir, Config),
+ Path = code:get_path(),
+ true = code:add_path(Priv),
+ try
+ call_purged_fun_test(Priv, Data, code_reload)
+ after
+ code:set_path(Path)
+ end,
+ ok.
-dropped_body() ->
- receive
- X -> exit(X)
- end.
+call_purged_fun_code_there(Config) when is_list(Config) ->
+ Priv = proplists:get_value(priv_dir, Config),
+ Data = proplists:get_value(data_dir, Config),
+ call_purged_fun_test(Priv, Data, code_there),
+ ok.
-gc() ->
- erlang:garbage_collect(),
- gc1().
-gc1() -> ok.
-
-t_check_process_code_ets(doc) ->
- "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)
- end.
+call_purged_fun_test(Priv, Data, Type) ->
+ OptsList = case erlang:system_info(hipe_architecture) of
+ undefined -> [[]];
+ _ -> [[], [native,{d,hipe}]]
+ end,
+ [call_purged_fun_test_do(Priv, Data, Type, CO, FO)
+ || CO <- OptsList, FO <- OptsList].
+
+
+call_purged_fun_test_do(Priv, Data, Type, CallerOpts, FunOpts) ->
+ io:format("Compile caller as ~p and funs as ~p\n", [CallerOpts, FunOpts]),
+ SrcFile = filename:join(Data, "call_purged_fun_tester.erl"),
+ ObjFile = filename:join(Priv, "call_purged_fun_tester.beam"),
+ {ok,Mod,Code} = compile:file(SrcFile, [binary, report | CallerOpts]),
+ {module,Mod} = code:load_binary(Mod, ObjFile, Code),
+
+ call_purged_fun_tester:do(Priv, Data, Type, FunOpts).
+
+
+multi_proc_purge(Config) when is_list(Config) ->
+ %%
+ %% Make sure purge requests aren't lost when
+ %% purger process is working.
+ %%
+ Priv = proplists:get_value(priv_dir, Config),
+ Data = proplists:get_value(data_dir, Config),
+ File1 = filename:join(Data, "my_code_test"),
+ File2 = filename:join(Data, "my_code_test2"),
+
+ {ok,my_code_test} = c:c(File1, [{outdir,Priv}]),
+ {ok,my_code_test2} = c:c(File2, [{outdir,Priv}]),
+ erlang:delete_module(my_code_test),
+ erlang:delete_module(my_code_test2),
-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),
- 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),
- receive after 1 -> ok end,
- ?line true = erlang:check_process_code(Pid, my_code_test),
- Pid ! call,
- Pid ! {drop_funs,self()},
+ Self = self(),
- receive
- funs_dropped -> ok;
- Other -> ?t:fail({unexpected,Other})
- after 10000 ->
- ?line ?t:fail(no_funs_dropped_answer)
- end,
+ Fun1 = fun () ->
+ erts_code_purger:purge(my_code_test),
+ Self ! {self(), done}
+ end,
+ Fun2 = fun () ->
+ erts_code_purger:soft_purge(my_code_test2),
+ Self ! {self(), done}
+ end,
+ Fun3 = fun () ->
+ erts_code_purger:purge('__nonexisting_module__'),
+ Self ! {self(), done}
+ end,
+ Fun4 = fun () ->
+ erts_code_purger:soft_purge('__another_nonexisting_module__'),
+ Self ! {self(), done}
+ end,
- ?line false = erlang:check_process_code(Pid, my_code_test),
+ Pid1 = spawn_link(Fun1),
+ Pid2 = spawn_link(Fun2),
+ Pid3 = spawn_link(Fun3),
+ Pid4 = spawn_link(Fun4),
+ Pid5 = spawn_link(Fun1),
+ Pid6 = spawn_link(Fun2),
+ Pid7 = spawn_link(Fun3),
+ receive after 50 -> ok end,
+ Pid8 = spawn_link(Fun4),
+ Pid9 = spawn_link(Fun1),
+ Pid10 = spawn_link(Fun2),
+ Pid11 = spawn_link(Fun3),
+ Pid12 = spawn_link(Fun4),
+ Pid13 = spawn_link(Fun1),
+ receive after 50 -> ok end,
+ Pid14 = spawn_link(Fun2),
+ Pid15 = spawn_link(Fun3),
+ Pid16 = spawn_link(Fun4),
+
+ lists:foreach(fun (P) -> receive {P, done} -> ok end end,
+ [Pid1, Pid2, Pid3, Pid4, Pid5, Pid6, Pid7, Pid8,
+ Pid9, Pid10, Pid11, Pid12, Pid13, Pid14, Pid15, Pid16]),
ok.
-fun_refc(F) ->
- {refc,Count} = erlang:fun_info(F, refc),
- Count.
-
-
%% 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),
+ catch erlang:purge_module(my_code_test),
+ catch erlang:delete_module(my_code_test),
+ catch erlang:purge_module(my_code_test),
- ?line false = erlang:check_old_code(my_code_test),
+ false = 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),
+ {ok,my_code_test,Code} = compile:file(File, [binary]),
+ {module,my_code_test} = code:load_binary(my_code_test, File, Code),
- ?line true = erlang:purge_module(my_code_test),
- ?line true = erlang:delete_module(my_code_test),
- ?line true = erlang:purge_module(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),
+
+ true = erlang:purge_module(my_code_test),
+ true = erlang:delete_module(my_code_test),
+ 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("AtU8", Code),
+ Chunk = get_chunk_ok("AtU8", make_sub_binary(Code)),
+ Chunk = get_chunk_ok("AtU8", 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), "AtU8")),
+ {'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">>, "AtU8"),
+ 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.
-make_stub(Config) when is_list(Config) ->
- catch erlang:purge_module(my_code_test),
-
- ?line Data = ?config(data_dir, Config),
- ?line File = filename:join(Data, "my_code_test"),
- ?line {ok,my_code_test,Code} = compile:file(File, [binary]),
-
- ?line my_code_test = code:make_stub_module(my_code_test, Code, {[],[]}),
- ?line true = erlang:delete_module(my_code_test),
- ?line true = erlang:purge_module(my_code_test),
-
- ?line my_code_test = code:make_stub_module(my_code_test,
- make_unaligned_sub_binary(Code),
- {[],[]}),
- ?line true = erlang:delete_module(my_code_test),
- ?line true = erlang:purge_module(my_code_test),
-
- ?line my_code_test = code:make_stub_module(my_code_test, zlib:gzip(Code),
- {[],[]}),
- ?line true = erlang:delete_module(my_code_test),
- ?line true = erlang:purge_module(my_code_test),
-
- %% Should fail.
- ?line {'EXIT',{badarg,_}} =
- (catch code:make_stub_module(my_code_test, <<"bad">>, {[],[]})),
- ?line {'EXIT',{badarg,_}} =
- (catch code:make_stub_module(my_code_test,
- bit_sized_binary(Code),
- {[],[]})),
- ?line {'EXIT',{badarg,_}} =
- (catch code:make_stub_module(my_code_test_with_wrong_name,
- Code, {[],[]})),
- ok.
-
-make_stub_many_funs(Config) when is_list(Config) ->
- catch erlang:purge_module(many_funs),
-
- ?line Data = ?config(data_dir, Config),
- ?line File = filename:join(Data, "many_funs"),
- ?line {ok,many_funs,Code} = compile:file(File, [binary]),
-
- ?line many_funs = code:make_stub_module(many_funs, Code, {[],[]}),
- ?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),
- {[],[]}),
- ?line true = erlang:delete_module(many_funs),
- ?line true = erlang:purge_module(many_funs),
-
- %% Should fail.
- ?line {'EXIT',{badarg,_}} =
- (catch code:make_stub_module(many_funs, <<"bad">>, {[],[]})),
- ?line {'EXIT',{badarg,_}} =
- (catch code:make_stub_module(many_funs,
- bit_sized_binary(Code),
- {[],[]})),
- 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
- end.
+ end,
+
+ {module,literals} = erlang:load_module(literals, Code),
+ %% Have a hibernated process that references the literals
+ %% in the 'literals' module.
+ {Hib, Mon} = spawn_monitor(fun() -> hibernated(Self) end),
+ receive go -> ok end,
+ [{heap_size,OldHeapSz},
+ {total_heap_size,OldTotHeapSz}] = process_info(Hib, [heap_size,
+ total_heap_size]),
+ OldHeapSz = OldTotHeapSz,
+ io:format("OldHeapSz=~p OldTotHeapSz=~p~n", [OldHeapSz, OldTotHeapSz]),
+ true = erlang:delete_module(literals),
+ false = erlang:check_process_code(Hib, literals),
+ erlang:check_process_code(self(), literals),
+ erlang:purge_module(literals),
+ receive after 1000 -> ok end,
+ [{heap_size,HeapSz},
+ {total_heap_size,TotHeapSz}] = process_info(Hib, [heap_size,
+ total_heap_size]),
+ io:format("HeapSz=~p TotHeapSz=~p~n", [HeapSz, TotHeapSz]),
+ Hib ! hej,
+ receive
+ {'DOWN', Mon, process, Hib, Reason} ->
+ {undef, [{no_module,
+ no_function,
+ [{A,B,C,[1,2,3|_]=Seq}], _}]} = Reason,
+ 16 = length(Seq)
+ end,
+ HeapSz = TotHeapSz, %% Ensure restored to hibernated state...
+ true = HeapSz > OldHeapSz,
+ ok.
no_old_heap(Parent) ->
A = literals:a(),
@@ -497,8 +399,8 @@ no_old_heap(Parent) ->
Res = {A,B,literals:huge_bignum()},
Parent ! go,
receive
- done ->
- exit(Res)
+ done ->
+ exit(Res)
end.
old_heap(Parent) ->
@@ -508,16 +410,23 @@ old_heap(Parent) ->
create_old_heap(),
Parent ! go,
receive
- done ->
- exit(Res)
+ done ->
+ exit(Res)
end.
+hibernated(Parent) ->
+ A = literals:a(),
+ B = literals:b(),
+ Res = {A,B,literals:huge_bignum(),lists:seq(1, 16)},
+ Parent ! go,
+ erlang:hibernate(no_module, no_function, [Res]).
+
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) ->
@@ -526,7 +435,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]),
@@ -551,29 +460,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;
@@ -583,19 +492,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.
@@ -603,14 +512,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.
@@ -622,112 +531,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.
-%% ?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),
+ %% %% 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),
-%% %% There should not be any dependency to cpbugx.
-%% ?line false = erlang:check_process_code(Pid, cpbugx),
-
+ %% %% There should not be any dependency to cpbugx.
+ %% 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,
@@ -750,6 +659,208 @@ 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.
+
+-define(mod, t_copy_literals_frags).
+t_copy_literals_frags(Config) when is_list(Config) ->
+ Bin = gen_lit(?mod,[{a,{1,2,3,4,5,6,7}},
+ {b,"hello world"},
+ {c, <<"hello world">>},
+ {d, {"hello world", {1.0, 2.0, <<"some">>, "string"}}},
+ {e, <<"off heap", 0, 1, 2, 3, 4, 5, 6, 7,
+ 8, 9,10,11,12,13,14,15,
+ 0, 1, 2, 3, 4, 5, 6, 7,
+ 8, 9,10,11,12,13,14,15,
+ 0, 1, 2, 3, 4, 5, 6, 7,
+ 8, 9,10,11,12,13,14,15,
+ 0, 1, 2, 3, 4, 5, 6, 7,
+ 8, 9,10,11,12,13,14,15>>}]),
+
+ {module, ?mod} = erlang:load_module(?mod, Bin),
+ N = 6000,
+ Recv = spawn_opt(fun() -> receive
+ read ->
+ io:format("reading"),
+ literal_receiver()
+ end
+ end, [link,{min_heap_size, 10000}]),
+ Switcher = spawn_link(fun() -> literal_switcher() end),
+ Pids = [spawn_opt(fun() -> receive
+ {Pid, go, Recv, N} ->
+ io:format("sender batch (~w) start ~w~n",[N,self()]),
+ literal_sender(N,Recv),
+ Pid ! {self(), ok}
+ end
+ end, [link,{min_heap_size,800}]) || _ <- lists:seq(1,100)],
+ _ = [Pid ! {self(), go, Recv, N} || Pid <- Pids],
+ %% don't read immediately
+ timer:sleep(5),
+ Recv ! read,
+ Switcher ! {switch,?mod,Bin,[Recv|Pids],200},
+ _ = [receive {Pid, ok} -> ok end || Pid <- Pids],
+ Switcher ! {self(), done},
+ receive {Switcher, ok} -> ok end,
+ Recv ! {self(), done},
+ receive {Recv, ok} -> ok end,
+ ok.
+
+literal_receiver() ->
+ receive
+ {Pid, done} ->
+ io:format("reader_done~n"),
+ Pid ! {self(), ok};
+ {_Pid, msg, [A,B,C,D,E]} ->
+ A = ?mod:a(),
+ B = ?mod:b(),
+ C = ?mod:c(),
+ D = ?mod:d(),
+ E = ?mod:e(),
+ literal_receiver();
+ {Pid, sender_confirm} ->
+ io:format("sender confirm ~w~n", [Pid]),
+ Pid ! {self(), ok},
+ literal_receiver()
+ end.
+
+literal_sender(0, Recv) ->
+ Recv ! {self(), sender_confirm},
+ receive {Recv, ok} -> ok end;
+literal_sender(N, Recv) ->
+ Recv ! {self(), msg, [?mod:a(),
+ ?mod:b(),
+ ?mod:c(),
+ ?mod:d(),
+ ?mod:e()]},
+ literal_sender(N - 1, Recv).
+
+literal_switcher() ->
+ receive
+ {switch,Mod,Bin,Pids,Tmo} ->
+ literal_switcher(Mod,Bin,Pids,Tmo)
+ end.
+literal_switcher(Mod,Bin,Pids,Tmo) ->
+ receive
+ {Pid,done} ->
+ Pid ! {self(),ok}
+ after Tmo ->
+ io:format("load module ~w~n", [Mod]),
+ {module, Mod} = erlang:load_module(Mod,Bin),
+ ok = check_and_purge(Pids,Mod),
+ io:format("purge complete ~w~n", [Mod]),
+ literal_switcher(Mod,Bin,Pids,Tmo+Tmo)
+ end.
+
+check_and_purge([],Mod) ->
+ erlang:purge_module(Mod),
+ ok;
+check_and_purge(Pids,Mod) ->
+ io:format("purge ~w~n", [Mod]),
+ Tag = make_ref(),
+ _ = [begin
+ erlang:check_process_code(Pid,Mod,[{async,{Tag,Pid}}])
+ end || Pid <- Pids],
+ Retry = check_and_purge_receive(Pids,Tag,[]),
+ check_and_purge(Retry,Mod).
+
+check_and_purge_receive([Pid|Pids],Tag,Retry) ->
+ receive
+ {check_process_code, {Tag, Pid}, false} ->
+ check_and_purge_receive(Pids,Tag,Retry);
+ {check_process_code, {Tag, Pid}, true} ->
+ check_and_purge_receive(Pids,Tag,[Pid|Retry])
+ end;
+check_and_purge_receive([],_,Retry) ->
+ Retry.
+
+
+gen_lit(Module,Terms) ->
+ FunStrings = [lists:flatten(io_lib:format("~w() -> ~w.~n", [F,Term]))||{F,Term}<-Terms],
+ FunForms = function_forms(FunStrings),
+ Forms = [{attribute,erl_anno:new(1),module,Module},
+ {attribute,erl_anno:new(2),export,[FA || {FA,_} <- FunForms]}] ++
+ [Function || {_, Function} <- FunForms],
+ {ok, Module, Bin} = compile:forms(Forms),
+ Bin.
+
+function_forms([]) -> [];
+function_forms([S|Ss]) ->
+ {ok, Ts,_} = erl_scan:string(S),
+ {ok, Form} = erl_parse:parse_form(Ts),
+ Fun = element(3, Form),
+ Arity = element(4, Form),
+ [{{Fun,Arity}, Form}|function_forms(Ss)].
+
+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) ->
@@ -772,4 +883,8 @@ 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/another_code_test.erl b/erts/emulator/test/code_SUITE_data/another_code_test.erl
index 1c9b5bdb5b..5708ec682c 100644
--- a/erts/emulator/test/code_SUITE_data/another_code_test.erl
+++ b/erts/emulator/test/code_SUITE_data/another_code_test.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2016. 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.
+%% 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%
%%
diff --git a/erts/emulator/test/code_SUITE_data/call_purged_fun_tester.erl b/erts/emulator/test/code_SUITE_data/call_purged_fun_tester.erl
new file mode 100644
index 0000000000..699f0c1161
--- /dev/null
+++ b/erts/emulator/test/code_SUITE_data/call_purged_fun_tester.erl
@@ -0,0 +1,186 @@
+-module(call_purged_fun_tester).
+
+-export([do/4]).
+
+%% Resurrect line macro when hipe compiled
+-ifdef(hipe).
+-define(line, put(the_line,?LINE),).
+do(Priv, Data, Type, Opts) ->
+ try do_it(Priv, Data, Type, Opts)
+ catch
+ C:E ->
+ ST = erlang:get_stacktrace(),
+ io:format("Caught exception from line ~p:\n~p\n",
+ [get(the_line), ST]),
+ io:format("Message queue: ~p\n", [process_info(self(), messages)]),
+ erlang:raise(C, E, ST)
+ end.
+-else.
+-define(line,).
+do(P,D,T,O) ->
+ do_it(P,D,T,O).
+-endif.
+
+
+do_it(Priv, Data, Type, Opts) ->
+ File = filename:join(Data, "my_code_test2"),
+ Code = filename:join(Priv, "my_code_test2"),
+
+ catch erlang:purge_module(my_code_test2),
+ catch erlang:delete_module(my_code_test2),
+ catch erlang:purge_module(my_code_test2),
+
+ ?line {ok,my_code_test2} = c:c(File, [{outdir,Priv} | Opts]),
+
+ ?line IsNative = lists:member(native,Opts),
+ ?line IsNative = code:is_module_native(my_code_test2),
+
+ ?line T = ets:new(my_code_test2_fun_table, []),
+ ets:insert(T, {my_fun,my_code_test2:make_fun(4711)}),
+ ets:insert(T, {my_fun2,my_code_test2:make_fun2()}),
+
+ Papa = self(),
+ {P0,M0} = spawn_monitor(fun () ->
+ [{my_fun2,F2}] = ets:lookup(T, my_fun2),
+ F2(fun () ->
+ Papa ! {self(),"going to sleep"},
+ receive {Papa,"wake up"} -> ok end
+ end,
+ fun () -> ok end),
+ exit(completed)
+ end),
+
+ ?line PurgeType = case Type of
+ code_gone ->
+ ok = file:delete(Code++".beam"),
+ true;
+ code_reload ->
+ true;
+ code_there ->
+ false
+ end,
+
+ ?line true = erlang:delete_module(my_code_test2),
+
+ ?line ok = receive {P0, "going to sleep"} -> ok
+ after 1000 -> timeout
+ end,
+
+ ?line Purge = start_purge(my_code_test2, PurgeType),
+
+ ?line {P1, M1} = spawn_monitor(fun () ->
+ ?line [{my_fun,F}] = ets:lookup(T, my_fun),
+ ?line 4712 = F(1),
+ exit(completed)
+ end),
+
+ ?line ok = wait_until(fun () ->
+ {status, suspended}
+ == process_info(P1, status)
+ end),
+
+ ?line ok = continue_purge(Purge),
+
+ ?line {P2, M2} = spawn_monitor(fun () ->
+ ?line [{my_fun,F}] = ets:lookup(T, my_fun),
+ ?line 4713 = F(2),
+ exit(completed)
+ end),
+ ?line {P3, M3} = spawn_monitor(fun () ->
+ ?line [{my_fun,F}] = ets:lookup(T, my_fun),
+ ?line 4714 = F(3),
+ exit(completed)
+ end),
+
+ ?line ok = wait_until(fun () ->
+ {status, suspended}
+ == process_info(P2, status)
+ end),
+ ?line ok = wait_until(fun () ->
+ {status, suspended}
+ == process_info(P3, status)
+ end),
+
+ ?line {current_function,
+ {erts_code_purger,
+ pending_purge_lambda,
+ 3}} = process_info(P1, current_function),
+ ?line {current_function,
+ {erts_code_purger,
+ pending_purge_lambda,
+ 3}} = process_info(P2, current_function),
+ ?line {current_function,
+ {erts_code_purger,
+ pending_purge_lambda,
+ 3}} = process_info(P3, current_function),
+
+ case Type of
+ code_there ->
+ ?line false = complete_purge(Purge),
+ P0 ! {self(), "wake up"},
+ ?line completed = wait_for_down(P0,M0);
+ _ ->
+ ?line {true, true} = complete_purge(Purge),
+ ?line killed = wait_for_down(P0,M0)
+ end,
+
+ case Type of
+ code_gone ->
+ ?line {undef, _} = wait_for_down(P1,M1),
+ ?line {undef, _} = wait_for_down(P2,M2),
+ ?line {undef, _} = wait_for_down(P3,M3);
+ _ ->
+ ?line completed = wait_for_down(P1,M1),
+ ?line completed = wait_for_down(P2,M2),
+ ?line completed = wait_for_down(P3,M3),
+ catch erlang:purge_module(my_code_test2),
+ catch erlang:delete_module(my_code_test2),
+ catch erlang:purge_module(my_code_test2)
+ end,
+ ok.
+
+wait_for_down(P,M) ->
+ receive
+ {'DOWN', M, process, P, Reason} ->
+ Reason
+ after 1000 ->
+ timeout
+ end.
+
+wait_until(Fun) ->
+ wait_until(Fun, 20).
+
+wait_until(Fun, N) ->
+ case {Fun(),N} of
+ {true, _} ->
+ ok;
+ {false, 0} ->
+ timeout;
+ {false, _} ->
+ receive after 100 -> ok end,
+ wait_until(Fun, N-1)
+ end.
+
+start_purge(Mod, Type) when is_atom(Mod)
+ andalso ((Type == true)
+ orelse (Type == false)) ->
+ Ref = make_ref(),
+ erts_code_purger ! {test_purge, Mod, self(), Type, Ref},
+ receive
+ {started, Ref} ->
+ Ref
+ end.
+
+continue_purge(Ref) when is_reference(Ref) ->
+ erts_code_purger ! {continue, Ref},
+ receive
+ {continued, Ref} ->
+ ok
+ end.
+
+complete_purge(Ref) when is_reference(Ref) ->
+ erts_code_purger ! {complete, Ref},
+ receive
+ {test_purge, Res, Ref} ->
+ Res
+ end.
diff --git a/erts/emulator/test/code_SUITE_data/cpbugx.erl b/erts/emulator/test/code_SUITE_data/cpbugx.erl
index fb617c1973..ae2075c867 100644
--- a/erts/emulator/test/code_SUITE_data/cpbugx.erl
+++ b/erts/emulator/test/code_SUITE_data/cpbugx.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2016. 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.
+%% 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%
%%
diff --git a/erts/emulator/test/code_SUITE_data/fun_confusion.erl b/erts/emulator/test/code_SUITE_data/fun_confusion.erl
index 16000861df..35279f241d 100644
--- a/erts/emulator/test/code_SUITE_data/fun_confusion.erl
+++ b/erts/emulator/test/code_SUITE_data/fun_confusion.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2011. All Rights Reserved.
+%% Copyright Ericsson AB 2011-2016. 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.
+%% 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%
%%
diff --git a/erts/emulator/test/code_SUITE_data/literals.erl b/erts/emulator/test/code_SUITE_data/literals.erl
index 658427095e..7c3b0ebe73 100644
--- a/erts/emulator/test/code_SUITE_data/literals.erl
+++ b/erts/emulator/test/code_SUITE_data/literals.erl
@@ -1,24 +1,26 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2016. 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.
+%% 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(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]}.
@@ -100,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_SUITE_data/many_funs.erl b/erts/emulator/test/code_SUITE_data/many_funs.erl
index 0f9c3a85a4..ada570feee 100644
--- a/erts/emulator/test/code_SUITE_data/many_funs.erl
+++ b/erts/emulator/test/code_SUITE_data/many_funs.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2016. 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.
+%% 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%
%%
diff --git a/erts/emulator/test/code_SUITE_data/my_code_test.erl b/erts/emulator/test/code_SUITE_data/my_code_test.erl
index 5039b7f937..9d12aa9897 100644
--- a/erts/emulator/test/code_SUITE_data/my_code_test.erl
+++ b/erts/emulator/test/code_SUITE_data/my_code_test.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2016. 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.
+%% 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%
%%
@@ -23,5 +24,3 @@
make_fun(A) ->
fun(X) -> A + X end.
-
-
diff --git a/erts/emulator/test/code_SUITE_data/my_code_test2.erl b/erts/emulator/test/code_SUITE_data/my_code_test2.erl
new file mode 100644
index 0000000000..57973535d4
--- /dev/null
+++ b/erts/emulator/test/code_SUITE_data/my_code_test2.erl
@@ -0,0 +1,32 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1999-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(my_code_test2).
+
+-export([make_fun/1, make_fun2/0]).
+
+make_fun(A) ->
+ fun(X) -> A + X end.
+
+make_fun2() ->
+ fun (F1,F2) ->
+ F1(),
+ F2()
+ end.
diff --git a/erts/emulator/test/code_SUITE_data/versions.erl b/erts/emulator/test/code_SUITE_data/versions.erl
index 7a6fd8847d..56407e877a 100644
--- a/erts/emulator/test/code_SUITE_data/versions.erl
+++ b/erts/emulator/test/code_SUITE_data/versions.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2011. All Rights Reserved.
+%% Copyright Ericsson AB 2011-2016. 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/.
+%% 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
%%
-%% 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.
+%% 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%
%%
diff --git a/erts/emulator/test/code_parallel_load_SUITE.erl b/erts/emulator/test/code_parallel_load_SUITE.erl
index 428f1242ab..827add71e5 100644
--- a/erts/emulator/test/code_parallel_load_SUITE.erl
+++ b/erts/emulator/test/code_parallel_load_SUITE.erl
@@ -1,66 +1,52 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2012-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2012-2016. 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/.
+%% 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
%%
-%% 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.
+%% 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(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
@@ -71,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],
@@ -190,13 +174,15 @@ handle_cpc_responses(N, Tag, Module) ->
generate(Module, Attributes, FunStrings) ->
FunForms = function_forms(FunStrings),
Forms = [
- {attribute,1,module,Module},
- {attribute,2,export,[FA || {FA,_} <- FunForms]}
- ] ++ [{attribute, 3, A, V}|| {A, V} <- Attributes] ++
+ {attribute,a(1),module,Module},
+ {attribute,a(2),export,[FA || {FA,_} <- FunForms]}
+ ] ++ [{attribute, a(3), A, V}|| {A, V} <- Attributes] ++
[ Function || {_, Function} <- FunForms],
{ok, Module, Bin} = compile:forms(Forms),
Bin.
+a(L) ->
+ erl_anno:new(L).
function_forms([]) -> [];
function_forms([S|Ss]) ->
diff --git a/erts/emulator/test/crypto_SUITE.erl b/erts/emulator/test/crypto_SUITE.erl
index a82bd4fe38..afb1be7332 100644
--- a/erts/emulator/test/crypto_SUITE.erl
+++ b/erts/emulator/test/crypto_SUITE.erl
@@ -1,83 +1,63 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2011. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2016. 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.
+%% 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(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.
@@ -92,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]).
@@ -101,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).
@@ -119,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.
@@ -279,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.
%%
@@ -346,5 +314,3 @@ bit_sized_binary(Bin0) ->
Bin.
id(I) -> I.
-
-
diff --git a/erts/emulator/test/crypto_reference.erl b/erts/emulator/test/crypto_reference.erl
index b91535a50e..950b0c1560 100644
--- a/erts/emulator/test/crypto_reference.erl
+++ b/erts/emulator/test/crypto_reference.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2016. 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.
+%% 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%
%%
diff --git a/erts/emulator/test/ddll_SUITE.erl b/erts/emulator/test/ddll_SUITE.erl
index ffb68ed4ee..031b05790d 100644
--- a/erts/emulator/test/ddll_SUITE.erl
+++ b/erts/emulator/test/ddll_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2017. 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.
+%% 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%
%%
@@ -30,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, {minutes, 1}}].
all() ->
[ddll_test, errors, reference_count, kill_port,
@@ -69,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,
- ?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,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,
+ 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,
- ?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,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,
+ 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),
+ 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),
- ?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,
+ 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.
- % Verify that the driver was automaticly unloaded when the
+ test_server:sleep(200), % Give time to unload.
+ % Verify that the driver was automatically 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 2baf91cf29..54ee4d5567 100644
--- a/erts/emulator/test/decode_packet_SUITE.erl
+++ b/erts/emulator/test/decode_packet_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2016. 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/.
+%% 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
%%
-%% 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.
+%% 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%
%%
@@ -21,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,
@@ -38,67 +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} = now(),
- 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)).
@@ -107,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),
@@ -133,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}.
@@ -148,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) ->
@@ -364,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}.
@@ -486,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,
@@ -547,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.
@@ -568,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">>, []),
@@ -584,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: /",
@@ -593,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/dgawd_handler.erl b/erts/emulator/test/dgawd_handler.erl
index 27085b7b7e..52cdd26427 100644
--- a/erts/emulator/test/dgawd_handler.erl
+++ b/erts/emulator/test/dgawd_handler.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2016. 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.
+%% 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%
%%
diff --git a/erts/emulator/test/dirty_bif_SUITE.erl b/erts/emulator/test/dirty_bif_SUITE.erl
new file mode 100644
index 0000000000..981ec4d48d
--- /dev/null
+++ b/erts/emulator/test/dirty_bif_SUITE.erl
@@ -0,0 +1,580 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2017. 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(dirty_bif_SUITE).
+
+%%-define(line_trace,true).
+-define(CHECK(Exp,Got), check(Exp,Got,?LINE)).
+%%-define(CHECK(Exp,Got), Exp = Got).
+
+-include_lib("common_test/include/ct.hrl").
+
+-export([all/0, suite/0,
+ init_per_suite/1, end_per_suite/1,
+ init_per_testcase/2, end_per_testcase/2,
+ dirty_bif/1, dirty_bif_exception/1,
+ dirty_bif_multischedule/1,
+ dirty_bif_multischedule_exception/1,
+ dirty_scheduler_exit/1,
+ dirty_call_while_terminated/1,
+ dirty_heap_access/1,
+ dirty_process_info/1,
+ dirty_process_register/1,
+ dirty_process_trace/1,
+ code_purge/1]).
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+%%
+%% All these tests utilize the debug BIFs:
+%% - erts_debug:dirty_cpu/2 - Statically determined
+%% to (begin to) execute on a dirty CPU scheduler.
+%% - erts_debug:dirty_io/2 - Statically determined
+%% to (begin to) execute on a dirty IO scheduler.
+%% - erts_debug:dirty/3
+%% Their implementations are located in
+%% $ERL_TOP/erts/emulator/beam/beam_debug.c
+%%
+
+all() ->
+ [dirty_bif,
+ dirty_bif_multischedule,
+ dirty_bif_exception,
+ dirty_bif_multischedule_exception,
+ dirty_scheduler_exit,
+ dirty_call_while_terminated,
+ dirty_heap_access,
+ dirty_process_info,
+ dirty_process_register,
+ dirty_process_trace,
+ code_purge].
+
+init_per_suite(Config) ->
+ case erlang:system_info(dirty_cpu_schedulers) of
+ N when N > 0 ->
+ Config;
+ _ ->
+ {skipped, "No dirty scheduler support"}
+ end.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_testcase(Case, Config) ->
+ [{testcase, Case} | Config].
+
+end_per_testcase(_Case, _Config) ->
+ ok.
+
+dirty_bif(Config) when is_list(Config) ->
+ dirty_cpu = erts_debug:dirty_cpu(scheduler,type),
+ dirty_io = erts_debug:dirty_io(scheduler,type),
+ normal = erts_debug:dirty(normal,scheduler,type),
+ dirty_cpu = erts_debug:dirty(dirty_cpu,scheduler,type),
+ dirty_io = erts_debug:dirty(dirty_io,scheduler,type),
+ ok.
+
+dirty_bif_multischedule(Config) when is_list(Config) ->
+ ok = erts_debug:dirty_cpu(reschedule,1000),
+ ok = erts_debug:dirty_io(reschedule,1000),
+ ok = erts_debug:dirty(normal,reschedule,1000),
+ ok.
+
+
+dirty_bif_exception(Config) when is_list(Config) ->
+ lists:foreach(fun (Error) ->
+ ErrorType = case Error of
+ _ when is_atom(Error) -> Error;
+ _ -> badarg
+ end,
+ try
+ erts_debug:dirty_cpu(error, Error),
+ ct:fail(expected_exception)
+ catch
+ error:ErrorType ->
+ [{erts_debug,dirty_cpu,[error, Error],_}|_]
+ = erlang:get_stacktrace(),
+ ok
+ end,
+ try
+ apply(erts_debug,dirty_cpu,[error, Error]),
+ ct:fail(expected_exception)
+ catch
+ error:ErrorType ->
+ [{erts_debug,dirty_cpu,[error, Error],_}|_]
+ = erlang:get_stacktrace(),
+ ok
+ end,
+ try
+ erts_debug:dirty_io(error, Error),
+ ct:fail(expected_exception)
+ catch
+ error:ErrorType ->
+ [{erts_debug,dirty_io,[error, Error],_}|_]
+ = erlang:get_stacktrace(),
+ ok
+ end,
+ try
+ apply(erts_debug,dirty_io,[error, Error]),
+ ct:fail(expected_exception)
+ catch
+ error:ErrorType ->
+ [{erts_debug,dirty_io,[error, Error],_}|_]
+ = erlang:get_stacktrace(),
+ ok
+ end,
+ try
+ erts_debug:dirty(normal, error, Error),
+ ct:fail(expected_exception)
+ catch
+ error:ErrorType ->
+ [{erts_debug,dirty,[normal, error, Error],_}|_]
+ = erlang:get_stacktrace(),
+ ok
+ end,
+ try
+ apply(erts_debug,dirty,[normal, error, Error]),
+ ct:fail(expected_exception)
+ catch
+ error:ErrorType ->
+ [{erts_debug,dirty,[normal, error, Error],_}|_]
+ = erlang:get_stacktrace(),
+ ok
+ end,
+ try
+ erts_debug:dirty(dirty_cpu, error, Error),
+ ct:fail(expected_exception)
+ catch
+ error:ErrorType ->
+ [{erts_debug,dirty,[dirty_cpu, error, Error],_}|_]
+ = erlang:get_stacktrace(),
+ ok
+ end,
+ try
+ apply(erts_debug,dirty,[dirty_cpu, error, Error]),
+ ct:fail(expected_exception)
+ catch
+ error:ErrorType ->
+ [{erts_debug,dirty,[dirty_cpu, error, Error],_}|_]
+ = erlang:get_stacktrace(),
+ ok
+ end,
+ try
+ erts_debug:dirty(dirty_io, error, Error),
+ ct:fail(expected_exception)
+ catch
+ error:ErrorType ->
+ [{erts_debug,dirty,[dirty_io, error, Error],_}|_]
+ = erlang:get_stacktrace(),
+ ok
+ end,
+ try
+ apply(erts_debug,dirty,[dirty_io, error, Error]),
+ ct:fail(expected_exception)
+ catch
+ error:ErrorType ->
+ [{erts_debug,dirty,[dirty_io, error, Error],_}|_]
+ = erlang:get_stacktrace(),
+ ok
+ end
+ end,
+ [badarg, undef, badarith, system_limit, noproc,
+ make_ref(), {another, "heap", term_to_binary("term")}]),
+ ok.
+
+
+dirty_bif_multischedule_exception(Config) when is_list(Config) ->
+ try
+ erts_debug:dirty_cpu(reschedule,1001)
+ catch
+ error:badarg ->
+ [{erts_debug,dirty_cpu,[reschedule, 1001],_}|_]
+ = erlang:get_stacktrace(),
+ ok
+ end,
+ try
+ erts_debug:dirty_io(reschedule,1001)
+ catch
+ error:badarg ->
+ [{erts_debug,dirty_io,[reschedule, 1001],_}|_]
+ = erlang:get_stacktrace(),
+ ok
+ end,
+ try
+ erts_debug:dirty(normal,reschedule,1001)
+ catch
+ error:badarg ->
+ [{erts_debug,dirty,[normal,reschedule,1001],_}|_]
+ = erlang:get_stacktrace(),
+ ok
+ end.
+
+dirty_scheduler_exit(Config) when is_list(Config) ->
+ {ok, Node} = start_node(Config, "+SDio 1"),
+ [ok] = mcall(Node,
+ [fun() ->
+ Start = erlang:monotonic_time(millisecond),
+ ok = test_dirty_scheduler_exit(),
+ End = erlang:monotonic_time(millisecond),
+ io:format("Time=~p ms~n", [End-Start]),
+ ok
+ 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 () -> erts_debug:dirty_io(wait, 5000) end),
+ 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,Reason} ->
+ killed = Reason
+ end,
+ wait_dse(Pids).
+
+dirty_call_while_terminated(Config) when is_list(Config) ->
+ Me = self(),
+ Bin = list_to_binary(lists:duplicate(4711, $r)),
+ {value, {BinAddr, 4711, 1}} = lists:keysearch(4711, 2,
+ element(2,
+ process_info(self(),
+ binary))),
+ {Dirty, DM} = spawn_opt(fun () ->
+ erts_debug:dirty_cpu(alive_waitexiting, Me),
+ blipp:blupp(Bin)
+ end,
+ [monitor,link]),
+ receive {alive, Dirty} -> ok end,
+ {value, {BinAddr, 4711, 2}} = lists:keysearch(4711, 2,
+ element(2,
+ process_info(self(),
+ binary))),
+ Reason = die_dirty_process,
+ OT = process_flag(trap_exit, true),
+ exit(Dirty, Reason),
+ receive
+ {'DOWN', DM, process, Dirty, R0} ->
+ R0 = Reason
+ end,
+ receive
+ {'EXIT', Dirty, R1} ->
+ R1 = Reason
+ end,
+ undefined = process_info(Dirty),
+ undefined = process_info(Dirty, status),
+ false = erlang:is_process_alive(Dirty),
+ false = lists:member(Dirty, processes()),
+ %% Binary still refered by Dirty process not yet cleaned up
+ %% since the dirty bif has not yet returned...
+ {value, {BinAddr, 4711, 2}} = lists:keysearch(4711, 2,
+ element(2,
+ process_info(self(),
+ binary))),
+ receive after 2000 -> ok end,
+ receive
+ Msg ->
+ ct:fail({unexpected_message, Msg})
+ after
+ 0 ->
+ ok
+ end,
+ {value, {BinAddr, 4711, 1}} = lists:keysearch(4711, 2,
+ element(2,
+ process_info(self(),
+ binary))),
+ process_flag(trap_exit, OT),
+ try
+ blipp:blupp(Bin)
+ catch
+ _ : _ -> ok
+ end.
+
+dirty_heap_access(Config) when is_list(Config) ->
+ {ok, Node} = start_node(Config),
+ Me = self(),
+ RGL = rpc:call(Node,erlang,whereis,[init]),
+ Ref = rpc:call(Node,erlang,make_ref,[]),
+ Dirty = spawn_link(fun () ->
+ Res = erts_debug:dirty_cpu(copy, Ref),
+ garbage_collect(),
+ Me ! {self(), Res},
+ receive after infinity -> ok end
+ end),
+ {N, R} = access_dirty_heap(Dirty, RGL, 0, 0),
+ receive
+ {_Pid, Res} ->
+ 1000 = length(Res),
+ lists:foreach(fun (X) -> Ref = X end, Res)
+ end,
+ unlink(Dirty),
+ exit(Dirty, kill),
+ stop_node(Node),
+ {comment, integer_to_list(N) ++ " GL change loops; "
+ ++ integer_to_list(R) ++ " while running dirty"}.
+
+access_dirty_heap(Dirty, RGL, N, R) ->
+ case process_info(Dirty, status) of
+ {status, waiting} ->
+ {N, R};
+ {status, Status} ->
+ {group_leader, GL} = process_info(Dirty, group_leader),
+ true = group_leader(RGL, Dirty),
+ {group_leader, RGL} = process_info(Dirty, group_leader),
+ true = group_leader(GL, Dirty),
+ {group_leader, GL} = process_info(Dirty, group_leader),
+ access_dirty_heap(Dirty, RGL, N+1, case Status of
+ running ->
+ R+1;
+ _ ->
+ R
+ end)
+ end.
+
+%% These tests verify that processes that access a process executing a
+%% dirty BIF where the main lock is needed for that access do not get
+%% blocked. Each test passes its pid to dirty_sleeper, which sends an
+%% 'alive' message when it's running on a dirty scheduler and just before
+%% it starts a 6 second sleep. When it receives the message, it verifies
+%% that access to the dirty process is as it expects. After the dirty
+%% process finishes its 6 second sleep but before it returns from the dirty
+%% scheduler, it sends a 'done' message. If the tester already received
+%% that message, the test fails because it means attempting to access the
+%% dirty process waited for that process to return to a regular scheduler,
+%% so verify that we haven't received that message, and also verify that
+%% the dirty process is still alive immediately after accessing it.
+dirty_process_info(Config) when is_list(Config) ->
+ access_dirty_process(
+ Config,
+ fun() -> ok end,
+ fun(BifPid) ->
+ PI = process_info(BifPid),
+ {current_function,{erts_debug,dirty_io,2}} =
+ lists:keyfind(current_function, 1, PI),
+ ok
+ end,
+ fun(_) -> ok end).
+
+dirty_process_register(Config) when is_list(Config) ->
+ access_dirty_process(
+ Config,
+ fun() -> ok end,
+ fun(BifPid) ->
+ register(test_dirty_process_register, BifPid),
+ BifPid = whereis(test_dirty_process_register),
+ unregister(test_dirty_process_register),
+ false = lists:member(test_dirty_process_register,
+ registered()),
+ ok
+ end,
+ fun(_) -> ok end).
+
+dirty_process_trace(Config) when is_list(Config) ->
+ access_dirty_process(
+ Config,
+ fun() ->
+ erlang:trace_pattern({erts_debug,dirty_io,2},
+ [{'_',[],[{return_trace}]}],
+ [local,meta]),
+ ok
+ end,
+ fun(BifPid) ->
+ erlang:trace(BifPid, true, [call,timestamp]),
+ ok
+ end,
+ fun(BifPid) ->
+ receive
+ {done, BifPid} ->
+ receive
+ {trace_ts,BifPid,call,{erts_debug,dirty_io,_},_} ->
+ ok
+ after
+ 0 ->
+ error(missing_trace_call_message)
+ end %%,
+ %% receive
+ %% {trace_ts,BifPid,return_from,{erts_debug,dirty_io,2},
+ %% ok,_} ->
+ %% ok
+ %% after
+ %% 100 ->
+ %% error(missing_trace_return_message)
+ %% end
+ after
+ 6500 ->
+ error(missing_done_message)
+ end,
+ ok
+ end).
+
+dirty_code_test_code() ->
+ "
+-module(dirty_code_test).
+
+-export([func/1]).
+
+func(Fun) ->
+ Fun(),
+ blipp:blapp().
+
+".
+
+code_purge(Config) when is_list(Config) ->
+ Path = ?config(data_dir, Config),
+ File = filename:join(Path, "dirty_code_test.erl"),
+ ok = file:write_file(File, dirty_code_test_code()),
+ {ok, dirty_code_test, Bin} = compile:file(File, [binary]),
+ {module, dirty_code_test} = erlang:load_module(dirty_code_test, Bin),
+ Start = erlang:monotonic_time(),
+ {Pid1, Mon1} = spawn_monitor(fun () ->
+ dirty_code_test:func(fun () ->
+ %% Sleep for 6 seconds
+ %% in dirty bif...
+ erts_debug:dirty_io(wait,6000)
+ end)
+ end),
+ {module, dirty_code_test} = erlang:load_module(dirty_code_test, Bin),
+ {Pid2, Mon2} = spawn_monitor(fun () ->
+ dirty_code_test:func(fun () ->
+ %% Sleep for 6 seconds
+ %% in dirty bif...
+ erts_debug:dirty_io(wait,6000)
+ end)
+ end),
+ receive
+ {'DOWN', Mon1, process, Pid1, _} ->
+ ct:fail(premature_death)
+ after 100 ->
+ ok
+ end,
+ true = erlang:purge_module(dirty_code_test),
+ receive
+ {'DOWN', Mon1, process, Pid1, Reason1} ->
+ killed = Reason1
+ end,
+ receive
+ {'DOWN', Mon2, process, Pid2, _} ->
+ ct:fail(premature_death)
+ after 100 ->
+ ok
+ end,
+ true = erlang:delete_module(dirty_code_test),
+ receive
+ {'DOWN', Mon2, process, Pid2, _} ->
+ ct:fail(premature_death)
+ after 100 ->
+ ok
+ end,
+ true = erlang:purge_module(dirty_code_test),
+ receive
+ {'DOWN', Mon2, process, Pid2, Reason2} ->
+ killed = Reason2
+ end,
+ End = erlang:monotonic_time(),
+ Time = erlang:convert_time_unit(End-Start, native, milli_seconds),
+ io:format("Time=~p~n", [Time]),
+ true = Time =< 1000,
+ ok.
+
+%%
+%% Internal...
+%%
+
+access_dirty_process(Config, Start, Test, Finish) ->
+ {ok, Node} = start_node(Config, ""),
+ [ok] = mcall(Node,
+ [fun() ->
+ ok = test_dirty_process_access(Start, Test, Finish)
+ end]),
+ stop_node(Node),
+ ok.
+
+test_dirty_process_access(Start, Test, Finish) ->
+ ok = Start(),
+ Self = self(),
+ BifPid = spawn_link(fun() ->
+ ok = erts_debug:dirty_io(ready_wait6_done, Self)
+ end),
+ ok = receive
+ {ready, BifPid} ->
+ ok = Test(BifPid),
+ receive
+ {done, BifPid} ->
+ error(dirty_process_info_blocked)
+ after
+ 0 ->
+ true = erlang:is_process_alive(BifPid),
+ ok
+ end
+ after
+ 3000 ->
+ error(timeout)
+ end,
+ ok = Finish(BifPid).
+
+start_node(Config) ->
+ start_node(Config, "").
+
+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(proplists:get_value(testcase, Config))
+ ++ "-"
+ ++ integer_to_list(erlang:system_time(second))
+ ++ "-"
+ ++ integer_to_list(erlang:unique_integer([positive]))),
+ test_server:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]).
+
+stop_node(Node) ->
+ test_server:stop_node(Node).
+
+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),
+ lists:map(fun (Ref) ->
+ receive
+ {Ref, Res} ->
+ Res
+ end
+ end, Refs).
diff --git a/erts/emulator/test/dirty_bif_SUITE_data/.gitignore b/erts/emulator/test/dirty_bif_SUITE_data/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/erts/emulator/test/dirty_bif_SUITE_data/.gitignore
diff --git a/erts/emulator/test/dirty_nif_SUITE.erl b/erts/emulator/test/dirty_nif_SUITE.erl
new file mode 100644
index 0000000000..13806fd5c4
--- /dev/null
+++ b/erts/emulator/test/dirty_nif_SUITE.erl
@@ -0,0 +1,683 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2017. 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(dirty_nif_SUITE).
+
+%%-define(line_trace,true).
+-define(CHECK(Exp,Got), check(Exp,Got,?LINE)).
+%%-define(CHECK(Exp,Got), Exp = Got).
+
+-include_lib("common_test/include/ct.hrl").
+
+-export([all/0, suite/0,
+ init_per_suite/1, end_per_suite/1,
+ init_per_testcase/2, end_per_testcase/2,
+ dirty_nif/1, dirty_nif_send/1,
+ dirty_nif_exception/1, call_dirty_nif_exception/1,
+ dirty_scheduler_exit/1, dirty_call_while_terminated/1,
+ dirty_heap_access/1, dirty_process_info/1,
+ dirty_process_register/1, dirty_process_trace/1,
+ code_purge/1, dirty_nif_send_traced/1,
+ nif_whereis/1, nif_whereis_parallel/1, nif_whereis_proxy/1]).
+
+-define(nif_stub,nif_stub_error(?LINE)).
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [dirty_nif,
+ dirty_nif_send,
+ dirty_nif_exception,
+ dirty_scheduler_exit,
+ dirty_call_while_terminated,
+ dirty_heap_access,
+ dirty_process_info,
+ dirty_process_register,
+ dirty_process_trace,
+ code_purge,
+ dirty_nif_send_traced,
+ nif_whereis,
+ nif_whereis_parallel].
+
+init_per_suite(Config) ->
+ case erlang:system_info(dirty_cpu_schedulers) of
+ N when N > 0 ->
+ case lib_loaded() of
+ false ->
+ ok = erlang:load_nif(
+ filename:join(?config(data_dir, Config),
+ "dirty_nif_SUITE"), []);
+ true ->
+ ok
+ end,
+ Config;
+ _ ->
+ {skipped, "No dirty scheduler support"}
+ end.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_testcase(Case, Config) ->
+ [{testcase, Case} | Config].
+
+end_per_testcase(_Case, _Config) ->
+ ok.
+
+dirty_nif(Config) when is_list(Config) ->
+ Val1 = 42,
+ Val2 = "Erlang",
+ Val3 = list_to_binary([Val2, 0]),
+ {Val1, Val2, Val3} = call_dirty_nif(Val1, Val2, Val3),
+ LargeArray = lists:duplicate(1000, ok),
+ LargeArray = call_dirty_nif_zero_args(),
+ ok.
+
+dirty_nif_send(Config) when is_list(Config) ->
+ Parent = self(),
+ Pid = spawn_link(fun() ->
+ Self = self(),
+ {ok, Self} = receive_any(),
+ Parent ! {ok, Self}
+ end),
+ {ok, Pid} = send_from_dirty_nif(Pid),
+ {ok, Pid} = receive_any(),
+ ok.
+
+dirty_nif_exception(Config) when is_list(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).
+
+nif_raise_exceptions(NifFunc) ->
+ ExcTerms = [{error, test}, "a string", <<"a binary">>,
+ 42, [1,2,3,4,5], [{p,1},{p,2},{p,3}]],
+ lists:foldl(fun(Term, ok) ->
+ try
+ erlang:apply(?MODULE,NifFunc,[Term]),
+ ct:fail({expected,Term})
+ catch
+ error:Term ->
+ [{?MODULE,NifFunc,[Term],_}|_] = erlang:get_stacktrace(),
+ ok
+ end
+ end, ok, ExcTerms).
+
+dirty_scheduler_exit(Config) when is_list(Config) ->
+ {ok, Node} = start_node(Config, "+SDio 1"),
+ Path = proplists:get_value(data_dir, Config),
+ NifLib = filename:join(Path, atom_to_list(?MODULE)),
+ [ok] = mcall(Node,
+ [fun() ->
+ ok = erlang:load_nif(NifLib, []),
+ Start = erlang:monotonic_time(millisecond),
+ ok = test_dirty_scheduler_exit(),
+ End = erlang:monotonic_time(millisecond),
+ io:format("Time=~p ms~n", [End-Start]),
+ ok
+ 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,Reason} ->
+ killed = Reason
+ end,
+ wait_dse(Pids).
+
+dirty_call_while_terminated(Config) when is_list(Config) ->
+ Me = self(),
+ Bin = list_to_binary(lists:duplicate(4711, $r)),
+ {value, {BinAddr, 4711, 1}} = lists:keysearch(4711, 2,
+ element(2,
+ process_info(self(),
+ binary))),
+ {Dirty, DM} = spawn_opt(fun () ->
+ dirty_call_while_terminated_nif(Me),
+ blipp:blupp(Bin)
+ end,
+ [monitor,link]),
+ receive {dirty_alive, _Pid} -> ok end,
+ {value, {BinAddr, 4711, 2}} = lists:keysearch(4711, 2,
+ element(2,
+ process_info(self(),
+ binary))),
+ Reason = die_dirty_process,
+ OT = process_flag(trap_exit, true),
+ exit(Dirty, Reason),
+ receive
+ {'DOWN', DM, process, Dirty, R0} ->
+ R0 = Reason
+ end,
+ receive
+ {'EXIT', Dirty, R1} ->
+ R1 = Reason
+ end,
+ undefined = process_info(Dirty),
+ undefined = process_info(Dirty, status),
+ false = erlang:is_process_alive(Dirty),
+ false = lists:member(Dirty, processes()),
+ %% Binary still referred by Dirty process not yet cleaned up
+ %% since the dirty nif has not yet returned...
+ {value, {BinAddr, 4711, 2}} = lists:keysearch(4711, 2,
+ element(2,
+ process_info(self(),
+ binary))),
+ receive after 2000 -> ok end,
+ receive
+ Msg ->
+ ct:fail({unexpected_message, Msg})
+ after
+ 0 ->
+ ok
+ end,
+ {value, {BinAddr, 4711, 1}} = lists:keysearch(4711, 2,
+ element(2,
+ process_info(self(),
+ binary))),
+ process_flag(trap_exit, OT),
+ try
+ blipp:blupp(Bin)
+ catch
+ _ : _ -> ok
+ end.
+
+dirty_heap_access(Config) when is_list(Config) ->
+ {ok, Node} = start_node(Config),
+ Me = self(),
+ RGL = rpc:call(Node,erlang,whereis,[init]),
+ Ref = rpc:call(Node,erlang,make_ref,[]),
+ Dirty = spawn_link(fun () ->
+ Res = dirty_heap_access_nif(Ref),
+ garbage_collect(),
+ Me ! {self(), Res},
+ receive after infinity -> ok end
+ end),
+ {N, R} = access_dirty_heap(Dirty, RGL, 0, 0),
+ receive
+ {_Pid, Res} ->
+ 1000 = length(Res),
+ lists:foreach(fun (X) -> Ref = X end, Res)
+ end,
+ unlink(Dirty),
+ exit(Dirty, kill),
+ stop_node(Node),
+ {comment, integer_to_list(N) ++ " GL change loops; "
+ ++ integer_to_list(R) ++ " while running dirty"}.
+
+access_dirty_heap(Dirty, RGL, N, R) ->
+ case process_info(Dirty, status) of
+ {status, waiting} ->
+ {N, R};
+ {status, Status} ->
+ {group_leader, GL} = process_info(Dirty, group_leader),
+ true = group_leader(RGL, Dirty),
+ {group_leader, RGL} = process_info(Dirty, group_leader),
+ true = group_leader(GL, Dirty),
+ {group_leader, GL} = process_info(Dirty, group_leader),
+ access_dirty_heap(Dirty, RGL, N+1, case Status of
+ running ->
+ R+1;
+ _ ->
+ R
+ end)
+ end.
+
+%% These tests verify that processes that access a process executing a
+%% dirty NIF where the main lock is needed for that access do not get
+%% blocked. Each test passes its pid to dirty_sleeper, which sends a
+%% 'ready' message when it's running on a dirty scheduler and just before
+%% it starts a 6 second sleep. When it receives the message, it verifies
+%% that access to the dirty process is as it expects. After the dirty
+%% process finishes its 6 second sleep but before it returns from the dirty
+%% scheduler, it sends a 'done' message. If the tester already received
+%% that message, the test fails because it means attempting to access the
+%% dirty process waited for that process to return to a regular scheduler,
+%% so verify that we haven't received that message, and also verify that
+%% the dirty process is still alive immediately after accessing it.
+dirty_process_info(Config) when is_list(Config) ->
+ access_dirty_process(
+ Config,
+ fun() -> ok end,
+ fun(NifPid) ->
+ PI = process_info(NifPid),
+ {current_function,{?MODULE,dirty_sleeper,1}} =
+ lists:keyfind(current_function, 1, PI),
+ ok
+ end,
+ fun(_) -> ok end).
+
+dirty_process_register(Config) when is_list(Config) ->
+ access_dirty_process(
+ Config,
+ fun() -> ok end,
+ fun(NifPid) ->
+ register(test_dirty_process_register, NifPid),
+ NifPid = whereis(test_dirty_process_register),
+ unregister(test_dirty_process_register),
+ false = lists:member(test_dirty_process_register,
+ registered()),
+ ok
+ end,
+ fun(_) -> ok end).
+
+dirty_process_trace(Config) when is_list(Config) ->
+ access_dirty_process(
+ Config,
+ fun() ->
+ erlang:trace_pattern({?MODULE,dirty_sleeper,1},
+ [{'_',[],[{return_trace}]}],
+ [local,meta]),
+ ok
+ end,
+ fun(NifPid) ->
+ erlang:trace(NifPid, true, [call,timestamp]),
+ ok
+ end,
+ fun(NifPid) ->
+ receive
+ done ->
+ receive
+ {trace_ts,NifPid,call,{?MODULE,dirty_sleeper,_},_} ->
+ ok
+ after
+ 0 ->
+ error(missing_trace_call_message)
+ end,
+ receive
+ {trace_ts,NifPid,return_from,{?MODULE,dirty_sleeper,1},
+ ok,_} ->
+ ok
+ after
+ 100 ->
+ error(missing_trace_return_message)
+ end
+ after
+ 6500 ->
+ error(missing_done_message)
+ end,
+ ok
+ end).
+
+dirty_code_test_code() ->
+ "
+-module(dirty_code_test).
+
+-export([func/1]).
+
+func(Fun) ->
+ Fun(),
+ blipp:blapp().
+
+".
+
+code_purge(Config) when is_list(Config) ->
+ Path = ?config(data_dir, Config),
+ File = filename:join(Path, "dirty_code_test.erl"),
+ ok = file:write_file(File, dirty_code_test_code()),
+ {ok, dirty_code_test, Bin} = compile:file(File, [binary]),
+ {module, dirty_code_test} = erlang:load_module(dirty_code_test, Bin),
+ Start = erlang:monotonic_time(),
+ {Pid1, Mon1} = spawn_monitor(fun () ->
+ dirty_code_test:func(fun () ->
+ %% Sleep for 6 seconds
+ %% in dirty nif...
+ dirty_sleeper()
+ end)
+ end),
+ {module, dirty_code_test} = erlang:load_module(dirty_code_test, Bin),
+ {Pid2, Mon2} = spawn_monitor(fun () ->
+ dirty_code_test:func(fun () ->
+ %% Sleep for 6 seconds
+ %% in dirty nif...
+ dirty_sleeper()
+ end)
+ end),
+ receive
+ {'DOWN', Mon1, process, Pid1, _} ->
+ ct:fail(premature_death)
+ after 100 ->
+ ok
+ end,
+ true = erlang:purge_module(dirty_code_test),
+ receive
+ {'DOWN', Mon1, process, Pid1, Reason1} ->
+ killed = Reason1
+ end,
+ receive
+ {'DOWN', Mon2, process, Pid2, _} ->
+ ct:fail(premature_death)
+ after 100 ->
+ ok
+ end,
+ true = erlang:delete_module(dirty_code_test),
+ receive
+ {'DOWN', Mon2, process, Pid2, _} ->
+ ct:fail(premature_death)
+ after 100 ->
+ ok
+ end,
+ true = erlang:purge_module(dirty_code_test),
+ receive
+ {'DOWN', Mon2, process, Pid2, Reason2} ->
+ killed = Reason2
+ end,
+ End = erlang:monotonic_time(),
+ Time = erlang:convert_time_unit(End-Start, native, milli_seconds),
+ io:format("Time=~p~n", [Time]),
+ true = Time =< 1000,
+ ok.
+
+dirty_nif_send_traced(Config) when is_list(Config) ->
+ Parent = self(),
+ Rcvr = spawn_link(fun() ->
+ Self = self(),
+ receive {ok, Self} -> ok end,
+ Parent ! {Self, received}
+ end),
+ Sndr = spawn_link(fun () ->
+ receive {Parent, go} -> ok end,
+ {ok, Rcvr} = send_wait_from_dirty_nif(Rcvr),
+ Parent ! {self(), sent}
+ end),
+ 1 = erlang:trace(Sndr, true, [send]),
+ Start = erlang:monotonic_time(),
+ Sndr ! {self(), go},
+ receive {trace, Sndr, send, {ok, Rcvr}, Rcvr} -> ok end,
+ receive {Rcvr, received} -> ok end,
+ End1 = erlang:monotonic_time(),
+ Time1 = erlang:convert_time_unit(End1-Start, native, 1000),
+ io:format("Time1: ~p milliseconds~n", [Time1]),
+ true = Time1 < 500,
+ receive {Sndr, sent} -> ok end,
+ End2 = erlang:monotonic_time(),
+ Time2 = erlang:convert_time_unit(End2-Start, native, 1000),
+ io:format("Time2: ~p milliseconds~n", [Time2]),
+ true = Time2 >= 1900,
+ ok.
+
+%%
+%% Internal...
+%%
+
+access_dirty_process(Config, Start, Test, Finish) ->
+ {ok, Node} = start_node(Config, ""),
+ [ok] = mcall(Node,
+ [fun() ->
+ Path = ?config(data_dir, Config),
+ Lib = atom_to_list(?MODULE),
+ ok = erlang:load_nif(filename:join(Path,Lib), []),
+ ok = test_dirty_process_access(Start, Test, Finish)
+ end]),
+ stop_node(Node),
+ ok.
+
+test_dirty_process_access(Start, Test, Finish) ->
+ ok = Start(),
+ Self = self(),
+ NifPid = spawn_link(fun() ->
+ ok = dirty_sleeper(Self)
+ end),
+ ok = receive
+ ready ->
+ ok = Test(NifPid),
+ receive
+ done ->
+ error(dirty_process_info_blocked)
+ after
+ 0 ->
+ true = erlang:is_process_alive(NifPid),
+ ok
+ end
+ after
+ 3000 ->
+ error(timeout)
+ end,
+ ok = Finish(NifPid).
+
+receive_any() ->
+ receive M -> M end.
+
+start_node(Config) ->
+ start_node(Config, "").
+
+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(proplists:get_value(testcase, Config))
+ ++ "-"
+ ++ integer_to_list(erlang:system_time(second))
+ ++ "-"
+ ++ integer_to_list(erlang:unique_integer([positive]))),
+ test_server:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]).
+
+stop_node(Node) ->
+ test_server:stop_node(Node).
+
+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),
+ lists:map(fun (Ref) ->
+ receive
+ {Ref, Res} ->
+ Res
+ end
+ end, Refs).
+
+%% Test enif_whereis_...
+%% These tests are mostly identical to their counterparts in nif_SUITE.erl,
+%% with just name and count changes in the first few lines.
+
+nif_whereis(Config) when is_list(Config) ->
+ erl_ddll:try_load(?config(data_dir, Config), echo_drv, []),
+
+ RegName = dirty_nif_whereis_test_thing,
+ undefined = erlang:whereis(RegName),
+ false = whereis_term(pid, RegName),
+
+ Mgr = self(),
+ Ref = make_ref(),
+ ProcMsg = {Ref, ?LINE},
+ PortMsg = ?MODULE_STRING " whereis hello\n",
+
+ {Pid, Mon} = spawn_monitor(?MODULE, nif_whereis_proxy, [Ref]),
+ true = register(RegName, Pid),
+ Pid = erlang:whereis(RegName),
+ Pid = whereis_term(pid, RegName),
+ false = whereis_term(port, RegName),
+ false = whereis_term(pid, [RegName]),
+
+ ok = whereis_send(pid, RegName, {forward, Mgr, ProcMsg}),
+ ok = receive ProcMsg -> ok end,
+
+ Pid ! {Ref, quit},
+ ok = receive {'DOWN', Mon, process, Pid, normal} -> ok end,
+ undefined = erlang:whereis(RegName),
+ false = whereis_term(pid, RegName),
+
+ Port = open_port({spawn, echo_drv}, [eof]),
+ true = register(RegName, Port),
+ Port = erlang:whereis(RegName),
+ Port = whereis_term(port, RegName),
+ false = whereis_term(pid, RegName),
+ false = whereis_term(port, [RegName]),
+
+ ok = whereis_send(port, RegName, PortMsg),
+ ok = receive {Port, {data, PortMsg}} -> ok end,
+
+ port_close(Port),
+ undefined = erlang:whereis(RegName),
+ false = whereis_term(port, RegName),
+ ok.
+
+nif_whereis_parallel(Config) when is_list(Config) ->
+
+ %% try to be at least a little asymetric
+ NProcs = trunc(3.5 * erlang:system_info(schedulers)),
+ NSeq = lists:seq(1, NProcs),
+ Names = [list_to_atom("dirty_nif_whereis_proc_" ++ integer_to_list(N))
+ || N <- NSeq],
+ Mgr = self(),
+ Ref = make_ref(),
+
+ NotReg = fun(Name) ->
+ erlang:whereis(Name) == undefined
+ end,
+ PidReg = fun({Name, Pid, _Mon}) ->
+ erlang:whereis(Name) == Pid andalso whereis_term(pid, Name) == Pid
+ end,
+ RecvDown = fun({_Name, Pid, Mon}) ->
+ receive {'DOWN', Mon, process, Pid, normal} -> true
+ after 1500 -> false end
+ end,
+ RecvNum = fun(N) ->
+ receive {N, Ref} -> true
+ after 1500 -> false end
+ end,
+
+ true = lists:all(NotReg, Names),
+
+ %% {Name, Pid, Mon}
+ Procs = lists:map(
+ fun(N) ->
+ Name = lists:nth(N, Names),
+ Prev = lists:nth((if N == 1 -> NProcs; true -> (N - 1) end), Names),
+ Next = lists:nth((if N == NProcs -> 1; true -> (N + 1) end), Names),
+ {Pid, Mon} = spawn_monitor(
+ ?MODULE, nif_whereis_proxy, [{N, Ref, Mgr, [Prev, Next]}]),
+ true = register(Name, Pid),
+ {Name, Pid, Mon}
+ end, NSeq),
+
+ true = lists:all(PidReg, Procs),
+
+ %% tell them all to 'fire' as fast as we can
+ [P ! {Ref, send_proc} || {_, P, _} <- Procs],
+
+ %% each gets forwarded through two processes
+ true = lists:all(RecvNum, NSeq),
+ true = lists:all(RecvNum, NSeq),
+
+ %% tell them all to 'quit' by name
+ [N ! {Ref, quit} || {N, _, _} <- Procs],
+ true = lists:all(RecvDown, Procs),
+ true = lists:all(NotReg, Names),
+ ok.
+
+%% exported to be spawned by MFA by whereis tests
+nif_whereis_proxy({N, Ref, Mgr, Targets} = Args) ->
+ receive
+ {forward, To, Data} ->
+ To ! Data,
+ nif_whereis_proxy(Args);
+ {Ref, quit} ->
+ ok;
+ {Ref, send_port} ->
+ Msg = ?MODULE_STRING " whereis " ++ integer_to_list(N) ++ "\n",
+ lists:foreach(
+ fun(T) ->
+ ok = whereis_send(port, T, Msg)
+ end, Targets),
+ nif_whereis_proxy(Args);
+ {Ref, send_proc} ->
+ lists:foreach(
+ fun(T) ->
+ ok = whereis_send(pid, T, {forward, Mgr, {N, Ref}})
+ end, Targets),
+ nif_whereis_proxy(Args)
+ end;
+nif_whereis_proxy(Ref) ->
+ receive
+ {forward, To, Data} ->
+ To ! Data,
+ nif_whereis_proxy(Ref);
+ {Ref, quit} ->
+ ok
+ end.
+
+%% The NIFs:
+lib_loaded() -> false.
+call_dirty_nif(_,_,_) -> ?nif_stub.
+send_from_dirty_nif(_) -> ?nif_stub.
+send_wait_from_dirty_nif(_) -> ?nif_stub.
+call_dirty_nif_exception(_) -> ?nif_stub.
+call_dirty_nif_zero_args() -> ?nif_stub.
+dirty_call_while_terminated_nif(_) -> ?nif_stub.
+dirty_sleeper() -> ?nif_stub.
+dirty_sleeper(_) -> ?nif_stub.
+dirty_heap_access_nif(_) -> ?nif_stub.
+whereis_term(_Type,_Name) -> ?nif_stub.
+whereis_send(_Type,_Name,_Msg) -> ?nif_stub.
+
+nif_stub_error(Line) ->
+ exit({nif_not_loaded,module,?MODULE,line,Line}).
diff --git a/erts/emulator/test/dirty_nif_SUITE_data/Makefile.src b/erts/emulator/test/dirty_nif_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..4462afd815
--- /dev/null
+++ b/erts/emulator/test/dirty_nif_SUITE_data/Makefile.src
@@ -0,0 +1,6 @@
+
+NIF_LIBS = dirty_nif_SUITE@dll@
+
+all: $(NIF_LIBS) echo_drv@dll@
+
+@SHLIB_RULES@
diff --git a/erts/emulator/test/dirty_nif_SUITE_data/dirty_nif_SUITE.c b/erts/emulator/test/dirty_nif_SUITE_data/dirty_nif_SUITE.c
new file mode 100644
index 0000000000..0321b9898f
--- /dev/null
+++ b/erts/emulator/test/dirty_nif_SUITE_data/dirty_nif_SUITE.c
@@ -0,0 +1,445 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2009-2017. 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 <erl_nif.h>
+#include <assert.h>
+#ifdef __WIN32__
+#include <windows.h>
+#else
+#include <unistd.h>
+#endif
+
+/*
+ * Hack to get around this function missing from the NIF API.
+ * TODO: Add this function/macro in the appropriate place, probably with
+ * enif_make_pid() in erl_nif_api_funcs.h
+ */
+#ifndef enif_make_port
+#define enif_make_port(ENV, PORT) ((void)(ENV),(const ERL_NIF_TERM)((PORT)->port_id))
+#endif
+
+static ERL_NIF_TERM atom_badarg;
+static ERL_NIF_TERM atom_error;
+static ERL_NIF_TERM atom_false;
+static ERL_NIF_TERM atom_lookup;
+static ERL_NIF_TERM atom_ok;
+static ERL_NIF_TERM atom_pid;
+static ERL_NIF_TERM atom_port;
+static ERL_NIF_TERM atom_send;
+
+static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info)
+{
+ atom_badarg = enif_make_atom(env, "badarg");
+ atom_error = enif_make_atom(env, "error");
+ atom_false = enif_make_atom(env,"false");
+ atom_lookup = enif_make_atom(env, "lookup");
+ atom_ok = enif_make_atom(env,"ok");
+ atom_pid = enif_make_atom(env, "pid");
+ atom_port = enif_make_atom(env, "port");
+ atom_send = enif_make_atom(env, "send");
+
+ return 0;
+}
+
+static ERL_NIF_TERM lib_loaded(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ return enif_make_atom(env, "true");
+}
+
+static int have_dirty_schedulers(void)
+{
+ ErlNifSysInfo si;
+ enif_system_info(&si, sizeof(si));
+ return si.dirty_scheduler_support;
+}
+
+static ERL_NIF_TERM dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ int n;
+ char s[10];
+ ErlNifBinary b;
+ if (have_dirty_schedulers()) {
+ assert(ERL_NIF_THR_DIRTY_CPU_SCHEDULER == enif_thread_type()
+ || ERL_NIF_THR_DIRTY_IO_SCHEDULER == enif_thread_type());
+ }
+ assert(argc == 3);
+ enif_get_int(env, argv[0], &n);
+ enif_get_string(env, argv[1], s, sizeof s, ERL_NIF_LATIN1);
+ enif_inspect_binary(env, argv[2], &b);
+ return enif_make_tuple3(env,
+ enif_make_int(env, n),
+ enif_make_string(env, s, ERL_NIF_LATIN1),
+ enif_make_binary(env, &b));
+}
+
+static ERL_NIF_TERM call_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ int n;
+ char s[10];
+ ErlNifBinary b;
+ assert(ERL_NIF_THR_NORMAL_SCHEDULER == enif_thread_type());
+ if (argc != 3)
+ return enif_make_badarg(env);
+ if (have_dirty_schedulers()) {
+ if (enif_get_int(env, argv[0], &n) &&
+ enif_get_string(env, argv[1], s, sizeof s, ERL_NIF_LATIN1) &&
+ enif_inspect_binary(env, argv[2], &b))
+ return enif_schedule_nif(env, "call_dirty_nif", ERL_NIF_DIRTY_JOB_CPU_BOUND, dirty_nif, argc, argv);
+ else
+ return enif_make_badarg(env);
+ } else {
+ return dirty_nif(env, argc, argv);
+ }
+}
+
+static ERL_NIF_TERM send_from_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ERL_NIF_TERM result;
+ ErlNifPid pid;
+ ErlNifEnv* menv;
+ int res;
+
+ if (!enif_get_local_pid(env, argv[0], &pid))
+ return enif_make_badarg(env);
+ result = enif_make_tuple2(env, enif_make_atom(env, "ok"), enif_make_pid(env, &pid));
+ menv = enif_alloc_env();
+ res = enif_send(env, &pid, menv, result);
+ enif_free_env(menv);
+ if (!res)
+ return enif_make_badarg(env);
+ else
+ return result;
+}
+
+static ERL_NIF_TERM send_wait_from_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ERL_NIF_TERM result;
+ ErlNifPid pid;
+ ErlNifEnv* menv;
+ int res;
+
+ if (!enif_get_local_pid(env, argv[0], &pid))
+ return enif_make_badarg(env);
+ result = enif_make_tuple2(env, enif_make_atom(env, "ok"), enif_make_pid(env, &pid));
+ menv = enif_alloc_env();
+ res = enif_send(env, &pid, menv, result);
+ enif_free_env(menv);
+
+#ifdef __WIN32__
+ Sleep(2000);
+#else
+ sleep(2);
+#endif
+
+ if (!res)
+ return enif_make_badarg(env);
+ else
+ return result;
+}
+
+static ERL_NIF_TERM call_dirty_nif_exception(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ switch (argc) {
+ case 1: {
+ int arg;
+ if (enif_get_int(env, argv[0], &arg) && arg < 2) {
+ ERL_NIF_TERM args[255];
+ int i;
+ args[0] = argv[0];
+ for (i = 1; i < 255; i++)
+ args[i] = enif_make_int(env, i);
+ return enif_schedule_nif(env, "call_dirty_nif_exception", ERL_NIF_DIRTY_JOB_CPU_BOUND,
+ call_dirty_nif_exception, 255, args);
+ } else {
+ return enif_raise_exception(env, argv[0]);
+ }
+ }
+ case 2: {
+ int return_badarg_directly;
+ enif_get_int(env, argv[0], &return_badarg_directly);
+ assert(return_badarg_directly == 1 || return_badarg_directly == 0);
+ if (return_badarg_directly)
+ return enif_make_badarg(env);
+ else {
+ /* ignore return value */ enif_make_badarg(env);
+ return enif_make_atom(env, "ok");
+ }
+ }
+ default:
+ return enif_schedule_nif(env, "call_dirty_nif_exception", ERL_NIF_DIRTY_JOB_CPU_BOUND,
+ call_dirty_nif_exception, argc-1, argv);
+ }
+}
+
+static ERL_NIF_TERM call_dirty_nif_zero_args(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ int i;
+ ERL_NIF_TERM result[1000];
+ ERL_NIF_TERM ok = enif_make_atom(env, "ok");
+ assert(argc == 0);
+ for (i = 0; i < sizeof(result)/sizeof(*result); i++) {
+ result[i] = ok;
+ }
+ return enif_make_list_from_array(env, result, i);
+}
+
+static ERL_NIF_TERM
+dirty_sleeper(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ErlNifPid pid;
+ ErlNifEnv* msg_env = NULL;
+
+ assert(ERL_NIF_THR_DIRTY_CPU_SCHEDULER == enif_thread_type()
+ || ERL_NIF_THR_DIRTY_IO_SCHEDULER == enif_thread_type());
+
+ /* If we get a pid argument, it indicates a process involved in the
+ test wants a message from us. Prior to the sleep we send a 'ready'
+ message, and then after the sleep, send a 'done' message. */
+ if (argc == 1 && enif_get_local_pid(env, argv[0], &pid)) {
+ msg_env = enif_alloc_env();
+ enif_send(env, &pid, msg_env, enif_make_atom(msg_env, "ready"));
+ }
+
+#ifdef __WIN32__
+ Sleep(6000);
+#else
+ sleep(6);
+#endif
+
+ if (argc == 1) {
+ assert(msg_env != NULL);
+ enif_send(env, &pid, msg_env, enif_make_atom(msg_env, "done"));
+ enif_free_env(msg_env);
+ }
+
+ return enif_make_atom(env, "ok");
+}
+
+static ERL_NIF_TERM dirty_call_while_terminated_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ErlNifPid self;
+ ERL_NIF_TERM result, self_term;
+ ErlNifPid to;
+ ErlNifEnv* menv;
+ int res;
+
+ if (!enif_get_local_pid(env, argv[0], &to))
+ return enif_make_badarg(env);
+
+ if (!enif_self(env, &self))
+ return enif_make_badarg(env);
+
+ self_term = enif_make_pid(env, &self);
+
+ result = enif_make_tuple2(env, enif_make_atom(env, "dirty_alive"), self_term);
+ menv = enif_alloc_env();
+ res = enif_send(env, &to, menv, result);
+ enif_free_env(menv);
+ if (!res)
+ return enif_make_badarg(env);
+
+ /* Wait until we have been killed */
+ while (enif_is_process_alive(env, &self))
+ ;
+
+ result = enif_make_tuple2(env, enif_make_atom(env, "dirty_dead"), self_term);
+ menv = enif_alloc_env();
+ res = enif_send(env, &to, menv, result);
+ enif_free_env(menv);
+
+#ifdef __WIN32__
+ Sleep(1000);
+#else
+ sleep(1);
+#endif
+
+ return enif_make_atom(env, "ok");
+}
+
+static ERL_NIF_TERM dirty_heap_access_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ERL_NIF_TERM res = enif_make_list(env, 0);
+ int i;
+ assert(ERL_NIF_THR_DIRTY_CPU_SCHEDULER == enif_thread_type()
+ || ERL_NIF_THR_DIRTY_IO_SCHEDULER == enif_thread_type());
+ for (i = 0; i < 1000; i++)
+ res = enif_make_list_cell(env, enif_make_copy(env, argv[0]), res);
+
+ return res;
+}
+
+/*
+ * enif_whereis_... tests
+ * subset of the functions in nif_SUITE.c
+ */
+
+enum {
+ /* results */
+ WHEREIS_SUCCESS,
+ WHEREIS_ERROR_TYPE,
+ WHEREIS_ERROR_LOOKUP,
+ WHEREIS_ERROR_SEND,
+ /* types */
+ WHEREIS_LOOKUP_PID, /* enif_whereis_pid() */
+ WHEREIS_LOOKUP_PORT /* enif_whereis_port() */
+};
+
+typedef union {
+ ErlNifPid pid;
+ ErlNifPort port;
+} whereis_term_data_t;
+
+static int whereis_type(ERL_NIF_TERM type)
+{
+ if (enif_is_identical(type, atom_pid))
+ return WHEREIS_LOOKUP_PID;
+
+ if (enif_is_identical(type, atom_port))
+ return WHEREIS_LOOKUP_PORT;
+
+ return WHEREIS_ERROR_TYPE;
+}
+
+static int whereis_lookup_internal(
+ ErlNifEnv* env, int type, ERL_NIF_TERM name, whereis_term_data_t* out)
+{
+ if (type == WHEREIS_LOOKUP_PID)
+ return enif_whereis_pid(env, name, & out->pid)
+ ? WHEREIS_SUCCESS : WHEREIS_ERROR_LOOKUP;
+
+ if (type == WHEREIS_LOOKUP_PORT)
+ return enif_whereis_port(env, name, & out->port)
+ ? WHEREIS_SUCCESS : WHEREIS_ERROR_LOOKUP;
+
+ return WHEREIS_ERROR_TYPE;
+}
+
+static int whereis_send_internal(
+ ErlNifEnv* env, int type, whereis_term_data_t* to, ERL_NIF_TERM msg)
+{
+ if (type == WHEREIS_LOOKUP_PID)
+ return enif_send(env, & to->pid, NULL, msg)
+ ? WHEREIS_SUCCESS : WHEREIS_ERROR_SEND;
+
+ if (type == WHEREIS_LOOKUP_PORT)
+ return enif_port_command(env, & to->port, NULL, msg)
+ ? WHEREIS_SUCCESS : WHEREIS_ERROR_SEND;
+
+ return WHEREIS_ERROR_TYPE;
+}
+
+static int whereis_lookup_term(
+ ErlNifEnv* env, int type, ERL_NIF_TERM name, ERL_NIF_TERM* out)
+{
+ whereis_term_data_t res;
+ int rc = whereis_lookup_internal(env, type, name, &res);
+ if (rc == WHEREIS_SUCCESS) {
+ switch (type) {
+ case WHEREIS_LOOKUP_PID:
+ *out = enif_make_pid(env, & res.pid);
+ break;
+ case WHEREIS_LOOKUP_PORT:
+ *out = enif_make_port(env, & res.port);
+ break;
+ default:
+ rc = WHEREIS_ERROR_TYPE;
+ break;
+ }
+ }
+ return rc;
+}
+
+static ERL_NIF_TERM whereis_result_term(ErlNifEnv* env, int result)
+{
+ ERL_NIF_TERM err;
+ switch (result)
+ {
+ case WHEREIS_SUCCESS:
+ return atom_ok;
+ case WHEREIS_ERROR_LOOKUP:
+ err = atom_lookup;
+ break;
+ case WHEREIS_ERROR_SEND:
+ err = atom_send;
+ break;
+ case WHEREIS_ERROR_TYPE:
+ err = atom_badarg;
+ break;
+ default:
+ err = enif_make_int(env, -result);
+ break;
+ }
+ return enif_make_tuple2(env, atom_error, err);
+}
+
+/* whereis_term(Type, Name) -> pid() | port() | false */
+static ERL_NIF_TERM
+whereis_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ERL_NIF_TERM ret;
+ int type, rc;
+
+ if (argc != 2) /* allow non-atom name for testing */
+ return enif_make_badarg(env);
+
+ if ((type = whereis_type(argv[0])) == WHEREIS_ERROR_TYPE)
+ return enif_make_badarg(env);
+
+ rc = whereis_lookup_term(env, type, argv[1], &ret);
+ return (rc == WHEREIS_SUCCESS) ? ret : atom_false;
+}
+
+/* whereis_send(Type, Name, Message) -> ok | {error, Reason} */
+static ERL_NIF_TERM
+whereis_send(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ whereis_term_data_t to;
+ int type, rc;
+
+ if (argc != 3 || !enif_is_atom(env, argv[1]))
+ return enif_make_badarg(env);
+
+ if ((type = whereis_type(argv[0])) == WHEREIS_ERROR_TYPE)
+ return enif_make_badarg(env);
+
+ rc = whereis_lookup_internal(env, type, argv[1], & to);
+ if (rc == WHEREIS_SUCCESS)
+ rc = whereis_send_internal(env, type, & to, argv[2]);
+
+ return whereis_result_term(env, rc);
+}
+
+
+static ErlNifFunc nif_funcs[] =
+{
+ {"lib_loaded", 0, lib_loaded},
+ {"call_dirty_nif", 3, call_dirty_nif},
+ {"send_from_dirty_nif", 1, send_from_dirty_nif, ERL_NIF_DIRTY_JOB_CPU_BOUND},
+ {"send_wait_from_dirty_nif", 1, send_wait_from_dirty_nif, ERL_NIF_DIRTY_JOB_IO_BOUND},
+ {"call_dirty_nif_exception", 1, call_dirty_nif_exception, ERL_NIF_DIRTY_JOB_IO_BOUND},
+ {"call_dirty_nif_zero_args", 0, call_dirty_nif_zero_args, ERL_NIF_DIRTY_JOB_CPU_BOUND},
+ {"dirty_sleeper", 0, dirty_sleeper, ERL_NIF_DIRTY_JOB_IO_BOUND},
+ {"dirty_sleeper", 1, dirty_sleeper, ERL_NIF_DIRTY_JOB_CPU_BOUND},
+ {"dirty_call_while_terminated_nif", 1, dirty_call_while_terminated_nif, ERL_NIF_DIRTY_JOB_CPU_BOUND},
+ {"dirty_heap_access_nif", 1, dirty_heap_access_nif, ERL_NIF_DIRTY_JOB_CPU_BOUND},
+ {"whereis_send", 3, whereis_send, ERL_NIF_DIRTY_JOB_IO_BOUND},
+ {"whereis_term", 2, whereis_term, ERL_NIF_DIRTY_JOB_CPU_BOUND}
+};
+
+ERL_NIF_INIT(dirty_nif_SUITE,nif_funcs,load,NULL,NULL,NULL)
diff --git a/erts/emulator/test/dirty_nif_SUITE_data/echo_drv.c b/erts/emulator/test/dirty_nif_SUITE_data/echo_drv.c
new file mode 100644
index 0000000000..2b3510c641
--- /dev/null
+++ b/erts/emulator/test/dirty_nif_SUITE_data/echo_drv.c
@@ -0,0 +1,62 @@
+#include <stdio.h>
+#include "erl_driver.h"
+
+static ErlDrvPort erlang_port;
+static ErlDrvData echo_start(ErlDrvPort, char *);
+static void from_erlang(ErlDrvData, char*, ErlDrvSizeT);
+static ErlDrvSSizeT echo_call(ErlDrvData drv_data, unsigned int command,
+ char *buf, ErlDrvSizeT len,
+ char **rbuf, ErlDrvSizeT rlen, unsigned *ret_flags);
+static ErlDrvEntry echo_driver_entry = {
+ NULL, /* Init */
+ echo_start,
+ NULL, /* Stop */
+ from_erlang,
+ NULL, /* Ready input */
+ NULL, /* Ready output */
+ "echo_drv",
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ echo_call,
+ NULL,
+ ERL_DRV_EXTENDED_MARKER,
+ ERL_DRV_EXTENDED_MAJOR_VERSION,
+ ERL_DRV_EXTENDED_MINOR_VERSION,
+ 0,
+ NULL,
+ NULL,
+ NULL
+};
+
+DRIVER_INIT(echo_drv)
+{
+ return &echo_driver_entry;
+}
+
+static ErlDrvData
+echo_start(ErlDrvPort port, char *buf)
+{
+ return (ErlDrvData) port;
+}
+
+static void
+from_erlang(ErlDrvData data, char *buf, ErlDrvSizeT count)
+{
+ driver_output((ErlDrvPort) data, buf, count);
+}
+
+static ErlDrvSSizeT
+echo_call(ErlDrvData drv_data, unsigned int command,
+ char *buf, ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen,
+ unsigned *ret_flags)
+{
+ *rbuf = buf;
+ *ret_flags |= DRIVER_CALL_KEEP_BUFFER;
+ return len;
+}
+
diff --git a/erts/emulator/test/distribution_SUITE.erl b/erts/emulator/test/distribution_SUITE.erl
index aa6cf2b881..4a0b299e03 100644
--- a/erts/emulator/test/distribution_SUITE.erl
+++ b/erts/emulator/test/distribution_SUITE.erl
@@ -1,24 +1,25 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2017. 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/.
+%% 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
%%
-%% 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.
+%% 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(distribution_SUITE).
--compile(r15).
+-compile(r16).
-define(VERSION_MAGIC, 131).
@@ -32,53 +33,58 @@
%% 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_r16b/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,
+ bad_dist_ext_size/1,
+ start_epmd_false/1, epmd_module/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,
- sendersender/4, sendersender2/4]).
+ 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]).
+
+%% epmd_module exports
+-export([start_link/0, register_node/2, register_node/3, port_please/2]).
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 4}}].
-all() ->
+all() ->
[ping, {group, bulk_send}, {group, local_send},
link_to_busy, exit_to_busy, lost_exit, link_to_dead,
link_to_dead_new_node, applied_monitor_node,
ref_port_roundtrip, nil_roundtrip, stop_dist,
{group, trap_bif}, {group, dist_auto_connect},
- dist_parallel_send, atom_roundtrip, unicode_atom_roundtrip, atom_roundtrip_r15b,
+ dist_parallel_send, atom_roundtrip, unicode_atom_roundtrip,
+ atom_roundtrip_r16b,
contended_atom_cache_entry, contended_unicode_atom_cache_entry,
- bad_dist_structure, {group, bad_dist_ext}].
+ bad_dist_structure, {group, bad_dist_ext},
+ start_epmd_false, epmd_module].
-groups() ->
+groups() ->
[{bulk_send, [], [bulk_send_small, bulk_send_big, bulk_send_bigbig]},
{local_send, [],
[local_send_small, local_send_big, local_send_legal]},
@@ -87,114 +93,90 @@ groups() ->
[dist_auto_connect_never, dist_auto_connect_once]},
{bad_dist_ext, [],
[bad_dist_ext_receive, bad_dist_ext_process_info,
+ bad_dist_ext_size,
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_bigbig(Config) when is_list(Config) ->
- ?line bulk_sendsend(32*5, 4).
+ bulk_send(32, 64).
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"}.
-
-bulk_sendsend(Terms, BinSize) ->
+ 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 = binary:copy(<<253>>, BinSize*1024),
+ Size = Terms*size(Bin),
+ {Elapsed, {Terms, Size}} = test_server:timecall(?MODULE, sender,
+ [Recv, Bin, Terms]),
+ stop_node(Node),
+ {comment, integer_to_list(round(Size/1024/max(1,Elapsed))) ++ " K/s"}.
+
+sender(To, _Bin, 0) ->
+ To ! {done, self()},
+ receive
+ Any ->
+ Any
+ end;
+sender(To, Bin, Left) ->
+ To ! {term, Bin},
+ sender(To, Bin, Left-1).
+
+bulk_send_bigbig(Config) when is_list(Config) ->
+ Terms = 32*5,
+ BinSize = 4,
{Rate1, MonitorCount1} = bulk_sendsend2(Terms, BinSize, 5),
{Rate2, MonitorCount2} = bulk_sendsend2(Terms, BinSize, 995),
Ratio = if MonitorCount2 == 0 -> MonitorCount1 / 1.0;
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",
- 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)
- end.
+ Comment0 = io_lib:format("~p K/s, ~p K/s, "
+ "~p monitor msgs, ~p monitor msgs, "
+ "~.1f monitor ratio",
+ [Rate1,Rate2,MonitorCount1,
+ MonitorCount2,Ratio]),
+ Comment = lists:flatten(Comment0),
+ {comment,Comment}.
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("\nSending ~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 = binary:copy(<<253>>, BinSize*1024),
%% SLF LEFT OFF HERE.
%% When the caller uses small hunks, like 4k via
@@ -205,143 +187,128 @@ 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
+ %% On some platforms (Windows), the time taken is 0 so we
+ %% simulate that some little time has passed.
+ {sendersender, {0.0,T,MC}} ->
+ {0.0015, T, MC};
+ {sendersender, BigRes} ->
BigRes
end,
- ?line stop_node(NodeRecv),
- ?line stop_node(NodeSend),
-
- ?line test_server:timetrap_cancel(Dog),
- {trunc(SizeN/1024/Elapsed+0.5), MonitorCount}.
-
-sender(To, _Bin, 0) ->
- To ! {done, self()},
- receive
- Any ->
- Any
- end;
-sender(To, Bin, Left) ->
- To ! {term, Bin},
- sender(To, Bin, Left-1).
+ stop_node(NodeRecv),
+ stop_node(NodeSend),
+ {round(SizeN/1024/Elapsed), MonitorCount}.
%% Sender process to be run on a slave node
sendersender(Parent, To, Bin, Left) ->
erlang:system_monitor(self(), [busy_dist_port]),
- [spawn(fun() -> sendersender2(To, Bin, Left, false) end) ||
- _ <- lists:seq(1,1)],
+ _ = spawn(fun() ->
+ sendersender_send(To, Bin, Left),
+ exit(normal)
+ end),
{USec, {Res, MonitorCount}} =
- timer:tc(?MODULE, sendersender2, [To, Bin, Left, true]),
+ timer:tc(fun() ->
+ sendersender_send(To, Bin, Left),
+ To ! {done, self()},
+ count_monitors(0)
+ end),
Parent ! {sendersender, {USec/1000000, Res, MonitorCount}}.
-sendersender2(To, Bin, Left, SendDone) ->
- sendersender3(To, Bin, Left, SendDone, 0).
+sendersender_send(_To, _Bin, 0) ->
+ ok;
+sendersender_send(To, Bin, Left) ->
+ To ! {term, Bin},
+ sendersender_send(To, Bin, Left-1).
-sendersender3(To, _Bin, 0, SendDone, MonitorCount) ->
- if SendDone ->
- To ! {done, self()};
- true ->
- ok
- end,
+count_monitors(MonitorCount) ->
receive
{monitor, _Pid, _Type, _Info} ->
- sendersender3(To, _Bin, 0, SendDone, MonitorCount + 1)
+ count_monitors(MonitorCount + 1)
after 0 ->
- if SendDone ->
- receive
- Any when is_tuple(Any), size(Any) == 2 ->
- {Any, MonitorCount}
- end;
- true ->
- exit(normal)
+ receive
+ {_,_}=Any ->
+ {Any,MonitorCount}
end
- end;
-sendersender3(To, Bin, Left, SendDone, MonitorCount) ->
- To ! {term, Bin},
- %%timer:sleep(50),
- sendersender3(To, Bin, Left-1, SendDone, MonitorCount).
+ end.
%% Receiver process to be run on a slave node.
receiver(Terms, Size) ->
receive
- {term, Bin} ->
- receiver(Terms+1, Size+size(Bin));
- {done, ReplyTo} ->
- ReplyTo ! {Terms, Size}
+ {term, Bin} ->
+ receiver(Terms+1, Size+byte_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
@@ -350,20 +317,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) ->
@@ -378,16 +344,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
@@ -396,59 +362,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) ->
@@ -457,27 +422,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) ->
@@ -490,29 +455,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),
@@ -534,234 +499,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.
@@ -769,37 +727,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}.
@@ -820,60 +772,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.
@@ -882,62 +835,53 @@ 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]),
+ io:format("~p:do_dist_auto_connect([false]) Node=~p~n", [?MODULE, Node]),
Ping = net_adm:ping(Node),
- io:format("~p:do_dist_auto_connect([false]) Ping=~p~n",
- [?MODULE, Ping]),
+ io:format("~p:do_dist_auto_connect([false]) Ping=~p~n", [?MODULE, Ping]),
Result = case Ping of
- pang -> ok;
- _ -> {error, Ping}
- end,
- io:format("~p:do_dist_auto_connect([false]) Result=~p~n",
- [?MODULE, Result]),
+ pang -> ok;
+ _ -> {error, Ping}
+ end,
+ io:format("~p:do_dist_auto_connect([false]) Result=~p~n", [?MODULE, Result]),
net_kernel:connect_node(Node),
catch {dist_auto_connect_relay, Node} ! {do_dist_auto_connect, Result};
% receive after 1000 -> ok end,
% halt();
do_dist_auto_connect(Arg) ->
- io:format("~p:do_dist_auto_connect(~p)~n",
- [?MODULE, Arg]),
+ io:format("~p:do_dist_auto_connect(~p)~n", [?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);
@@ -947,16 +891,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}}.
@@ -974,102 +918,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) ->
+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};
@@ -1091,71 +1016,75 @@ 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.
-
-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"}
+ AtomData = atom_data(),
+ verify_atom_data(AtomData),
+ {ok, Node} = start_node(Config),
+ do_atom_roundtrip(Node, AtomData),
+ stop_node(Node),
+ ok.
+
+atom_roundtrip_r16b(Config) when is_list(Config) ->
+ case test_server:is_release_available("r16b") of
+ true ->
+ ct:timetrap({minutes, 6}),
+ AtomData = unicode_atom_data(),
+ verify_atom_data(AtomData),
+ case start_node(Config, [], "r16b") of
+ {ok, Node} ->
+ do_atom_roundtrip(Node, AtomData),
+ stop_node(Node);
+ {error, timeout} ->
+ {skip,"Unable to start OTP R16B release"}
+ end;
+ false ->
+ {skip,"No OTP R16B 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),
@@ -1208,9 +1137,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).
@@ -1219,79 +1147,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;
@@ -1303,11 +1229,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).
@@ -1315,51 +1241,45 @@ 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) ->
- {A, B, C} = now(),
- Atom = list_to_atom("atom" ++ integer_to_list(A*1000000000000
- + B*1000000
- + C)),
+ 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) ->
[];
get_conflicting_unicode_atoms(CIX, N) ->
- {A, B, C} = now(),
- Atom = string_to_atom([16#1f608] ++ "atom" ++ integer_to_list(A*1000000000000
- + B*1000000
- + C)),
+ 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, '').
@@ -1381,482 +1301,525 @@ 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,
+
+ {message_queue_len, 0}
+ = rpc:call(Victim, erlang, process_info, [P, message_queue_len]),
+
+ verify_still_up(Offender, Victim),
+ P ! done,
+ unlink(P),
+ verify_no_down(Offender, Victim),
+ stop_node(Offender),
+ stop_node(Victim).
+
+%% OTP-14661: Bad message is discovered by erts_msg_attached_data_size
+bad_dist_ext_size(Config) when is_list(Config) ->
+ {ok, Offender} = start_node(bad_dist_ext_process_info_offender),
+ %%Prog = "Prog=/home/uabseri/src/otp_new3/bin/cerl -rr -debug",
+ Prog = [],
+ {ok, Victim} = start_node(bad_dist_ext_process_info_victim, [], Prog),
+ start_node_monitors([Offender,Victim]),
+
+ Parent = self(),
+ P = spawn_link(Victim,
+ fun () ->
+ Parent ! {self(), started},
+ receive check_msgs -> ok end, %% DID CRASH HERE
+ bad_dist_ext_check_msgs([one]),
+ Parent ! {self(), messages_checked}
+ 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, 1, dmsg_bad_tag()),
+
+ %% Make sure bad msgs has reached Victim
+ rpc:call(Offender, rpc, call, [Victim, erlang, node, []]),
+
+ verify_still_up(Offender, Victim),
+
+ rpc:call(Victim, erlang, process_info, [P, total_heap_size]),
- ?line P ! check_msgs,
- ?line receive {P, messages_checked} -> ok end,
+ verify_down(Offender, connection_closed, Victim, killed),
- ?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).
+ P ! check_msgs,
+ exit(S, bang), % resume Victim
+ receive {P, messages_checked} -> ok end,
+
+ 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),
- receive
- {WhatSent,Done} ->
- io:format("Offender sent ~p~n",[WhatSent]),
- ok
+ 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
after 5000 ->
- exit(unable_to_send)
+ exit(unable_to_send)
end.
-
+
%% send_bad_msgs():
%% Send a valid distribution header and control message
@@ -1865,22 +1828,25 @@ send_bad_structure(Offender,Victim,Bad,WhereToPutSelf,PayLoad) ->
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) ->
+send_bad_msgs(BadNode, To, Repeat) ->
+ send_bad_msgs(BadNode, To, Repeat, dmsg_bad_atom_cache_ref()).
+
+send_bad_msgs(BadNode, To, Repeat, BadTerm) when is_atom(BadNode),
+ 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}),
+ BadTerm],
+ repeat(fun () -> port_command(DPrt, DData) end, Repeat),
+ Parent ! Done
+ end),
receive Done -> ok end.
%% send_bad_ctl():
@@ -1889,24 +1855,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():
@@ -1915,17 +1881,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}).
@@ -1938,7 +1904,7 @@ dmsg_bad_hdr() ->
[131, % Version Magic
$D, % Dist header
255]. % 255 atom references
-
+
%% dmsg_fake_hdr1() ->
%% A = <<"fake header atom 1">>,
@@ -1957,18 +1923,82 @@ dmsg_fake_hdr2() ->
1, size(A2), A2,
2, size(A3), A3].
-dmsg_ext(Term) ->
+dmsg_ext(Term) ->
<<131, Res/binary>> = term_to_binary(Term),
Res.
dmsg_bad_atom_cache_ref() ->
[$R, 137].
+dmsg_bad_tag() -> %% Will fail early at heap size calculation
+ [$?, 66].
+
+start_epmd_false(Config) when is_list(Config) ->
+ %% Start a node with the option -start_epmd false.
+ {ok, OtherNode} = start_node(start_epmd_false, "-start_epmd false"),
+ %% We should be able to ping it, as epmd was started by us:
+ pong = net_adm:ping(OtherNode),
+ stop_node(OtherNode),
+
+ ok.
+
+epmd_module(Config) when is_list(Config) ->
+ %% We need a relay node to test this, since the test node uses the
+ %% standard epmd module.
+ Sock1 = start_relay_node(epmd_module_node1, "-epmd_module " ++ ?MODULE_STRING),
+ Node1 = inet_rpc_nodename(Sock1),
+ %% Ask what port it's listening on - it won't have registered with
+ %% epmd.
+ {ok, {ok, Port1}} = do_inet_rpc(Sock1, application, get_env, [kernel, dist_listen_port]),
+
+ %% Start a second node, passing the port number as a secret
+ %% argument.
+ Sock2 = start_relay_node(epmd_module_node2, "-epmd_module " ++ ?MODULE_STRING
+ ++ " -other_node_port " ++ integer_to_list(Port1)),
+ Node2 = inet_rpc_nodename(Sock2),
+ %% Node 1 can't ping node 2
+ {ok, pang} = do_inet_rpc(Sock1, net_adm, ping, [Node2]),
+ {ok, []} = do_inet_rpc(Sock1, erlang, nodes, []),
+ {ok, []} = do_inet_rpc(Sock2, erlang, nodes, []),
+ %% But node 2 can ping node 1
+ {ok, pong} = do_inet_rpc(Sock2, net_adm, ping, [Node1]),
+ {ok, [Node2]} = do_inet_rpc(Sock1, erlang, nodes, []),
+ {ok, [Node1]} = do_inet_rpc(Sock2, erlang, nodes, []),
+
+ stop_relay_node(Sock2),
+ stop_relay_node(Sock1).
+
+%% epmd_module functions:
+
+start_link() ->
+ ignore.
+
+register_node(Name, Port) ->
+ register_node(Name, Port, inet_tcp).
+register_node(_Name, Port, _Driver) ->
+ %% Save the port number we're listening on.
+ application:set_env(kernel, dist_listen_port, Port),
+ Creation = rand:uniform(3),
+ {ok, Creation}.
+
+port_please(_Name, _Ip) ->
+ case init:get_argument(other_node_port) of
+ error ->
+ %% None specified. Default to 42.
+ Port = 42,
+ Version = 5,
+ {port, Port, Version};
+ {ok, [[PortS]]} ->
+ %% Port number given on command line.
+ Port = list_to_integer(PortS),
+ Version = 5,
+ {port, Port, Version}
+ end.
+
%%% Utilities
timestamp() ->
- {A,B,C} = erlang:now(),
- (C div 1000) + (B * 1000) + (A * 1000000000).
+ erlang:monotonic_time(millisecond).
start_node(X) ->
start_node(X, [], []).
@@ -1980,19 +2010,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,
- test_server:start_node(Name, slave,
- [{args,
- Args++" -setcookie "++Cookie++" -pa \""++Pa++"\""}
- | RelArg]);
+ [] -> [];
+ _ -> [{erl,[{release,Rel}]}]
+ end,
+ test_server:start_node(Name, slave,
+ [{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(timestamp()))),
+ ++ "-"
+ ++ atom_to_list(proplists:get_value(testcase, Config))
+ ++ "-"
+ ++ integer_to_list(erlang:system_time(second))
+ ++ "-"
+ ++ integer_to_list(erlang:unique_integer([positive])))),
start_node(Name, Args, Rel).
stop_node(Node) ->
@@ -2003,13 +2035,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.
@@ -2020,46 +2052,44 @@ 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}]),
+ {ok, LSock} = gen_tcp:listen(0, [binary, {packet, 4}, {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),
- {ok, NN} =
- test_server:start_node(Node, peer,
- [{args, Args ++
- " -setcookie "++Cookie++" -pa "++Pa++" "++
- RunArg}]),
+ Host ++ " " ++ integer_to_list(Port),
+ {ok, NN} = 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),
@@ -2074,28 +2104,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) ->
@@ -2104,42 +2134,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:now(), 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(microsecond), 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:now(), 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:now(), Msg]),
- node_monitor_loop(Master)
+ {nodeup, Node, _InfoList} = Msg ->
+ Master ! {nodeup, node(), Node},
+ io:format("~p ~p: ~p~n", [node(), erlang:system_time(microsecond), 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(microsecond), Msg]),
+ node_monitor_loop(Master)
end.
verify_up(A, B) ->
@@ -2153,16 +2183,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) ->
@@ -2171,12 +2201,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.
@@ -2196,17 +2226,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) ->
@@ -2231,9 +2261,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) ->
@@ -2246,106 +2276,60 @@ 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)),
16#80 bor (16#3F band CP)
| string_to_utf8_list(CPs)].
-utf8_list_to_string([]) ->
- [];
-utf8_list_to_string([B|Bs]) when is_integer(B),
- 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 ->
- [(((B0 band 16#1F) bsl 6)
- 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 ->
- [(((B0 band 16#F) bsl 12)
- 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 ->
- [(((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))
- | utf8_list_to_string(Bs)].
-
mk_pid({NodeName, Creation}, Number, Serial) when is_atom(NodeName) ->
<<?VERSION_MAGIC, NodeNameExt/binary>> = term_to_binary(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) ->
@@ -2353,59 +2337,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 e2137a1ec5..f574b2c02c 100644
--- a/erts/emulator/test/distribution_SUITE_data/run.erl
+++ b/erts/emulator/test/distribution_SUITE_data/run.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1998-2016. 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.
+%% 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%
%%
@@ -29,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
@@ -46,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 c62bc0c454..6810729285 100644
--- a/erts/emulator/test/driver_SUITE.erl
+++ b/erts/emulator/test/driver_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2014. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2017. 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.
+%% 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%
@@ -28,62 +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,
- 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]).
+ 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
@@ -111,30 +114,30 @@
-define(MAX_DATA_SIZE, 16384).
% This is the allowed delay when testing the driver timer functionality
--define(delay, 100).
+-define(delay, 400).
-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 = 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),
+end_per_testcase(Case, _Config) ->
erlang:display({end_per_testcase, Case}),
- ?line 0 = 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() ->
- [outputv_errors, outputv_echo, queue_echo, {group, timer},
+all() -> %% Keep a_test first and z_test last...
+ [a_test, outputv_errors, outputv_echo, queue_echo, {group, timer},
driver_unloaded, io_ready_exit, use_fallback_pollset,
bad_fd_in_pollset, driver_event, fd_change,
steal_control, otp_6602, driver_system_info_base_ver,
@@ -151,7 +154,8 @@ all() ->
thr_free_drv,
async_blast,
thr_msg_blast,
- consume_timeslice].
+ consume_timeslice,
+ z_test].
groups() ->
[{timer, [],
@@ -175,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.
@@ -220,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) ->
@@ -350,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.
@@ -373,146 +375,134 @@ 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 = now(),
- ?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
- after Timeout + ?delay ->
- ?line test_server:fail("driver failed to timeout")
+ {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 + 100*?delay ->
+ 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 100*?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 = now(),
+ TimeBefore = erlang:monotonic_time(),
Timeout0 = 350,
- ?line 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,
+ erlang:port_command(Port, <<?DELAY_START_TIMER,Timeout0:32>>),
+ Timeout = Timeout0 + 1000,
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 = now(),
- ?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
- after Timeout + ?delay ->
- ?line test_server:fail("driver failed to timeout")
+ {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 + 100*?delay ->
+ ct:fail("driver failed to timeout")
end.
@@ -520,49 +510,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) ->
@@ -602,7 +590,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) ->
@@ -622,9 +610,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])),
%% ***********************************************************************
@@ -639,22 +627,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;
@@ -672,26 +659,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)
@@ -709,8 +692,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) ->
@@ -720,83 +703,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).
@@ -808,140 +785,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 wait_until_no_pending_updates(),
- ?line ChkIo = erlang:system_info(check_io),
- ?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 wait_until_no_pending_updates(),
- ?line After = erlang:system_info(check_io),
- ?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'}, []).
@@ -949,248 +914,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 = 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.
-
-
-
-wait_until_no_pending_updates() ->
- case lists:keysearch(pending_updates, 1, erlang:system_info(check_io)) of
- {value, {pending_updates, 0}} ->
- ok;
- false ->
- ok;
- _ ->
- receive after 10 -> ok end,
- wait_until_no_pending_updates()
+ 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, {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()
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),
- {ok, Port} = inet:port(S),
- %% Steal fd (lock checker used to
- %% trigger here).
- {ok, _S2} = gen_udp:open(Port,[{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_NAMES, ?EXPECTED_SYSTEM_INFO_NAMES2).
+-define(EXPECTED_SYSTEM_INFO_NAMES3,
+ (?EXPECTED_SYSTEM_INFO_NAMES2 ++
+ ["emu_nif_vsn"])).
+
+-define(EXPECTED_SYSTEM_INFO_NAMES4,
+ (?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);
- {{2, 0}, _} ->
- ?line [] = 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]) ->
+ 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).
@@ -1198,171 +1170,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).
@@ -1376,726 +1345,657 @@ 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.
-
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) ->
@@ -2127,7 +2027,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}]),
@@ -2137,18 +2037,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,
@@ -2159,18 +2059,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,
@@ -2181,18 +2081,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),
@@ -2202,18 +2102,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),
@@ -2225,43 +2125,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]),
@@ -2269,34 +2169,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]),
@@ -2316,19 +2216,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() ->
@@ -2341,7 +2241,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.
@@ -2354,26 +2254,63 @@ 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().
+
+z_test(Config) when is_list(Config) ->
+ check_io_debug().
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Utilities
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+check_io_debug() ->
+ get_stable_check_io_info(),
+ {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,
+ 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 ->
@@ -2388,26 +2325,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) ->
@@ -2438,11 +2375,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.
@@ -2474,26 +2411,17 @@ 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).
-%% return millisecs from statistics source
erl_millisecs() ->
- {Ms, S, Us} = erlang:now(),
- Ms * 1000000000 + S * 1000 + Us / 1000.
+ erl_millisecs(erlang:monotonic_time()).
-erl_millisecs({Ms,S,Us}) ->
- Ms * 1000000000 + S * 1000 + Us / 1000.
+erl_millisecs(MonotonicTime) ->
+ (1000*MonotonicTime)/erlang:convert_time_unit(1,second,native).
%% 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
@@ -2501,31 +2429,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() ->
@@ -2538,55 +2466,52 @@ sleep(Ms) when is_integer(Ms), Ms >= 0 ->
start_node(Config) when is_list(Config) ->
- ?line Pa = filename:dirname(code:which(?MODULE)),
- ?line {A, B, C} = now(),
- ?line Name = list_to_atom(atom_to_list(?MODULE)
- ++ "-"
- ++ atom_to_list(?config(testcase, Config))
- ++ "-"
- ++ integer_to_list(A)
- ++ "-"
- ++ integer_to_list(B)
- ++ "-"
- ++ integer_to_list(C)),
- ?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(second))
+ ++ "-"
+ ++ 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/driver_SUITE_data/async_blast_drv.c b/erts/emulator/test/driver_SUITE_data/async_blast_drv.c
index 72be107168..1432bc42c1 100644
--- a/erts/emulator/test/driver_SUITE_data/async_blast_drv.c
+++ b/erts/emulator/test/driver_SUITE_data/async_blast_drv.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2011-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2011-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/test/driver_SUITE_data/caller_drv.c b/erts/emulator/test/driver_SUITE_data/caller_drv.c
index 2731f9b317..3bb20d86f5 100644
--- a/erts/emulator/test/driver_SUITE_data/caller_drv.c
+++ b/erts/emulator/test/driver_SUITE_data/caller_drv.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
diff --git a/erts/emulator/test/driver_SUITE_data/chkio_drv.c b/erts/emulator/test/driver_SUITE_data/chkio_drv.c
index faf1040276..8e5e81665c 100644
--- a/erts/emulator/test/driver_SUITE_data/chkio_drv.c
+++ b/erts/emulator/test/driver_SUITE_data/chkio_drv.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
@@ -1396,10 +1397,18 @@ static void assert_print(char* str, int line)
static void assert_failed(ErlDrvPort port, char* str, int line)
{
char buf[30];
+ size_t bufsz = sizeof(buf);
+
assert_print(str,line);
- snprintf(buf,sizeof(buf),"failed_at_line_%d",line);
- driver_failure_atom(port,buf);
- /*abort();*/
+
+ if (erl_drv_getenv("ERL_ABORT_ON_FAILURE", buf, &bufsz) == 0
+ && (strcmp("true", buf) == 0 || strcmp("yes", buf) == 0)) {
+ abort();
+ }
+ else {
+ snprintf(buf,sizeof(buf),"failed_at_line_%d",line);
+ driver_failure_atom(port,buf);
+ }
}
#define my_driver_select(PORT,FD,MODE,ON) \
diff --git a/erts/emulator/test/driver_SUITE_data/consume_timeslice_drv.c b/erts/emulator/test/driver_SUITE_data/consume_timeslice_drv.c
index 578a210ab2..142ae46247 100644
--- a/erts/emulator/test/driver_SUITE_data/consume_timeslice_drv.c
+++ b/erts/emulator/test/driver_SUITE_data/consume_timeslice_drv.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2012-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2012-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/test/driver_SUITE_data/invalid_extended_marker_drv.c b/erts/emulator/test/driver_SUITE_data/invalid_extended_marker_drv.c
index 59145447f8..4bc5b85338 100644
--- a/erts/emulator/test/driver_SUITE_data/invalid_extended_marker_drv.c
+++ b/erts/emulator/test/driver_SUITE_data/invalid_extended_marker_drv.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
diff --git a/erts/emulator/test/driver_SUITE_data/io_ready_exit_drv.c b/erts/emulator/test/driver_SUITE_data/io_ready_exit_drv.c
index 1e107309df..11ccd2574e 100644
--- a/erts/emulator/test/driver_SUITE_data/io_ready_exit_drv.c
+++ b/erts/emulator/test/driver_SUITE_data/io_ready_exit_drv.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
diff --git a/erts/emulator/test/driver_SUITE_data/ioq_exit_drv.c b/erts/emulator/test/driver_SUITE_data/ioq_exit_drv.c
index e2b338f801..d87c2bec93 100644
--- a/erts/emulator/test/driver_SUITE_data/ioq_exit_drv.c
+++ b/erts/emulator/test/driver_SUITE_data/ioq_exit_drv.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2007-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2007-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/test/driver_SUITE_data/larger_major_vsn_drv.c b/erts/emulator/test/driver_SUITE_data/larger_major_vsn_drv.c
index 4eb0e6fa57..3e46d89288 100644
--- a/erts/emulator/test/driver_SUITE_data/larger_major_vsn_drv.c
+++ b/erts/emulator/test/driver_SUITE_data/larger_major_vsn_drv.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
diff --git a/erts/emulator/test/driver_SUITE_data/larger_minor_vsn_drv.c b/erts/emulator/test/driver_SUITE_data/larger_minor_vsn_drv.c
index 396deb9bef..d7336ed59b 100644
--- a/erts/emulator/test/driver_SUITE_data/larger_minor_vsn_drv.c
+++ b/erts/emulator/test/driver_SUITE_data/larger_minor_vsn_drv.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
diff --git a/erts/emulator/test/driver_SUITE_data/missing_callback_drv.c b/erts/emulator/test/driver_SUITE_data/missing_callback_drv.c
index 851f2c745b..e7480d2e00 100644
--- a/erts/emulator/test/driver_SUITE_data/missing_callback_drv.c
+++ b/erts/emulator/test/driver_SUITE_data/missing_callback_drv.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson AB. Portions
* created by Ericsson are Copyright 2008, Ericsson Utvecklings AB. All
diff --git a/erts/emulator/test/driver_SUITE_data/monitor_drv.c b/erts/emulator/test/driver_SUITE_data/monitor_drv.c
index 81dfb65191..1418250484 100644
--- a/erts/emulator/test/driver_SUITE_data/monitor_drv.c
+++ b/erts/emulator/test/driver_SUITE_data/monitor_drv.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
diff --git a/erts/emulator/test/driver_SUITE_data/otp_6879_drv.c b/erts/emulator/test/driver_SUITE_data/otp_6879_drv.c
index ff44145ca7..594a996ab9 100644
--- a/erts/emulator/test/driver_SUITE_data/otp_6879_drv.c
+++ b/erts/emulator/test/driver_SUITE_data/otp_6879_drv.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
diff --git a/erts/emulator/test/driver_SUITE_data/otp_9302_drv.c b/erts/emulator/test/driver_SUITE_data/otp_9302_drv.c
index ad29d17f06..37cb93fb3a 100644
--- a/erts/emulator/test/driver_SUITE_data/otp_9302_drv.c
+++ b/erts/emulator/test/driver_SUITE_data/otp_9302_drv.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2011-2014. All Rights Reserved.
+ * Copyright Ericsson AB 2011-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/test/driver_SUITE_data/peek_non_existing_queue_drv.c b/erts/emulator/test/driver_SUITE_data/peek_non_existing_queue_drv.c
index cbee1c3dce..685cda3e07 100644
--- a/erts/emulator/test/driver_SUITE_data/peek_non_existing_queue_drv.c
+++ b/erts/emulator/test/driver_SUITE_data/peek_non_existing_queue_drv.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
diff --git a/erts/emulator/test/driver_SUITE_data/smaller_major_vsn_drv.c b/erts/emulator/test/driver_SUITE_data/smaller_major_vsn_drv.c
index 6b9d4745ba..d50546b919 100644
--- a/erts/emulator/test/driver_SUITE_data/smaller_major_vsn_drv.c
+++ b/erts/emulator/test/driver_SUITE_data/smaller_major_vsn_drv.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
diff --git a/erts/emulator/test/driver_SUITE_data/smaller_minor_vsn_drv.c b/erts/emulator/test/driver_SUITE_data/smaller_minor_vsn_drv.c
index 42b1d2a187..082694de82 100644
--- a/erts/emulator/test/driver_SUITE_data/smaller_minor_vsn_drv.c
+++ b/erts/emulator/test/driver_SUITE_data/smaller_minor_vsn_drv.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
diff --git a/erts/emulator/test/driver_SUITE_data/sys_info_base_drv.c b/erts/emulator/test/driver_SUITE_data/sys_info_base_drv.c
index e44c7dbd5e..c69961928e 100644
--- a/erts/emulator/test/driver_SUITE_data/sys_info_base_drv.c
+++ b/erts/emulator/test/driver_SUITE_data/sys_info_base_drv.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web at http://www.erlang.org/.
+/* ``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
*
- * 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.
+ * 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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
@@ -41,7 +42,9 @@
"thread=%s " \
"smp=%s " \
"async_thrs=%d " \
- "sched_thrs=%d"
+ "sched_thrs=%d " \
+ "emu_nif_vsn=%d.%d"
+
static size_t
sys_info_drv_max_res_len(ErlDrvSysInfo *sip)
@@ -55,6 +58,7 @@ sys_info_drv_max_res_len(ErlDrvSysInfo *sip)
slen += 5; /* smp */
slen += 20; /* async_thrs */
slen += 20; /* sched_thrs */
+ slen += 2*20; /* emu_nif_vsn */
return slen;
}
@@ -72,7 +76,9 @@ sys_info_drv_sprintf_sys_info(ErlDrvSysInfo *sip, char *str)
sip->thread_support ? "true" : "false",
sip->smp_support ? "true" : "false",
sip->async_threads,
- sip->scheduler_threads);
+ sip->scheduler_threads,
+ sip->nif_major_version,
+ sip->nif_minor_version);
}
#include "sys_info_drv_impl.c"
diff --git a/erts/emulator/test/driver_SUITE_data/sys_info_curr_drv.c b/erts/emulator/test/driver_SUITE_data/sys_info_curr_drv.c
index 5bbc966932..a847dbb6ad 100644
--- a/erts/emulator/test/driver_SUITE_data/sys_info_curr_drv.c
+++ b/erts/emulator/test/driver_SUITE_data/sys_info_curr_drv.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
@@ -40,7 +41,9 @@
"thread=%s " \
"smp=%s " \
"async_thrs=%d " \
- "sched_thrs=%d"
+ "sched_thrs=%d " \
+ "emu_nif_vsn=%d.%d " \
+ "dirty_sched=%s"
static size_t
sys_info_drv_max_res_len(ErlDrvSysInfo *sip)
@@ -54,6 +57,8 @@ sys_info_drv_max_res_len(ErlDrvSysInfo *sip)
slen += 5; /* smp */
slen += 20; /* async_thrs */
slen += 20; /* sched_thrs */
+ slen += 2*20; /* emu_nif_vsn */
+ slen += 5; /* dirty_sched */
return slen;
}
@@ -71,7 +76,10 @@ sys_info_drv_sprintf_sys_info(ErlDrvSysInfo *sip, char *str)
sip->thread_support ? "true" : "false",
sip->smp_support ? "true" : "false",
sip->async_threads,
- sip->scheduler_threads);
+ sip->scheduler_threads,
+ sip->nif_major_version,
+ sip->nif_minor_version,
+ sip->dirty_scheduler_support ? "true" : "false");
}
#include "sys_info_drv_impl.c"
diff --git a/erts/emulator/test/driver_SUITE_data/sys_info_drv_impl.c b/erts/emulator/test/driver_SUITE_data/sys_info_drv_impl.c
index c6c70a2075..7c22e2c365 100644
--- a/erts/emulator/test/driver_SUITE_data/sys_info_drv_impl.c
+++ b/erts/emulator/test/driver_SUITE_data/sys_info_drv_impl.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
diff --git a/erts/emulator/test/driver_SUITE_data/sys_info_drv_impl.h b/erts/emulator/test/driver_SUITE_data/sys_info_drv_impl.h
index 5a6ddb15cf..35e60c0d86 100644
--- a/erts/emulator/test/driver_SUITE_data/sys_info_drv_impl.h
+++ b/erts/emulator/test/driver_SUITE_data/sys_info_drv_impl.h
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
diff --git a/erts/emulator/test/driver_SUITE_data/sys_info_prev_drv.c b/erts/emulator/test/driver_SUITE_data/sys_info_prev_drv.c
index 63c69f751c..33a4794fba 100644
--- a/erts/emulator/test/driver_SUITE_data/sys_info_prev_drv.c
+++ b/erts/emulator/test/driver_SUITE_data/sys_info_prev_drv.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web at http://www.erlang.org/.
+/* ``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
*
- * 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.
+ * 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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
@@ -41,7 +42,9 @@
"thread=%s " \
"smp=%s " \
"async_thrs=%d " \
- "sched_thrs=%d"
+ "sched_thrs=%d " \
+ "emu_nif_vsn=%d.%d"
+
static size_t
sys_info_drv_max_res_len(ErlDrvSysInfo *sip)
@@ -55,6 +58,7 @@ sys_info_drv_max_res_len(ErlDrvSysInfo *sip)
slen += 5; /* smp */
slen += 20; /* async_thrs */
slen += 20; /* sched_thrs */
+ slen += 2*20; /* emu_nif_vsn */
return slen;
}
@@ -72,7 +76,9 @@ sys_info_drv_sprintf_sys_info(ErlDrvSysInfo *sip, char *str)
sip->thread_support ? "true" : "false",
sip->smp_support ? "true" : "false",
sip->async_threads,
- sip->scheduler_threads);
+ sip->scheduler_threads,
+ sip->nif_major_version,
+ sip->nif_minor_version);
}
#include "sys_info_drv_impl.c"
diff --git a/erts/emulator/test/driver_SUITE_data/thr_alloc_drv.c b/erts/emulator/test/driver_SUITE_data/thr_alloc_drv.c
index 500725a7cd..f1f2b438f0 100644
--- a/erts/emulator/test/driver_SUITE_data/thr_alloc_drv.c
+++ b/erts/emulator/test/driver_SUITE_data/thr_alloc_drv.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
diff --git a/erts/emulator/test/driver_SUITE_data/thr_free_drv.c b/erts/emulator/test/driver_SUITE_data/thr_free_drv.c
index 439fe6a184..48fe5fa435 100644
--- a/erts/emulator/test/driver_SUITE_data/thr_free_drv.c
+++ b/erts/emulator/test/driver_SUITE_data/thr_free_drv.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2011. All Rights Reserved.
+ * Copyright Ericsson AB 2011-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/test/driver_SUITE_data/thr_msg_blast_drv.c b/erts/emulator/test/driver_SUITE_data/thr_msg_blast_drv.c
index 5a9112afa3..56183c9484 100644
--- a/erts/emulator/test/driver_SUITE_data/thr_msg_blast_drv.c
+++ b/erts/emulator/test/driver_SUITE_data/thr_msg_blast_drv.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2012. All Rights Reserved.
+ * Copyright Ericsson AB 2012-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/test/driver_SUITE_data/timer_drv.c b/erts/emulator/test/driver_SUITE_data/timer_drv.c
index 57538e0d57..c3ce3b6e49 100644
--- a/erts/emulator/test/driver_SUITE_data/timer_drv.c
+++ b/erts/emulator/test/driver_SUITE_data/timer_drv.c
@@ -1,5 +1,13 @@
#include <stdio.h>
#include "erl_driver.h"
+#ifdef __WIN32__
+# include <windows.h>
+#else
+# include <sys/time.h>
+# include <sys/types.h>
+# include <sys/select.h>
+# include <unistd.h>
+#endif
#define get_int32(s) ((((unsigned char*) (s))[0] << 24) | \
(((unsigned char*) (s))[1] << 16) | \
@@ -17,6 +25,7 @@ static ErlDrvData timer_start(ErlDrvPort, char*);
static void timer_stop(ErlDrvData);
static void timer_read(ErlDrvData, char*, ErlDrvSizeT);
static void timer(ErlDrvData);
+static void ms_sleep(int ms);
static ErlDrvEntry timer_driver_entry =
{
@@ -75,9 +84,7 @@ static void timer_read(ErlDrvData p, char *buf, ErlDrvSizeT len)
reply[0] = CANCELLED;
driver_output(port, reply, 1);
} else if (buf[0] == DELAY_START_TIMER) {
-#ifndef __WIN32__
- sleep(1);
-#endif
+ ms_sleep(1000);
driver_set_timer(port, get_int32(buf + 1));
}
}
@@ -95,3 +102,34 @@ static void timer(ErlDrvData port)
reply[0] = TIMER;
driver_output((ErlDrvPort)port, reply, 1);
}
+
+static void
+ms_sleep(int ms)
+{
+ /* Important that we do not return too early... */
+ ErlDrvTime time, timeout_time;
+
+ time = erl_drv_monotonic_time(ERL_DRV_USEC);
+
+ timeout_time = time + ((ErlDrvTime) ms)*1000;
+
+ while (time < timeout_time) {
+ ErlDrvTime timeout = timeout_time - time;
+
+#ifdef __WIN32__
+ Sleep((DWORD) (timeout / 1000));
+#else
+ {
+ struct timeval tv;
+
+ tv.tv_sec = (long) timeout / (1000*1000);
+ tv.tv_usec = (long) timeout % (1000*1000);
+
+ select(0, NULL, NULL, NULL, &tv);
+ }
+#endif
+
+ time = erl_drv_monotonic_time(ERL_DRV_USEC);
+ }
+
+}
diff --git a/erts/emulator/test/driver_SUITE_data/vsn_mismatch_drv_impl.c b/erts/emulator/test/driver_SUITE_data/vsn_mismatch_drv_impl.c
index 53b0a029ce..6750b8a78b 100644
--- a/erts/emulator/test/driver_SUITE_data/vsn_mismatch_drv_impl.c
+++ b/erts/emulator/test/driver_SUITE_data/vsn_mismatch_drv_impl.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
diff --git a/erts/emulator/test/driver_SUITE_data/zero_extended_marker_garb_drv.c b/erts/emulator/test/driver_SUITE_data/zero_extended_marker_garb_drv.c
index ed705e565f..e7f4edde08 100644
--- a/erts/emulator/test/driver_SUITE_data/zero_extended_marker_garb_drv.c
+++ b/erts/emulator/test/driver_SUITE_data/zero_extended_marker_garb_drv.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
diff --git a/erts/emulator/test/efile_SUITE.erl b/erts/emulator/test/efile_SUITE.erl
index f79bb761d1..f0e1bcf04b 100644
--- a/erts/emulator/test/efile_SUITE.erl
+++ b/erts/emulator/test/efile_SUITE.erl
@@ -1,50 +1,35 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2017. 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.
+%% 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(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),
@@ -69,59 +54,57 @@ 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),
- TestFile = filename:join(DataDir, "existing_file"),
+ DataDir = proplists:get_value(data_dir,Config),
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.
%%
@@ -129,54 +112,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/emulator_node_container_SUITE.spec b/erts/emulator/test/emulator_node_container_SUITE.spec
new file mode 100644
index 0000000000..77c28ba7ae
--- /dev/null
+++ b/erts/emulator/test/emulator_node_container_SUITE.spec
@@ -0,0 +1,2 @@
+{enable_builtin_hooks, false}.
+{suites,"../emulator_test",node_container_SUITE}.
diff --git a/erts/emulator/test/emulator_smoke.spec b/erts/emulator/test/emulator_smoke.spec
index 3219aeb823..b2d0de8835 100644
--- a/erts/emulator/test/emulator_smoke.spec
+++ b/erts/emulator/test/emulator_smoke.spec
@@ -1,3 +1,9 @@
-{suites,"../emulator_test",[smoke_test_SUITE,time_SUITE]}.
-{cases,"../emulator_test",crypto_SUITE,[t_md5]}.
-{cases,"../emulator_test",float_SUITE,[fpe,cmp_integer]}. \ No newline at end of file
+{define,'Dir',"../emulator_test"}.
+{suites,'Dir',[smoke_test_SUITE]}.
+{suites,'Dir',[time_SUITE]}.
+{skip_cases,'Dir',time_SUITE,
+ [univ_to_local,local_to_univ],"Depends on CET timezone"}.
+{skip_cases,'Dir',time_SUITE,
+ [consistency],"Not reliable in October and March"}.
+{cases,'Dir',crypto_SUITE,[t_md5]}.
+{cases,'Dir',float_SUITE,[fpe,cmp_integer]}.
diff --git a/erts/emulator/test/erl_drv_thread_SUITE.erl b/erts/emulator/test/erl_drv_thread_SUITE.erl
index 84a82cced0..f99c151936 100644
--- a/erts/emulator/test/erl_drv_thread_SUITE.erl
+++ b/erts/emulator/test/erl_drv_thread_SUITE.erl
@@ -1,30 +1,30 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2016. 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.
+%% 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(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).
@@ -33,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).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% %%
@@ -80,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 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,
- ?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.
+ 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,
+ 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_drv_thread_SUITE_data/Makefile.src b/erts/emulator/test/erl_drv_thread_SUITE_data/Makefile.src
index 216707e8a5..169fad9231 100644
--- a/erts/emulator/test/erl_drv_thread_SUITE_data/Makefile.src
+++ b/erts/emulator/test/erl_drv_thread_SUITE_data/Makefile.src
@@ -1,13 +1,14 @@
-# ``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 via the world wide web 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.
+# ``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.
#
# The Initial Developer of the Original Code is Ericsson Utvecklings AB.
# Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
diff --git a/erts/emulator/test/erl_drv_thread_SUITE_data/basic.c b/erts/emulator/test/erl_drv_thread_SUITE_data/basic.c
index fca2c1dbea..8ceb9eff08 100644
--- a/erts/emulator/test/erl_drv_thread_SUITE_data/basic.c
+++ b/erts/emulator/test/erl_drv_thread_SUITE_data/basic.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
diff --git a/erts/emulator/test/erl_drv_thread_SUITE_data/rwlock.c b/erts/emulator/test/erl_drv_thread_SUITE_data/rwlock.c
index 064f52c16b..98d0162b55 100644
--- a/erts/emulator/test/erl_drv_thread_SUITE_data/rwlock.c
+++ b/erts/emulator/test/erl_drv_thread_SUITE_data/rwlock.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
diff --git a/erts/emulator/test/erl_drv_thread_SUITE_data/testcase_driver.c b/erts/emulator/test/erl_drv_thread_SUITE_data/testcase_driver.c
index 2cd3209231..7f5faf9121 100644
--- a/erts/emulator/test/erl_drv_thread_SUITE_data/testcase_driver.c
+++ b/erts/emulator/test/erl_drv_thread_SUITE_data/testcase_driver.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
diff --git a/erts/emulator/test/erl_drv_thread_SUITE_data/testcase_driver.h b/erts/emulator/test/erl_drv_thread_SUITE_data/testcase_driver.h
index 18d5229780..bffe4f9f27 100644
--- a/erts/emulator/test/erl_drv_thread_SUITE_data/testcase_driver.h
+++ b/erts/emulator/test/erl_drv_thread_SUITE_data/testcase_driver.h
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
diff --git a/erts/emulator/test/erl_drv_thread_SUITE_data/tsd.c b/erts/emulator/test/erl_drv_thread_SUITE_data/tsd.c
index 3809c915e0..4c952767c2 100644
--- a/erts/emulator/test/erl_drv_thread_SUITE_data/tsd.c
+++ b/erts/emulator/test/erl_drv_thread_SUITE_data/tsd.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
diff --git a/erts/emulator/test/erl_link_SUITE.erl b/erts/emulator/test/erl_link_SUITE.erl
index 435c0872e6..5622cce980 100644
--- a/erts/emulator/test/erl_link_SUITE.erl
+++ b/erts/emulator/test/erl_link_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2001-2017. 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.
+%% 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%
%%
@@ -28,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]).
@@ -60,25 +60,24 @@
% These are to be kept in sync with erl_monitors.h
-define(MON_ORIGIN, 1).
--define(MON_TARGET, 3).
+-define(MON_TARGET, 2).
-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
+ 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,
@@ -86,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.
@@ -95,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 --------------------------------------------------------
@@ -518,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) ->
@@ -546,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.
@@ -562,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) ->
@@ -595,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;
@@ -636,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);
@@ -727,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([]) ->
@@ -735,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.
@@ -757,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) ->
@@ -789,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);
@@ -1035,31 +1007,28 @@ get_names(N, T) when is_atom(T) ->
get_names(0, _, Acc) ->
Acc;
get_names(N, T, Acc) ->
- {A, B, C} = now(),
get_names(N-1, T, [list_to_atom(atom_to_list(?MODULE)
- ++ "-"
- ++ atom_to_list(T)
- ++ "-"
- ++ integer_to_list(A)
- ++ "-"
- ++ integer_to_list(B)
- ++ "-"
- ++ integer_to_list(C)) | Acc]).
+ ++ "-"
+ ++ atom_to_list(T)
+ ++ "-"
+ ++ integer_to_list(erlang:system_time(second))
+ ++ "-"
+ ++ 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).
@@ -1082,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}).
@@ -1138,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 87778dd0c2..6aa7a445b5 100644
--- a/erts/emulator/test/erts_debug_SUITE.erl
+++ b/erts/emulator/test/erts_debug_SUITE.erl
@@ -1,59 +1,37 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2005-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2005-2017. 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.
+%% 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_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,
- instructions/1]).
+-export([all/0, suite/0,
+ test_size/1,flat_size_big/1,df/1,term_type/1,
+ instructions/1, stack_check/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,
+ stack_check].
test_size(Config) when is_list(Config) ->
ConsCell1 = id([a|b]),
@@ -67,6 +45,14 @@ test_size(Config) when is_list(Config) ->
2 = do_test_size({[]}),
3 = do_test_size({a,b}),
7 = do_test_size({a,[b,c]}),
+ 8 = do_test_size(#{b => 2,c => 3}),
+ 4 = do_test_size(#{}),
+ 32 = do_test_size(#{b => 2,c => 3,txt => "hello world"}),
+
+ true = do_test_size(maps:from_list([{I,I}||I<-lists:seq(1,256)])) >= map_size_lower_bound(256),
+ true = do_test_size(maps:from_list([{I,I}||I<-lists:seq(1,4096)])) >= map_size_lower_bound(4096),
+ true = do_test_size(maps:from_list([{I,I}||I<-lists:seq(1,254)])) >= map_size_lower_bound(254),
+ true = do_test_size(maps:from_list([{I,I}||I<-lists:seq(1,239)])) >= map_size_lower_bound(239),
%% Test internal consistency of sizes, but without testing
%% exact sizes.
@@ -89,14 +75,17 @@ test_size(Config) when is_list(Config) ->
%% Test shared data structures.
do_test_size([ConsCell1|ConsCell1],
- 3*ConsCellSz,
- 2*ConsCellSz),
+ 3*ConsCellSz,
+ 2*ConsCellSz),
do_test_size(fun() -> {ConsCell1,ConsCell2} end,
- FunSz2 + 2*ConsCellSz,
- FunSz2 + ConsCellSz),
+ FunSz2 + 2*ConsCellSz,
+ FunSz2 + ConsCellSz),
do_test_size({SimplestFun,SimplestFun},
- 2*FunSz0+do_test_size({a,b}),
- FunSz0+do_test_size({a,b})),
+ 2*FunSz0+do_test_size({a,b}),
+ FunSz0+do_test_size({a,b})),
+
+ M = id(#{ "atom" => first, i => 0}),
+ do_test_size([M,M#{ "atom" := other },M#{i := 42}],54,32),
ok.
do_test_size(Term) ->
@@ -107,6 +96,13 @@ do_test_size(Term, FlatSz, Sz) ->
FlatSz = erts_debug:flat_size(Term),
Sz = erts_debug:size(Term).
+map_size_lower_bound(N) ->
+ %% this est. is a bit lower that actual lower bound
+ %% number of internal nodes
+ T = (N - 1) div 15,
+ %% total words
+ 2 + 17 * T + 2 * N.
+
flat_size_big(Config) when is_list(Config) ->
%% Build a term whose external size only fits in a big num (on 32-bit CPU).
flat_size_big_1(16#11111111111111117777777777777777888889999, 0, 16#FFFFFFF).
@@ -119,24 +115,99 @@ 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) ->
- ?line P0 = pps(),
- ?line PrivDir = ?config(priv_dir, Config),
- ?line ok = file:set_cwd(PrivDir),
- ?line erts_debug:df(?MODULE),
- ?line Beam = filename:join(PrivDir, ?MODULE_STRING++".dis"),
- ?line {ok,Bin} = file:read_file(Beam),
- ?line ok = io:put_chars(binary_to_list(Bin)),
- ?line ok = file:delete(Beam),
- ?line true = (P0 == pps()),
+ P0 = pps(),
+ PrivDir = proplists:get_value(priv_dir, Config),
+ ok = file:set_cwd(PrivDir),
+
+ AllLoaded = [M || {M,_} <- code:all_loaded()],
+ {Pid,Ref} = spawn_monitor(fun() -> df_smoke(AllLoaded) end),
+ receive
+ {'DOWN',Ref,process,Pid,Status} ->
+ normal = Status
+ after 20*1000 ->
+ %% Not finished (i.e. a slow computer). Stop now.
+ Pid ! stop,
+ receive
+ {'DOWN',Ref,process,Pid,Status} ->
+ normal = Status,
+ io:format("...")
+ end
+ end,
+ io:nl(),
+ _ = [_ = file:delete(atom_to_list(M) ++ ".dis") ||
+ M <- AllLoaded],
+
+ true = (P0 == pps()),
ok.
+stack_check(Config) when is_list(Config) ->
+ erts_debug:set_internal_state(available_internal_state,true),
+ %% Recurses on the C stack until stacklimit is reached. That
+ %% is, tests that the stack limit functionality works (used
+ %% by PCRE). VM will crash if it doesn't work...
+ Size = erts_debug:get_internal_state(stack_check),
+ erts_debug:set_internal_state(available_internal_state,false),
+ {comment, "Stack size: "++integer_to_list(Size)++" bytes"}.
+
+df_smoke([M|Ms]) ->
+ io:format("~p", [M]),
+ erts_debug:df(M),
+ receive
+ stop ->
+ ok
+ after 0 ->
+ df_smoke(Ms)
+ end;
+df_smoke([]) -> ok.
+
pps() ->
{erlang:ports()}.
instructions(Config) when is_list(Config) ->
- ?line Is = erts_debug:instructions(),
- ?line _ = [list_to_atom(I) || I <- Is],
+ Is = erts_debug:instructions(),
+ _ = [list_to_atom(I) || I <- Is],
ok.
id(I) ->
diff --git a/erts/emulator/test/estone_SUITE.erl b/erts/emulator/test/estone_SUITE.erl
index 1de6d6fb56..8b336b366d 100644
--- a/erts/emulator/test/estone_SUITE.erl
+++ b/erts/emulator/test/estone_SUITE.erl
@@ -1,26 +1,26 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2002-2017. 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.
+%% 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(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,
@@ -45,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).
@@ -65,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].
@@ -83,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,
@@ -339,7 +312,6 @@ micros() ->
].
macro(Ms,DataDir) ->
- erlang:now(), %% compensate for old 4.3 firsttime clock bug :-(
statistics(reductions),
statistics(runtime),
lists(500), %% fixup cache on first round
@@ -369,10 +341,9 @@ run_micro(Top, M, DataDir) ->
apply_micro(M) ->
{GC0, Words0, _} = statistics(garbage_collection),
statistics(reductions),
- Before = erlang:now(),
-
+ Before = monotonic_time(),
Compensate = apply_micro(M#micro.function, M#micro.loops),
- After = erlang:now(),
+ After = monotonic_time(),
{GC1, Words1, _} = statistics(garbage_collection),
{_, Reds} = statistics(reductions),
Elapsed = subtr(Before, After),
@@ -383,18 +354,19 @@ 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.
-subtr(Before, After) ->
- (element(1,After)*1000000000000
- +element(2,After)*1000000+element(3,After)) -
- (element(1,Before)*1000000000000
- +element(2,Before)*1000000+element(3,Before)).
+subtr(Before, After) when is_integer(Before), is_integer(After) ->
+ erlang:convert_time_unit(After-Before, native, microsecond);
+subtr({_,_,_}=Before, {_,_,_}=After) ->
+ timer:now_diff(After, Before).
gci(Micros, Words, Gcs) ->
((256 * Gcs) / Micros) + (Words / Micros).
@@ -633,10 +605,10 @@ tup_trav(T, P, End) ->
%% Port I/O
port_io(I) ->
EstoneCat = get(estone_cat),
- Before = erlang:now(),
+ Before = monotonic_time(),
Pps = make_port_pids(5, I, EstoneCat), %% 5 ports
send_procs(Pps, go),
- After = erlang:now(),
+ After = monotonic_time(),
wait_for_pids(Pps),
subtr(Before, After).
@@ -736,7 +708,7 @@ alloc(I) ->
%% Time to call bif's
%% Lot's of element stuff which reflects the record code which
-%% is becomming more and more common
+%% is becoming more and more common
bif_dispatch(0) ->
0;
bif_dispatch(I) ->
@@ -854,10 +826,10 @@ handle_call(_From, State, [abc]) ->
%% Binary handling, creating, manipulating and sending binaries
binary_h(I) ->
- Before = erlang:now(),
+ Before = monotonic_time(),
P = spawn(?MODULE, echo, [self()]),
B = list_to_binary(lists:duplicate(2000, 5)),
- After = erlang:now(),
+ After = monotonic_time(),
Compensate = subtr(Before, After),
binary_h_2(I, P, B),
Compensate.
@@ -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 f982b9d4ff..fc4ac037ac 100644
--- a/erts/emulator/test/evil_SUITE.erl
+++ b/erts/emulator/test/evil_SUITE.erl
@@ -1,40 +1,40 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2002-2017. 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.
+%% 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(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
- ]).
+-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("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() ->
[heap_frag, encode_decode_ext, decode_integer_ext,
@@ -42,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.
@@ -86,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.
@@ -124,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.
@@ -379,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 09a7a87a9a..aaca522da6 100644
--- a/erts/emulator/test/exception_SUITE.erl
+++ b/erts/emulator/test/exception_SUITE.erl
@@ -1,85 +1,71 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2011. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2017. 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.
+%% 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(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, {minutes, 1}}].
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)
@@ -88,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
@@ -100,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) ->
@@ -121,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;
@@ -158,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) ->
@@ -250,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).
@@ -259,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) ->
@@ -302,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
@@ -318,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}) ->
@@ -340,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].
@@ -427,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() ->
@@ -447,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,
@@ -470,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.
@@ -645,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
@@ -661,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
@@ -683,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 4a45afa9e9..4098aa9c6a 100644
--- a/erts/emulator/test/float_SUITE.erl
+++ b/erts/emulator/test/float_SUITE.erl
@@ -1,81 +1,59 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2012. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2017. 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.
+%% 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(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,
@@ -83,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.
@@ -99,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) ->
@@ -170,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.
@@ -183,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;
@@ -230,84 +208,81 @@ span_cmp(Axis, Incr, Length) ->
%% for both negative and positive numbers.
%%
%% Axis: The number around which to do the tests eg. (1 bsl 58) - 1.0
-%% Incr: How much to increment the test numbers inbetween each test.
+%% Incr: How much to increment the test numbers in-between each test.
%% Length: Length/2 is the number of Incr away from Axis to test on the
%% negative and positive plane.
%% 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 {A, B, C} = now(),
- ?line Name = list_to_atom(atom_to_list(?MODULE)
- ++ "-"
- ++ atom_to_list(?config(testcase, Config))
- ++ "-"
- ++ integer_to_list(A)
- ++ "-"
- ++ integer_to_list(B)
- ++ "-"
- ++ integer_to_list(C)),
- ?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(second))
+ ++ "-"
+ ++ 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
@@ -317,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) ->
@@ -330,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 b80385c3f9..a91d622040 100644
--- a/erts/emulator/test/float_SUITE_data/fp_drv.c
+++ b/erts/emulator/test/float_SUITE_data/fp_drv.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson AB. Portions
* created by Ericsson are Copyright 2008, Ericsson AB. All Rights
@@ -17,6 +18,7 @@
*/
#if defined(DEBUG) || 0
+# include <stdio.h>
# define PRINTF(X) printf X
#else
# define PRINTF(X)
@@ -29,9 +31,14 @@
#if defined (__GNUC__)
int _finite(double x);
#endif
-#ifndef finite
-#define finite _finite
+#ifndef isfinite
+#define isfinite _finite
#endif
+#elif !defined(HAVE_ISFINITE) && defined(HAVE_FINITE)
+/* If not windows and we do not have isfinite */
+#define isfinite finite
+#elif !defined(HAVE_ISFINITE)
+# error "No finite function found!"
#endif
#include "erl_driver.h"
@@ -79,21 +86,21 @@ do_test(void *unused)
x = 3.23e133;
y = 3.57e257;
z = x*y;
- if (finite(z))
+ if (isfinite(z))
return "is finite (1)";
x = 5.0;
y = 0.0;
z = x/y;
- if (finite(z))
+ if (isfinite(z))
return "is finite (2)";
z = log(-1.0);
- if (finite(z))
+ if (isfinite(z))
return "is finite (3)";
z = log(0.0);
- if (finite(z))
+ if (isfinite(z))
return "is finite (4)";
return "ok";
diff --git a/erts/emulator/test/float_SUITE_data/has_fpe_bug.erl b/erts/emulator/test/float_SUITE_data/has_fpe_bug.erl
index 31af2b2698..26837de274 100644
--- a/erts/emulator/test/float_SUITE_data/has_fpe_bug.erl
+++ b/erts/emulator/test/float_SUITE_data/has_fpe_bug.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2016. 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.
+%% 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%
%%
diff --git a/erts/emulator/test/fun_SUITE.erl b/erts/emulator/test/fun_SUITE.erl
index 8ad5f290ed..7d29ebec52 100644
--- a/erts/emulator/test/fun_SUITE.erl
+++ b/erts/emulator/test/fun_SUITE.erl
@@ -1,88 +1,63 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2012. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2016. 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/.
+%% 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
%%
-%% 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.
+%% 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(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,
+ bad_arglist/1,
equality/1,ordering/1,
- fun_to_port/1,t_hash/1,t_phash/1,t_phash2/1,md5/1,
+ fun_to_port/1,t_phash/1,t_phash2/1,md5/1,
refc/1,refc_ets/1,refc_dist/1,
const_propagation/1,t_arity/1,t_is_function2/1,
- t_fun_info/1]).
+ t_fun_info/1,t_fun_info_mfa/1]).
-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() ->
+all() ->
[bad_apply, bad_fun_call, badarity, ext_badarity,
- equality, ordering, fun_to_port, t_hash, t_phash,
+ bad_arglist,
+ equality, ordering, fun_to_port, t_phash,
t_phash2, md5, refc, refc_ets, refc_dist,
- const_propagation, t_arity, t_is_function2, t_fun_info].
-
-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].
+ const_propagation, t_arity, t_is_function2, t_fun_info,
+ t_fun_info_mfa].
-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) ->
@@ -94,7 +69,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) ->
@@ -106,23 +81,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) ->
@@ -133,74 +106,86 @@ 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.
+% Test erlang:apply with non-proper arg-list
+bad_arglist(Config) when is_list(Config) ->
+ Fun = fun(A,B) -> A+B end,
+ {'EXIT', {badarg,_}} = (catch apply(Fun, 17)),
+ {'EXIT', {badarg,_}} = (catch apply(Fun, [17|18])),
+ {'EXIT', {badarg,_}} = (catch apply(Fun, [17,18|19])),
+ {'EXIT', {badarg,_}} = (catch apply(lists,seq, 17)),
+ {'EXIT', {badarg,_}} = (catch apply(lists,seq, [17|18])),
+ {'EXIT', {badarg,_}} = (catch apply(lists,seq, [17,18|19])),
+ ok.
+
+
%% 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.
@@ -212,29 +197,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,
@@ -244,23 +229,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,
@@ -283,7 +268,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),
@@ -296,140 +281,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) -> [];
@@ -441,86 +425,55 @@ build_io_list(N) ->
1 -> [7,L|L]
end.
-t_hash(doc) -> "Test the hash/2 BIF on funs.";
-t_hash(suite) -> [];
-t_hash(Config) when is_list(Config) ->
- F1 = fun(_X) -> 1 end,
- F2 = fun(_X) -> 2 end,
- ?line 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),
-
- 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),
- 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.
@@ -530,52 +483,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]),
@@ -584,115 +536,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) ->
@@ -700,67 +649,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) ->
@@ -769,66 +718,81 @@ 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) ->
+ Fun1 = fun spawn_call/2,
+ {module,M1} = erlang:fun_info(Fun1, module),
+ {name,F1} = erlang:fun_info(Fun1, name),
+ {arity,A1} = erlang:fun_info(Fun1, arity),
+ {M1,F1,A1=2} = erlang:fun_info_mfa(Fun1),
+ %% Module fun.
+ Fun2 = fun ?MODULE:t_fun_info/1,
+ {module,M2} = erlang:fun_info(Fun2, module),
+ {name,F2} = erlang:fun_info(Fun2, name),
+ {arity,A2} = erlang:fun_info(Fun2, arity),
+ {M2,F2,A2=1} = erlang:fun_info_mfa(Fun2),
+
+ %% Not fun.
+ {'EXIT',_} = (catch erlang:fun_info_mfa(id(d))),
+ ok.
+
+
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.
@@ -839,7 +803,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.
@@ -864,15 +828,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.
@@ -891,6 +855,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
deleted file mode 100644
index 76ddf9fec9..0000000000
--- a/erts/emulator/test/fun_r13_SUITE.erl
+++ /dev/null
@@ -1,97 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2007-2011. 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%
-%%
-
--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]).
-
--define(default_timeout, ?t:minutes(1)).
--include_lib("test_server/include/test_server.hrl").
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-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"}
- end.
-
-do_dist_old(Config) when is_list(Config) ->
- ?line 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),
- 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,
- ok.
-
-cons(H, T) ->
- [H|T].
diff --git a/erts/emulator/test/gc_SUITE.erl b/erts/emulator/test/gc_SUITE.erl
index 36889b6c36..f3942ef416 100644
--- a/erts/emulator/test/gc_SUITE.erl
+++ b/erts/emulator/test/gc_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2017. 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.
+%% 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%
%%
@@ -21,45 +22,38 @@
-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]).
+-include_lib("common_test/include/ct.hrl").
+-include_lib("eunit/include/eunit.hrl").
--define(default_timeout, ?t:minutes(10)).
+-export([all/0, suite/0]).
--export([grow_heap/1, grow_stack/1, grow_stack_heap/1]).
+-export([
+ grow_heap/1,
+ grow_stack/1,
+ grow_stack_heap/1,
+ max_heap_size/1,
+ minor_major_gc_option_async/1,
+ minor_major_gc_option_self/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.
+ [grow_heap, grow_stack, grow_stack_heap, max_heap_size,
+ minor_major_gc_option_self,
+ minor_major_gc_option_async].
-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) ->
@@ -77,7 +71,7 @@ grow_heap1(List, MaxLen, CurLen, up) ->
grow_heap1([], _MaxLen, _, down) ->
ok;
grow_heap1([_|List], MaxLen, CurLen, down) ->
- {_,_,C} = erlang:now(),
+ C=erlang:unique_integer([positive]),
Num = C rem (length(List))+1,
Elem = lists:nth(Num, List),
NewList = lists:delete(Elem, List),
@@ -85,14 +79,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, _) ->
@@ -109,14 +102,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) ->
@@ -136,7 +127,7 @@ grow_stack_heap1(List, MaxLen, CurLen, up) ->
grow_stack_heap1([], _MaxLen, _, down) -> ok;
grow_stack_heap1([_|List], MaxLen, CurLen, down) ->
grow_stack1(CurLen*2,0),
- {_,_,C}=erlang:now(),
+ C=erlang:unique_integer([positive]),
Num=C rem (length(List))+1,
Elem=lists:nth(Num, List),
NewList=lists:delete(Elem, List),
@@ -146,8 +137,8 @@ grow_stack_heap1([_|List], MaxLen, CurLen, down) ->
%% Create an arbitrary element/term.
make_arbit() ->
- {AA,BB,CC}=erlang:now(),
- A=AA+1, B=BB+1, C=CC+1,
+ {AA,BB,CC}=erlang:timestamp(),
+ A=AA+1, B=BB+1, C=(CC+erlang:unique_integer([positive])) rem 1000000 + 1,
New =
case C rem 9 of
0 -> make_string((B div C) +5);
@@ -171,7 +162,7 @@ make_string(Length) ->
make_string(_, 0, Acc) ->
Acc;
make_string(Alph, Length, Acc) ->
- {_,_,C}=erlang:now(),
+ C=erlang:unique_integer([positive]),
Pos=1+(Length*C rem length(Alph)),
make_string(Alph, Length-1,
[lists:nth(Pos,Alph)|Acc]).
@@ -183,3 +174,119 @@ show_heap(String) ->
{stack_size, SSize}=process_info(self(), stack_size),
io:format("Heap/Stack "++String++"~p/~p", [HSize, SSize]).
+%% Test that doing a remote GC that triggers the max heap size
+%% kills the process.
+max_heap_size(_Config) ->
+
+ Pid = spawn_opt(fun long_receive/0,[{max_heap_size, 1024},
+ {message_queue_data, on_heap}]),
+ [Pid ! lists:duplicate(I,I) || I <- lists:seq(1,100)],
+ Ref = erlang:monitor(process, Pid),
+
+ %% Force messages to be viewed as part of heap
+ erlang:process_info(Pid, messages),
+
+ %% Do the GC that triggers max heap
+ erlang:garbage_collect(Pid),
+
+ %% Verify that max heap was triggered
+ receive
+ {'DOWN', Ref, process, Pid, killed} -> ok
+ after 5000 ->
+ ct:fail({process_did_not_die, Pid, erlang:process_info(Pid)})
+ end.
+
+long_receive() ->
+ receive
+ after 10000 ->
+ ok
+ end.
+
+minor_major_gc_option_self(_Config) ->
+ %% Try as major, the test process will self-trigger GC
+ check_gc_tracing_around(
+ fun(Pid, Ref) ->
+ Pid ! {gc, Ref, major}
+ end, [gc_major_start, gc_major_end]),
+
+ %% Try as minor, the test process will self-trigger GC
+ check_gc_tracing_around(
+ fun(Pid, Ref) ->
+ Pid ! {gc, Ref, minor}
+ end, [gc_minor_start, gc_minor_end]).
+
+minor_major_gc_option_async(_Config) ->
+ %% Try with default option, must be major GC
+ check_gc_tracing_around(
+ fun(Pid, _Ref) ->
+ erlang:garbage_collect(Pid, [])
+ end, [gc_major_start, gc_major_end]),
+
+ %% Try with the 'major' type
+ check_gc_tracing_around(
+ fun(Pid, _Ref) ->
+ erlang:garbage_collect(Pid, [{type, major}])
+ end, [gc_major_start, gc_major_end]),
+
+ %% Try with 'minor' option, once
+ check_gc_tracing_around(
+ fun(Pid, _Ref) ->
+ erlang:garbage_collect(Pid, [{type, minor}])
+ end, [gc_minor_start, gc_minor_end]),
+
+ %% Try with 'minor' option, once, async
+ check_gc_tracing_around(
+ fun(Pid, Ref) ->
+ ?assertEqual(async,
+ erlang:garbage_collect(Pid, [{type, minor}, {async, Ref}])),
+
+ receive
+ {garbage_collect, Ref, true} ->
+ ok
+ after 10000 ->
+ ct:fail("Did not receive a completion notification on async GC")
+ end
+ end, [gc_minor_start, gc_minor_end]).
+
+%% Traces garbage collection around the given operation, and fails the test if
+%% it results in any unexpected messages or if the expected trace tags are not
+%% received.
+check_gc_tracing_around(Fun, ExpectedTraceTags) ->
+ Ref = erlang:make_ref(),
+ Pid = spawn(
+ fun Endless() ->
+ receive
+ {gc, Ref, Type} ->
+ erlang:garbage_collect(self(), [{type, Type}])
+ after 100 ->
+ ok
+ end,
+ Endless()
+ end),
+ erlang:garbage_collect(Pid, []),
+ erlang:trace(Pid, true, [garbage_collection]),
+ Fun(Pid, Ref),
+ expect_trace_messages(Pid, ExpectedTraceTags),
+ erlang:trace(Pid, false, [garbage_collection]),
+ erlang:exit(Pid, kill),
+ check_no_unexpected_messages().
+
+%% Ensures that trace messages with the provided tags have all been received
+%% within a reasonable timeframe.
+expect_trace_messages(_Pid, []) ->
+ ok;
+expect_trace_messages(Pid, [Tag | TraceTags]) ->
+ receive
+ {trace, Pid, Tag, _Data} ->
+ expect_trace_messages(Pid, TraceTags)
+ after 4000 ->
+ ct:fail("Didn't receive tag ~p within 4000ms", [Tag])
+ end.
+
+check_no_unexpected_messages() ->
+ receive
+ Anything ->
+ ct:fail("Unexpected message: ~p", [Anything])
+ after 0 ->
+ ok
+ end.
diff --git a/erts/emulator/test/guard_SUITE.erl b/erts/emulator/test/guard_SUITE.erl
index a5df9b59a0..1a93a9f5c2 100644
--- a/erts/emulator/test/guard_SUITE.erl
+++ b/erts/emulator/test/guard_SUITE.erl
@@ -1,30 +1,31 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2011. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2017. 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/.
+%% 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
%%
-%% 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.
+%% 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(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]).
@@ -35,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 ->
@@ -63,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 ->
@@ -78,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
@@ -142,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) ->
@@ -164,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})),
@@ -197,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)
@@ -322,91 +305,92 @@ 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('round/1', 6209607916799025.0, 6209607916799025),
+ 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) ->
@@ -414,9 +398,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) ->
@@ -424,9 +406,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 ->
@@ -456,22 +436,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) ->
@@ -498,7 +476,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 647bb45049..3cbb3c7d5f 100644
--- a/erts/emulator/test/hash_SUITE.erl
+++ b/erts/emulator/test/hash_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2016. 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.
+%% 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%
%%
@@ -33,7 +34,6 @@
-export([basic_test/0,cmp_test/1,range_test/0,spread_test/1,
phash2_test/0, otp_5292_test/0,
otp_7127_test/0]).
--compile({nowarn_deprecated_function, {erlang,hash,2}}).
%%
%% Define to run outside of test server
@@ -49,7 +49,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).
@@ -69,83 +69,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,
- 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].
-
-groups() ->
- [].
+ test_phash2, otp_5292, bit_level_binaries, otp_7127,
+ test_hash_zero].
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-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().
@@ -153,13 +113,12 @@ 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().
+test_hash_zero(Config) when is_list(Config) ->
+ hash_zero_test().
-endif.
@@ -170,24 +129,12 @@ otp_7127(Config) when is_list(Config) ->
%%
basic_test() ->
685556714 = erlang:phash({a,b,c},16#FFFFFFFF),
- 14468079 = erlang:hash({a,b,c},16#7FFFFFF),
37442646 = erlang:phash([a,b,c,{1,2,3},c:pid(0,2,3),
16#77777777777777],16#FFFFFFFF),
- Comment = case erlang:hash([a,b,c,{1,2,3},c:pid(0,2,3),
- 16#77777777777777],16#7FFFFFF) of
- 102727602 ->
- big = erlang:system_info(endian),
- "Big endian machine";
- 105818829 ->
- little = erlang:system_info(endian),
- "Little endian machine"
- end,
ExternalReference = <<131,114,0,3,100,0,13,110,111,110,111,100,101,64,
110,111,104,111,115,116,0,0,0,0,122,0,0,0,0,0,0,0,0>>,
1113403635 = erlang:phash(binary_to_term(ExternalReference),
16#FFFFFFFF),
- 123 = erlang:hash(binary_to_term(ExternalReference),
- 16#7FFFFFF),
ExternalFun = <<131,117,0,0,0,3,103,100,0,13,110,111,110,111,100,101,64,
110,111,104,111,115,116,0,0,0,38,0,0,0,0,0,100,0,8,101,
114,108,95,101,118,97,108,97,20,98,5,182,139,98,108,0,0,
@@ -206,22 +153,19 @@ basic_test() ->
64,110,111,104,111,115,116,0,0,0,22,0,0,0,0,0,106>>,
170987488 = erlang:phash(binary_to_term(ExternalFun),
16#FFFFFFFF),
- 124460689 = erlang:hash(binary_to_term(ExternalFun),
- 16#7FFFFFF),
case (catch erlang:phash(1,0)) of
{'EXIT',{badarg, _}} ->
- {comment, Comment};
+ ok;
_ ->
exit(phash_accepted_zero_as_range)
end.
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,
@@ -234,7 +178,6 @@ range_test() ->
end,
F(1,16#100000000,F).
-
spread_test(N) ->
test_fun(N,{erlang,phash},16#50000000000,fun(X) ->
@@ -259,14 +202,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;
_ ->
@@ -461,7 +403,7 @@ phash2_test() ->
{"abc"++[1009], 290369864},
{"abc"++[1009]++"de", 4134369195},
{"1234567890123456", 963649519},
-
+
%% tuple
{{}, 221703996},
{{{}}, 2165044361},
@@ -494,30 +436,15 @@ f3(X, Y) ->
-endif.
otp_5292_test() ->
- H = fun(E) -> [erlang:hash(E, 16#7FFFFFF),
- erlang:hash(-E, 16#7FFFFFF)]
- end,
- S1 = md5([md5(hash_int(S, E, H)) || {Start, N, Sz} <- d(),
- {S, E} <- int(Start, N, Sz)]),
PH = fun(E) -> [erlang:phash(E, 1 bsl 32),
erlang:phash(-E, 1 bsl 32),
erlang:phash2(E, 1 bsl 32),
erlang:phash2(-E, 1 bsl 32)]
end,
- S2 = md5([md5(hash_int(S, E, PH)) || {Start, N, Sz} <- d(),
+ S2 = md5([md5(hash_int(S, E, PH)) || {Start, N, Sz} <- d(),
{S, E} <- int(Start, N, Sz)]),
- Comment = case S1 of
- <<4,248,208,156,200,131,7,1,173,13,239,173,112,81,16,174>> ->
- big = erlang:system_info(endian),
- "Big endian machine";
- <<180,28,33,231,239,184,71,125,76,47,227,241,78,184,176,233>> ->
- little = erlang:system_info(endian),
- "Little endian machine"
- end,
<<124,81,198,121,174,233,19,137,10,83,33,80,226,111,238,99>> = S2,
- 2 = erlang:hash(1, (1 bsl 27) -1),
- {'EXIT', _} = (catch erlang:hash(1, (1 bsl 27))),
- {comment, Comment}.
+ ok.
d() ->
[%% Start, NumOfIntervals, SizeOfInterval
@@ -538,8 +465,6 @@ md5(T) ->
bit_level_binaries_do() ->
[3511317,7022633,14044578,28087749,56173436,112344123,90467083|_] =
- bit_level_all_different(fun erlang:hash/2),
- [3511317,7022633,14044578,28087749,56173436,112344123,90467083|_] =
bit_level_all_different(fun erlang:phash/2),
[102233154,19716,102133857,4532024,123369135,24565730,109558721|_] =
bit_level_all_different(fun erlang:phash2/2),
@@ -577,9 +502,7 @@ bit_level_all_different(Hash) ->
Hashes1.
test_hash_phash(Bitstr, Rem) ->
- Hash = erlang:hash(Bitstr, Rem),
Hash = erlang:phash(Bitstr, Rem),
- Hash = erlang:hash(unaligned_sub_bitstr(Bitstr), Rem),
Hash = erlang:phash(unaligned_sub_bitstr(Bitstr), Rem).
test_phash2(Bitstr, Rem) ->
@@ -591,6 +514,25 @@ otp_7127_test() ->
38990304 = erlang:phash2(<<"Scott9">>),
ok.
+hash_zero_test() ->
+ Zs = [0.0, -0.0, 0/-1, 0.0/-1, 0/-(1 bsl 65),
+ binary_to_term(<<131,70,0,0,0,0,0,0,0,0>>), %% +0.0
+ binary_to_term(<<131,70,128,0,0,0,0,0,0,0>>)], %% -0.0
+ ok = hash_zero_test(Zs,fun(T) -> erlang:phash2(T, 1 bsl 32) end),
+ ok = hash_zero_test(Zs,fun(T) -> erlang:phash(T, 1 bsl 32) end),
+ ok.
+
+hash_zero_test([Z|Zs],F) ->
+ hash_zero_test(Zs,Z,F(Z),F).
+hash_zero_test([Z|Zs],Z0,V,F) ->
+ true = Z0 =:= Z, %% assert exact equal
+ Z0 = Z, %% assert matching
+ V = F(Z), %% assert hash
+ hash_zero_test(Zs,Z0,V,F);
+hash_zero_test([],_,_,_) ->
+ ok.
+
+
%%
%% Reference implementation of integer hashing
%%
diff --git a/erts/emulator/test/hibernate_SUITE.erl b/erts/emulator/test/hibernate_SUITE.erl
index 31938e6c65..a20f306e04 100644
--- a/erts/emulator/test/hibernate_SUITE.erl
+++ b/erts/emulator/test/hibernate_SUITE.erl
@@ -1,65 +1,44 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2003-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2003-2017. 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.
+%% 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(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.
%%%
@@ -68,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;
@@ -84,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),
@@ -164,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) ->
@@ -194,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}) ->
@@ -238,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) ->
@@ -265,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.
@@ -282,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) ->
@@ -295,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.
@@ -311,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.
@@ -351,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(),
@@ -378,22 +349,20 @@ clean_dict() ->
lists:foreach(fun ({Key, _}) -> erase(Key) end, Dict).
%%
-%% Wake up and then immediatly bif trap with a lengthy computation.
+%% Wake up and then immediately 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/hipe_SUITE.erl b/erts/emulator/test/hipe_SUITE.erl
new file mode 100644
index 0000000000..e62d4260f6
--- /dev/null
+++ b/erts/emulator/test/hipe_SUITE.erl
@@ -0,0 +1,188 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2016-2017. 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(hipe_SUITE).
+-export([all/0
+ ,t_copy_literals/1
+ ,t_purge/1
+ ,t_trycatch/1
+ ]).
+
+all() ->
+ case erlang:system_info(hipe_architecture) of
+ undefined -> {skip, "HiPE is disabled"};
+ _ -> [t_copy_literals
+ ,t_purge
+ ,t_trycatch
+ ]
+ end.
+
+t_copy_literals(doc) ->
+ "Check that BEAM literals referenced from HiPE stack are copied by"
+ " check_process_code";
+t_copy_literals(Config) when is_list(Config) ->
+ %% Compile the the ref_cell and literals modules.
+ Data = proplists:get_value(data_dir, Config),
+ Priv = proplists:get_value(priv_dir, Config),
+ RefFile = filename:join(Data, "ref_cell"),
+ {ok,ref_cell} = c:c(RefFile, [{outdir,Priv},native]),
+ true = code:is_module_native(ref_cell),
+ LitFile = filename:join(Data, "literals"),
+ {ok,literals} = c:c(LitFile, [{outdir,Priv}]),
+
+ %% store references to literals on HiPE stacks
+ PA = ref_cell:start_link(),
+ ref_cell:call(PA, {put_res_of, fun literals:a/0}),
+ PB = ref_cell:start_link_deep(),
+ ref_cell:call(PB, {put_res_of, fun literals:b/0}),
+
+ %% purge the literals
+ _ = (catch erlang:purge_module(literals)),
+ true = erlang:delete_module(literals),
+ true = erlang:purge_module(literals),
+
+ %% Give the literal collector some time to work...
+ receive after 2000 -> ok end,
+
+ %% check that the ex-literals are ok
+ [a,b,c] = ref_cell:call(PA, get),
+ {a,b,c} = ref_cell:call(PB, get),
+
+ %% cleanup
+ ref_cell:call(PA, done),
+ ref_cell:call(PB, done),
+ _ = (catch erlang:purge_module(ref_cell)),
+ true = erlang:delete_module(ref_cell),
+ true = erlang:purge_module(ref_cell),
+ ok.
+
+t_purge(doc) -> "Checks that native code is properly found and purged";
+t_purge(Config) when is_list(Config) ->
+ Data = proplists:get_value(data_dir, Config),
+ Priv = proplists:get_value(priv_dir, Config),
+ SrcFile = filename:join(Data, "ref_cell"),
+ BeamFile = filename:join(Priv, "ref_cell"),
+ {ok,ref_cell} = c:c(SrcFile, [{outdir,Priv},native]),
+ true = code:is_module_native(ref_cell),
+
+ PA = ref_cell:start_link(),
+
+ %% Unload, PA should still be running
+ true = erlang:delete_module(ref_cell),
+ %% Can't use ref_cel:call/2, it's in old code!
+ call(PA, {put_res_of, fun()-> hej end}),
+ hej = call(PA, get),
+
+ %% Load same module again
+ code:load_abs(BeamFile),
+ true = code:is_module_native(ref_cell),
+ PB = ref_cell:start_link(),
+
+ %% Purge old code, PA should be killed, PB should survive
+ unlink(PA),
+ ARef = monitor(process, PA),
+ true = erlang:purge_module(ref_cell),
+ receive {'DOWN', ARef, process, PA, killed} -> ok
+ after 1 -> ct:fail("PA was not killed")
+ end,
+
+ %% Unload, PB should still be running
+ true = erlang:delete_module(ref_cell),
+ call(PB, {put_res_of, fun()-> svejs end}),
+ svejs = call(PB, get),
+
+ unlink(PB),
+ BRef = monitor(process, PB),
+ true = erlang:purge_module(ref_cell),
+ receive {'DOWN', BRef, process, PB, killed} -> ok
+ after 1 -> ct:fail("PB was not killed")
+ end,
+
+ ok.
+
+call(Pid, Call) ->
+ Pid ! {Call, self()},
+ receive {Pid, Res} -> Res end.
+
+t_trycatch(Config) ->
+ DataDir = proplists:get_value(data_dir, Config),
+ Files = ["trycatch_1.erl","trycatch_2.erl","trycatch_3.erl"],
+ Sources0 = [filename:join(DataDir, Src) || Src <- Files],
+ Sources = trycatch_combine(Sources0),
+ t_trycatch_1(Sources).
+
+t_trycatch_1([S|Ss]) ->
+ io:format("~p", [S]),
+ compile_and_load(S),
+ call_trycatch(try_catch),
+ call_trycatch(plain_catch),
+ io:nl(),
+ t_trycatch_1(Ss);
+t_trycatch_1([]) ->
+ ok.
+
+trycatch_combine([N|Ns]) ->
+ Combined = trycatch_combine(Ns),
+ lists:append([[[{N,[]}|C],[{N,[native]},C]] || C <- Combined]);
+trycatch_combine([]) ->
+ [[]].
+
+call_trycatch(Func) ->
+ case do_call_trycatch(error, Func, {error,whatever}) of
+ {error,whatever,[{trycatch_3,three,1,_}|_]} ->
+ ok
+ end,
+ case do_call_trycatch(error, Func, fc) of
+ {error,function_clause,[{trycatch_3,three,[fc],_}|_]} ->
+ ok;
+ {error,function_clause,[{trycatch_3,three,1,_}|_]} ->
+ ok
+ end,
+ case do_call_trycatch(throw, Func, {throw,{a,b}}) of
+ {throw,{a,b},[{trycatch_3,three,1,_}|_]} ->
+ ok
+ end,
+ case do_call_trycatch(exit, Func, {exit,{a,b,c}}) of
+ {exit,{a,b,c},[{trycatch_3,three,1,_}|_]} ->
+ ok
+ end,
+ ok.
+
+do_call_trycatch(_Class, try_catch, Argument) ->
+ trycatch_1:one_try_catch(Argument);
+do_call_trycatch(error, plain_catch, Argument) ->
+ {{'EXIT',{Reason,Stk}},Stk} = trycatch_1:one_plain_catch(Argument),
+ {error,Reason,Stk};
+do_call_trycatch(throw, plain_catch, Argument) ->
+ {Reason,Stk} = trycatch_1:one_plain_catch(Argument),
+ {throw,Reason,Stk};
+do_call_trycatch(exit, plain_catch, Argument) ->
+ {{'EXIT',Reason},Stk} = trycatch_1:one_plain_catch(Argument),
+ {exit,Reason,Stk}.
+
+compile_and_load(Sources) ->
+ _ = [begin
+ {ok,Mod,Bin} = compile:file(Src, [binary,report|Opts]),
+ code:purge(Mod),
+ code:delete(Mod),
+ code:purge(Mod),
+ {module,Mod} = code:load_binary(Mod, atom_to_list(Mod), Bin)
+ end || {Src,Opts} <- Sources],
+ ok.
diff --git a/erts/emulator/test/hipe_SUITE_data/literals.erl b/erts/emulator/test/hipe_SUITE_data/literals.erl
new file mode 100644
index 0000000000..31e443970f
--- /dev/null
+++ b/erts/emulator/test/hipe_SUITE_data/literals.erl
@@ -0,0 +1,26 @@
+%%
+%% %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(literals).
+
+-export([a/0, b/0]).
+
+a() -> [a,b,c].
+b() -> {a,b,c}.
diff --git a/erts/emulator/test/hipe_SUITE_data/ref_cell.erl b/erts/emulator/test/hipe_SUITE_data/ref_cell.erl
new file mode 100644
index 0000000000..2654e4077b
--- /dev/null
+++ b/erts/emulator/test/hipe_SUITE_data/ref_cell.erl
@@ -0,0 +1,64 @@
+%%
+%% %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(ref_cell).
+
+-export([start_link/0, start_link_deep/0, call/2]).
+
+-compile(native).
+
+-define(DEPTH, 100).
+-define(ALLOCS, 500).
+
+start_link() ->
+ spawn_link(fun() -> loop(undefined) end).
+
+start_link_deep() ->
+ spawn_link(fun() -> go_deep(?DEPTH) end).
+
+%% Create a stack large enough to get a graylimit trap placed next time there's
+%% a minor gc.
+go_deep(0) ->
+ alloc_some(?ALLOCS),
+ loop(undefined),
+ 0;
+go_deep(Depth) ->
+ go_deep(Depth-1)+1.
+
+%% Do some allocation to trigger a minor gc
+alloc_some(Amount) ->
+ Check = (Amount * (Amount + 1)) div 2,
+ Check = lists:sum(lists:seq(1, Amount)).
+
+call(Pid, Call) ->
+ Pid ! {Call, self()},
+ receive {Pid, Res} -> Res end.
+
+loop(Thing) ->
+ receive
+ {done, Pid} -> Pid ! {self(), done};
+ {{put_res_of, Fun}, Pid} ->
+ NewThing = Fun(),
+ Pid ! {self(), put},
+ loop(NewThing);
+ {get, Pid} ->
+ Pid ! {self(), Thing},
+ loop(Thing)
+ end.
diff --git a/erts/emulator/test/hipe_SUITE_data/trycatch_1.erl b/erts/emulator/test/hipe_SUITE_data/trycatch_1.erl
new file mode 100644
index 0000000000..702b14b5b9
--- /dev/null
+++ b/erts/emulator/test/hipe_SUITE_data/trycatch_1.erl
@@ -0,0 +1,14 @@
+-module(trycatch_1).
+-export([one_try_catch/1,one_plain_catch/1]).
+
+one_try_catch(Term) ->
+ try
+ trycatch_2:two(Term)
+ catch
+ C:R ->
+ Stk = erlang:get_stacktrace(),
+ {C,R,Stk}
+ end.
+
+one_plain_catch(Term) ->
+ {catch trycatch_2:two(Term),erlang:get_stacktrace()}.
diff --git a/erts/emulator/test/hipe_SUITE_data/trycatch_2.erl b/erts/emulator/test/hipe_SUITE_data/trycatch_2.erl
new file mode 100644
index 0000000000..ffac420197
--- /dev/null
+++ b/erts/emulator/test/hipe_SUITE_data/trycatch_2.erl
@@ -0,0 +1,10 @@
+-module(trycatch_2).
+-export([two/1]).
+
+two(Term) ->
+ Res = trycatch_3:three(Term),
+ foo(),
+ Res.
+
+foo() ->
+ ok.
diff --git a/erts/emulator/test/hipe_SUITE_data/trycatch_3.erl b/erts/emulator/test/hipe_SUITE_data/trycatch_3.erl
new file mode 100644
index 0000000000..578fa0e87e
--- /dev/null
+++ b/erts/emulator/test/hipe_SUITE_data/trycatch_3.erl
@@ -0,0 +1,9 @@
+-module(trycatch_3).
+-export([three/1]).
+
+three({error,Term}) ->
+ error(Term);
+three({throw,Term}) ->
+ throw(Term);
+three({exit,Term}) ->
+ exit(Term).
diff --git a/erts/emulator/test/ignore_cores.erl b/erts/emulator/test/ignore_cores.erl
index 8b1ac0fe6c..25dce346b9 100644
--- a/erts/emulator/test/ignore_cores.erl
+++ b/erts/emulator/test/ignore_cores.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2016. 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/.
+%% 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
%%
-%% 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.
+%% 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%
%%
@@ -27,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]).
@@ -52,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
@@ -69,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)
++ "_"
@@ -93,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 {os:type(), filelib:is_dir("/cores")} of
{{unix,darwin}, true} ->
filelib:fold_files("/cores",
"^core.*$",
@@ -118,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 ->
@@ -154,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/iovec_SUITE.erl b/erts/emulator/test/iovec_SUITE.erl
new file mode 100644
index 0000000000..49dc64b0d2
--- /dev/null
+++ b/erts/emulator/test/iovec_SUITE.erl
@@ -0,0 +1,176 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. 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(iovec_SUITE).
+
+-export([all/0, suite/0, init_per_suite/1, end_per_suite/1]).
+
+-export([integer_lists/1, binary_lists/1, empty_lists/1, empty_binary_lists/1,
+ mixed_lists/1, improper_lists/1, illegal_lists/1, cons_bomb/1,
+ sub_binary_lists/1, iolist_to_iovec_idempotence/1,
+ iolist_to_iovec_correctness/1]).
+
+-include_lib("common_test/include/ct.hrl").
+
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 2}}].
+
+all() ->
+ [integer_lists, binary_lists, empty_lists, empty_binary_lists, mixed_lists,
+ sub_binary_lists, illegal_lists, improper_lists, cons_bomb,
+ iolist_to_iovec_idempotence, iolist_to_iovec_correctness].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(Config) ->
+ application:stop(os_mon),
+ Config.
+
+integer_lists(Config) when is_list(Config) ->
+ Variations = gen_variations([I || I <- lists:seq(1, 255)]),
+ equivalence_test(fun erlang:iolist_to_iovec/1, Variations).
+
+sub_binary_lists(Config) when is_list(Config) ->
+ Parent = <<0:256/unit:8, "gazurka">>,
+ <<0:196/unit:8, Child/binary>> = Parent,
+ equivalence_test(fun erlang:iolist_to_iovec/1, gen_variations(Child)).
+
+binary_lists(Config) when is_list(Config) ->
+ Variations = gen_variations([<<I:8>> || I <- lists:seq(1, 255)]),
+ equivalence_test(fun erlang:iolist_to_iovec/1, Variations).
+
+empty_lists(Config) when is_list(Config) ->
+ Variations = gen_variations([[] || _ <- lists:seq(1, 256)]),
+ equivalence_test(fun erlang:iolist_to_iovec/1, Variations),
+ [] = erlang:iolist_to_iovec([]),
+ ok.
+
+empty_binary_lists(Config) when is_list(Config) ->
+ Variations = gen_variations([<<>> || _ <- lists:seq(1, 8192)]),
+ equivalence_test(fun erlang:iolist_to_iovec/1, Variations),
+ [] = erlang:iolist_to_iovec(Variations),
+ ok.
+
+mixed_lists(Config) when is_list(Config) ->
+ Variations = gen_variations([<<>>, lists:seq(1, 40), <<12, 45, 78>>]),
+ equivalence_test(fun erlang:iolist_to_iovec/1, Variations).
+
+illegal_lists(Config) when is_list(Config) ->
+ BitStrs = gen_variations(["gurka", <<1:1>>, "gaffel"]),
+ BadInts = gen_variations(["gurka", 890, "gaffel"]),
+ Atoms = gen_variations([gurka, "gaffel"]),
+ BadTails = [["test" | 0], ["gurka", gaffel]],
+
+ Variations =
+ BitStrs ++ BadInts ++ Atoms ++ BadTails,
+
+ illegality_test(fun erlang:iolist_to_iovec/1, Variations).
+
+improper_lists(Config) when is_list(Config) ->
+ Variations = [
+ [[[[1 | <<2>>] | <<3>>] | <<4>>] | <<5>>],
+ [[<<1>>, 2] | <<3, 4, 5>>],
+ [1, 2, 3 | <<4, 5>>]
+ ],
+ equivalence_test(fun erlang:iolist_to_iovec/1, Variations).
+
+cons_bomb(Config) when is_list(Config) ->
+ IntBase = gen_variations([I || I <- lists:seq(1, 255)]),
+ BinBase = gen_variations([<<I:8>> || I <- lists:seq(1, 255)]),
+ MixBase = gen_variations([<<12, 45, 78>>, lists:seq(1, 255)]),
+
+ Rounds =
+ case system_mem_size() of
+ Mem when Mem >= (16 bsl 30) -> 32;
+ Mem when Mem >= (3 bsl 30) -> 28;
+ _ -> 20
+ end,
+
+ Variations = gen_variations([IntBase, BinBase, MixBase], Rounds),
+ equivalence_test(fun erlang:iolist_to_iovec/1, Variations).
+
+iolist_to_iovec_idempotence(Config) when is_list(Config) ->
+ IntVariations = gen_variations([I || I <- lists:seq(1, 255)]),
+ BinVariations = gen_variations([<<I:8>> || I <- lists:seq(1, 255)]),
+ MixVariations = gen_variations([<<12, 45, 78>>, lists:seq(1, 255)]),
+
+ Variations = [IntVariations, BinVariations, MixVariations],
+ Optimized = erlang:iolist_to_iovec(Variations),
+
+ true = Optimized =:= erlang:iolist_to_iovec(Optimized),
+ ok.
+
+iolist_to_iovec_correctness(Config) when is_list(Config) ->
+ IntVariations = gen_variations([I || I <- lists:seq(1, 255)]),
+ BinVariations = gen_variations([<<I:8>> || I <- lists:seq(1, 255)]),
+ MixVariations = gen_variations([<<12, 45, 78>>, lists:seq(1, 255)]),
+
+ Variations = [IntVariations, BinVariations, MixVariations],
+ Optimized = erlang:iolist_to_iovec(Variations),
+
+ true = is_iolist_equal(Optimized, Variations),
+ ok.
+
+illegality_test(Fun, Variations) ->
+ [{'EXIT',{badarg, _}} = (catch Fun(Variation)) || Variation <- Variations],
+ ok.
+
+equivalence_test(Fun, [Head | _] = Variations) ->
+ %% Check that each variation is equal to the others, and that the sum of
+ %% them is equal to the input.
+ Comparand = Fun(Head),
+ [true = is_iolist_equal(Comparand, Fun(V)) || V <- Variations],
+ true = is_iolist_equal(Variations, Fun(Variations)),
+ ok.
+
+is_iolist_equal(A, B) ->
+ iolist_to_binary(A) =:= iolist_to_binary(B).
+
+%% Generates a bunch of lists whose contents will be equal to Base repeated a
+%% few times. The lists only differ by their structure, so their reduction to
+%% a simpler format should yield the same result.
+gen_variations(Base) ->
+ gen_variations(Base, 16).
+gen_variations(Base, N) ->
+ [gen_flat_list(Base, N),
+ gen_nested_list(Base, N),
+ gen_nasty_list(Base, N)].
+
+gen_flat_list(Base, N) ->
+ lists:flatten(gen_nested_list(Base, N)).
+
+gen_nested_list(Base, N) ->
+ [Base || _ <- lists:seq(1, N)].
+
+gen_nasty_list(Base, N) ->
+ gen_nasty_list_1(gen_nested_list(Base, N), []).
+gen_nasty_list_1([], Result) ->
+ Result;
+gen_nasty_list_1([Head | Base], Result) when is_list(Head) ->
+ gen_nasty_list_1(Base, [[Result], [gen_nasty_list_1(Head, [])]]);
+gen_nasty_list_1([Head | Base], Result) ->
+ gen_nasty_list_1(Base, [[Result], [Head]]).
+
+system_mem_size() ->
+ application:ensure_all_started(os_mon),
+ {Tot,_Used,_} = memsup:get_memory_data(),
+ Tot.
diff --git a/erts/emulator/test/lcnt_SUITE.erl b/erts/emulator/test/lcnt_SUITE.erl
new file mode 100644
index 0000000000..504b9b54cf
--- /dev/null
+++ b/erts/emulator/test/lcnt_SUITE.erl
@@ -0,0 +1,156 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. 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(lcnt_SUITE).
+
+-include_lib("common_test/include/ct.hrl").
+
+-export(
+ [all/0, suite/0,
+ init_per_suite/1, end_per_suite/1,
+ init_per_testcase/2, end_per_testcase/2]).
+
+-export(
+ [toggle_lock_counting/1, error_on_invalid_category/1, preserve_locks/1]).
+
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {seconds, 10}}].
+
+all() ->
+ [toggle_lock_counting, error_on_invalid_category, preserve_locks].
+
+init_per_suite(Config) ->
+ case erlang:system_info(lock_counting) of
+ true ->
+ %% The tests will run straight over these properties, so we have to
+ %% preserve them to avoid tainting the other tests.
+ OldCopySave = erts_debug:lcnt_control(copy_save),
+ OldMask = erts_debug:lcnt_control(mask),
+ [{lcnt_SUITE, {OldCopySave, OldMask}} | Config];
+ _ ->
+ {skip, "Lock counting is not enabled"}
+ end.
+
+end_per_suite(Config) ->
+ {OldCopySave, OldMask} = proplists:get_value(lcnt_SUITE, Config),
+
+ erts_debug:lcnt_control(copy_save, OldCopySave),
+ OldCopySave = erts_debug:lcnt_control(copy_save),
+
+ erts_debug:lcnt_control(mask, OldMask),
+ OldMask = erts_debug:lcnt_control(mask),
+
+ erts_debug:lcnt_clear(),
+ ok.
+
+init_per_testcase(_Case, Config) ->
+ disable_lock_counting(),
+ Config.
+
+end_per_testcase(_Case, _Config) ->
+ ok.
+
+disable_lock_counting() ->
+ ok = erts_debug:lcnt_control(copy_save, false),
+ ok = erts_debug:lcnt_control(mask, []),
+ ok = erts_debug:lcnt_clear(),
+
+ %% Sanity check.
+ false = erts_debug:lcnt_control(copy_save),
+ [] = erts_debug:lcnt_control(mask),
+
+ %% The above commands rely on some lazy operations, so we'll have to wait
+ %% for the list to clear.
+ ok = wait_for_empty_lock_list().
+
+wait_for_empty_lock_list() ->
+ wait_for_empty_lock_list(10).
+wait_for_empty_lock_list(Tries) when Tries > 0 ->
+ try_flush_cleanup_ops(),
+ case erts_debug:lcnt_collect() of
+ [{duration, _}, {locks, []}] ->
+ ok;
+ _ ->
+ timer:sleep(50),
+ wait_for_empty_lock_list(Tries - 1)
+ end;
+wait_for_empty_lock_list(0) ->
+ ct:fail("Lock list failed to clear after disabling lock counting.").
+
+%% Queue up a lot of thread progress cleanup ops in a vain attempt to
+%% flush the lock list.
+try_flush_cleanup_ops() ->
+ false = lists:member(process, erts_debug:lcnt_control(mask)),
+ [spawn(fun() -> ok end) || _ <- lists:seq(1, 1000)].
+
+%%
+%% Test cases
+%%
+
+toggle_lock_counting(Config) when is_list(Config) ->
+ Categories =
+ [allocator, db, debug, distribution, generic, io, process, scheduler],
+ lists:foreach(
+ fun(Category) ->
+ Locks = get_lock_info_for(Category),
+ if
+ Locks =/= [] ->
+ disable_lock_counting();
+ Locks =:= [] ->
+ ct:fail("Failed to toggle ~p locks.", [Category])
+ end
+ end, Categories).
+
+get_lock_info_for(Categories) when is_list(Categories) ->
+ ok = erts_debug:lcnt_control(mask, Categories),
+ [{duration, _}, {locks, Locks}] = erts_debug:lcnt_collect(),
+ Locks;
+
+get_lock_info_for(Category) when is_atom(Category) ->
+ get_lock_info_for([Category]).
+
+preserve_locks(Config) when is_list(Config) ->
+ erts_debug:lcnt_control(mask, [process]),
+
+ erts_debug:lcnt_control(copy_save, true),
+ [spawn(fun() -> ok end) || _ <- lists:seq(1, 1000)],
+
+ %% Wait for the processes to be fully destroyed before disabling copy_save,
+ %% then remove all active locks from the list. (There's no foolproof method
+ %% to do this; sleeping before/after is the best way we have)
+ timer:sleep(500),
+
+ erts_debug:lcnt_control(copy_save, false),
+ erts_debug:lcnt_control(mask, []),
+
+ try_flush_cleanup_ops(),
+ timer:sleep(500),
+
+ case erts_debug:lcnt_collect() of
+ [{duration, _}, {locks, Locks}] when length(Locks) > 0 ->
+ ct:pal("Preserved ~p locks.", [length(Locks)]);
+ [{duration, _}, {locks, []}] ->
+ ct:fail("copy_save didn't preserve any locks.")
+ end.
+
+error_on_invalid_category(Config) when is_list(Config) ->
+ {error, badarg, q_invalid} = erts_debug:lcnt_control(mask, [q_invalid]),
+ ok.
diff --git a/erts/emulator/test/list_bif_SUITE.erl b/erts/emulator/test/list_bif_SUITE.erl
index 45a44d8b43..f95251943d 100644
--- a/erts/emulator/test/list_bif_SUITE.erl
+++ b/erts/emulator/test/list_bif_SUITE.erl
@@ -1,166 +1,141 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2011. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2017. 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.
+%% 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(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]).
+ t_list_to_port/1,t_list_to_float/1,t_list_to_integer/1]).
+
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 1}}].
-suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- [hd_test, tl_test, t_length, t_list_to_pid,
+ [hd_test, tl_test, t_length, t_list_to_pid, t_list_to_port,
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]),
+ {error, badarg} = string:to_integer([$1,$2,a]),
+ {error,no_integer} = string:to_integer([$A]),
+ {error,badarg} = 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.~n"
+ "Result: ~p", [Res])
+ end,
ok.
+%% Test list_to_port/1 with correct and incorrect arguments.
+
+t_list_to_port(Config) when is_list(Config) ->
+ Me = hd(erlang:ports()),
+ MyListedPid = port_to_list(Me),
+ Me = list_to_port(MyListedPid),
+ case catch list_to_port(id("Incorrect list")) of
+ {'EXIT', {badarg, _}} ->
+ ok;
+ Res ->
+ ct:fail("list_to_port/1 with incorrect arg succeeded.~n"
+ "Result: ~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/long_timers_test.erl b/erts/emulator/test/long_timers_test.erl
index 28a4fba9f6..de1a6e6d32 100644
--- a/erts/emulator/test/long_timers_test.erl
+++ b/erts/emulator/test/long_timers_test.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2017. 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.
+%% 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%
%%
@@ -26,11 +27,16 @@
%%% Created : 21 Aug 2006 by Rickard Green <[email protected]>
%%%-------------------------------------------------------------------
+-define(HIGH_CPU_INFO, "Ignored due to high CPU utilization.").
+-define(MISSING_CPU_INFO, "Ignored due to missing CPU utilization information.").
-define(MAX_TIMEOUT, 60). % Minutes
--define(MAX_LATE, 10*1000). % Milliseconds
+-define(MAX_LATE_MS, 1000). % Milliseconds
-define(REG_NAME, '___LONG___TIMERS___TEST___SERVER___').
+-define(HIGH_UTIL, 96.0).
+-define(UTIL_INTERVAL, 10000).
+
-define(DRV_NAME, timer_driver).
% First byte in communication with the timer driver
@@ -71,75 +77,206 @@ check_result() ->
receive
{'DOWN', Mon, process, _, Reason} ->
{?REG_NAME, 'DOWN', Reason};
- {result, ?REG_NAME, TORs, Start, End} ->
+ {result, ?REG_NAME, TORs, Start, End, UtilData} ->
erlang:demonitor(Mon),
receive {'DOWN', Mon, _, _, _} -> ok after 0 -> ok end,
stop_node(Node),
- check(TORs, (timer:now_diff(End, Start) div 1000) - ?MAX_LATE, ok)
+ Res = check(TORs, Start, End, UtilData, ms((End - Start) - max_late()), ok),
+ io:format("Start = ~p~n End = ~p~n UtilData = ~p~n", [Start, End, UtilData]),
+ Res
end.
+res(New, Old) when New == failed; Old == failed ->
+ failed;
+res(New, Old) when New == missing_cpu_info; Old == missing_cpu_info ->
+ missing_cpu_info;
+res(New, Old) when New == high_cpu; Old == high_cpu ->
+ high_cpu;
+res(New, _Old) ->
+ New.
+
check([#timeout_rec{timeout = Timeout,
type = Type,
timeout_diff = undefined} | TORs],
+ Start,
+ End,
+ UtilData,
NeedRes,
- _Ok) when Timeout < NeedRes ->
- io:format("~p timeout = ~p failed! No timeout.~n",
- [Type, Timeout]),
- check(TORs, NeedRes, failed);
+ Ok) when Timeout < NeedRes ->
+ {NewOk, HCPU} = case had_high_cpu_util(Start,
+ Timeout,
+ End - Timeout*1000,
+ UtilData) of
+ yes -> {res(high_cpu, Ok), ?HIGH_CPU_INFO};
+ no -> {res(failed, Ok), ""};
+ missing -> {res(missing_cpu_info, Ok), "FAILED", ?MISSING_CPU_INFO}
+ end,
+ io:format("~p timeout = ~p ms FAILED! No timeout. ~s~n",
+ [Type, Timeout, HCPU]),
+ check(TORs, Start, End, UtilData, NeedRes, NewOk);
check([#timeout_rec{timeout_diff = undefined} | TORs],
+ Start,
+ End,
+ UtilData,
NeedRes,
Ok) ->
- check(TORs, NeedRes, Ok);
+ check(TORs, Start, End, UtilData, NeedRes, Ok);
check([#timeout_rec{timeout = Timeout,
type = Type,
timeout_diff = {error, Reason}} | TORs],
+ Start,
+ End,
+ UtilData,
NeedRes,
_Ok) ->
- io:format("~p timeout = ~p failed! exit reason ~p~n",
+ io:format("~p timeout = ~p ms FAILED! exit reason ~p~n",
[Type, Timeout, Reason]),
- check(TORs, NeedRes, failed);
+ check(TORs, Start, End, UtilData, NeedRes, failed);
check([#timeout_rec{timeout = Timeout,
type = Type,
timeout_diff = TimeoutDiff} | TORs],
+ Start,
+ End,
+ UtilData,
NeedRes,
Ok) ->
- case (0 =< TimeoutDiff) and (TimeoutDiff =< ?MAX_LATE) of
- true ->
- io:format("~p timeout = ~p succeded! timeout diff = ~p.~n",
- [Type, Timeout, TimeoutDiff]),
- check(TORs, NeedRes, Ok);
- false ->
- io:format("~p timeout = ~p failed! timeout diff = ~p.~n",
- [Type, Timeout, TimeoutDiff]),
- check(TORs, NeedRes, failed)
- end;
-check([], _NeedRes, Ok) ->
+ {NewOk, SuccessStr, HCPU} = case {(0 =< TimeoutDiff),
+ (TimeoutDiff =< max_late())} of
+ {true, true} ->
+ {res(ok, Ok), "succeeded", ""};
+ {false, _} ->
+ {res(failed, Ok), "FAILED", ""};
+ _ ->
+ case had_high_cpu_util(Start,
+ Timeout,
+ TimeoutDiff,
+ UtilData) of
+ yes -> {res(high_cpu, Ok), "FAILED", ?HIGH_CPU_INFO};
+ no -> {res(failed, Ok), "FAILED", ""};
+ missing -> {res(missing_cpu_info, Ok), "FAILED", ?MISSING_CPU_INFO}
+ end
+ end,
+ io:format("~s timeout = ~s ms ~s! timeout diff = ~s. ~s~n",
+ [type_str(Type),
+ time_str(Timeout),
+ SuccessStr,
+ time_str(TimeoutDiff, 1000000),
+ HCPU]),
+ check(TORs, Start, End, UtilData, NeedRes, NewOk);
+check([],_Start,_End,_UtilData,_NeedRes, Ok) ->
Ok.
+% TargetTimeout in ms, other in us.
+had_high_cpu_util(StartTime,
+ TargetTimeout,
+ TimeoutDiff,
+ UtilData) ->
+ TargetTo = StartTime + TargetTimeout*1000,
+ ActTo = TargetTo + TimeoutDiff,
+ hcpu(ActTo, TargetTo, UtilData).
+
+hcpu(_ActTo, _TargetTo, [{_UT, 0} | _]) ->
+ missing; %% Util is the integer zero when not supported...
+%% UT2 =:= UT1
+hcpu(ActTo, TargetTo, [{UT, _}, {UT, _} | _] = UD) ->
+ hcpu(ActTo, TargetTo, tl(UD));
+%% UT2 > UT1 > ActTo > TargetTo
+hcpu(ActTo, TargetTo, [{_UT2, _}, {UT1, _} | _] = UD) when UT1 > ActTo ->
+ hcpu(ActTo, TargetTo, tl(UD));
+%% UT2 >= ActTo > TargetTo >= UT1
+hcpu(ActTo, TargetTo,
+ [{UT2, U}, {UT1, _} | _]) when UT2 >= ActTo,
+ TargetTo >= UT1 ->
+ case U >= (((ActTo - TargetTo) / (UT2 - UT1))
+ * (?HIGH_UTIL/100.0)) of
+ true -> yes;
+ false -> no
+ end;
+%% UT2 >= ActTo >= UT1 > TargetTo
+hcpu(ActTo, TargetTo,
+ [{UT2, U}, {UT1, _} | _] = UD) when UT2 >= ActTo,
+ ActTo >= UT1,
+ UT1 > TargetTo ->
+ case U >= (((ActTo - UT1) / (UT2 - UT1))
+ * (?HIGH_UTIL/100.0)) of
+ true -> hcpu(ActTo, TargetTo, tl(UD));
+ false -> no
+ end;
+%% ActTo > UT2 >= TargetTo >= UT1
+hcpu(ActTo, TargetTo,
+ [{UT2, U}, {UT1, _} | _]) when ActTo > UT2,
+ TargetTo >= UT1 ->
+ case U >= (((UT2 - TargetTo) / (UT2 - UT1))
+ * (?HIGH_UTIL/100.0)) of
+ true -> yes;
+ false -> no
+ end;
+%% ActTo > UT2 > UT1 > TargetTo
+hcpu(ActTo, TargetTo,
+ [{UT2, U}, {UT1, _} | _] = UD) when ActTo > UT2,
+ UT1 > TargetTo ->
+ case U >= ?HIGH_UTIL of
+ true -> hcpu(ActTo, TargetTo, tl(UD));
+ false -> no
+ end.
+
+type_str(receive_after) -> "receive ... after";
+type_str(bif_timer) -> "BIF timer";
+type_str(driver) -> "driver".
+
+time_str(Time, Unit) ->
+ lists:flatten([time_str(Time), " ", unit_str(Unit)]).
+
+time_str(Time) ->
+ lists:reverse(conv_time_str(lists:reverse(integer_to_list(Time)))).
+
+conv_time_str([X,Y,Z,C|Cs]) when C /= $- ->
+ [X,Y,Z,$`|conv_time_str([C|Cs])];
+conv_time_str(Cs) ->
+ Cs.
+
+unit_str(1) -> "s";
+unit_str(1000) -> "ms";
+unit_str(1000000) -> "us";
+unit_str(1000000000) -> "ns";
+unit_str(Res) when is_integer(Res) -> ["/ ", integer_to_list(Res), " s"];
+unit_str(Res) -> Res.
+
+to_diff(Timeout, Start, Stop) ->
+ %% 'Timeout' in milli seconds
+ %% 'Start', 'Stop', and result in micro seconds
+ (Stop - Start) - Timeout*1000.
+
+ms(Time) ->
+ erlang:convert_time_unit(Time, microsecond, millisecond).
+
+max_late() ->
+ erlang:convert_time_unit(?MAX_LATE_MS, millisecond, microsecond).
+
receive_after(Timeout) ->
- Start = now(),
+ Start = erlang:monotonic_time(microsecond),
receive
{get_result, ?REG_NAME} ->
?REG_NAME ! #timeout_rec{pid = self(),
type = receive_after,
timeout = Timeout}
after Timeout ->
- Stop = now(),
+ Stop = erlang:monotonic_time(microsecond),
receive
{get_result, ?REG_NAME} ->
- TimeoutDiff = ((timer:now_diff(Stop, Start) div 1000)
- - Timeout),
?REG_NAME ! #timeout_rec{pid = self(),
type = receive_after,
timeout = Timeout,
- timeout_diff = TimeoutDiff}
+ timeout_diff = to_diff(Timeout,
+ Start,
+ Stop)}
end
end.
driver(Timeout) ->
Port = open_port({spawn, ?DRV_NAME},[]),
link(Port),
- Start = now(),
+ Start = erlang:monotonic_time(microsecond),
erlang:port_command(Port, <<?START_TIMER, Timeout:32>>),
receive
{get_result, ?REG_NAME} ->
@@ -147,49 +284,58 @@ driver(Timeout) ->
type = driver,
timeout = Timeout};
{Port,{data,[?TIMER]}} ->
- Stop = now(),
+ Stop = erlang:monotonic_time(microsecond),
unlink(Port),
true = erlang:port_close(Port),
receive
{get_result, ?REG_NAME} ->
- TimeoutDiff = ((timer:now_diff(Stop, Start) div 1000)
- - Timeout),
?REG_NAME ! #timeout_rec{pid = self(),
type = driver,
timeout = Timeout,
- timeout_diff = TimeoutDiff}
+ timeout_diff = to_diff(Timeout,
+ Start,
+ Stop)}
end
end.
bif_timer(Timeout) ->
+ Start = erlang:monotonic_time(microsecond),
Tmr = erlang:start_timer(Timeout, self(), ok),
- Start = now(),
receive
{get_result, ?REG_NAME} ->
?REG_NAME ! #timeout_rec{pid = self(),
type = bif_timer,
timeout = Timeout};
{timeout, Tmr, ok} ->
- Stop = now(),
+ Stop = erlang:monotonic_time(microsecond),
receive
{get_result, ?REG_NAME} ->
- TimeoutDiff = ((timer:now_diff(Stop, Start) div 1000)
- - Timeout),
?REG_NAME ! #timeout_rec{pid = self(),
type = bif_timer,
timeout = Timeout,
- timeout_diff = TimeoutDiff}
+ timeout_diff = to_diff(Timeout,
+ Start,
+ Stop)}
end
end.
test(Starter, DrvDir, StartDone) ->
+ process_flag(priority, high),
erl_ddll:start(),
ok = load_driver(DrvDir, ?DRV_NAME),
process_flag(trap_exit, true),
register(?REG_NAME, self()),
{group_leader, GL} = process_info(whereis(net_kernel),group_leader),
group_leader(GL, self()),
- Start = now(),
+ try
+ application:start(sasl),
+ application:start(os_mon)
+ catch
+ _ : _ ->
+ ok
+ end,
+ UtilData = new_util(),
+ Start = erlang:monotonic_time(microsecond),
TORs = lists:map(fun (Min) ->
TO = Min*60*1000,
[#timeout_rec{pid = spawn_opt(
@@ -217,16 +363,27 @@ test(Starter, DrvDir, StartDone) ->
lists:seq(1, ?MAX_TIMEOUT)),
FlatTORs = lists:flatten(TORs),
Starter ! StartDone,
- test_loop(FlatTORs, Start).
+ test_loop(FlatTORs, Start, UtilData).
+
+new_util() ->
+ new_util([]).
+
+new_util(UtilData) ->
+ Util = cpu_sup:util(),
+ Time = erlang:monotonic_time(microsecond),
+ [{Time, Util} | UtilData].
-test_loop(TORs, Start) ->
+test_loop(TORs, Start, UtilData) ->
receive
{get_result, ?REG_NAME, Pid} ->
- End = now(),
- Pid ! {result, ?REG_NAME, get_test_results(TORs), Start, End},
+ End = erlang:monotonic_time(microsecond),
+ EndUtilData = new_util(UtilData),
+ Pid ! {result, ?REG_NAME, get_test_results(TORs), Start, End, EndUtilData},
erl_ddll:unload_driver(?DRV_NAME),
erl_ddll:stop(),
exit(bye)
+ after ?UTIL_INTERVAL ->
+ test_loop(TORs, Start, new_util(UtilData))
end.
get_test_results(TORs) ->
diff --git a/erts/emulator/test/lttng_SUITE.erl b/erts/emulator/test/lttng_SUITE.erl
new file mode 100644
index 0000000000..a012fa1da2
--- /dev/null
+++ b/erts/emulator/test/lttng_SUITE.erl
@@ -0,0 +1,502 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1999-2017. 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(lttng_SUITE).
+
+-export([all/0, suite/0]).
+-export([init_per_suite/1, end_per_suite/1]).
+-export([init_per_testcase/2, end_per_testcase/2]).
+
+-export([t_lttng_list/1,
+ t_carrier_pool/1,
+ t_memory_carrier/1,
+ t_async_io_pool/1,
+ t_driver_control_ready_async/1,
+ t_driver_start_stop/1,
+ t_driver_ready_input_output/1,
+ t_driver_timeout/1,
+ t_driver_caller/1,
+ t_driver_flush/1,
+ t_scheduler_poll/1]).
+
+-include_lib("common_test/include/ct.hrl").
+
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 1}}].
+
+all() ->
+ [t_lttng_list,
+ t_memory_carrier,
+ t_carrier_pool,
+ t_async_io_pool,
+ t_driver_start_stop,
+ t_driver_ready_input_output,
+ t_driver_control_ready_async,
+ t_driver_timeout,
+ t_driver_caller,
+ t_driver_flush,
+ t_scheduler_poll].
+
+
+init_per_suite(Config) ->
+ case erlang:system_info(dynamic_trace) of
+ lttng ->
+ ensure_lttng_stopped("--all"),
+ Config;
+ _ ->
+ {skip, "No LTTng configured on system."}
+ end.
+
+end_per_suite(_Config) ->
+ ensure_lttng_stopped("--all"),
+ ok.
+
+init_per_testcase(Case, Config) ->
+ Name = atom_to_list(Case),
+ ok = ensure_lttng_started(Name, Config),
+ [{session, Name}|Config].
+
+end_per_testcase(Case, _Config) ->
+ Name = atom_to_list(Case),
+ ok = ensure_lttng_stopped(Name),
+ ok.
+
+%% Not tested yet
+%% org_erlang_otp:driver_process_exit
+%% org_erlang_otp:driver_event
+
+%% tracepoints
+%%
+%% org_erlang_otp:carrier_pool_get
+%% org_erlang_otp:carrier_pool_put
+%% org_erlang_otp:carrier_destroy
+%% org_erlang_otp:carrier_create
+%% org_erlang_otp:aio_pool_put
+%% org_erlang_otp:aio_pool_get
+%% org_erlang_otp:driver_control
+%% org_erlang_otp:driver_call
+%% org_erlang_otp:driver_finish
+%% org_erlang_otp:driver_ready_async
+%% org_erlang_otp:driver_process_exit
+%% org_erlang_otp:driver_stop
+%% org_erlang_otp:driver_flush
+%% org_erlang_otp:driver_stop_select
+%% org_erlang_otp:driver_timeout
+%% org_erlang_otp:driver_event
+%% org_erlang_otp:driver_ready_output
+%% org_erlang_otp:driver_ready_input
+%% org_erlang_otp:driver_output
+%% org_erlang_otp:driver_outputv
+%% org_erlang_otp:driver_init
+%% org_erlang_otp:driver_start
+%% org_erlang_otp:scheduler_poll
+
+%%
+%% Testcases
+%%
+
+t_lttng_list(_Config) ->
+ {ok, _} = cmd("lttng list -u"),
+ ok.
+
+%% org_erlang_otp:carrier_pool_get
+%% org_erlang_otp:carrier_pool_put
+t_carrier_pool(Config) ->
+ case have_carriers(ets_alloc) of
+ false ->
+ {skip, "No Memory Carriers configured on system."};
+ true ->
+ ok = lttng_start_event("org_erlang_otp:carrier_pool*", Config),
+
+ ok = ets_load(),
+
+ Res = lttng_stop_and_view(Config),
+ ok = check_tracepoint("org_erlang_otp:carrier_pool_get", Res),
+ ok = check_tracepoint("org_erlang_otp:carrier_pool_put", Res),
+ ok
+ end.
+
+%% org_erlang_otp:carrier_destroy
+%% org_erlang_otp:carrier_create
+t_memory_carrier(Config) ->
+ case have_carriers(ets_alloc) of
+ false ->
+ {skip, "No Memory Carriers configured on system."};
+ true ->
+ ok = lttng_start_event("org_erlang_otp:carrier_*", Config),
+
+ ok = ets_load(),
+
+ Res = lttng_stop_and_view(Config),
+ ok = check_tracepoint("org_erlang_otp:carrier_destroy", Res),
+ ok = check_tracepoint("org_erlang_otp:carrier_create", Res),
+ ok
+ end.
+
+%% org_erlang_otp:aio_pool_put
+%% org_erlang_otp:aio_pool_get
+t_async_io_pool(Config) ->
+ case have_async_threads() of
+ false ->
+ {skip, "No Async Threads configured on system."};
+ true ->
+ ok = lttng_start_event("org_erlang_otp:aio_pool_*", Config),
+
+ Path1 = proplists:get_value(priv_dir, Config),
+ {ok, [[Path2]]} = init:get_argument(home),
+ {ok, _} = file:list_dir(Path1),
+ {ok, _} = file:list_dir(Path2),
+ {ok, _} = file:list_dir(Path1),
+ {ok, _} = file:list_dir(Path2),
+
+ Res = lttng_stop_and_view(Config),
+ ok = check_tracepoint("org_erlang_otp:aio_pool_put", Res),
+ ok = check_tracepoint("org_erlang_otp:aio_pool_get", Res),
+ ok
+ end.
+
+
+%% org_erlang_otp:driver_start
+%% org_erlang_otp:driver_stop
+t_driver_start_stop(Config) ->
+ ok = lttng_start_event("org_erlang_otp:driver_*", Config),
+ timer:sleep(500),
+ Path = proplists:get_value(priv_dir, Config),
+ Name = filename:join(Path, "sometext.txt"),
+ Bin = txt(),
+ ok = file:write_file(Name, Bin),
+ {ok, Bin} = file:read_file(Name),
+ timer:sleep(500),
+ Res = lttng_stop_and_view(Config),
+ ok = check_tracepoint("org_erlang_otp:driver_start", Res),
+ ok = check_tracepoint("org_erlang_otp:driver_stop", Res),
+ ok = check_tracepoint("org_erlang_otp:driver_control", Res),
+ ok = check_tracepoint("org_erlang_otp:driver_outputv", Res),
+ ok = check_tracepoint("org_erlang_otp:driver_ready_async", Res),
+ ok.
+
+%% org_erlang_otp:driver_control
+%% org_erlang_otp:driver_outputv
+%% org_erlang_otp:driver_ready_async
+t_driver_control_ready_async(Config) ->
+ ok = lttng_start_event("org_erlang_otp:driver_control", Config),
+ ok = lttng_start_event("org_erlang_otp:driver_outputv", Config),
+ ok = lttng_start_event("org_erlang_otp:driver_ready_async", Config),
+ Path = proplists:get_value(priv_dir, Config),
+ Name = filename:join(Path, "sometext.txt"),
+ Bin = txt(),
+ ok = file:write_file(Name, Bin),
+ {ok, Bin} = file:read_file(Name),
+ Res = lttng_stop_and_view(Config),
+ ok = check_tracepoint("org_erlang_otp:driver_control", Res),
+ ok = check_tracepoint("org_erlang_otp:driver_outputv", Res),
+ ok = check_tracepoint("org_erlang_otp:driver_ready_async", Res),
+ ok.
+
+%% org_erlang_otp:driver_ready_input
+%% org_erlang_otp:driver_ready_output
+t_driver_ready_input_output(Config) ->
+ ok = lttng_start_event("org_erlang_otp:driver_ready_*", Config),
+ timer:sleep(500),
+ Me = self(),
+ Pid = spawn_link(fun() -> tcp_server(Me, active) end),
+ receive {Pid, accept} -> ok end,
+ Bin = txt(),
+ Sz = byte_size(Bin),
+
+ {ok, Sock} = gen_tcp:connect("localhost", 5679, [binary, {packet, 2}]),
+ ok = gen_tcp:send(Sock, <<Sz:16, Bin/binary>>),
+ ok = gen_tcp:send(Sock, <<Sz:16, Bin/binary>>),
+ ok = gen_tcp:close(Sock),
+ receive {Pid, done} -> ok end,
+
+ timer:sleep(500),
+ Res = lttng_stop_and_view(Config),
+ ok = check_tracepoint("org_erlang_otp:driver_ready_input", Res),
+ ok = check_tracepoint("org_erlang_otp:driver_ready_output", Res),
+ ok.
+
+
+%% org_erlang_otp:driver_stop_select
+%% org_erlang_otp:driver_timeout
+t_driver_timeout(Config) ->
+ ok = lttng_start_event("org_erlang_otp:driver_*", Config),
+ Me = self(),
+ Pid = spawn_link(fun() -> tcp_server(Me, timeout) end),
+ receive {Pid, accept} -> ok end,
+ {ok, Sock} = gen_tcp:connect("localhost", 5679, [binary]),
+ ok = gen_tcp:send(Sock, <<"hej">>),
+ receive {Pid, done} -> ok end,
+ ok = gen_tcp:close(Sock),
+ Res = lttng_stop_and_view(Config),
+ ok = check_tracepoint("org_erlang_otp:driver_timeout", Res),
+ ok = check_tracepoint("org_erlang_otp:driver_stop_select", Res),
+ ok.
+
+%% org_erlang_otp:driver_call
+%% org_erlang_otp:driver_output
+%% org_erlang_otp:driver_init
+%% org_erlang_otp:driver_finish
+t_driver_caller(Config) ->
+ ok = lttng_start_event("org_erlang_otp:driver_*", Config),
+
+ Drv = 'caller_drv',
+ os:putenv("CALLER_DRV_USE_OUTPUTV", "false"),
+
+ 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, output, spawn_link(fun() ->
+ port_command(Port, "")
+ end)),
+ Port ! {self(), {command, ""}},
+ chk_caller(Port, output, 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),
+
+ Res = lttng_stop_and_view(Config),
+ ok = check_tracepoint("org_erlang_otp:driver_call", Res),
+ ok = check_tracepoint("org_erlang_otp:driver_output", Res),
+ ok = check_tracepoint("org_erlang_otp:driver_init", Res),
+ ok = check_tracepoint("org_erlang_otp:driver_finish", Res),
+ ok.
+
+%% org_erlang_otp:scheduler_poll
+t_scheduler_poll(Config) ->
+ ok = lttng_start_event("org_erlang_otp:scheduler_poll", Config),
+
+ ok = memory_load(),
+
+ Res = lttng_stop_and_view(Config),
+ ok = check_tracepoint("org_erlang_otp:scheduler_poll", Res),
+ ok.
+
+%% org_erlang_otp:driver_flush
+t_driver_flush(Config) ->
+ ok = lttng_start_event("org_erlang_otp:driver_flush", Config),
+
+ Me = self(),
+ Pid = spawn_link(fun() -> tcp_server(Me, passive_no_read) end),
+ receive {Pid, accept} -> ok end,
+ Bin = iolist_to_binary([txt() || _ <- lists:seq(1,100)]),
+ Sz = byte_size(Bin),
+
+ %% We want to create a scenario where sendings stalls and we
+ %% queue packets in the driver.
+ %% When we close the socket it has to flush the queue.
+ {ok, Sock} = gen_tcp:connect("localhost", 5679, [binary, {packet, 2},
+ {send_timeout, 10},
+ {sndbuf, 10000000}]),
+ Pids = [spawn_link(fun() ->
+ gen_tcp:send(Sock, <<Sz:16, Bin/binary>>),
+ Me ! {self(), ok}
+ end) || _ <- lists:seq(1,100)],
+ [receive {P, ok} -> ok end || P <- Pids],
+ ok = gen_tcp:close(Sock),
+ Pid ! die,
+ receive {Pid, done} -> ok end,
+
+ Res = lttng_stop_and_view(Config),
+ ok = check_tracepoint("org_erlang_otp:driver_flush", Res),
+ ok.
+
+%%
+%% AUX
+%%
+
+chk_caller(Port, Callback, ExpectedCaller) ->
+ receive
+ {caller, Port, Callback, Caller} ->
+ ExpectedCaller = Caller
+ end.
+
+
+ets_load() ->
+ Tid = ets:new(ets_load, [public,set]),
+ N = erlang:system_info(schedulers_online),
+ Pids = [spawn_link(fun() -> ets_shuffle(Tid) end) || _ <- lists:seq(1,N)],
+ ok = ets_kill(Pids, 500),
+ ok.
+
+
+ets_kill([], _) -> ok;
+ets_kill([Pid|Pids], Time) ->
+ timer:sleep(Time),
+ Pid ! done,
+ ets_kill(Pids, Time).
+
+ets_shuffle(Tid) ->
+ Payload = lists:duplicate(100, $x),
+ ets_shuffle(Tid, 100, Payload).
+ets_shuffle(Tid, I, Data) ->
+ ets_shuffle(Tid, I, I, Data, Data).
+
+ets_shuffle(Tid, 0, N, _, Data) ->
+ ets_shuffle(Tid, N, N, Data, Data);
+ets_shuffle(Tid, I, N, Data, Data0) ->
+ receive
+ done -> ok
+ after 0 ->
+ Key = rand:uniform(1000),
+ Data1 = [I|Data],
+ ets:insert(Tid, {Key, Data1}),
+ ets_shuffle(Tid, I - 1, N, Data1, Data0)
+ end.
+
+
+
+
+memory_load() ->
+ Me = self(),
+ Pids0 = [spawn_link(fun() -> memory_loop(Me, 20, <<42>>) end) || _ <- lists:seq(1,30)],
+ timer:sleep(50),
+ Pids1 = [spawn_link(fun() -> memory_loop(Me, 20, <<42>>) end) || _ <- lists:seq(1,30)],
+ [receive {Pid, done} -> ok end || Pid <- Pids0 ++ Pids1],
+ timer:sleep(500),
+ ok.
+
+memory_loop(Parent, N, Bin) ->
+ memory_loop(Parent, N, Bin, []).
+
+memory_loop(Parent, 0, _Bin, _) ->
+ Parent ! {self(), done};
+memory_loop(Parent, N, Bin0, Ls) ->
+ Bin = binary:copy(<<Bin0/binary, Bin0/binary>>),
+ memory_loop(Parent, N - 1, Bin, [a,b,c|Ls]).
+
+tcp_server(Pid, Type) ->
+ {ok, LSock} = gen_tcp:listen(5679, [binary,
+ {reuseaddr, true},
+ {active, false}]),
+ Pid ! {self(), accept},
+ {ok, Sock} = gen_tcp:accept(LSock),
+ case Type of
+ passive_no_read ->
+ receive die -> ok end;
+ active ->
+ inet:setopts(Sock, [{active, once}, {packet,2}]),
+ receive Msg1 -> io:format("msg1: ~p~n", [Msg1]) end,
+ inet:setopts(Sock, [{active, once}, {packet,2}]),
+ receive Msg2 -> io:format("msg2: ~p~n", [Msg2]) end,
+ ok = gen_tcp:close(Sock);
+ timeout ->
+ Res = gen_tcp:recv(Sock, 2000, 1000),
+ io:format("res ~p~n", [Res])
+ end,
+ Pid ! {self(), done},
+ ok.
+
+txt() ->
+ <<"%% tracepoints\n"
+ "%%\n"
+ "%% org_erlang_otp:carrier_pool_get\n"
+ "%% org_erlang_otp:carrier_pool_put\n"
+ "%% org_erlang_otp:carrier_destroy\n"
+ "%% org_erlang_otp:carrier_create\n"
+ "%% org_erlang_otp:aio_pool_put\n"
+ "%% org_erlang_otp:aio_pool_get\n"
+ "%% org_erlang_otp:driver_control\n"
+ "%% org_erlang_otp:driver_call\n"
+ "%% org_erlang_otp:driver_finish\n"
+ "%% org_erlang_otp:driver_ready_async\n"
+ "%% org_erlang_otp:driver_process_exit\n"
+ "%% org_erlang_otp:driver_stop\n"
+ "%% org_erlang_otp:driver_flush\n"
+ "%% org_erlang_otp:driver_stop_select\n"
+ "%% org_erlang_otp:driver_timeout\n"
+ "%% org_erlang_otp:driver_event\n"
+ "%% org_erlang_otp:driver_ready_output\n"
+ "%% org_erlang_otp:driver_ready_input\n"
+ "%% org_erlang_otp:driver_output\n"
+ "%% org_erlang_otp:driver_outputv\n"
+ "%% org_erlang_otp:driver_init\n"
+ "%% org_erlang_otp:driver_start\n"
+ "%% org_erlang_otp:scheduler_poll">>.
+
+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
+ end.
+
+%% check
+
+have_carriers(Alloc) ->
+ case erlang:system_info({allocator,Alloc}) of
+ false -> false;
+ _ -> true
+ end.
+
+have_async_threads() ->
+ Tps = erlang:system_info(thread_pool_size),
+ if Tps =:= 0 -> false;
+ true -> true
+ end.
+
+%% lttng
+lttng_stop_and_view(Config) ->
+ Path = proplists:get_value(priv_dir, Config),
+ Name = proplists:get_value(session, Config),
+ {ok,_} = cmd("lttng stop " ++ Name),
+ {ok,Res} = cmd("lttng view " ++ Name ++ " --trace-path=" ++ Path),
+ Res.
+
+check_tracepoint(TP, Data) ->
+ case re:run(Data, TP, [global]) of
+ {match, _} -> ok;
+ _ -> notfound
+ end.
+
+lttng_start_event(Event, Config) ->
+ Name = proplists:get_value(session, Config),
+ {ok, _} = cmd("lttng enable-event -u " ++ Event ++ " --session=" ++ Name),
+ {ok, _} = cmd("lttng start " ++ Name),
+ ok.
+
+ensure_lttng_started(Name, Config) ->
+ Out = case proplists:get_value(priv_dir, Config) of
+ undefined -> [];
+ Path -> "--output="++Path++" "
+ end,
+ {ok,_} = cmd("lttng create " ++ Out ++ Name),
+ ok.
+
+ensure_lttng_stopped(Name) ->
+ {ok,_} = cmd("lttng stop"),
+ {ok,_} = cmd("lttng destroy " ++ Name),
+ ok.
+
+cmd(Cmd) ->
+ io:format("<< ~ts~n", [Cmd]),
+ Res = os:cmd(Cmd),
+ io:format(">> ~ts~n", [Res]),
+ {ok,Res}.
diff --git a/erts/emulator/test/lttng_SUITE_data/Makefile.src b/erts/emulator/test/lttng_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..fe7a1b6ef3
--- /dev/null
+++ b/erts/emulator/test/lttng_SUITE_data/Makefile.src
@@ -0,0 +1,7 @@
+
+MISC_DRVS = caller_drv@dll@
+
+
+all: $(MISC_DRVS)
+
+@SHLIB_RULES@
diff --git a/erts/emulator/test/lttng_SUITE_data/caller_drv.c b/erts/emulator/test/lttng_SUITE_data/caller_drv.c
new file mode 100644
index 0000000000..86fd0a2995
--- /dev/null
+++ b/erts/emulator/test/lttng_SUITE_data/caller_drv.c
@@ -0,0 +1,159 @@
+/* ``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.
+ *
+ * The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+ * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+ * AB. All Rights Reserved.''
+ *
+ * $Id$
+ */
+
+#include <stdlib.h>
+#include <string.h>
+#include "erl_driver.h"
+
+static int init();
+static void stop(ErlDrvData drv_data);
+static void finish();
+static void flush(ErlDrvData drv_data);
+static ErlDrvData start(ErlDrvPort port, char *command);
+static void output(ErlDrvData drv_data, char *buf, ErlDrvSizeT len);
+static void outputv(ErlDrvData drv_data, ErlIOVec *ev);
+static ErlDrvSSizeT control(ErlDrvData drv_data,
+ unsigned int command, char *buf,
+ ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen);
+static ErlDrvSSizeT call(ErlDrvData drv_data,
+ unsigned int command,
+ char *buf, ErlDrvSizeT len,
+ char **rbuf, ErlDrvSizeT rlen,
+ unsigned int *flags);
+
+static ErlDrvEntry caller_drv_entry = {
+ init,
+ start,
+ stop,
+ output,
+ NULL /* ready_input */,
+ NULL /* ready_output */,
+ "caller_drv",
+ finish,
+ NULL /* handle */,
+ control,
+ NULL /* timeout */,
+ outputv,
+ NULL /* ready_async */,
+ flush,
+ call,
+ NULL /* event */,
+ ERL_DRV_EXTENDED_MARKER,
+ ERL_DRV_EXTENDED_MAJOR_VERSION,
+ ERL_DRV_EXTENDED_MINOR_VERSION,
+ ERL_DRV_FLAG_USE_PORT_LOCKING,
+ NULL /* handle2 */,
+ NULL /* handle_monitor */
+};
+
+DRIVER_INIT(caller_drv)
+{
+ char buf[10];
+ size_t bufsz = sizeof(buf);
+ char *use_outputv;
+ use_outputv = (erl_drv_getenv("CALLER_DRV_USE_OUTPUTV", buf, &bufsz) == 0
+ ? buf
+ : "false");
+ if (strcmp(use_outputv, "true") != 0)
+ caller_drv_entry.outputv = NULL;
+ return &caller_drv_entry;
+}
+
+void
+send_caller(ErlDrvData drv_data, char *func)
+{
+ int res;
+ ErlDrvPort port = (ErlDrvPort) drv_data;
+ ErlDrvTermData msg[] = {
+ ERL_DRV_ATOM, driver_mk_atom("caller"),
+ ERL_DRV_PORT, driver_mk_port(port),
+ ERL_DRV_ATOM, driver_mk_atom(func),
+ ERL_DRV_PID, driver_caller(port),
+ ERL_DRV_TUPLE, (ErlDrvTermData) 4
+ };
+ res = erl_drv_output_term(driver_mk_port(port), msg, sizeof(msg)/sizeof(ErlDrvTermData));
+ if (res <= 0)
+ driver_failure_atom(port, "erl_drv_output_term failed");
+}
+
+static int
+init() {
+ return 0;
+}
+
+static void
+stop(ErlDrvData drv_data)
+{
+
+}
+
+static void
+flush(ErlDrvData drv_data)
+{
+
+}
+
+static void
+finish()
+{
+
+}
+
+static ErlDrvData
+start(ErlDrvPort port, char *command)
+{
+ send_caller((ErlDrvData) port, "start");
+ return (ErlDrvData) port;
+}
+
+static void
+output(ErlDrvData drv_data, char *buf, ErlDrvSizeT len)
+{
+ send_caller(drv_data, "output");
+}
+
+static void
+outputv(ErlDrvData drv_data, ErlIOVec *ev)
+{
+ send_caller(drv_data, "outputv");
+}
+
+static ErlDrvSSizeT
+control(ErlDrvData drv_data,
+ unsigned int command, char *buf,
+ ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen)
+{
+ send_caller(drv_data, "control");
+ return 0;
+}
+
+static ErlDrvSSizeT
+call(ErlDrvData drv_data,
+ unsigned int command,
+ char *buf, ErlDrvSizeT len,
+ char **rbuf, ErlDrvSizeT rlen,
+ unsigned int *flags)
+{
+ /* echo call */
+ if (len > rlen)
+ *rbuf = driver_alloc(len);
+ memcpy((void *) *rbuf, (void *) buf, len);
+ send_caller(drv_data, "call");
+ return len;
+}
diff --git a/erts/emulator/test/map_SUITE.erl b/erts/emulator/test/map_SUITE.erl
index 888ed8e272..02f3c89318 100644
--- a/erts/emulator/test/map_SUITE.erl
+++ b/erts/emulator/test/map_SUITE.erl
@@ -2,112 +2,152 @@
%%
%% Copyright Ericsson AB 2013. 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.
+%% 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(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_update_literals/1,t_match_and_update_literals/1,
- t_update_map_expressions/1,
- t_update_assoc/1,t_update_exact/1,
- t_guard_bifs/1, t_guard_sequence/1, t_guard_update/1,
- t_guard_receive/1, t_guard_fun/1,
- t_list_comprehension/1,
- t_map_sort_literals/1,
- t_map_equal/1,
- %t_size/1,
- t_map_size/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,
-
- %% maps module not bifs
- t_maps_fold/1,
- t_maps_map/1,
- t_maps_size/1,
- t_maps_without/1,
-
- %% misc
- t_pdict/1,
- t_ets/1,
- t_dets/1,
- t_tracing/1
- ]).
+-export([all/0, suite/0]).
+
+-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_take/1, t_bif_map_take_large/1,
+ t_bif_map_update/1,
+ t_bif_map_values/1,
+ t_bif_map_to_list/1,
+ t_bif_map_from_list/1,
+ t_bif_erts_internal_maps_to_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,
+ t_hash_entropy/1,
+
+ %% instruction-level tests
+ t_has_map_fields/1,
+ y_regs/1,
+ badmap_17/1]).
-include_lib("stdlib/include/ms_transform.hrl").
-suite() -> [].
-
-all() -> [
- t_build_and_match_literals,
- t_update_literals, t_match_and_update_literals,
- t_update_map_expressions,
- t_update_assoc,t_update_exact,
- t_guard_bifs, t_guard_sequence, t_guard_update,
- t_guard_receive,t_guard_fun, t_list_comprehension,
- t_map_equal,
- 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,
+-define(CHECK(Cond,Term),
+ case (catch (Cond)) of
+ true -> true;
+ _ -> io:format("###### CHECK FAILED ######~nINPUT: ~p~n", [Term]),
+ exit(Term)
+ end).
- %% maps module
- t_maps_fold, t_maps_map,
- t_maps_size, t_maps_without,
-
-
- %% Other functions
- t_pdict,
- t_ets,
- t_tracing
- ].
-
-groups() -> [].
-
-init_per_suite(Config) -> Config.
-end_per_suite(_Config) -> ok.
+suite() -> [].
-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_take, t_bif_map_take_large,
+ t_bif_map_update,
+ t_bif_map_values,
+ t_bif_map_to_list, t_bif_map_from_list,
+ t_bif_erts_internal_maps_to_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,
+ t_hash_entropy,
+
+ %% instruction-level tests
+ t_has_map_fields,
+ y_regs,
+ badmap_17].
%% tests
@@ -124,6 +164,9 @@ t_build_and_match_literals(Config) when is_list(Config) ->
#{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>,{"6",7}:="f",8:=g} =
id(#{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>,{"6",7}=>"f",8=>g}),
+ #{[]:=a,42.0:=b,x:={x,y},[a,b]:=list} =
+ id(#{[]=>a,42.0=>b,x=>{x,y},[a,b]=>list}),
+
#{<<"hi all">> := 1} = id(#{<<"hi",32,"all">> => 1}),
#{a:=X,a:=X=3,b:=4} = id(#{a=>3,b=>4}), % weird but ok =)
@@ -145,17 +188,461 @@ t_build_and_match_literals(Config) when is_list(Config) ->
{'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{x=>"three"}))),
ok.
+t_build_and_match_literals_large(Config) when is_list(Config) ->
+ % normal non-repeating
+ M0 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10",
+ 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11",
+ 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12",
+ 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13",
+ 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14",
+
+ 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15",
+ 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16",
+ 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17",
+ 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18",
+ 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" }),
+
+ #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M0,
+ #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M0,
+ #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M0,
+ #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M0,
+ #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M0,
+
+ #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M0,
+ #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M0,
+ #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M0,
+ #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M0,
+ #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M0,
+
+ 60 = map_size(M0),
+ 60 = maps:size(M0),
+
+ % with repeating
+ M1 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10",
+ 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11",
+ 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12",
+ 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13",
+ 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14",
+
+ 10=>na0,20=>nb0,30=>"nc0","40"=>"nd0",<<"50">>=>"ne0",{["00"]}=>"n10",
+ 11=>na1,21=>nb1,31=>"nc1","41"=>"nd1",<<"51">>=>"ne1",{["01"]}=>"n11",
+ 12=>na2,22=>nb2,32=>"nc2","42"=>"nd2",<<"52">>=>"ne2",{["02"]}=>"n12",
+
+ 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15",
+ 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16",
+ 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17",
+
+ 13=>na3,23=>nb3,33=>"nc3","43"=>"nd3",<<"53">>=>"ne3",{["03"]}=>"n13",
+ 14=>na4,24=>nb4,34=>"nc4","44"=>"nd4",<<"54">>=>"ne4",{["04"]}=>"n14",
+
+ 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18",
+ 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" }),
+
+ #{10:=na0,20:=nb0,30:="nc0","40":="nd0",<<"50">>:="ne0",{["00"]}:="n10"} = M1,
+ #{11:=na1,21:=nb1,31:="nc1","41":="nd1",<<"51">>:="ne1",{["01"]}:="n11"} = M1,
+ #{12:=na2,22:=nb2,32:="nc2","42":="nd2",<<"52">>:="ne2",{["02"]}:="n12"} = M1,
+ #{13:=na3,23:=nb3,33:="nc3","43":="nd3",<<"53">>:="ne3",{["03"]}:="n13"} = M1,
+ #{14:=na4,24:=nb4,34:="nc4","44":="nd4",<<"54">>:="ne4",{["04"]}:="n14"} = M1,
+
+ #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M1,
+ #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M1,
+ #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M1,
+ #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M1,
+ #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M1,
+
+ 60 = map_size(M1),
+ 60 = maps:size(M1),
+
+ % with floats
+
+ M2 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10",
+ 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11",
+ 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12",
+ 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13",
+ 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14",
+
+ 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15",
+ 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16",
+ 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17",
+ 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18",
+ 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19",
+
+ 10.0=>fa0,20.0=>fb0,30.0=>"fc0",
+ 11.0=>fa1,21.0=>fb1,31.0=>"fc1",
+ 12.0=>fa2,22.0=>fb2,32.0=>"fc2",
+ 13.0=>fa3,23.0=>fb3,33.0=>"fc3",
+ 14.0=>fa4,24.0=>fb4,34.0=>"fc4",
+
+ 15.0=>fa5,25.0=>fb5,35.0=>"fc5",
+ 16.0=>fa6,26.0=>fb6,36.0=>"fc6",
+ 17.0=>fa7,27.0=>fb7,37.0=>"fc7",
+ 18.0=>fa8,28.0=>fb8,38.0=>"fc8",
+ 19.0=>fa9,29.0=>fb9,39.0=>"fc9"}),
+
+ #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M2,
+ #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M2,
+ #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M2,
+ #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M2,
+ #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M2,
+
+ #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M2,
+ #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M2,
+ #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M2,
+ #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M2,
+ #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M2,
+
+ #{10.0:=fa0,20.0:=fb0,30.0:="fc0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M2,
+ #{11.0:=fa1,21.0:=fb1,31.0:="fc1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M2,
+ #{12.0:=fa2,22.0:=fb2,32.0:="fc2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M2,
+ #{13.0:=fa3,23.0:=fb3,33.0:="fc3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M2,
+ #{14.0:=fa4,24.0:=fb4,34.0:="fc4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M2,
+
+ #{15.0:=fa5,25.0:=fb5,35.0:="fc5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M2,
+ #{16.0:=fa6,26.0:=fb6,36.0:="fc6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M2,
+ #{17.0:=fa7,27.0:=fb7,37.0:="fc7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M2,
+ #{18.0:=fa8,28.0:=fb8,38.0:="fc8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M2,
+ #{19.0:=fa9,29.0:=fb9,39.0:="fc9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M2,
+
+ 90 = map_size(M2),
+ 90 = maps:size(M2),
+
+ % with bignums
+ M3 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10",
+ 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11",
+ 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12",
+ 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13",
+ 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14",
+
+ 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15",
+ 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16",
+ 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17",
+ 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18",
+ 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19",
+
+ 10.0=>fa0,20.0=>fb0,30.0=>"fc0",
+ 11.0=>fa1,21.0=>fb1,31.0=>"fc1",
+ 12.0=>fa2,22.0=>fb2,32.0=>"fc2",
+ 13.0=>fa3,23.0=>fb3,33.0=>"fc3",
+ 14.0=>fa4,24.0=>fb4,34.0=>"fc4",
+
+ 15.0=>fa5,25.0=>fb5,35.0=>"fc5",
+ 16.0=>fa6,26.0=>fb6,36.0=>"fc6",
+ 17.0=>fa7,27.0=>fb7,37.0=>"fc7",
+ 18.0=>fa8,28.0=>fb8,38.0=>"fc8",
+ 19.0=>fa9,29.0=>fb9,39.0=>"fc9",
+
+ 36893488147419103232=>big1, 73786976294838206464=>big2,
+ 147573952589676412928=>big3, 18446744073709551616=>big4,
+ 4294967296=>big5, 8589934592=>big6,
+ 4294967295=>big7, 67108863=>big8
+ }),
+
+ #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M3,
+ #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M3,
+ #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M3,
+ #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M3,
+ #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M3,
+
+ #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3,
+ #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3,
+ #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3,
+ #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3,
+ #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M3,
+
+ #{10.0:=fa0,20.0:=fb0,30.0:="fc0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M3,
+ #{11.0:=fa1,21.0:=fb1,31.0:="fc1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M3,
+ #{12.0:=fa2,22.0:=fb2,32.0:="fc2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M3,
+ #{13.0:=fa3,23.0:=fb3,33.0:="fc3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M3,
+ #{14.0:=fa4,24.0:=fb4,34.0:="fc4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M3,
+
+ #{15.0:=fa5,25.0:=fb5,35.0:="fc5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3,
+ #{16.0:=fa6,26.0:=fb6,36.0:="fc6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3,
+ #{17.0:=fa7,27.0:=fb7,37.0:="fc7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3,
+ #{18.0:=fa8,28.0:=fb8,38.0:="fc8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3,
+ #{19.0:=fa9,29.0:=fb9,39.0:="fc9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M3,
+
+ #{36893488147419103232:=big1,67108863:=big8,"45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3,
+ #{147573952589676412928:=big3,8589934592:=big6,"46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3,
+ #{4294967296:=big5,18446744073709551616:=big4,"47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3,
+ #{4294967295:=big7,73786976294838206464:=big2,"48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3,
+
+ 98 = map_size(M3),
+ 98 = maps:size(M3),
+
+ %% with maps
+
+ M4 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10",
+ 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11",
+ 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12",
+ 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13",
+ 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14",
+
+ 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15",
+ 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16",
+ 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17",
+ 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18",
+ 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19",
+
+ 10.0=>fa0,20.0=>fb0,30.0=>"fc0",
+ 11.0=>fa1,21.0=>fb1,31.0=>"fc1",
+ 12.0=>fa2,22.0=>fb2,32.0=>"fc2",
+ 13.0=>fa3,23.0=>fb3,33.0=>"fc3",
+ 14.0=>fa4,24.0=>fb4,34.0=>"fc4",
+
+ 15.0=>fa5,25.0=>fb5,35.0=>"fc5",
+ 16.0=>fa6,26.0=>fb6,36.0=>"fc6",
+ 17.0=>fa7,27.0=>fb7,37.0=>"fc7",
+ 18.0=>fa8,28.0=>fb8,38.0=>"fc8",
+ 19.0=>fa9,29.0=>fb9,39.0=>"fc9",
+
+ #{ one => small, map => key } => "small map key 1",
+ #{ second => small, map => key } => "small map key 2",
+ #{ third => small, map => key } => "small map key 3",
+
+ #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10",
+ 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11",
+ 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12",
+ 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13",
+ 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14",
+
+ 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15",
+ 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16",
+ 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17",
+ 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18",
+ 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1",
+
+ #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10",
+ 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11",
+ 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12",
+ 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13",
+ 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14",
+
+ 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15",
+ k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16",
+ 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17",
+ 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18",
+ 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }),
+
+ #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M4,
+ #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M4,
+ #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M4,
+ #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M4,
+ #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M4,
+
+ #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M4,
+ #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M4,
+ #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M4,
+ #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M4,
+ #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M4,
+
+ #{ #{ one => small, map => key } := "small map key 1",
+ #{ second => small, map => key } := "small map key 2",
+ #{ third => small, map => key } := "small map key 3" } = M4,
+
+ #{ #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10",
+ 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11",
+ 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12",
+ 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13",
+ 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14",
+
+ 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15",
+ 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16",
+ 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17",
+ 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18",
+ 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := "large map key 1",
+
+ #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10",
+ 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11",
+ 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12",
+ 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13",
+ 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14",
+
+ 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15",
+ k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16",
+ 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17",
+ 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18",
+ 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := "large map key 2" } = M4,
+
+
+ #{ 15:=V1,25:=b5,35:=V2,"45":="d5",<<"55">>:=V3,{["05"]}:="15",
+ #{ one => small, map => key } := "small map key 1",
+ #{ second => small, map => key } := V4,
+ #{ third => small, map => key } := "small map key 3",
+ #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10",
+ 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11",
+ 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12",
+ 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13",
+ 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14",
+
+ 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15",
+ 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16",
+ 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17",
+ 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18",
+ 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := V5 } = M4,
+
+ a5 = V1,
+ "c5" = V2,
+ "e5" = V3,
+ "small map key 2" = V4,
+ "large map key 1" = V5,
+
+ 95 = map_size(M4),
+ 95 = maps:size(M4),
+
+ % call for value
+
+ M5 = id(#{ 10=>id(a0),20=>b0,30=>id("c0"),"40"=>"d0",<<"50">>=>id("e0"),{["00"]}=>"10",
+ 11=>id(a1),21=>b1,31=>id("c1"),"41"=>"d1",<<"51">>=>id("e1"),{["01"]}=>"11",
+ 12=>id(a2),22=>b2,32=>id("c2"),"42"=>"d2",<<"52">>=>id("e2"),{["02"]}=>"12",
+ 13=>id(a3),23=>b3,33=>id("c3"),"43"=>"d3",<<"53">>=>id("e3"),{["03"]}=>"13",
+ 14=>id(a4),24=>b4,34=>id("c4"),"44"=>"d4",<<"54">>=>id("e4"),{["04"]}=>"14",
+
+ 15=>id(a5),25=>b5,35=>id("c5"),"45"=>"d5",<<"55">>=>id("e5"),{["05"]}=>"15",
+ 16=>id(a6),26=>b6,36=>id("c6"),"46"=>"d6",<<"56">>=>id("e6"),{["06"]}=>"16",
+ 17=>id(a7),27=>b7,37=>id("c7"),"47"=>"d7",<<"57">>=>id("e7"),{["07"]}=>"17",
+ 18=>id(a8),28=>b8,38=>id("c8"),"48"=>"d8",<<"58">>=>id("e8"),{["08"]}=>"18",
+ 19=>id(a9),29=>b9,39=>id("c9"),"49"=>"d9",<<"59">>=>id("e9"),{["09"]}=>"19",
+
+ 10.0=>fa0,20.0=>id(fb0),30.0=>id("fc0"),
+ 11.0=>fa1,21.0=>id(fb1),31.0=>id("fc1"),
+ 12.0=>fa2,22.0=>id(fb2),32.0=>id("fc2"),
+ 13.0=>fa3,23.0=>id(fb3),33.0=>id("fc3"),
+ 14.0=>fa4,24.0=>id(fb4),34.0=>id("fc4"),
+
+ 15.0=>fa5,25.0=>id(fb5),35.0=>id("fc5"),
+ 16.0=>fa6,26.0=>id(fb6),36.0=>id("fc6"),
+ 17.0=>fa7,27.0=>id(fb7),37.0=>id("fc7"),
+ 18.0=>fa8,28.0=>id(fb8),38.0=>id("fc8"),
+ 19.0=>fa9,29.0=>id(fb9),39.0=>id("fc9"),
+
+ #{ one => small, map => key } => id("small map key 1"),
+ #{ second => small, map => key } => "small map key 2",
+ #{ third => small, map => key } => "small map key 3",
+
+ #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10",
+ 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11",
+ 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12",
+ 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13",
+ 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14",
+
+ 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15",
+ 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16",
+ 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17",
+ 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18",
+ 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1",
+
+ #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10",
+ 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11",
+ 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12",
+ 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13",
+ 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14",
+
+ 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15",
+ k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16",
+ 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17",
+ 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18",
+ 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => id("large map key 2") }),
+
+ #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M5,
+ #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M5,
+ #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M5,
+ #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M5,
+ #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M5,
+
+ #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M5,
+ #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M5,
+ #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M5,
+ #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M5,
+ #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M5,
+
+ #{ #{ one => small, map => key } := "small map key 1",
+ #{ second => small, map => key } := "small map key 2",
+ #{ third => small, map => key } := "small map key 3" } = M5,
+
+ #{ #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10",
+ 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11",
+ 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12",
+ 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13",
+ 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14",
+
+ 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15",
+ 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16",
+ 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17",
+ 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18",
+ 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := "large map key 1",
+
+ #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10",
+ 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11",
+ 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12",
+ 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13",
+ 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14",
+
+ 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15",
+ k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16",
+ 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17",
+ 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18",
+ 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := "large map key 2" } = M5,
+
+ 95 = map_size(M5),
+ 95 = maps:size(M5),
+
+ %% remember
+
+ #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M0,
+ #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M0,
+ #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M0,
+ #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M0,
+ #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M0,
+
+ #{10:=na0,20:=nb0,30:="nc0","40":="nd0",<<"50">>:="ne0",{["00"]}:="n10"} = M1,
+ #{11:=na1,21:=nb1,31:="nc1","41":="nd1",<<"51">>:="ne1",{["01"]}:="n11"} = M1,
+ #{12:=na2,22:=nb2,32:="nc2","42":="nd2",<<"52">>:="ne2",{["02"]}:="n12"} = M1,
+ #{13:=na3,23:=nb3,33:="nc3","43":="nd3",<<"53">>:="ne3",{["03"]}:="n13"} = M1,
+ #{14:=na4,24:=nb4,34:="nc4","44":="nd4",<<"54">>:="ne4",{["04"]}:="n14"} = M1,
+
+ #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M1,
+ #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M1,
+ #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M1,
+ #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M1,
+ #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M1,
+
+ #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M2,
+ #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M2,
+ #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M2,
+ #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M2,
+ #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M2,
+
+ #{10.0:=fa0,20.0:=fb0,30.0:="fc0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M2,
+ #{11.0:=fa1,21.0:=fb1,31.0:="fc1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M2,
+ #{12.0:=fa2,22.0:=fb2,32.0:="fc2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M2,
+ #{13.0:=fa3,23.0:=fb3,33.0:="fc3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M2,
+ #{14.0:=fa4,24.0:=fb4,34.0:="fc4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M2,
+
+ #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3,
+ #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3,
+ #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3,
+ #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3,
+ #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M3,
+
+ #{10.0:=fa0,20.0:=fb0,30.0:="fc0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M3,
+ #{11.0:=fa1,21.0:=fb1,31.0:="fc1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M3,
+ #{12.0:=fa2,22.0:=fb2,32.0:="fc2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M3,
+ #{13.0:=fa3,23.0:=fb3,33.0:="fc3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M3,
+ #{14.0:=fa4,24.0:=fb4,34.0:="fc4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M3,
+
+ #{15.0:=fa5,25.0:=fb5,35.0:="fc5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3,
+ #{16.0:=fa6,26.0:=fb6,36.0:="fc6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3,
+ #{17.0:=fa7,27.0:=fb7,37.0:="fc7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3,
+ #{18.0:=fa8,28.0:=fb8,38.0:="fc8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3,
+ #{19.0:=fa9,29.0:=fb9,39.0:="fc9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M3,
+
+ #{36893488147419103232:=big1,67108863:=big8,"45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3,
+ #{147573952589676412928:=big3,8589934592:=big6,"46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3,
+ #{4294967296:=big5,18446744073709551616:=big4,"47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3,
+ #{4294967295:=big7,73786976294838206464:=big2,"48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3,
-%% Tests size(Map).
-%% not implemented, perhaps it shouldn't be either
+ ok.
-%t_size(Config) when is_list(Config) ->
-% 0 = size(#{}),
-% 1 = size(#{a=>1}),
-% 1 = size(#{a=>#{a=>1}}),
-% 2 = size(#{a=>1, b=>2}),
-% 3 = size(#{a=>1, b=>2, b=>"3"}),
-% ok.
t_map_size(Config) when is_list(Config) ->
0 = map_size(id(#{})),
@@ -172,16 +659,108 @@ t_map_size(Config) when is_list(Config) ->
true = map_is_size(M#{ "a" => 2}, 2),
false = map_is_size(M#{ "c" => 2}, 2),
+ Ks = [build_key(fun(K) -> <<1,K:32,1>> end,I)||I<-lists:seq(1,100)],
+ ok = build_and_check_size(Ks,0,#{}),
+
+ %% try deep collisions
+ %% statistically we get another subtree at 50k -> 100k elements
+ %% Try to be nice and don't use too much memory in the testcase,
+
+ N = 500000,
+ Is = lists:seq(1,N),
+ N = map_size(maps:from_list([{I,I}||I<-Is])),
+ N = map_size(maps:from_list([{<<I:32>>,I}||I<-Is])),
+ N = map_size(maps:from_list([{integer_to_list(I),I}||I<-Is])),
+ N = map_size(maps:from_list([{float(I),I}||I<-Is])),
+
%% Error cases.
- {'EXIT',{badarg,_}} = (catch map_size([])),
- {'EXIT',{badarg,_}} = (catch map_size(<<1,2,3>>)),
- {'EXIT',{badarg,_}} = (catch map_size(1)),
+ do_badmap(fun(T) ->
+ {'EXIT',{{badmap,T},_}} =
+ (catch map_size(T))
+ end),
+ ok.
+
+build_and_check_size([K|Ks],N,M0) ->
+ N = map_size(M0),
+ M1 = M0#{ K => K },
+ build_and_check_size(Ks,N + 1,M1);
+build_and_check_size([],N,M) ->
+ N = map_size(M),
ok.
map_is_size(M,N) when map_size(M) =:= N -> true;
map_is_size(_,_) -> false.
+t_is_map(Config) when is_list(Config) ->
+ true = is_map(#{}),
+ true = is_map(#{a=>1}),
+ false = is_map({a,b}),
+ false = is_map(x),
+ if is_map(#{}) -> ok end,
+ if is_map(#{b=>1}) -> ok end,
+ if not is_map([1,2,3]) -> ok end,
+ if not is_map(x) -> ok end,
+ ok.
+
% test map updates without matching
+t_update_literals_large(Config) when is_list(Config) ->
+ Map = id(#{ 10=>id(a0),20=>b0,30=>id("c0"),"40"=>"d0",<<"50">>=>id("e0"),{["00"]}=>"10",
+ 11=>id(a1),21=>b1,31=>id("c1"),"41"=>"d1",<<"51">>=>id("e1"),{["01"]}=>"11",
+ 12=>id(a2),22=>b2,32=>id("c2"),"42"=>"d2",<<"52">>=>id("e2"),{["02"]}=>"12",
+ 13=>id(a3),23=>b3,33=>id("c3"),"43"=>"d3",<<"53">>=>id("e3"),{["03"]}=>"13",
+ 14=>id(a4),24=>b4,34=>id("c4"),"44"=>"d4",<<"54">>=>id("e4"),{["04"]}=>"14",
+
+ 15=>id(a5),25=>b5,35=>id("c5"),"45"=>"d5",<<"55">>=>id("e5"),{["05"]}=>"15",
+ 16=>id(a6),26=>b6,36=>id("c6"),"46"=>"d6",<<"56">>=>id("e6"),{["06"]}=>"16",
+ 17=>id(a7),27=>b7,37=>id("c7"),"47"=>"d7",<<"57">>=>id("e7"),{["07"]}=>"17",
+ 18=>id(a8),28=>b8,38=>id("c8"),"48"=>"d8",<<"58">>=>id("e8"),{["08"]}=>"18",
+ 19=>id(a9),29=>b9,39=>id("c9"),"49"=>"d9",<<"59">>=>id("e9"),{["09"]}=>"19",
+
+ 10.0=>fa0,20.0=>id(fb0),30.0=>id("fc0"),
+ 11.0=>fa1,21.0=>id(fb1),31.0=>id("fc1"),
+ 12.0=>fa2,22.0=>id(fb2),32.0=>id("fc2"),
+ 13.0=>fa3,23.0=>id(fb3),33.0=>id("fc3"),
+ 14.0=>fa4,24.0=>id(fb4),34.0=>id("fc4"),
+
+ 15.0=>fa5,25.0=>id(fb5),35.0=>id("fc5"),
+ 16.0=>fa6,26.0=>id(fb6),36.0=>id("fc6"),
+ 17.0=>fa7,27.0=>id(fb7),37.0=>id("fc7"),
+ 18.0=>fa8,28.0=>id(fb8),38.0=>id("fc8"),
+ 19.0=>fa9,29.0=>id(fb9),39.0=>id("fc9"),
+
+ #{ one => small, map => key } => id("small map key 1"),
+ #{ second => small, map => key } => "small map key 2",
+ #{ third => small, map => key } => "small map key 3",
+
+ #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10",
+ 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11",
+ 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12",
+ 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13",
+ 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14",
+
+ 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15",
+ 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16",
+ 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17",
+ 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18",
+ 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1",
+
+ #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10",
+ 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11",
+ 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12",
+ 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13",
+ 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14",
+
+ 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15",
+ k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16",
+ 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17",
+ 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18",
+ 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => id("large map key 2") }),
+
+ #{x:="d",q:="4"} = loop_update_literals_x_q(Map, [
+ {"a","1"},{"b","2"},{"c","3"},{"d","4"}
+ ]),
+ ok.
+
t_update_literals(Config) when is_list(Config) ->
Map = #{x=>1,y=>2,z=>3,q=>4},
#{x:="d",q:="4"} = loop_update_literals_x_q(Map, [
@@ -189,13 +768,15 @@ t_update_literals(Config) when is_list(Config) ->
]),
ok.
+
loop_update_literals_x_q(Map, []) -> Map;
loop_update_literals_x_q(Map, [{X,Q}|Vs]) ->
loop_update_literals_x_q(Map#{q=>Q,x=>X},Vs).
% test map updates with matching
t_match_and_update_literals(Config) when is_list(Config) ->
- Map = #{x=>0,y=>"untouched",z=>"also untouched",q=>1},
+ Map = #{ x=>0,y=>"untouched",z=>"also untouched",q=>1,
+ #{ "one" => small, map => key } => "small map key 1" },
#{x:=16,q:=21,y:="untouched",z:="also untouched"} = loop_match_and_update_literals_x_q(Map, [
{1,2},{3,4},{5,6},{7,8}
]),
@@ -209,8 +790,78 @@ t_match_and_update_literals(Config) when is_list(Config) ->
#{ 4 := another_number, int := 3 } = M2#{ 4 => another_number },
ok.
+t_match_and_update_literals_large(Config) when is_list(Config) ->
+ Map = id(#{ 10=>id(a0),20=>b0,30=>id("c0"),"40"=>"d0",<<"50">>=>id("e0"),{["00"]}=>"10",
+ 11=>id(a1),21=>b1,31=>id("c1"),"41"=>"d1",<<"51">>=>id("e1"),{["01"]}=>"11",
+ 12=>id(a2),22=>b2,32=>id("c2"),"42"=>"d2",<<"52">>=>id("e2"),{["02"]}=>"12",
+ 13=>id(a3),23=>b3,33=>id("c3"),"43"=>"d3",<<"53">>=>id("e3"),{["03"]}=>"13",
+ 14=>id(a4),24=>b4,34=>id("c4"),"44"=>"d4",<<"54">>=>id("e4"),{["04"]}=>"14",
+
+ 15=>id(a5),25=>b5,35=>id("c5"),"45"=>"d5",<<"55">>=>id("e5"),{["05"]}=>"15",
+ 16=>id(a6),26=>b6,36=>id("c6"),"46"=>"d6",<<"56">>=>id("e6"),{["06"]}=>"16",
+ 17=>id(a7),27=>b7,37=>id("c7"),"47"=>"d7",<<"57">>=>id("e7"),{["07"]}=>"17",
+ 18=>id(a8),28=>b8,38=>id("c8"),"48"=>"d8",<<"58">>=>id("e8"),{["08"]}=>"18",
+ 19=>id(a9),29=>b9,39=>id("c9"),"49"=>"d9",<<"59">>=>id("e9"),{["09"]}=>"19",
+
+ 10.0=>fa0,20.0=>id(fb0),30.0=>id("fc0"),
+ 11.0=>fa1,21.0=>id(fb1),31.0=>id("fc1"),
+ 12.0=>fa2,22.0=>id(fb2),32.0=>id("fc2"),
+ 13.0=>fa3,23.0=>id(fb3),33.0=>id("fc3"),
+ 14.0=>fa4,24.0=>id(fb4),34.0=>id("fc4"),
+
+ 15.0=>fa5,25.0=>id(fb5),35.0=>id("fc5"),
+ 16.0=>fa6,26.0=>id(fb6),36.0=>id("fc6"),
+ 17.0=>fa7,27.0=>id(fb7),37.0=>id("fc7"),
+ 18.0=>fa8,28.0=>id(fb8),38.0=>id("fc8"),
+ 19.0=>fa9,29.0=>id(fb9),39.0=>id("fc9"),
+
+ x=>0,y=>"untouched",z=>"also untouched",q=>1,
+
+ #{ "one" => small, map => key } => id("small map key 1"),
+ #{ second => small, map => key } => "small map key 2",
+ #{ third => small, map => key } => "small map key 3",
+
+ #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10",
+ 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11",
+ 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12",
+ 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13",
+ 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14",
+
+ 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15",
+ 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16",
+ 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17",
+ 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18",
+ 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1",
+
+ #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10",
+ 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11",
+ 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12",
+ 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13",
+ 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14",
+
+ 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15",
+ k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16",
+ 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17",
+ 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18",
+ 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => id("large map key 2") }),
+
+ #{x:=16,q:=21,y:="untouched",z:="also untouched"} = loop_match_and_update_literals_x_q(Map, [
+ {1,2},{3,4},{5,6},{7,8}
+ ]),
+ M0 = id(Map#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>,
+ 4 => number, 18446744073709551629 => wat}),
+ M1 = id(Map#{}),
+ M2 = M1#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>,
+ 4 => number, 18446744073709551629 => wat},
+ M0 = M2,
+
+ #{ 4 := another_number, int := 3 } = M2#{ 4 => another_number },
+ ok.
+
+
loop_match_and_update_literals_x_q(Map, []) -> Map;
-loop_match_and_update_literals_x_q(#{q:=Q0,x:=X0} = Map, [{X,Q}|Vs]) ->
+loop_match_and_update_literals_x_q(#{ q:=Q0, x:=X0,
+ #{ "one" => small, map => key } := "small map key 1" } = Map, [{X,Q}|Vs]) ->
loop_match_and_update_literals_x_q(Map#{q=>Q0+Q,x=>X0+X},Vs).
@@ -222,13 +873,17 @@ t_update_map_expressions(Config) when is_list(Config) ->
#{ a :=42, b:=42, c:=42 } = (maps:from_list([{a,1},{b,2},{c,3}]))#{ a := 42, b := 42, c := 42 },
#{ "a" :=1, "b":=42, "c":=42 } = (maps:from_list([{"a",1},{"b",2}]))#{ "b" := 42, "c" => 42 },
+ Ks = lists:seq($a,$z),
+ #{ "aa" := {$a,$a}, "ac":=41, "dc":=42 } =
+ (maps:from_list([{[K1,K2],{K1,K2}}|| K1 <- Ks, K2 <- Ks]))#{ "ac" := 41, "dc" => 42 },
- %% Error cases, FIXME: should be 'badmap'?
- {'EXIT',{badarg,_}} = (catch (id(<<>>))#{ a := 42, b => 2 }),
- {'EXIT',{badarg,_}} = (catch (id([]))#{ a := 42, b => 2 }),
+ %% Error cases.
+ do_badmap(fun(T) ->
+ {'EXIT',{{badmap,T},_}} =
+ (catch (T)#{a:=42,b=>2})
+ end),
ok.
-
t_update_assoc(Config) when is_list(Config) ->
M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}),
@@ -241,8 +896,75 @@ t_update_assoc(Config) when is_list(Config) ->
M2 = M0#{3.0:=wrong,3.0=>new},
%% Errors cases.
- BadMap = id(badmap),
- {'EXIT',{badarg,_}} = (catch BadMap#{nonexisting=>val}),
+ do_badmap(fun(T) ->
+ {'EXIT',{{badmap,T},_}} =
+ (catch T#{nonexisting=>val})
+ end),
+ ok.
+
+
+t_update_assoc_large(Config) when is_list(Config) ->
+ M0 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10",
+ 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11",
+ 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12",
+ 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13",
+ 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14",
+
+ 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15",
+ 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16",
+ 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17",
+ 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18",
+ 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19",
+
+ 10.0=>fa0,20.0=>fb0,30.0=>"fc0",
+ 11.0=>fa1,21.0=>fb1,31.0=>"fc1",
+ 12.0=>fa2,22.0=>fb2,32.0=>"fc2",
+ 13.0=>fa3,23.0=>fb3,33.0=>"fc3",
+ 14.0=>fa4,24.0=>fb4,34.0=>"fc4",
+
+ 15.0=>fa5,25.0=>fb5,35.0=>"fc5",
+ 16.0=>fa6,26.0=>fb6,36.0=>"fc6",
+ 17.0=>fa7,27.0=>fb7,37.0=>"fc7",
+ 18.0=>fa8,28.0=>fb8,38.0=>"fc8",
+ 19.0=>fa9,29.0=>fb9,39.0=>"fc9",
+
+ #{ one => small, map => key } => "small map key 1",
+ #{ second => small, map => key } => "small map key 2",
+ #{ third => small, map => key } => "small map key 3",
+
+ #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10",
+ 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11",
+ 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12",
+ 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13",
+ 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14",
+
+ 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15",
+ 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16",
+ 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17",
+ 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18",
+ 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1",
+
+ #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10",
+ 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11",
+ 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12",
+ 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13",
+ 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14",
+
+ 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15",
+ k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16",
+ 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17",
+ 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18",
+ 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }),
+
+
+ M1 = M0#{1=>42,2=>100,4=>[a,b,c]},
+ #{1:=42,2:=100,10.0:=fa0,4:=[a,b,c],25:=b5} = M1,
+ #{ 10:=43, 24:=b4, 15:=a5, 35:="c5", 2.0:=100, 13.0:=fa3, 4.0:=[a,b,c]} =
+ M0#{1.0=>float,10:=43,2.0=>wrong,2.0=>100,4.0=>[a,b,c]},
+
+ M2 = M0#{13.0=>new},
+ #{10:=a0,20:=b0,13.0:=new,"40":="d0",<<"50">>:="e0"} = M2,
+ M2 = M0#{13.0:=wrong,13.0=>new},
ok.
@@ -265,15 +987,124 @@ t_update_exact(Config) when is_list(Config) ->
1 := update2, 1.0 := new_val2, 1.0 => new_val3,
1.0 => new_val4 },
+ %% Errors cases.
+ do_badmap(fun(T) ->
+ {'EXIT',{{badmap,T},_}} =
+ (catch T#{nonexisting=>val})
+ end),
+ Empty = id(#{}),
+ {'EXIT',{{badkey,nonexisting},_}} = (catch Empty#{nonexisting:=val}),
+ {'EXIT',{{badkey,nonexisting},_}} = (catch M0#{nonexisting:=val}),
+ {'EXIT',{{badkey,1.0},_}} = (catch M0#{1.0:=v,1.0=>v2}),
+ {'EXIT',{{badkey,42},_}} = (catch M0#{42.0:=v,42:=v2}),
+ {'EXIT',{{badkey,42.0},_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}),
+
+ ok.
+
+t_update_exact_large(Config) when is_list(Config) ->
+ M0 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10",
+ 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11",
+ 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12",
+ 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13",
+ 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14",
+
+ 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15",
+ 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16",
+ 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17",
+ 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18",
+ 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19",
+
+ 10.0=>fa0,20.0=>fb0,30.0=>"fc0",
+ 11.0=>fa1,21.0=>fb1,31.0=>"fc1",
+ 12.0=>fa2,22.0=>fb2,32.0=>"fc2",
+ 13.0=>fa3,23.0=>fb3,33.0=>"fc3",
+ 14.0=>fa4,24.0=>fb4,34.0=>"fc4",
+
+ 15.0=>fa5,25.0=>fb5,35.0=>"fc5",
+ 16.0=>fa6,26.0=>fb6,36.0=>"fc6",
+ 17.0=>fa7,27.0=>fb7,37.0=>"fc7",
+ 18.0=>fa8,28.0=>fb8,38.0=>"fc8",
+ 19.0=>fa9,29.0=>fb9,39.0=>"fc9",
+
+ #{ one => small, map => key } => "small map key 1",
+ #{ second => small, map => key } => "small map key 2",
+ #{ third => small, map => key } => "small map key 3",
+
+ #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10",
+ 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11",
+ 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12",
+ 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13",
+ 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14",
+
+ 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15",
+ 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16",
+ 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17",
+ 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18",
+ 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1",
+
+ #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10",
+ 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11",
+ 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12",
+ 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13",
+ 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14",
+
+ 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15",
+ k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16",
+ 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17",
+ 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18",
+ 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }),
+
+
+ M1 = M0#{10:=42,<<"55">>:=100,10.0:=[a,b,c]},
+ #{ 10:=42,<<"55">>:=100,{["05"]}:="15",10.0:=[a,b,c],
+ #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10",
+ 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11",
+ 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12",
+ 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13",
+ 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14",
+
+ 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15",
+ 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16",
+ 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17",
+ 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18",
+ 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := "large map key 1" } = M1,
+
+ M1 = M0#{10:=wrong,10=>42,<<"55">>=>wrong,<<"55">>:=100,10.0:=[a,b,c]},
+
+ M2 = M0#{13.0:=new},
+ #{10:=a0,20:=b0,13.0:=new} = M2,
+ M2 = M0#{13.0=>wrong,13.0:=new},
%% Errors cases.
- {'EXIT',{badarg,_}} = (catch M0#{nonexisting:=val}),
- {'EXIT',{badarg,_}} = (catch M0#{1.0:=v,1.0=>v2}),
- {'EXIT',{badarg,_}} = (catch M0#{42.0:=v,42:=v2}),
- {'EXIT',{badarg,_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}),
+ {'EXIT',{{badkey,nonexisting},_}} = (catch M0#{nonexisting:=val}),
+ {'EXIT',{{badkey,1.0},_}} = (catch M0#{1.0:=v,1.0=>v2}),
+ {'EXIT',{{badkey,42},_}} = (catch M0#{42.0:=v,42:=v2}),
+ {'EXIT',{{badkey,42.0},_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}),
ok.
+t_update_deep(Config) when is_list(Config) ->
+ N = 250000,
+ M0 = maps:from_list([{integer_to_list(I),a}||I<-lists:seq(1,N)]),
+ #{ "1" := a, "10" := a, "100" := a, "1000" := a, "10000" := a } = M0,
+
+ M1 = M0#{ "1" := b, "10" := b, "100" := b, "1000" := b, "10000" := b },
+ #{ "1" := a, "10" := a, "100" := a, "1000" := a, "10000" := a } = M0,
+ #{ "1" := b, "10" := b, "100" := b, "1000" := b, "10000" := b } = M1,
+
+ M2 = M0#{ "1" => c, "10" => c, "100" => c, "1000" => c, "10000" => c },
+ #{ "1" := a, "10" := a, "100" := a, "1000" := a, "10000" := a } = M0,
+ #{ "1" := b, "10" := b, "100" := b, "1000" := b, "10000" := b } = M1,
+ #{ "1" := c, "10" := c, "100" := c, "1000" := c, "10000" := c } = M2,
+
+ M3 = M2#{ "n1" => d, "n10" => d, "n100" => d, "n1000" => d, "n10000" => d },
+ #{ "1" := a, "10" := a, "100" := a, "1000" := a, "10000" := a } = M0,
+ #{ "1" := b, "10" := b, "100" := b, "1000" := b, "10000" := b } = M1,
+ #{ "1" := c, "10" := c, "100" := c, "1000" := c, "10000" := c } = M2,
+ #{ "1" := c, "10" := c, "100" := c, "1000" := c, "10000" := c } = M3,
+ #{ "n1" := d, "n10" := d, "n100" := d, "n1000" := d, "n10000" := d } = M3,
+ ok.
+
t_guard_bifs(Config) when is_list(Config) ->
true = map_guard_head(#{a=>1}),
false = map_guard_head([]),
@@ -303,12 +1134,82 @@ t_guard_sequence(Config) when is_list(Config) ->
{3,gg,M3} = map_guard_sequence_2(M3 = id(#{a=>gg, b=>4})),
{4,sc,sc,M4} = map_guard_sequence_2(M4 = id(#{a=>sc, b=>3, c=>sc2})),
{5,kk,kk,M5} = map_guard_sequence_2(M5 = id(#{a=>kk, b=>other, c=>sc2})),
-
+
%% error case
{'EXIT',{function_clause,_}} = (catch map_guard_sequence_1(#{seq=>6,val=>id("e")})),
{'EXIT',{function_clause,_}} = (catch map_guard_sequence_2(#{b=>5})),
ok.
+t_guard_sequence_large(Config) when is_list(Config) ->
+ M0 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00",03]}=>"10",
+ 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01",03]}=>"11",
+ 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02",03]}=>"12",
+ 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03",03]}=>"13",
+ 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04",03]}=>"14",
+
+ 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05",03]}=>"15",
+ 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06",03]}=>"16",
+ 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07",03]}=>"17",
+ 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08",03]}=>"18",
+ 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09",03]}=>"19",
+
+ 10.0=>fa0,20.0=>fb0,30.0=>"fc0",
+ 11.0=>fa1,21.0=>fb1,31.0=>"fc1",
+ 12.0=>fa2,22.0=>fb2,32.0=>"fc2",
+ 13.0=>fa3,23.0=>fb3,33.0=>"fc3",
+ 14.0=>fa4,24.0=>fb4,34.0=>"fc4",
+
+ 15.0=>fa5,25.0=>fb5,35.0=>"fc5",
+ 16.0=>fa6,26.0=>fb6,36.0=>"fc6",
+ 17.0=>fa7,27.0=>fb7,37.0=>"fc7",
+ 18.0=>fa8,28.0=>fb8,38.0=>"fc8",
+ 19.0=>fa9,29.0=>fb9,39.0=>"fc9",
+
+ #{ one => small, map => key } => "small map key 1",
+ #{ second => small, map => key } => "small map key 2",
+ #{ third => small, map => key } => "small map key 3",
+
+ #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10",
+ 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11",
+ 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12",
+ 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13",
+ 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14",
+
+ 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15",
+ 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16",
+ 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17",
+ 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18",
+ 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1",
+
+ #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10",
+ 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11",
+ 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12",
+ 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13",
+ 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14",
+
+ 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15",
+ k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16",
+ 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17",
+ 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18",
+ 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }),
+
+ {1, "a"} = map_guard_sequence_1(M0#{seq=>1,val=>id("a")}),
+ {2, "b"} = map_guard_sequence_1(M0#{seq=>2,val=>id("b")}),
+ {3, "c"} = map_guard_sequence_1(M0#{seq=>3,val=>id("c")}),
+ {4, "d"} = map_guard_sequence_1(M0#{seq=>4,val=>id("d")}),
+ {5, "e"} = map_guard_sequence_1(M0#{seq=>5,val=>id("e")}),
+
+ {1,M1} = map_guard_sequence_2(M1 = id(M0#{a=>3})),
+ {2,M2} = map_guard_sequence_2(M2 = id(M0#{a=>4, b=>4})),
+ {3,gg,M3} = map_guard_sequence_2(M3 = id(M0#{a=>gg, b=>4})),
+ {4,sc,sc,M4} = map_guard_sequence_2(M4 = id(M0#{a=>sc, b=>3, c=>sc2})),
+ {5,kk,kk,M5} = map_guard_sequence_2(M5 = id(M0#{a=>kk, b=>other, c=>sc2})),
+
+ {'EXIT',{function_clause,_}} = (catch map_guard_sequence_1(M0#{seq=>6,val=>id("e")})),
+ {'EXIT',{function_clause,_}} = (catch map_guard_sequence_2(M0#{b=>5})),
+ ok.
+
+
map_guard_sequence_1(#{seq:=1=Seq, val:=Val}) -> {Seq,Val};
map_guard_sequence_1(#{seq:=2=Seq, val:=Val}) -> {Seq,Val};
map_guard_sequence_1(#{seq:=3=Seq, val:=Val}) -> {Seq,Val};
@@ -328,6 +1229,66 @@ t_guard_update(Config) when is_list(Config) ->
second = map_guard_update(#{y=>old}, #{x=>second,y=>old}),
ok.
+t_guard_update_large(Config) when is_list(Config) ->
+ M0 = id(#{ 70=>a0,80=>b0,90=>"c0","40"=>"d0",<<"50">>=>"e0",{["00",03]}=>"10",
+ 71=>a1,81=>b1,91=>"c1","41"=>"d1",<<"51">>=>"e1",{["01",03]}=>"11",
+ 72=>a2,82=>b2,92=>"c2","42"=>"d2",<<"52">>=>"e2",{["02",03]}=>"12",
+ 73=>a3,83=>b3,93=>"c3","43"=>"d3",<<"53">>=>"e3",{["03",03]}=>"13",
+ 74=>a4,84=>b4,94=>"c4","44"=>"d4",<<"54">>=>"e4",{["04",03]}=>"14",
+
+ 75=>a5,85=>b5,95=>"c5","45"=>"d5",<<"55">>=>"e5",{["05",03]}=>"15",
+ 76=>a6,86=>b6,96=>"c6","46"=>"d6",<<"56">>=>"e6",{["06",03]}=>"16",
+ 77=>a7,87=>b7,97=>"c7","47"=>"d7",<<"57">>=>"e7",{["07",03]}=>"17",
+ 78=>a8,88=>b8,98=>"c8","48"=>"d8",<<"58">>=>"e8",{["08",03]}=>"18",
+ 79=>a9,89=>b9,99=>"c9","49"=>"d9",<<"59">>=>"e9",{["09",03]}=>"19",
+
+ 70.0=>fa0,80.0=>fb0,90.0=>"fc0",
+ 71.0=>fa1,81.0=>fb1,91.0=>"fc1",
+ 72.0=>fa2,82.0=>fb2,92.0=>"fc2",
+ 73.0=>fa3,83.0=>fb3,93.0=>"fc3",
+ 74.0=>fa4,84.0=>fb4,94.0=>"fc4",
+
+ 75.0=>fa5,85.0=>fb5,95.0=>"fc5",
+ 76.0=>fa6,86.0=>fb6,96.0=>"fc6",
+ 77.0=>fa7,87.0=>fb7,97.0=>"fc7",
+ 78.0=>fa8,88.0=>fb8,98.0=>"fc8",
+ 79.0=>fa9,89.0=>fb9,99.0=>"fc9",
+
+ #{ one => small, map => key } => "small map key 1",
+ #{ second => small, map => key } => "small map key 2",
+ #{ third => small, map => key } => "small map key 3",
+
+ #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10",
+ 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11",
+ 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12",
+ 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13",
+ 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14",
+
+ 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15",
+ 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16",
+ 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17",
+ 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18",
+ 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1",
+
+ #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10",
+ 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11",
+ 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12",
+ 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13",
+ 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14",
+
+ 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15",
+ k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16",
+ 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17",
+ 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18",
+ 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }),
+
+
+ error = map_guard_update(M0#{},M0#{}),
+ first = map_guard_update(M0#{},M0#{x=>first}),
+ second = map_guard_update(M0#{y=>old}, M0#{x=>second,y=>old}),
+ ok.
+
+
map_guard_update(M1, M2) when M1#{x=>first} =:= M2 -> first;
map_guard_update(M1, M2) when M1#{x=>second} =:= M2 -> second;
map_guard_update(_, _) -> error.
@@ -357,6 +1318,42 @@ t_guard_receive(Config) when is_list(Config) ->
done = call(Pid, done),
ok.
+-define(t_guard_receive_large_procs, 1500).
+
+t_guard_receive_large(Config) when is_list(Config) ->
+ M = lists:foldl(fun(_,#{procs := Ps } = M) ->
+ M#{ procs := Ps#{ spawn_link(fun() -> grecv_loop() end) => 0 }}
+ end, #{procs => #{}, done => 0}, lists:seq(1,?t_guard_receive_large_procs)),
+ lists:foreach(fun(Pid) ->
+ Pid ! {self(), hello}
+ end, maps:keys(maps:get(procs,M))),
+ ok = guard_receive_large_loop(M),
+ ok.
+
+guard_receive_large_loop(#{done := ?t_guard_receive_large_procs}) ->
+ ok;
+guard_receive_large_loop(M) ->
+ receive
+ #{pid := Pid, msg := hello} ->
+ case M of
+ #{done := Count, procs := #{Pid := 150}} ->
+ Pid ! {self(), done},
+ guard_receive_large_loop(M#{done := Count + 1});
+ #{procs := #{Pid := Count} = Ps} ->
+ Pid ! {self(), hello},
+ guard_receive_large_loop(M#{procs := Ps#{Pid := Count + 1}})
+ end
+ end.
+
+grecv_loop() ->
+ receive
+ {_, done} ->
+ ok;
+ {Pid, hello} ->
+ Pid ! #{pid=>self(), msg=>hello},
+ grecv_loop()
+ end.
+
call(Pid, M) ->
Pid ! {self(), M}, receive {Pid, Res} -> Res end.
@@ -387,6 +1384,11 @@ guard_receive_loop() ->
t_list_comprehension(Config) when is_list(Config) ->
[#{k:=1},#{k:=2},#{k:=3}] = [#{k=>I} || I <- [1,2,3]],
+
+ Ks = lists:seq($a,$z),
+ Ms = [#{[K1,K2]=>{K1,K2}} || K1 <- Ks, K2 <- Ks],
+ [#{"aa" := {$a,$a}},#{"ab":={$a,$b}}|_] = Ms,
+ [#{"zz" := {$z,$z}},#{"zy":={$z,$y}}|_] = lists:reverse(Ms),
ok.
t_guard_fun(Config) when is_list(Config) ->
@@ -432,7 +1434,7 @@ t_map_sort_literals(Config) when is_list(Config) ->
true = #{ c => 1, b => 1, a => 1 } < id(#{ b => 1, c => 1, d => 1}),
true = #{ "a" => 1 } < id(#{ <<"a">> => 1}),
false = #{ <<"a">> => 1 } < id(#{ "a" => 1}),
- false = #{ 1 => 1 } < id(#{ 1.0 => 1}),
+ true = #{ 1 => 1 } < id(#{ 1.0 => 1}),
false = #{ 1.0 => 1 } < id(#{ 1 => 1}),
%% value order
@@ -440,16 +1442,47 @@ t_map_sort_literals(Config) when is_list(Config) ->
false = #{ a => 2 } < id(#{ a => 1}),
false = #{ a => 2, b => 1 } < id(#{ a => 1, b => 3}),
true = #{ a => 1, b => 1 } < id(#{ a => 1, b => 3}),
+ false = #{ a => 1 } < id(#{ a => 1.0}),
+ false = #{ a => 1.0 } < id(#{ a => 1}),
true = #{ "a" => "hi", b => 134 } == id(#{ b => 134,"a" => "hi"}),
+ %% large maps
+
+ M = maps:from_list([{I,I}||I <- lists:seq(1,500)]),
+
+ %% size order
+ true = M#{ a => 1, b => 2} < id(M#{ a => 1, b => 1, c => 1}),
+ true = M#{ b => 1, a => 1} < id(M#{ c => 1, a => 1, b => 1}),
+ false = M#{ c => 1, b => 1, a => 1} < id(M#{ c => 1, a => 1}),
+
+ %% key order
+ true = M#{ a => 1 } < id(M#{ b => 1}),
+ false = M#{ b => 1 } < id(M#{ a => 1}),
+ true = M#{ a => 1, b => 1, c => 1 } < id(M#{ b => 1, c => 1, d => 1}),
+ true = M#{ b => 1, c => 1, d => 1 } > id(M#{ a => 1, b => 1, c => 1}),
+ true = M#{ c => 1, b => 1, a => 1 } < id(M#{ b => 1, c => 1, d => 1}),
+ true = M#{ "a" => 1 } < id(M#{ <<"a">> => 1}),
+ false = M#{ <<"a">> => 1 } < id(#{ "a" => 1}),
+ true = M#{ 1 => 1 } < id(maps:remove(1,M#{ 1.0 => 1})),
+ false = M#{ 1.0 => 1 } < id(M#{ 1 => 1}),
+
+ %% value order
+ true = M#{ a => 1 } < id(M#{ a => 2}),
+ false = M#{ a => 2 } < id(M#{ a => 1}),
+ false = M#{ a => 2, b => 1 } < id(M#{ a => 1, b => 3}),
+ true = M#{ a => 1, b => 1 } < id(M#{ a => 1, b => 3}),
+ false = M#{ a => 1 } < id(M#{ a => 1.0}),
+ false = M#{ a => 1.0 } < id(M#{ a => 1}),
+
+ true = M#{ "a" => "hi", b => 134 } == id(M#{ b => 134,"a" => "hi"}),
+
%% lists:sort
SortVs = [#{"a"=>1},#{a=>2},#{1=>3},#{<<"a">>=>4}],
[#{1:=ok},#{a:=ok},#{"a":=ok},#{<<"a">>:=ok}] = lists:sort([#{"a"=>ok},#{a=>ok},#{1=>ok},#{<<"a">>=>ok}]),
[#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(SortVs),
[#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(lists:reverse(SortVs)),
-
ok.
t_map_equal(Config) when is_list(Config) ->
@@ -469,27 +1502,268 @@ t_map_equal(Config) when is_list(Config) ->
true = id(#{ a => 1, b => 3, c => <<"wat">> }) =:= id(#{ a => 1, b => 3, c=><<"wat">>}),
ok.
+
+t_map_compare(Config) when is_list(Config) ->
+ 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.
+
+float_int_compare() ->
+ Terms = numeric_keys(3),
+ %%io:format("Keys to use: ~p\n", [Terms]),
+ Pairs = lists:map(fun(K) -> list_to_tuple([{K,V} || V <- Terms]) end, Terms),
+ lists:foreach(fun(Size) ->
+ MapGen = fun() -> map_gen(list_to_tuple(Pairs), Size) end,
+ repeat(100, fun do_compare/1, [MapGen, MapGen])
+ end,
+ lists:seq(1,length(Terms))),
+ ok.
+
+numeric_keys(N) ->
+ lists:foldl(fun(_,Acc) ->
+ Int = rand:uniform(N*4) - N*2,
+ Float = float(Int),
+ [Int, Float, Float * 0.99, Float * 1.01 | Acc]
+ end,
+ [],
+ lists:seq(1,N)).
+
+
+repeat(0, _, _) ->
+ ok;
+repeat(N, Fun, Arg) ->
+ Fun(Arg),
+ repeat(N-1, Fun, Arg).
+
+copy_term(T) ->
+ Papa = self(),
+ P = spawn_link(fun() -> receive Msg -> Papa ! Msg end end),
+ P ! T,
+ receive R -> R end.
+
+do_compare([Gen1, Gen2]) ->
+ M1 = Gen1(),
+ M2 = Gen2(),
+ %%io:format("Maps to compare: ~p AND ~p\n", [M1, M2]),
+ C = (M1 < M2),
+ Erlang = maps_lessthan(M1, M2),
+ C = Erlang,
+ ?CHECK(M1==M1, M1),
+
+ %% Change one key from int to float (or vice versa) and check compare
+ ML1 = maps:to_list(M1),
+ {K1,V1} = lists:nth(rand:uniform(length(ML1)), ML1),
+ case K1 of
+ I when is_integer(I) ->
+ case maps:find(float(I),M1) of
+ error ->
+ M1f = maps:remove(I, maps:put(float(I), V1, M1)),
+ ?CHECK(M1f > M1, [M1f, M1]);
+ _ -> ok
+ end;
+
+ F when is_float(F), round(F) == F ->
+ case maps:find(round(F),M1) of
+ error ->
+ M1i = maps:remove(F, maps:put(round(F), V1, M1)),
+ ?CHECK(M1i < M1, [M1i, M1]);
+ _ -> ok
+ end;
+
+ _ -> ok % skip floats with decimals
+ end,
+
+ ?CHECK(M2 == M2, [M2]).
+
+
+maps_lessthan(M1, M2) ->
+ case {maps:size(M1),maps:size(M2)} of
+ {_S,_S} ->
+ {K1,V1} = lists:unzip(term_sort(maps:to_list(M1))),
+ {K2,V2} = lists:unzip(term_sort(maps:to_list(M2))),
+
+ case erts_internal:cmp_term(K1,K2) of
+ -1 -> true;
+ 0 -> (V1 < V2);
+ 1 -> false
+ end;
+
+ {S1, S2} ->
+ S1 < S2
+ end.
+
+term_sort(L) ->
+ lists:sort(fun(A,B) -> erts_internal:cmp_term(A,B) =< 0 end,
+ L).
+
+
+cmp(T1, T2, Exact) when is_tuple(T1) and is_tuple(T2) ->
+ case {size(T1),size(T2)} of
+ {_S,_S} -> cmp(tuple_to_list(T1), tuple_to_list(T2), Exact);
+ {S1,S2} when S1 < S2 -> -1;
+ {S1,S2} when S1 > S2 -> 1
+ end;
+
+cmp([H1|T1], [H2|T2], Exact) ->
+ case cmp(H1,H2, Exact) of
+ 0 -> cmp(T1,T2, Exact);
+ C -> C
+ end;
+
+cmp(M1, M2, Exact) when is_map(M1) andalso is_map(M2) ->
+ cmp_maps(M1,M2,Exact);
+cmp(M1, M2, Exact) ->
+ cmp_others(M1, M2, Exact).
+
+cmp_maps(M1, M2, Exact) ->
+ case {maps:size(M1),maps:size(M2)} of
+ {_S,_S} ->
+ {K1,V1} = lists:unzip(term_sort(maps:to_list(M1))),
+ {K2,V2} = lists:unzip(term_sort(maps:to_list(M2))),
+
+ case cmp(K1, K2, true) of
+ 0 -> cmp(V1, V2, Exact);
+ C -> C
+ end;
+
+ {S1,S2} when S1 < S2 -> -1;
+ {S1,S2} when S1 > S2 -> 1
+ end.
+
+cmp_others(I, F, true) when is_integer(I), is_float(F) ->
+ -1;
+cmp_others(F, I, true) when is_float(F), is_integer(I) ->
+ 1;
+cmp_others(T1, T2, _) ->
+ case {T1<T2, T1==T2} of
+ {true,false} -> -1;
+ {false,true} -> 0;
+ {false,false} -> 1
+ end.
+
+map_gen(Pairs, Size) ->
+ {_,L} = lists:foldl(fun(_, {Keys, Acc}) ->
+ KI = rand:uniform(size(Keys)),
+ K = element(KI,Keys),
+ KV = element(rand:uniform(size(K)), K),
+ {erlang:delete_element(KI,Keys), [KV | Acc]}
+ end,
+ {Pairs, []},
+ lists:seq(1,Size)),
+
+ maps:from_list(L).
+
+
+recursive_compare() ->
+ Leafs = {atom, 17, 16.9, 17.1, [], self(), spawn(fun() -> ok end), make_ref(), make_ref()},
+ {A, B} = term_gen_recursive(Leafs, 0, 0),
+ %%io:format("Recursive term A = ~p\n", [A]),
+ %%io:format("Recursive term B = ~p\n", [B]),
+
+ ?CHECK({true,false} =:= case do_cmp(A, B, false) of
+ -1 -> {A<B, A>=B};
+ 0 -> {A==B, A/=B};
+ 1 -> {A>B, A=<B}
+ end,
+ {A,B}),
+ A2 = copy_term(A),
+ ?CHECK(A == A2, {A,A2}),
+ ?CHECK(0 =:= cmp(A, A2, false), {A,A2}),
+
+ B2 = copy_term(B),
+ ?CHECK(B == B2, {B,B2}),
+ ?CHECK(0 =:= cmp(B, B2, false), {B,B2}),
+ ok.
+
+do_cmp(A, B, Exact) ->
+ C = cmp(A, B, Exact),
+ C.
+
+%% Generate two terms {A,B} that may only differ
+%% at float vs integer types.
+term_gen_recursive(Leafs, Flags, Depth) ->
+ MaxDepth = 10,
+ Rnd = case {Flags, Depth} of
+ {_, MaxDepth} -> % Only leafs
+ rand:uniform(size(Leafs)) + 3;
+ {0, 0} -> % Only containers
+ rand:uniform(3);
+ {0,_} -> % Anything
+ rand:uniform(size(Leafs)+3)
+ end,
+ case Rnd of
+ 1 -> % Make map
+ 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),
+ {maps:put(K1,V1, Acc1), maps:put(K2,V2, Acc2)}
+ end,
+ {maps:new(), maps:new()},
+ lists:seq(1,Size));
+ 2 -> % Make cons
+ {Car1,Car2} = term_gen_recursive(Leafs, Flags, Depth+1),
+ {Cdr1,Cdr2} = term_gen_recursive(Leafs, Flags, Depth+1),
+ {[Car1 | Cdr1], [Car2 | Cdr2]};
+ 3 -> % Make tuple
+ 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),
+ {list_to_tuple(L1), list_to_tuple(L2)};
+
+ N -> % Make leaf
+ case element(N-3, Leafs) of
+ I when is_integer(I) ->
+ case rand:uniform(4) of
+ 1 -> {I, float(I)};
+ 2 -> {float(I), I};
+ _ -> {I,I}
+ end;
+ T -> {T,T}
+ end
+ end.
+
+
%% BIFs
t_bif_map_get(Config) when is_list(Config) ->
-
+ %% small map
1 = maps:get(a, #{ a=> 1}),
2 = maps:get(b, #{ a=> 1, b => 2}),
"hi" = maps:get("hello", #{ a=>1, "hello" => "hi"}),
"tuple hi" = maps:get({1,1.0}, #{ a=>a, {1,1.0} => "tuple hi"}),
- M = id(#{ k1=>"v1", <<"k2">> => <<"v3">> }),
- "v4" = maps:get(<<"k2">>, M#{ <<"k2">> => "v4" }),
+ M0 = id(#{ k1=>"v1", <<"k2">> => <<"v3">> }),
+ "v4" = maps:get(<<"k2">>, M0#{<<"k2">> => "v4"}),
- %% error case
- {'EXIT',{badarg, [{maps,get,_,_}|_]}} = (catch maps:get(a,[])),
- {'EXIT',{badarg, [{maps,get,_,_}|_]}} = (catch maps:get(a,<<>>)),
- {'EXIT',{bad_key,[{maps,get,_,_}|_]}} = (catch maps:get({1,1}, #{{1,1.0} => "tuple"})),
- {'EXIT',{bad_key,[{maps,get,_,_}|_]}} = (catch maps:get(a,#{})),
- {'EXIT',{bad_key,[{maps,get,_,_}|_]}} = (catch maps:get(a,#{ b=>1, c=>2})),
+ %% large map
+ M1 = maps:from_list([{I,I}||I<-lists:seq(1,100)] ++
+ [{a,1},{b,2},{"hello","hi"},{{1,1.0},"tuple hi"},
+ {k1,"v1"},{<<"k2">>,"v3"}]),
+ 1 = maps:get(a, M1),
+ 2 = maps:get(b, M1),
+ "hi" = maps:get("hello", M1),
+ "tuple hi" = maps:get({1,1.0}, M1),
+ "v3" = maps:get(<<"k2">>, M1),
+
+ %% error cases
+ do_badmap(fun(T) ->
+ {'EXIT',{{badmap,T},[{maps,get,_,_}|_]}} =
+ (catch maps:get(a, T))
+ end),
+
+ {'EXIT',{{badkey,{1,1}},[{maps,get,_,_}|_]}} =
+ (catch maps:get({1,1}, #{{1,1.0} => "tuple"})),
+ {'EXIT',{{badkey,a},[{maps,get,_,_}|_]}} = (catch maps:get(a, #{})),
+ {'EXIT',{{badkey,a},[{maps,get,_,_}|_]}} =
+ (catch maps:get(a, #{b=>1, c=>2})),
ok.
t_bif_map_find(Config) when is_list(Config) ->
-
+ %% small map
{ok, 1} = maps:find(a, #{ a=> 1}),
{ok, 2} = maps:find(b, #{ a=> 1, b => 2}),
{ok, "int"} = maps:find(1, #{ 1 => "int"}),
@@ -498,8 +1772,18 @@ t_bif_map_find(Config) when is_list(Config) ->
{ok, "hi"} = maps:find("hello", #{ a=>1, "hello" => "hi"}),
{ok, "tuple hi"} = maps:find({1,1.0}, #{ a=>a, {1,1.0} => "tuple hi"}),
- M = id(#{ k1=>"v1", <<"k2">> => <<"v3">> }),
- {ok, "v4"} = maps:find(<<"k2">>, M#{ <<"k2">> => "v4" }),
+ M0 = id(#{ k1=>"v1", <<"k2">> => <<"v3">> }),
+ {ok, "v4"} = maps:find(<<"k2">>, M0#{ <<"k2">> => "v4" }),
+
+ %% large map
+ M1 = maps:from_list([{I,I}||I<-lists:seq(1,100)] ++
+ [{a,1},{b,2},{"hello","hi"},{{1,1.0},"tuple hi"},
+ {k1,"v1"},{<<"k2">>,"v3"}]),
+ {ok, 1} = maps:find(a, M1),
+ {ok, 2} = maps:find(b, M1),
+ {ok, "hi"} = maps:find("hello", M1),
+ {ok, "tuple hi"} = maps:find({1,1.0}, M1),
+ {ok, "v3"} = maps:find(<<"k2">>, M1),
%% error case
error = maps:find(a,#{}),
@@ -508,9 +1792,10 @@ t_bif_map_find(Config) when is_list(Config) ->
error = maps:find(1, #{ 1.0 => "float"}),
error = maps:find({1.0,1}, #{ a=>a, {1,1.0} => "tuple hi"}), % reverse types in tuple key
-
- {'EXIT',{badarg,[{maps,find,_,_}|_]}} = (catch maps:find(a,id([]))),
- {'EXIT',{badarg,[{maps,find,_,_}|_]}} = (catch maps:find(a,id(<<>>))),
+ do_badmap(fun(T) ->
+ {'EXIT',{{badmap,T},[{maps,find,_,_}|_]}} =
+ (catch maps:find(a, T))
+ end),
ok.
@@ -535,26 +1820,27 @@ t_bif_map_is_key(Config) when is_list(Config) ->
false = maps:is_key(1.0, maps:put(1, "number", M1)),
%% error case
- {'EXIT',{badarg,[{maps,is_key,_,_}|_]}} = (catch maps:is_key(a,id([]))),
- {'EXIT',{badarg,[{maps,is_key,_,_}|_]}} = (catch maps:is_key(a,id(<<>>))),
+ do_badmap(fun(T) ->
+ {'EXIT',{{badmap,T},[{maps,is_key,_,_}|_]}} =
+ (catch maps:is_key(a, T))
+ end),
ok.
t_bif_map_keys(Config) when is_list(Config) ->
[] = maps:keys(#{}),
- [1,2,3,4,5] = maps:keys(#{ 1 => a, 2 => b, 3 => c, 4 => d, 5 => e}),
- [1,2,3,4,5] = maps:keys(#{ 4 => d, 5 => e, 1 => a, 2 => b, 3 => c}),
+ [1,2,3,4,5] = lists:sort(maps:keys(#{ 1 => a, 2 => b, 3 => c, 4 => d, 5 => e})),
+ [1,2,3,4,5] = lists:sort(maps:keys(#{ 4 => d, 5 => e, 1 => a, 2 => b, 3 => c})),
% values in key order: [4,int,"hi",<<"key">>]
M1 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, 4 => number},
- [4,int,"hi",<<"key">>] = maps:keys(M1),
+ [4,int,"hi",<<"key">>] = lists:sort(maps:keys(M1)),
%% error case
- {'EXIT',{badarg,[{maps,keys,_,_}|_]}} = (catch maps:keys(1 bsl 65 + 3)),
- {'EXIT',{badarg,[{maps,keys,_,_}|_]}} = (catch maps:keys(154)),
- {'EXIT',{badarg,[{maps,keys,_,_}|_]}} = (catch maps:keys(atom)),
- {'EXIT',{badarg,[{maps,keys,_,_}|_]}} = (catch maps:keys([])),
- {'EXIT',{badarg,[{maps,keys,_,_}|_]}} = (catch maps:keys(<<>>)),
+ do_badmap(fun(T) ->
+ {'EXIT',{{badmap,T},[{maps,keys,_,_}|_]}} =
+ (catch maps:keys(T))
+ end),
ok.
t_bif_map_new(Config) when is_list(Config) ->
@@ -582,11 +1868,58 @@ t_bif_map_merge(Config) when is_list(Config) ->
#{4 := integer, 18446744073709551629 := wat, float := 3.3, int := 3,
{1,2} := "tuple", "hi" := "hello again", <<"key">> := <<"value">>} = maps:merge(M0,M1),
- %% error case
- {'EXIT',{badarg,[{maps,merge,_,_}|_]}} = (catch maps:merge((1 bsl 65 + 3), <<>>)),
- {'EXIT',{badarg,[{maps,merge,_,_}|_]}} = (catch maps:merge(<<>>, id(#{ a => 1}))),
- {'EXIT',{badarg,[{maps,merge,_,_}|_]}} = (catch maps:merge(id(#{ a => 2}), <<>> )),
+ %% try deep collisions
+ N = 150000,
+ Is = lists:seq(1,N),
+ M2 = maps:from_list([{I,I}||I<-Is]),
+ 150000 = maps:size(M2),
+ M3 = maps:from_list([{<<I:32>>,I}||I<-Is]),
+ 150000 = maps:size(M3),
+ M4 = maps:merge(M2,M3),
+ 300000 = maps:size(M4),
+ M5 = maps:from_list([{integer_to_list(I),I}||I<-Is]),
+ 150000 = maps:size(M5),
+ M6 = maps:merge(M4,M5),
+ 450000 = maps:size(M6),
+ M7 = maps:from_list([{float(I),I}||I<-Is]),
+ 150000 = maps:size(M7),
+ M8 = maps:merge(M7,M6),
+ 600000 = maps:size(M8),
+
+ #{ 1 := 1, "1" := 1, <<1:32>> := 1 } = M8,
+ #{ 10 := 10, "10" := 10, <<10:32>> := 10 } = M8,
+ #{ 100 := 100, "100" := 100, <<100:32>> := 100 } = M8,
+ #{ 1000 := 1000, "1000" := 1000, <<1000:32>> := 1000 } = M8,
+ #{ 10000 := 10000, "10000" := 10000, <<10000:32>> := 10000 } = M8,
+ #{ 100000 := 100000, "100000" := 100000, <<100000:32>> := 100000 } = M8,
+
+ %% overlapping
+ M8 = maps:merge(M2,M8),
+ M8 = maps:merge(M3,M8),
+ M8 = maps:merge(M4,M8),
+ M8 = maps:merge(M5,M8),
+ M8 = maps:merge(M6,M8),
+ M8 = maps:merge(M7,M8),
+ M8 = maps:merge(M8,M8),
+
+ %% maps:merge/2 and mixed
+
+ Ks1 = [764492191,2361333849], %% deep collision
+ Ks2 = lists:seq(1,33),
+ M9 = maps:from_list([{K,K}||K <- Ks1]),
+ M10 = maps:from_list([{K,K}||K <- Ks2]),
+ M11 = maps:merge(M9,M10),
+ ok = check_keys_exist(Ks1 ++ Ks2, M11),
+ %% error case
+ do_badmap(fun(T) ->
+ {'EXIT',{{badmap,T},[{maps,merge,_,_}|_]}} =
+ (catch maps:merge(#{}, T)),
+ {'EXIT',{{badmap,T},[{maps,merge,_,_}|_]}} =
+ (catch maps:merge(T, #{})),
+ {'EXIT',{{badmap,T},[{maps,merge,_,_}|_]}} =
+ (catch maps:merge(T, T))
+ end),
ok.
@@ -596,63 +1929,70 @@ t_bif_map_put(Config) when is_list(Config) ->
M1 = #{ "hi" := "hello"} = maps:put("hi", "hello", #{}),
- ["hi"] = maps:keys(M1),
- ["hello"] = maps:values(M1),
+ true = is_members(["hi"],maps:keys(M1)),
+ true = is_members(["hello"],maps:values(M1)),
M2 = #{ int := 3 } = maps:put(int, 3, M1),
- [int,"hi"] = maps:keys(M2),
- [3,"hello"] = maps:values(M2),
+ true = is_members([int,"hi"],maps:keys(M2)),
+ true = is_members([3,"hello"],maps:values(M2)),
M3 = #{ <<"key">> := <<"value">> } = maps:put(<<"key">>, <<"value">>, M2),
- [int,"hi",<<"key">>] = maps:keys(M3),
- [3,"hello",<<"value">>] = maps:values(M3),
+ true = is_members([int,"hi",<<"key">>],maps:keys(M3)),
+ true = is_members([3,"hello",<<"value">>],maps:values(M3)),
M4 = #{ 18446744073709551629 := wat } = maps:put(18446744073709551629, wat, M3),
- [18446744073709551629,int,"hi",<<"key">>] = maps:keys(M4),
- [wat,3,"hello",<<"value">>] = maps:values(M4),
+ true = is_members([18446744073709551629,int,"hi",<<"key">>],maps:keys(M4)),
+ true = is_members([wat,3,"hello",<<"value">>],maps:values(M4)),
M0 = #{ 4 := number } = M5 = maps:put(4, number, M4),
- [4,18446744073709551629,int,"hi",<<"key">>] = maps:keys(M5),
- [number,wat,3,"hello",<<"value">>] = maps:values(M5),
+ true = is_members([4,18446744073709551629,int,"hi",<<"key">>],maps:keys(M5)),
+ true = is_members([number,wat,3,"hello",<<"value">>],maps:values(M5)),
M6 = #{ <<"key">> := <<"other value">> } = maps:put(<<"key">>, <<"other value">>, M5),
- [4,18446744073709551629,int,"hi",<<"key">>] = maps:keys(M6),
- [number,wat,3,"hello",<<"other value">>] = maps:values(M6),
+ true = is_members([4,18446744073709551629,int,"hi",<<"key">>],maps:keys(M6)),
+ true = is_members([number,wat,3,"hello",<<"other value">>],maps:values(M6)),
%% error case
- {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,1 bsl 65 + 3)),
- {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,154)),
- {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,atom)),
- {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,[])),
- {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,<<>>)),
- ok.
+ do_badmap(fun(T) ->
+ {'EXIT',{{badmap,T},[{maps,put,_,_}|_]}} =
+ (catch maps:put(1, a, T))
+ end),
+ ok.
+
+is_members(Ks,Ls) when length(Ks) =/= length(Ls) -> false;
+is_members(Ks,Ls) -> is_members_do(Ks,Ls).
+
+is_members_do([],[]) -> true;
+is_members_do([],_) -> false;
+is_members_do([K|Ks],Ls) ->
+ is_members_do(Ks, lists:delete(K,Ls)).
t_bif_map_remove(Config) when is_list(Config) ->
0 = erlang:map_size(maps:remove(some_key, #{})),
M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>,
- 4 => number, 18446744073709551629 => wat},
+ 4 => number, 18446744073709551629 => wat},
M1 = maps:remove("hi", M0),
- [4,18446744073709551629,int,<<"key">>] = maps:keys(M1),
- [number,wat,3,<<"value">>] = maps:values(M1),
+ true = is_members([4,18446744073709551629,int,<<"key">>],maps:keys(M1)),
+ true = is_members([number,wat,3,<<"value">>],maps:values(M1)),
M2 = maps:remove(int, M1),
- [4,18446744073709551629,<<"key">>] = maps:keys(M2),
- [number,wat,<<"value">>] = maps:values(M2),
+ true = is_members([4,18446744073709551629,<<"key">>],maps:keys(M2)),
+ true = is_members([number,wat,<<"value">>],maps:values(M2)),
M3 = maps:remove(<<"key">>, M2),
- [4,18446744073709551629] = maps:keys(M3),
- [number,wat] = maps:values(M3),
+ true = is_members([4,18446744073709551629],maps:keys(M3)),
+ true = is_members([number,wat],maps:values(M3)),
M4 = maps:remove(18446744073709551629, M3),
- [4] = maps:keys(M4),
- [number] = maps:values(M4),
+ true = is_members([4],maps:keys(M4)),
+ true = is_members([number],maps:values(M4)),
M5 = maps:remove(4, M4),
[] = maps:keys(M5),
@@ -664,12 +2004,72 @@ t_bif_map_remove(Config) when is_list(Config) ->
#{ "hi" := "hello", int := 3, 4 := number} = maps:remove(18446744073709551629,maps:remove(<<"key">>,M0)),
%% error case
- {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(a,1 bsl 65 + 3)),
- {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(1,154)),
- {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(a,atom)),
- {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(1,[])),
- {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(a,<<>>)),
- ok.
+ do_badmap(fun(T) ->
+ {'EXIT',{{badmap,T},[{maps,remove,_,_}|_]}} = (catch maps:remove(a, T))
+ end),
+ ok.
+
+t_bif_map_take(Config) when is_list(Config) ->
+ error = maps:take(some_key, #{}),
+
+ M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>,
+ 4 => number, 18446744073709551629 => wat},
+
+ 5 = maps:size(M0),
+ {"hello", M1} = maps:take("hi", M0),
+ true = is_members([4,18446744073709551629,int,<<"key">>],maps:keys(M1)),
+ true = is_members([number,wat,3,<<"value">>],maps:values(M1)),
+ error = maps:take("hi", M1),
+ 4 = maps:size(M1),
+
+ {3, M2} = maps:take(int, M1),
+ true = is_members([4,18446744073709551629,<<"key">>],maps:keys(M2)),
+ true = is_members([number,wat,<<"value">>],maps:values(M2)),
+ error = maps:take(int, M2),
+ 3 = maps:size(M2),
+
+ {<<"value">>,M3} = maps:take(<<"key">>, M2),
+ true = is_members([4,18446744073709551629],maps:keys(M3)),
+ true = is_members([number,wat],maps:values(M3)),
+ error = maps:take(<<"key">>, M3),
+ 2 = maps:size(M3),
+
+ {wat,M4} = maps:take(18446744073709551629, M3),
+ true = is_members([4],maps:keys(M4)),
+ true = is_members([number],maps:values(M4)),
+ error = maps:take(18446744073709551629, M4),
+ 1 = maps:size(M4),
+
+ {number,M5} = maps:take(4, M4),
+ [] = maps:keys(M5),
+ [] = maps:values(M5),
+ error = maps:take(4, M5),
+ 0 = maps:size(M5),
+
+ {wat,#{ "hi" := "hello", int := 3, 4 := number, <<"key">> := <<"value">>}} = maps:take(18446744073709551629,M0),
+
+ %% error case
+ do_badmap(fun(T) ->
+ {'EXIT',{{badmap,T},[{maps,take,_,_}|_]}} = (catch maps:take(a, T))
+ end),
+ ok.
+
+t_bif_map_take_large(Config) when is_list(Config) ->
+ KVs = [{{erlang:md5(<<I:64>>),I}, I}|| I <- lists:seq(1,500)],
+ M0 = maps:from_list(KVs),
+ ok = bif_map_take_all(KVs, M0),
+ ok.
+
+bif_map_take_all([], M0) ->
+ 0 = maps:size(M0),
+ ok;
+bif_map_take_all([{K,V}|KVs],M0) ->
+ {ok,V} = maps:find(K,M0),
+ {V,M1} = maps:take(K,M0),
+ error = maps:find(K,M1),
+ error = maps:take(K,M1),
+ bif_map_take_all(KVs,M1).
+
t_bif_map_update(Config) when is_list(Config) ->
M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>,
@@ -691,10 +2091,10 @@ t_bif_map_update(Config) when is_list(Config) ->
4 := number, 18446744073709551629 := wazzup} = maps:update(18446744073709551629, wazzup, M0),
%% error case
- {'EXIT',{badarg,[{maps,update,_,_}|_]}} = (catch maps:update(1,none,{})),
- {'EXIT',{badarg,[{maps,update,_,_}|_]}} = (catch maps:update(1,none,<<"value">>)),
- {'EXIT',{badarg,[{maps,update,_,_}|_]}} = (catch maps:update(5,none,M0)),
-
+ do_badmap(fun(T) ->
+ {'EXIT',{{badmap,T},[{maps,update,_,_}|_]}} =
+ (catch maps:update(1, none, T))
+ end),
ok.
@@ -702,92 +2102,77 @@ t_bif_map_update(Config) when is_list(Config) ->
t_bif_map_values(Config) when is_list(Config) ->
[] = maps:values(#{}),
+ [1] = maps:values(#{a=>1}),
- [a,b,c,d,e] = maps:values(#{ 1 => a, 2 => b, 3 => c, 4 => d, 5 => e}),
- [a,b,c,d,e] = maps:values(#{ 4 => d, 5 => e, 1 => a, 2 => b, 3 => c}),
+ true = is_members([a,b,c,d,e],maps:values(#{ 1 => a, 2 => b, 3 => c, 4 => d, 5 => e})),
+ true = is_members([a,b,c,d,e],maps:values(#{ 4 => d, 5 => e, 1 => a, 2 => b, 3 => c})),
- % values in key order: [4,int,"hi",<<"key">>]
M1 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, 4 => number},
M2 = M1#{ "hi" => "hello2", <<"key">> => <<"value2">> },
- [number,3,"hello2",<<"value2">>] = maps:values(M2),
- [number,3,"hello",<<"value">>] = maps:values(M1),
+ true = is_members([number,3,"hello2",<<"value2">>],maps:values(M2)),
+ true = is_members([number,3,"hello",<<"value">>],maps:values(M1)),
+
+ Vs = lists:seq(1000,20000),
+ M3 = maps:from_list([{K,K}||K<-Vs]),
+ M4 = maps:merge(M1,M3),
+ M5 = maps:merge(M2,M3),
+ true = is_members(Vs,maps:values(M3)),
+ true = is_members([number,3,"hello",<<"value">>]++Vs,maps:values(M4)),
+ true = is_members([number,3,"hello2",<<"value2">>]++Vs,maps:values(M5)),
%% error case
- {'EXIT',{badarg,[{maps,values,_,_}|_]}} = (catch maps:values(1 bsl 65 + 3)),
- {'EXIT',{badarg,[{maps,values,_,_}|_]}} = (catch maps:values(atom)),
- {'EXIT',{badarg,[{maps,values,_,_}|_]}} = (catch maps:values([])),
- {'EXIT',{badarg,[{maps,values,_,_}|_]}} = (catch maps:values(<<>>)),
+ do_badmap(fun(T) ->
+ {'EXIT',{{badmap,T},[{maps,values,_,_}|_]}} =
+ (catch maps:values(T))
+ end),
ok.
t_erlang_hash(Config) when is_list(Config) ->
ok = t_bif_erlang_phash2(),
ok = t_bif_erlang_phash(),
- ok = t_bif_erlang_hash(),
-
ok.
t_bif_erlang_phash2() ->
39679005 = erlang:phash2(#{}),
- 78942764 = erlang:phash2(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 }),
- 37338230 = erlang:phash2(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} }),
- 14363616 = erlang:phash2(#{ 1 => a }),
- 51612236 = erlang:phash2(#{ a => 1 }),
+ 33667975 = erlang:phash2(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 }), % 78942764
+ 95332690 = erlang:phash2(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} }), % 37338230
+ 108954384 = erlang:phash2(#{ 1 => a }), % 14363616
+ 59617982 = erlang:phash2(#{ a => 1 }), % 51612236
- 37468437 = erlang:phash2(#{{} => <<>>}),
- 44049159 = erlang:phash2(#{<<>> => {}}),
+ 42770201 = erlang:phash2(#{{} => <<>>}), % 37468437
+ 71687700 = erlang:phash2(#{<<>> => {}}), % 44049159
M0 = #{ a => 1, "key" => <<"value">> },
M1 = maps:remove("key",M0),
M2 = M1#{ "key" => <<"value">> },
- 118679416 = erlang:phash2(M0),
- 51612236 = erlang:phash2(M1),
- 118679416 = erlang:phash2(M2),
+ 70249457 = erlang:phash2(M0), % 118679416
+ 59617982 = erlang:phash2(M1), % 51612236
+ 70249457 = erlang:phash2(M2), % 118679416
ok.
t_bif_erlang_phash() ->
Sz = 1 bsl 32,
- 268440612 = erlang:phash(#{},Sz),
- 1196461908 = erlang:phash(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 },Sz),
- 3944426064 = erlang:phash(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} },Sz),
- 1394238263 = erlang:phash(#{ 1 => a },Sz),
- 4066388227 = erlang:phash(#{ a => 1 },Sz),
-
- 1578050717 = erlang:phash(#{{} => <<>>},Sz),
- 1578050717 = erlang:phash(#{<<>> => {}},Sz), % yep, broken
-
- M0 = #{ a => 1, "key" => <<"value">> },
- M1 = maps:remove("key",M0),
- M2 = M1#{ "key" => <<"value">> },
-
- 3590546636 = erlang:phash(M0,Sz),
- 4066388227 = erlang:phash(M1,Sz),
- 3590546636 = erlang:phash(M2,Sz),
- ok.
-
-t_bif_erlang_hash() ->
- Sz = 1 bsl 27 - 1,
- 5158 = erlang:hash(#{},Sz),
- 71555838 = erlang:hash(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 },Sz),
- 5497225 = erlang:hash(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} },Sz),
- 126071654 = erlang:hash(#{ 1 => a },Sz),
- 126426236 = erlang:hash(#{ a => 1 },Sz),
+ 1113425985 = erlang:phash(#{},Sz), % 268440612
+ 1510068139 = erlang:phash(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 },Sz), % 1196461908
+ 3182345590 = erlang:phash(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} },Sz), % 3944426064
+ 2927531828 = erlang:phash(#{ 1 => a },Sz), % 1394238263
+ 1670235874 = erlang:phash(#{ a => 1 },Sz), % 4066388227
- 101655720 = erlang:hash(#{{} => <<>>},Sz),
- 101655720 = erlang:hash(#{<<>> => {}},Sz), % yep, broken
+ 3935089469 = erlang:phash(#{{} => <<>>},Sz), % 1578050717
+ 71692856 = erlang:phash(#{<<>> => {}},Sz), % 1578050717
M0 = #{ a => 1, "key" => <<"value">> },
M1 = maps:remove("key",M0),
M2 = M1#{ "key" => <<"value">> },
- 38260486 = erlang:hash(M0,Sz),
- 126426236 = erlang:hash(M1,Sz),
- 38260486 = erlang:hash(M2,Sz),
+ 2620391445 = erlang:phash(M0,Sz), % 3590546636
+ 1670235874 = erlang:phash(M1,Sz), % 4066388227
+ 2620391445 = erlang:phash(M2,Sz), % 3590546636
ok.
-
t_map_encode_decode(Config) when is_list(Config) ->
<<131,116,0,0,0,0>> = erlang:term_to_binary(#{}),
Pairs = [
@@ -805,7 +2190,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,[],#{}),
@@ -818,14 +2205,35 @@ t_map_encode_decode(Config) when is_list(Config) ->
%% literally #{ "hi" => "value", a=>33, b=>55 } in the internal order
#{ a:=33, b:=55, "hi" := "value"} = erlang:binary_to_term(<<131,116,0,0,0,3,
- 107,0,2,104,105, % "hi" :: list()
+ 107,0,2,104,105, % "hi" :: list()
107,0,5,118,97,108,117,101, % "value" :: list()
- 100,0,1,97, % a :: atom()
- 97,33, % 33 :: integer()
- 100,0,1,98, % b :: atom()
- 97,55 % 55 :: integer()
+ 100,0,1,97, % a :: atom()
+ 97,33, % 33 :: integer()
+ 100,0,1,98, % b :: atom()
+ 97,55 % 55 :: integer()
>>),
+ %% Maps of different sizes
+ lists:foldl(fun(Key, M0) ->
+ M1 = M0#{Key => Key},
+ case Key rem 17 of
+ 0 ->
+ M1 = binary_to_term(term_to_binary(M1));
+ _ ->
+ ok
+ end,
+ M1
+ end,
+ #{},
+ lists:seq(1,10000)),
+
+ %% many maps in same binary
+ MapList = lists:foldl(fun(K, [M|_]=Acc) -> [M#{K => K} | Acc] end,
+ [#{}],
+ lists:seq(1,100)),
+ MapList = binary_to_term(term_to_binary(MapList)),
+ MapListR = lists:reverse(MapList),
+ MapListR = binary_to_term(term_to_binary(MapListR)),
%% error cases
%% template: <<131,116,0,0,0,2,100,0,1,97,100,0,1,98,97,1,97,1>>
@@ -848,51 +2256,77 @@ 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) ->
M1 = maps:put(K,V,M0),
B0 = erlang:term_to_binary(M1),
- Ls = lists:sort(fun(A,B) -> erts_internal:cmp_term(A,B) < 0 end, [{K, erlang:term_to_binary(K), erlang:term_to_binary(V)}|EncodedPairs]),
- %% sort Ks and Vs according to term spec, then match it
- KVbins = lists:foldr(fun({_,Kbin,Vbin}, Acc) -> [Kbin,Vbin | Acc] end, [], Ls),
- ok = match_encoded_map(B0, length(Ls), KVbins),
+ Ls = [{erlang:term_to_binary(K), erlang:term_to_binary(V)}|EncodedPairs],
+ ok = match_encoded_map(B0, length(Ls), Ls),
%% decode and match it
M1 = erlang:binary_to_term(B0),
map_encode_decode_and_match(Pairs,Ls,M1);
map_encode_decode_and_match([],_,_) -> ok.
match_encoded_map(<<131,116,Size:32,Encoded/binary>>,Size,Items) ->
- match_encoded_map(Encoded,Items);
+ match_encoded_map_stripped_size(Encoded,Items,Items);
match_encoded_map(_,_,_) -> no_match_size.
-match_encoded_map(<<>>,[]) -> ok;
-match_encoded_map(Bin,[<<131,Item/binary>>|Items]) ->
- Size = erlang:byte_size(Item),
- <<EncodedTerm:Size/binary, Bin1/binary>> = Bin,
- EncodedTerm = Item, %% Asssert
- match_encoded_map(Bin1,Items).
+match_encoded_map_stripped_size(<<>>,_,_) -> ok;
+match_encoded_map_stripped_size(B0,[{<<131,K/binary>>,<<131,V/binary>>}|Items],Ls) ->
+ Ksz = byte_size(K),
+ Vsz = byte_size(V),
+ case B0 of
+ <<K:Ksz/binary,V:Vsz/binary,B1/binary>> ->
+ match_encoded_map_stripped_size(B1,Ls,Ls);
+ _ ->
+ match_encoded_map_stripped_size(B0,Items,Ls)
+ end;
+match_encoded_map_stripped_size(_,[],_) -> fail.
t_bif_map_to_list(Config) when is_list(Config) ->
[] = maps:to_list(#{}),
- [{a,1},{b,2}] = maps:to_list(#{a=>1,b=>2}),
- [{a,1},{b,2},{c,3}] = maps:to_list(#{c=>3,a=>1,b=>2}),
- [{a,1},{b,2},{g,3}] = maps:to_list(#{g=>3,a=>1,b=>2}),
- [{a,1},{b,2},{g,3},{"c",4}] = maps:to_list(#{g=>3,a=>1,b=>2,"c"=>4}),
- [{3,v2},{hi,v4},{{hi,3},v5},{"hi",v3},{<<"hi">>,v1}] = maps:to_list(#{
- <<"hi">>=>v1,3=>v2,"hi"=>v3,hi=>v4,{hi,3}=>v5}),
+ [{a,1},{b,2}] = lists:sort(maps:to_list(#{a=>1,b=>2})),
+ [{a,1},{b,2},{c,3}] = lists:sort(maps:to_list(#{c=>3,a=>1,b=>2})),
+ [{a,1},{b,2},{g,3}] = lists:sort(maps:to_list(#{g=>3,a=>1,b=>2})),
+ [{a,1},{b,2},{g,3},{"c",4}] = lists:sort(maps:to_list(#{g=>3,a=>1,b=>2,"c"=>4})),
+ [{3,v2},{hi,v4},{{hi,3},v5},{"hi",v3},{<<"hi">>,v1}] =
+ lists:sort(maps:to_list(#{<<"hi">>=>v1,3=>v2,"hi"=>v3,hi=>v4,{hi,3}=>v5})),
- [{3,v7},{hi,v9},{{hi,3},v10},{"hi",v8},{<<"hi">>,v6}] = maps:to_list(#{
- <<"hi">>=>v1,3=>v2,"hi"=>v3,hi=>v4,{hi,3}=>v5,
- <<"hi">>=>v6,3=>v7,"hi"=>v8,hi=>v9,{hi,3}=>v10}),
+ [{3,v7},{hi,v9},{{hi,3},v10},{"hi",v8},{<<"hi">>,v6}] =
+ lists:sort(maps:to_list(#{<<"hi">>=>v1,3=>v2,"hi"=>v3,hi=>v4,{hi,3}=>v5,
+ <<"hi">>=>v6,3=>v7,"hi"=>v8,hi=>v9,{hi,3}=>v10})),
%% error cases
- {'EXIT', {badarg,_}} = (catch maps:to_list(id(a))),
- {'EXIT', {badarg,_}} = (catch maps:to_list(id(42))),
+ do_badmap(fun(T) ->
+ {'EXIT', {{badmap,T},_}} =
+ (catch maps:to_list(T))
+ end),
ok.
@@ -901,7 +2335,7 @@ t_bif_map_from_list(Config) when is_list(Config) ->
A = maps:from_list([]),
0 = erlang:map_size(A),
- #{a:=1,b:=2} = maps:from_list([{a,1},{b,2}]),
+ #{a:=1,b:=2} = maps:from_list([{a,1},{b,2}]),
#{c:=3,a:=1,b:=2} = maps:from_list([{a,1},{b,2},{c,3}]),
#{g:=3,a:=1,b:=2} = maps:from_list([{a,1},{b,2},{g,3}]),
@@ -914,6 +2348,13 @@ t_bif_map_from_list(Config) when is_list(Config) ->
maps:from_list([ {{hi,3},v3}, {"hi",v0},{3,v1}, {<<"hi">>,v4}, {hi,v2},
{<<"hi">>,v6}, {{hi,3},v10},{"hi",v11}, {hi,v9}, {3,v8}]),
+ %% repeated keys (large -> small)
+ Ps1 = [{a,I}|| I <- lists:seq(1,32)],
+ Ps2 = [{a,I}|| I <- lists:seq(33,64)],
+
+ M = maps:from_list(Ps1 ++ [{b,1},{c,1}] ++ Ps2),
+ #{ a := 64, b := 1, c := 1 } = M,
+
%% error cases
{'EXIT', {badarg,_}} = (catch maps:from_list(id([{a,b},b]))),
{'EXIT', {badarg,_}} = (catch maps:from_list(id([{a,b},{b,b,3}]))),
@@ -923,6 +2364,216 @@ t_bif_map_from_list(Config) when is_list(Config) ->
{'EXIT', {badarg,_}} = (catch maps:from_list(id(42))),
ok.
+t_bif_erts_internal_maps_to_list(Config) when is_list(Config) ->
+ %% small maps
+ [] = erts_internal:maps_to_list(#{},-1),
+ [] = erts_internal:maps_to_list(#{},-2),
+ [] = erts_internal:maps_to_list(#{},10),
+ [{a,1},{b,2}] = lists:sort(erts_internal:maps_to_list(#{a=>1,b=>2}, 2)),
+ [{a,1},{b,2}] = lists:sort(erts_internal:maps_to_list(#{a=>1,b=>2}, -1)),
+ [{_,_}] = erts_internal:maps_to_list(#{a=>1,b=>2}, 1),
+ [{a,1},{b,2},{c,3}] = lists:sort(erts_internal:maps_to_list(#{c=>3,a=>1,b=>2},-2)),
+ [{a,1},{b,2},{c,3}] = lists:sort(erts_internal:maps_to_list(#{c=>3,a=>1,b=>2},3)),
+ [{a,1},{b,2},{c,3}] = lists:sort(erts_internal:maps_to_list(#{c=>3,a=>1,b=>2},5)),
+ [{_,_},{_,_}] = erts_internal:maps_to_list(#{c=>3,a=>1,b=>2},2),
+ [{_,_}] = erts_internal:maps_to_list(#{c=>3,a=>1,b=>2},1),
+ [] = erts_internal:maps_to_list(#{c=>3,a=>1,b=>2},0),
+
+ %% big maps
+ M = maps:from_list([{I,ok}||I <- lists:seq(1,500)]),
+ [] = erts_internal:maps_to_list(M,0),
+ [{_,_}] = erts_internal:maps_to_list(M,1),
+ [{_,_},{_,_}] = erts_internal:maps_to_list(M,2),
+ Ls1 = erts_internal:maps_to_list(M,10),
+ 10 = length(Ls1),
+ Ls2 = erts_internal:maps_to_list(M,20),
+ 20 = length(Ls2),
+ Ls3 = erts_internal:maps_to_list(M,120),
+ 120 = length(Ls3),
+ Ls4 = erts_internal:maps_to_list(M,-1),
+ 500 = length(Ls4),
+
+ %% error cases
+ {'EXIT', {{badmap,[{a,b},b]},_}} = (catch erts_internal:maps_to_list(id([{a,b},b]),id(1))),
+ {'EXIT', {badarg,_}} = (catch erts_internal:maps_to_list(id(#{}),id(a))),
+ {'EXIT', {badarg,_}} = (catch erts_internal:maps_to_list(id(#{1=>2}),id(<<>>))),
+ ok.
+
+t_bif_build_and_check(Config) when is_list(Config) ->
+ ok = check_build_and_remove(750,[fun(K) -> [K,K] end,
+ fun(K) -> [float(K),K] end,
+ fun(K) -> K end,
+ fun(K) -> {1,K} end,
+ fun(K) -> {K} end,
+ fun(K) -> [K|K] end,
+ fun(K) -> [K,1,2,3,4] end,
+ fun(K) -> {K,atom} end,
+ fun(K) -> float(K) end,
+ fun(K) -> integer_to_list(K) end,
+ fun(K) -> list_to_atom(integer_to_list(K)) end,
+ fun(K) -> [K,{K,[K,{K,[K]}]}] end,
+ fun(K) -> <<K:32>> end]),
+ ok.
+
+check_build_and_remove(_,[]) -> ok;
+check_build_and_remove(N,[F|Fs]) ->
+ {M,Ks} = build_and_check(N, maps:new(), F, []),
+ ok = remove_and_check(Ks,M),
+ check_build_and_remove(N,Fs).
+
+build_and_check(0, M0, _, Ks) -> {M0, Ks};
+build_and_check(N, M0, F, Ks) ->
+ K = build_key(F,N),
+ M1 = maps:put(K,K,M0),
+ ok = check_keys_exist([I||{I,_} <- [{K,M1}|Ks]], M1),
+ M2 = maps:update(K,v,M1),
+ v = maps:get(K,M2),
+ build_and_check(N-1,M1,F,[{K,M1}|Ks]).
+
+remove_and_check([],_) -> ok;
+remove_and_check([{K,Mc}|Ks], M0) ->
+ K = maps:get(K,M0),
+ true = maps:is_key(K,M0),
+ true = Mc =:= M0,
+ true = M0 == Mc,
+ M1 = maps:remove(K,M0),
+ false = M1 =:= Mc,
+ false = Mc == M1,
+ false = maps:is_key(K,M1),
+ true = maps:is_key(K,M0),
+ ok = check_keys_exist([I||{I,_} <- Ks],M1),
+ error = maps:find(K,M1),
+ remove_and_check(Ks, M1).
+
+build_key(F,N) when N rem 3 =:= 0 -> F(N);
+build_key(F,N) when N rem 3 =:= 1 -> K = F(N), {K,K};
+build_key(F,N) when N rem 3 =:= 2 -> K = F(N), [K,K].
+
+check_keys_exist([], _) -> ok;
+check_keys_exist([K|Ks],M) ->
+ true = maps:is_key(K,M),
+ check_keys_exist(Ks,M).
+
+t_bif_merge_and_check(Config) when is_list(Config) ->
+
+ io:format("rand:export_seed() -> ~p\n",[rand:export_seed()]),
+
+ %% simple disjunct ones
+ %% make sure all keys are unique
+ Kss = [[a,b,c,d],
+ [1,2,3,4],
+ [],
+ ["hi"],
+ [e],
+ [build_key(fun(K) -> {small,K} end, I) || I <- lists:seq(1,32)],
+ lists:seq(5, 28),
+ lists:seq(29, 59),
+ [build_key(fun(K) -> integer_to_list(K) end, I) || I <- lists:seq(2000,10000)],
+ [build_key(fun(K) -> <<K:32>> end, I) || I <- lists:seq(1,80)],
+ [build_key(fun(K) -> {<<K:32>>} end, I) || I <- lists:seq(100,1000)]],
+
+
+ KsMs = build_keys_map_pairs(Kss),
+ Cs = [{CKs1,CM1,CKs2,CM2} || {CKs1,CM1} <- KsMs, {CKs2,CM2} <- KsMs],
+ ok = merge_and_check_combo(Cs),
+
+ %% overlapping ones
+
+ KVs1 = [{a,1},{b,2},{c,3}],
+ KVs2 = [{b,3},{c,4},{d,5}],
+ KVs = [{I,I} || I <- lists:seq(1,32)],
+ KVs3 = KVs1 ++ KVs,
+ KVs4 = KVs2 ++ KVs,
+
+ M1 = maps:from_list(KVs1),
+ M2 = maps:from_list(KVs2),
+ M3 = maps:from_list(KVs3),
+ M4 = maps:from_list(KVs4),
+
+ M12 = maps:merge(M1,M2),
+ ok = check_key_values(KVs2 ++ [{a,1}], M12),
+ M21 = maps:merge(M2,M1),
+ ok = check_key_values(KVs1 ++ [{d,5}], M21),
+
+ M34 = maps:merge(M3,M4),
+ ok = check_key_values(KVs4 ++ [{a,1}], M34),
+ M43 = maps:merge(M4,M3),
+ ok = check_key_values(KVs3 ++ [{d,5}], M43),
+
+ M14 = maps:merge(M1,M4),
+ ok = check_key_values(KVs4 ++ [{a,1}], M14),
+ M41 = maps:merge(M4,M1),
+ ok = check_key_values(KVs1 ++ [{d,5}] ++ KVs, M41),
+
+ [begin Ma = random_map(SzA, a),
+ Mb = random_map(SzB, b),
+ ok = merge_maps(Ma, Mb)
+ end || SzA <- [3,10,20,100,200,1000], SzB <- [3,10,20,100,200,1000]],
+
+ ok.
+
+% Generate random map with an average of Sz number of pairs: K -> {V,K}
+random_map(Sz, V) ->
+ random_map_insert(#{}, 0, V, Sz*2).
+
+random_map_insert(M0, K0, _, Sz) when K0 > Sz ->
+ M0;
+random_map_insert(M0, K0, V, Sz) ->
+ Key = K0 + rand:uniform(3),
+ random_map_insert(M0#{Key => {V,Key}}, Key, V, Sz).
+
+
+merge_maps(A, B) ->
+ AB = maps:merge(A, B),
+ %%io:format("A=~p\nB=~p\n",[A,B]),
+ maps_foreach(fun(K,VB) -> VB = maps:get(K, AB)
+ end, B),
+ maps_foreach(fun(K,VA) ->
+ case {maps:get(K, AB),maps:find(K, B)} of
+ {VA, error} -> ok;
+ {VB, {ok, VB}} -> ok
+ end
+ end, A),
+
+ maps_foreach(fun(K,V) ->
+ case {maps:find(K, A),maps:find(K, B)} of
+ {{ok, V}, error} -> ok;
+ {error, {ok, V}} -> ok;
+ {{ok,_}, {ok, V}} -> ok
+ end
+ end, AB),
+ ok.
+
+maps_foreach(Fun, Map) ->
+ maps:fold(fun(K,V,_) -> Fun(K,V) end, void, Map).
+
+
+check_key_values([],_) -> ok;
+check_key_values([{K,V}|KVs],M) ->
+ V = maps:get(K,M),
+ check_key_values(KVs,M).
+
+merge_and_check_combo([]) -> ok;
+merge_and_check_combo([{Ks1,M1,Ks2,M2}|Cs]) ->
+ M12 = maps:merge(M1,M2),
+ ok = check_keys_exist(Ks1 ++ Ks2, M12),
+ M21 = maps:merge(M2,M1),
+ ok = check_keys_exist(Ks1 ++ Ks2, M21),
+
+ true = M12 =:= M21,
+ M12 = M21,
+
+ merge_and_check_combo(Cs).
+
+build_keys_map_pairs([]) -> [];
+build_keys_map_pairs([Ks|Kss]) ->
+ M = maps:from_list(keys_to_pairs(Ks)),
+ ok = check_keys_exist(Ks, M),
+ [{Ks,M}|build_keys_map_pairs(Kss)].
+
+keys_to_pairs(Ks) -> [{K,K} || K <- Ks].
+
+
%% Maps module, not BIFs
t_maps_fold(_Config) ->
Vs = lists:seq(1,100),
@@ -960,6 +2611,191 @@ t_maps_without(_Config) ->
%% MISC
+
+%% Verify that the the number of nodes in hashmaps
+%% of different types and sizes does not deviate too
+%% much from the theoretical model.
+t_hashmap_balance(_Config) ->
+ io:format("Integer keys\n", []),
+ hashmap_balance(fun(I) -> I end),
+ io:format("Float keys\n", []),
+ hashmap_balance(fun(I) -> float(I) end),
+ io:format("String keys\n", []),
+ hashmap_balance(fun(I) -> integer_to_list(I) end),
+ io:format("Binary (big) keys\n", []),
+ hashmap_balance(fun(I) -> <<I:16/big>> end),
+ io:format("Binary (little) keys\n", []),
+ hashmap_balance(fun(I) -> <<I:16/little>> end),
+ io:format("Atom keys\n", []),
+ erts_debug:set_internal_state(available_internal_state, true),
+ hashmap_balance(fun(I) -> erts_debug:get_internal_state({atom,I}) end),
+ erts_debug:set_internal_state(available_internal_state, false),
+
+ ok.
+
+hashmap_balance(KeyFun) ->
+ F = fun(I, {M0,Max0}) ->
+ Key = KeyFun(I),
+ M1 = M0#{Key => Key},
+ Max1 = case erts_internal:term_type(M1) of
+ hashmap ->
+ Nodes = hashmap_nodes(M1),
+ Avg = maps:size(M1) * 0.4,
+ StdDev = math:sqrt(maps:size(M1)) / 3,
+ SD_diff = abs(Nodes - Avg) / StdDev,
+ %%io:format("~p keys: ~p nodes avg=~p SD_diff=~p\n",
+ %% [maps:size(M1), Nodes, Avg, SD_diff]),
+ {MaxDiff0, _} = Max0,
+ case {Nodes > Avg, SD_diff > MaxDiff0} of
+ {true, true} -> {SD_diff, M1};
+ _ -> Max0
+ end;
+
+ flatmap -> Max0
+ end,
+ {M1, Max1}
+ end,
+
+ {_,{MaxDiff,MaxMap}} = lists:foldl(F,
+ {#{}, {0, 0}},
+ lists:seq(1,10000)),
+ io:format("Max std dev diff ~p for map of size ~p (nodes=~p, flatsize=~p)\n",
+ [MaxDiff, maps:size(MaxMap), hashmap_nodes(MaxMap), erts_debug:flat_size(MaxMap)]),
+
+ true = (MaxDiff < 6), % The probability of this line failing is about 0.000000001
+ % for a uniform hash. I've set the probability this "high" for now
+ % to detect flaws in our make_internal_hash.
+ % Hard limit is 15 (see hashmap_over_estimated_heap_size).
+ ok.
+
+hashmap_nodes(M) ->
+ Info = erts_debug:map_info(M),
+ lists:foldl(fun(Tpl,Acc) ->
+ case element(1,Tpl) of
+ bitmaps -> Acc + element(2,Tpl);
+ arrays -> Acc + element(2,Tpl);
+ _ -> Acc
+ end
+ end,
+ 0,
+ Info).
+
+t_erts_internal_order(_Config) when is_list(_Config) ->
+
+ -1 = erts_internal:cmp_term(1,2),
+ 1 = erts_internal:cmp_term(2,1),
+ 0 = erts_internal:cmp_term(2,2),
+
+
+ -1 = erts_internal:cmp_term(1,a),
+ 1 = erts_internal:cmp_term(a,1),
+ 0 = erts_internal:cmp_term(a,a),
+
+ -1 = erts_internal:cmp_term(1,1.0),
+ 1 = erts_internal:cmp_term(1.0,1),
+ 0 = erts_internal:cmp_term(1.0,1.0),
+
+ -1 = erts_internal:cmp_term(1,1 bsl 65),
+ 1 = erts_internal:cmp_term(1 bsl 65,1),
+ 0 = erts_internal:cmp_term(1 bsl 65, 1 bsl 65),
+
+ -1 = erts_internal:cmp_term(1 bsl 65,float(1)),
+ 1 = erts_internal:cmp_term(float(1),1 bsl 65),
+ -1 = erts_internal:cmp_term(1,float(1 bsl 65)),
+ 1 = erts_internal:cmp_term(float(1 bsl 65),1),
+ 0 = erts_internal:cmp_term(float(1 bsl 65), float(1 bsl 65)),
+
+ %% reported errors
+ -1 = erts_internal:cmp_term(0,2147483648),
+ 0 = erts_internal:cmp_term(2147483648,2147483648),
+ 1 = erts_internal:cmp_term(2147483648,0),
+
+ M = #{0 => 0,2147483648 => 0},
+ true = M =:= binary_to_term(term_to_binary(M)),
+
+ F1 = fun(_, _) -> 0 end,
+ F2 = fun(_, _) -> 1 end,
+ M0 = maps:from_list( [{-2147483649, 0}, {0,0}, {97, 0}, {false, 0}, {flower, 0}, {F1, 0}, {F2, 0}, {<<>>, 0}]),
+ M1 = maps:merge(M0, #{0 => 1}),
+ 8 = maps:size(M1),
+ 1 = maps:get(0,M1),
+ ok.
+
+t_erts_internal_hash(_Config) when is_list(_Config) ->
+ K1 = 0.0,
+ K2 = 0.0/-1,
+ M = maps:from_list([{I,I}||I<-lists:seq(1,32)]),
+
+ M1 = M#{ K1 => a, K2 => b },
+ b = maps:get(K2,M1),
+
+ M2 = M#{ K2 => a, K1 => b },
+ b = maps:get(K1,M2),
+
+ %% test previously faulty hash list optimization
+
+ M3 = M#{[0] => a, [0,0] => b, [0,0,0] => c, [0,0,0,0] => d},
+ a = maps:get([0],M3),
+ b = maps:get([0,0],M3),
+ c = maps:get([0,0,0],M3),
+ d = maps:get([0,0,0,0],M3),
+
+ M4 = M#{{[0]} => a, {[0,0]} => b, {[0,0,0]} => c, {[0,0,0,0]} => d},
+ a = maps:get({[0]},M4),
+ b = maps:get({[0,0]},M4),
+ c = maps:get({[0,0,0]},M4),
+ d = maps:get({[0,0,0,0]},M4),
+
+ M5 = M3#{[0,0,0] => e, [0,0,0,0] => f, [0,0,0,0,0] => g,
+ [0,0,0,0,0,0] => h, [0,0,0,0,0,0,0] => i,
+ [0,0,0,0,0,0,0,0] => j, [0,0,0,0,0,0,0,0,0] => k},
+
+ a = maps:get([0],M5),
+ b = maps:get([0,0],M5),
+ e = maps:get([0,0,0],M5),
+ f = maps:get([0,0,0,0],M5),
+ g = maps:get([0,0,0,0,0],M5),
+ h = maps:get([0,0,0,0,0,0],M5),
+ i = maps:get([0,0,0,0,0,0,0],M5),
+ j = maps:get([0,0,0,0,0,0,0,0],M5),
+ k = maps:get([0,0,0,0,0,0,0,0,0],M5),
+
+ M6 = M4#{{[0,0,0]} => e, {[0,0,0,0]} => f, {[0,0,0,0,0]} => g,
+ {[0,0,0,0,0,0]} => h, {[0,0,0,0,0,0,0]} => i,
+ {[0,0,0,0,0,0,0,0]} => j, {[0,0,0,0,0,0,0,0,0]} => k},
+
+ a = maps:get({[0]},M6),
+ b = maps:get({[0,0]},M6),
+ e = maps:get({[0,0,0]},M6),
+ f = maps:get({[0,0,0,0]},M6),
+ g = maps:get({[0,0,0,0,0]},M6),
+ h = maps:get({[0,0,0,0,0,0]},M6),
+ i = maps:get({[0,0,0,0,0,0,0]},M6),
+ j = maps:get({[0,0,0,0,0,0,0,0]},M6),
+ k = maps:get({[0,0,0,0,0,0,0,0,0]},M6),
+
+ M7 = maps:merge(M5,M6),
+
+ a = maps:get([0],M7),
+ b = maps:get([0,0],M7),
+ e = maps:get([0,0,0],M7),
+ f = maps:get([0,0,0,0],M7),
+ g = maps:get([0,0,0,0,0],M7),
+ h = maps:get([0,0,0,0,0,0],M7),
+ i = maps:get([0,0,0,0,0,0,0],M7),
+ j = maps:get([0,0,0,0,0,0,0,0],M7),
+ k = maps:get([0,0,0,0,0,0,0,0,0],M7),
+ a = maps:get({[0]},M7),
+ b = maps:get({[0,0]},M7),
+ e = maps:get({[0,0,0]},M7),
+ f = maps:get({[0,0,0,0]},M7),
+ g = maps:get({[0,0,0,0,0]},M7),
+ h = maps:get({[0,0,0,0,0,0]},M7),
+ i = maps:get({[0,0,0,0,0,0,0]},M7),
+ j = maps:get({[0,0,0,0,0,0,0,0]},M7),
+ k = maps:get({[0,0,0,0,0,0,0,0,0]},M7),
+ ok.
+
t_pdict(_Config) ->
put(#{ a => b, b => a},#{ c => d}),
@@ -1086,5 +2922,330 @@ trace_collector(Msg,Parent) ->
Parent ! Msg,
Parent.
+t_has_map_fields(Config) when is_list(Config) ->
+ true = has_map_fields_1(#{one=>1}),
+ true = has_map_fields_1(#{one=>1,two=>2}),
+ false = has_map_fields_1(#{two=>2}),
+ false = has_map_fields_1(#{}),
+
+ true = has_map_fields_2(#{c=>1,b=>2,a=>3}),
+ true = has_map_fields_2(#{c=>1,b=>2,a=>3,x=>42}),
+ false = has_map_fields_2(#{b=>2,c=>1}),
+ false = has_map_fields_2(#{x=>y}),
+ false = has_map_fields_2(#{}),
+
+ true = has_map_fields_3(#{c=>1,b=>2,a=>3}),
+ true = has_map_fields_3(#{c=>1,b=>2,a=>3,[]=>42}),
+ true = has_map_fields_3(#{b=>2,a=>3,[]=>42,42.0=>43}),
+ true = has_map_fields_3(#{a=>3,[]=>42,42.0=>43}),
+ true = has_map_fields_3(#{[]=>42,42.0=>43}),
+ false = has_map_fields_3(#{b=>2,c=>1}),
+ false = has_map_fields_3(#{[]=>y}),
+ false = has_map_fields_3(#{42.0=>x,a=>99}),
+ false = has_map_fields_3(#{}),
+
+ ok.
+
+has_map_fields_1(#{one:=_}) -> true;
+has_map_fields_1(#{}) -> false.
+
+has_map_fields_2(#{a:=_,b:=_,c:=_}) -> true;
+has_map_fields_2(#{}) -> false.
+
+has_map_fields_3(#{a:=_,b:=_}) -> true;
+has_map_fields_3(#{[]:=_,42.0:=_}) -> true;
+has_map_fields_3(#{}) -> false.
+
+y_regs(Config) when is_list(Config) ->
+ Val = [length(Config)],
+ Map0 = y_regs_update(#{}, Val),
+ Map2 = y_regs_update(Map0, Val),
+
+ Map3 = maps:from_list([{I,I*I} || I <- lists:seq(1, 100)]),
+ Map4 = y_regs_update(Map3, Val),
+
+ true = is_map(Map2) andalso is_map(Map4),
+
+ ok.
+
+y_regs_update(Map0, Val0) ->
+ Val1 = {t,Val0},
+ K1 = id({key,1}),
+ K2 = id({key,2}),
+ Map1 = Map0#{K1=>K1,
+ a=>Val0,b=>Val0,c=>Val0,d=>Val0,e=>Val0,
+ f=>Val0,g=>Val0,h=>Val0,i=>Val0,j=>Val0,
+ k=>Val0,l=>Val0,m=>Val0,n=>Val0,o=>Val0,
+ p=>Val0,q=>Val0,r=>Val0,s=>Val0,t=>Val0,
+ u=>Val0,v=>Val0,w=>Val0,x=>Val0,y=>Val0,
+ z=>Val0,
+ aa=>Val0,ab=>Val0,ac=>Val0,ad=>Val0,ae=>Val0,
+ af=>Val0,ag=>Val0,ah=>Val0,ai=>Val0,aj=>Val0,
+ ak=>Val0,al=>Val0,am=>Val0,an=>Val0,ao=>Val0,
+ ap=>Val0,aq=>Val0,ar=>Val0,as=>Val0,at=>Val0,
+ au=>Val0,av=>Val0,aw=>Val0,ax=>Val0,ay=>Val0,
+ az=>Val0,
+ K2=>[a,b,c]},
+ Map2 = Map1#{K1=>K1,
+ a:=Val1,b:=Val1,c:=Val1,d:=Val1,e:=Val1,
+ f:=Val1,g:=Val1,h:=Val1,i:=Val1,j:=Val1,
+ k:=Val1,l:=Val1,m:=Val1,n:=Val1,o:=Val1,
+ p:=Val1,q:=Val1,r:=Val1,s:=Val1,t:=Val1,
+ u:=Val1,v:=Val1,w:=Val1,x:=Val1,y:=Val1,
+ z:=Val1,
+ aa:=Val1,ab:=Val1,ac:=Val1,ad:=Val1,ae:=Val1,
+ af:=Val1,ag:=Val1,ah:=Val1,ai:=Val1,aj:=Val1,
+ ak:=Val1,al:=Val1,am:=Val1,an:=Val1,ao:=Val1,
+ ap:=Val1,aq:=Val1,ar:=Val1,as:=Val1,at:=Val1,
+ au:=Val1,av:=Val1,aw:=Val1,ax:=Val1,ay:=Val1,
+ az:=Val1,
+ K2=>[a,b,c]},
+
+ %% Traverse the maps to validate them.
+ _ = erlang:phash2({Map1,Map2}, 100000),
+
+ _ = id({K1,K2,Val0,Val1}), %Force use of Y registers.
+ Map2.
+
+do_badmap(Test) ->
+ Terms = [Test,fun erlang:abs/1,make_ref(),self(),0.0/id(-1),
+ <<0:1024>>,<<1:1>>,<<>>,<<1,2,3>>,
+ [],{a,b,c},[a,b],atom,10.0,42,(1 bsl 65) + 3],
+ [Test(T) || T <- Terms].
+
+%% Test that a module compiled with the OTP 17 compiler will
+%% generate the correct 'badmap' exception.
+badmap_17(Config) ->
+ case ?MODULE of
+ map_SUITE -> do_badmap_17(Config);
+ _ -> {skip,"Run in map_SUITE"}
+ end.
+
+do_badmap_17(Config) ->
+ Mod = badmap_17,
+ DataDir = test_server:lookup_config(data_dir, Config),
+ Beam = filename:join(DataDir, Mod),
+ {module,Mod} = code:load_abs(Beam),
+ do_badmap(fun Mod:update/1).
+
%% Use this function to avoid compile-time evaluation of an expression.
id(I) -> I.
+
+
+%% OTP-13763
+t_hash_entropy(Config) when is_list(Config) ->
+ %% entropy bug in 18.3, 19.0
+ M1 = maps:from_list([{#{"id" => I}, ok}||I <- lists:seq(1,50000)]),
+
+ #{ #{"id" => 100} := ok,
+ #{"id" => 200} := ok,
+ #{"id" => 300} := ok,
+ #{"id" => 400} := ok,
+ #{"id" => 500} := ok,
+ #{"id" => 600} := ok,
+ #{"id" => 700} := ok,
+ #{"id" => 800} := ok,
+ #{"id" => 900} := ok,
+ #{"id" => 25061} := ok,
+ #{"id" => 39766} := ok } = M1,
+
+ M0 = maps:from_list([{I,ok}||I <- lists:seq(1,33)]),
+ M2 = maps:from_list([{M0#{"id" => I}, ok}||I <- lists:seq(1,50000)]),
+
+ ok = maps:get(M0#{"id" => 100}, M2),
+ ok = maps:get(M0#{"id" => 200}, M2),
+ ok = maps:get(M0#{"id" => 300}, M2),
+ ok = maps:get(M0#{"id" => 400}, M2),
+ ok = maps:get(M0#{"id" => 500}, M2),
+ ok = maps:get(M0#{"id" => 600}, M2),
+ ok = maps:get(M0#{"id" => 700}, M2),
+ ok = maps:get(M0#{"id" => 800}, M2),
+ ok = maps:get(M0#{"id" => 900}, M2),
+ ok = maps:get(M0#{"id" => 25061}, M2),
+ ok = maps:get(M0#{"id" => 39766}, M2),
+ ok.
+
+%% 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/map_SUITE_data/badmap_17.beam b/erts/emulator/test/map_SUITE_data/badmap_17.beam
new file mode 100644
index 0000000000..277fc34b94
--- /dev/null
+++ b/erts/emulator/test/map_SUITE_data/badmap_17.beam
Binary files differ
diff --git a/erts/emulator/test/map_SUITE_data/badmap_17.erl b/erts/emulator/test/map_SUITE_data/badmap_17.erl
new file mode 100644
index 0000000000..0ec65e0e33
--- /dev/null
+++ b/erts/emulator/test/map_SUITE_data/badmap_17.erl
@@ -0,0 +1,26 @@
+-module(badmap_17).
+-export([update/1]).
+
+%% Compile this source file with OTP 17.
+
+update(Map) ->
+ try
+ update_1(Map),
+ error(update_did_not_fail)
+ catch
+ error:{badmap,Map} ->
+ ok
+ end,
+ try
+ update_2(Map),
+ error(update_did_not_fail)
+ catch
+ error:{badmap,Map} ->
+ ok
+ end.
+
+update_1(M) ->
+ M#{a=>42}.
+
+update_2(M) ->
+ M#{a:=42}.
diff --git a/erts/emulator/test/match_spec_SUITE.erl b/erts/emulator/test/match_spec_SUITE.erl
index 8038888796..08a7b4560c 100644
--- a/erts/emulator/test/match_spec_SUITE.erl
+++ b/erts/emulator/test/match_spec_SUITE.erl
@@ -1,35 +1,36 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2014. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2017. 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.
+%% 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(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([test_1/1, test_2/1, test_3/1, bad_match_spec_bin/1,
+-export([all/0, suite/0, not_run/1]).
+-export([test_1/1, test_2/1, test_3/1, caller_and_return_to/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,
+ ms_trace2/1, ms_trace3/1, ms_trace_dead/1, boxed_and_small/1,
destructive_in_test_bif/1, guard_exceptions/1,
empty_list/1,
unary_plus/1, unary_minus/1, moving_labels/1]).
-export([fpe/1]).
-export([otp_9422/1]).
-export([faulty_seq_trace/1, do_faulty_seq_trace/0]).
+-export([maps/1]).
-export([runner/2, loop_runner/3]).
-export([f1/1, f2/2, f3/2, fn/1, fn/2, fn/3]).
-export([do_boxed_and_small/0]).
@@ -37,193 +38,202 @@
% 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").
-
--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].
+-include_lib("common_test/include/ct.hrl").
-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, 1}}].
all() ->
case test_server:is_native(match_spec_SUITE) of
false ->
- [test_1, test_2, test_3, bad_match_spec_bin,
+ [test_1, test_2, test_3, caller_and_return_to, bad_match_spec_bin,
trace_control_word, silent, silent_no_ms, silent_test, ms_trace2,
- ms_trace3, boxed_and_small, destructive_in_test_bif,
+ ms_trace3, ms_trace_dead, boxed_and_small, destructive_in_test_bif,
guard_exceptions, unary_plus, unary_minus, fpe,
moving_labels,
faulty_seq_trace,
empty_list,
- otp_9422];
+ otp_9422,
+ maps];
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]}}]),
-
-% case tr0(fun() -> ?MODULE:f2(a, a) end,
-% {?MODULE, f2, 2},
-% [{['$1','$1'],[{is_atom, '$1'}],[{message, {process_dump}}]}]) of
-% [{trace, _, call, {?MODULE, f2, [a, a]}, Bin}] ->
-% erlang:display(binary_to_list(Bin))
-% end,
-
-% Error cases
- ?line errchk([{['$1','$1'],[{is_atom, '$1'}],[{banka, kanin}]}]),
-
+ 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,
+ {?MODULE, f1, 1},
+ [{['_'],[],[{message, {process_dump}}]}],
+ [fun({trace, _, call, {?MODULE, f1, [0]}, _Bin}) -> true end]),
+
+ % 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.
+
+%% Test that caller and return to work as they should
+%% There was a bug where caller would be undefined when return_to was set
+%% for r the bif erlang:put().
+caller_and_return_to(Config) ->
+ tr(
+ fun do_put_wrapper/0,
+ fun (Tracee) ->
+ MsgCaller = [{'_',[],[{message,{caller}}]}],
+ 1 = erlang:trace(Tracee, true, [call,return_to]),
+ 1 = erlang:trace_pattern( {?MODULE,do_put,1}, MsgCaller, [local]),
+ 1 = erlang:trace_pattern( {?MODULE,do_the_put,1}, MsgCaller, [local]),
+ 1 = erlang:trace_pattern( {erlang,integer_to_list,1}, MsgCaller, [local]),
+ 1 = erlang:trace_pattern( {erlang,put,2}, MsgCaller, [local]),
+
+ [{trace,Tracee,call,{?MODULE,do_put,[test]},{?MODULE,do_put_wrapper,0}},
+ {trace,Tracee,call,{?MODULE,do_the_put,[test]},{?MODULE,do_put,1}},
+ {trace,Tracee,call,{erlang,integer_to_list,[1]},{?MODULE,do_the_put,1}},
+ {trace,Tracee,return_to,{?MODULE,do_the_put,1}},
+ {trace,Tracee,call,{erlang,put,[test,"1"]},{?MODULE,do_put,1}},
+ {trace,Tracee,return_to,{?MODULE,do_put,1}},
+
+ %% These last trace messages are a bit strange...
+ %% if call tracing had been enabled for do_put_wrapper
+ %% then caller and return_to would have been {?MODULE,do_put_wrapper,1}
+ %% but since it is not, they are set to do_put instead, but we still
+ %% get the do_put_wrapper return_to message...
+ {trace,Tracee,call,{erlang,integer_to_list,[2]},{?MODULE,do_put,1}},
+ {trace,Tracee,return_to,{?MODULE,do_put,1}},
+ {trace,Tracee,return_to,{?MODULE,do_put_wrapper,0}}
+ ]
+ end),
+ ok.
+
+do_put_wrapper() ->
+ do_put(test),
+ ok.
+
+do_put(Var) ->
+ do_the_put(Var),
+ erlang:integer_to_list(id(2)).
+do_the_put(Var) ->
+ Lst = erlang:integer_to_list(id(1)),
+ erlang:put(Var, Lst).
-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),
@@ -242,9 +252,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).
@@ -259,261 +269,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-3-',0}},
+ {trace,Tracee,call,{?MODULE,f2,[f,g]}},
+ {trace,Tracee,return_to,
+ {?MODULE,'-silent_no_ms/1-fun-3-',0}},
+ {trace,Tracee,call,{erlang,integer_to_list,[2]}},
+ {trace,Tracee,return_to,
+ {?MODULE,'-silent_no_ms/1-fun-3-',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
@@ -521,75 +497,60 @@ 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-1-',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),
+ %% Silence valgrind
+ erlang:trace_pattern({?MODULE,fn,'_'},[],[]),
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(),
@@ -600,134 +561,140 @@ 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-2-',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 a dead tracer is removed using ms
+ms_trace_dead(_Config) ->
+ Self = self(),
+ TFun = fun F() -> receive M -> Self ! M, F() end end,
+ {Tracer, MRef} = spawn_monitor(TFun),
+ MetaTracer = spawn_link(TFun),
+ erlang:trace_pattern({?MODULE, f1, '_'},
+ [{'_',[],[{message, false},
+ {trace,[],
+ [call,{const,{tracer,Tracer}}]}]}],
+ [{meta, MetaTracer}]),
+ erlang:trace_pattern({?MODULE, f2, '_'}, []),
+ ?MODULE:f2(1,2),
+ ?MODULE:f1(1),
+ {tracer,Tracer} = erlang:trace_info(self(), tracer),
+ {flags,[call]} = erlang:trace_info(self(), flags),
+ ?MODULE:f2(2,3),
+ receive {trace, Self, call, {?MODULE, f2, _}} -> ok end,
+ exit(Tracer, stop),
+ receive {'DOWN',MRef,_,_,_} -> ok end,
+ ?MODULE:f1(2),
+ {tracer,[]} = erlang:trace_info(self(), tracer),
+ ?MODULE:f2(3,4),
+ TRef = erlang:trace_delivered(all),
+ receive {trace_delivered, _, TRef} -> ok end,
+ receive M -> ct:fail({unexpected, M}) after 10 -> ok end.
+
+%% 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 comparison 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() ->
@@ -737,13 +704,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() ->
@@ -755,63 +720,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}],
@@ -822,53 +782,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'},
@@ -876,7 +833,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'},
@@ -886,19 +843,84 @@ 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),
+ {ok,false,[],[]} =
+ erlang:match_spec_test(#{}, [{not_a_map,[],['$_']}], table),
+ {ok,bar,[],[]} =
+ erlang:match_spec_test(#{foo => bar},
+ [{#{foo => '$1'},[],['$1']}],
+ table),
+ {ok,false,[],[]} =
+ erlang:match_spec_test(#{foo => bar},
+ [{#{foo => qux},[],[qux]}],
+ table),
+ {ok,false,[],[]} =
+ erlang:match_spec_test(#{}, [{#{foo => '_'},[],[foo]}], table),
+ {error,_} =
+ erlang:match_spec_test(#{}, [{#{'$1' => '_'},[],[foo]}], table),
+ {ok,bar,[],[]} =
+ erlang:match_spec_test({#{foo => bar}},
+ [{{#{foo => '$1'}},[],['$1']}],
+ table),
+ {ok,#{foo := 3},[],[]} =
+ erlang:match_spec_test({}, [{{},[],[#{foo => {'+',1,2}}]}], table),
+
+ {ok,"camembert",[],[]} =
+ erlang:match_spec_test(#{b => "camembert",c => "cabécou"},
+ [{#{b => '$1',c => "cabécou"},[],['$1']}], table),
+
+ {ok,#{a :="camembert",b := "hi"},[],[]} =
+ erlang:match_spec_test(#{<<"b">> =>"camembert","c"=>"cabécou", "wat"=>"hi", b=><<"other">>},
+ [{#{<<"b">> => '$1',"wat" => '$2'},[],[#{a=>'$1',b=>'$2'}]}],
+ table),
+ %% large maps
+
+ Ls0 = [{I,<<I:32>>}||I <- lists:seq(1,415)],
+ M0 = maps:from_list(Ls0),
+ M1 = #{a=>1,b=>2,c=>3,d=>4},
+
+ R1 = M0#{263 := #{ a=> 3 }},
+ Ms1 = [{M1#{c:='$1'},[],[M0#{263 := #{a => '$1'}}]}],
+
+ {ok,R1,[],[]} = erlang:match_spec_test(M1,Ms1,table),
+
+ Ms2 = [{M0#{63:='$1', 19:='$2'},[],[M0#{19:='$1', 63:='$2'}]}],
+ R2 = M0#{63 := maps:get(19,M0), 19 := maps:get(63,M0) },
+ {ok,R2,[],[]} = erlang:match_spec_test(M0,Ms2,table),
+
+ ok = maps_check_loop(M1),
+ ok = maps_check_loop(M0),
+ M2 = maps:from_list([{integer_to_list(K),V} || {K,V} <- Ls0]),
+ ok = maps_check_loop(M2),
+ ok.
+
+maps_check_loop(M) ->
+ Ks = maps:keys(M),
+ maps_check_loop(M,M,M,M,Ks,lists:reverse(Ks),1).
+
+maps_check_loop(Orig,M0,MsM0,Rm0,[K|Ks],[Rk|Rks],Ix) ->
+ MsK = list_to_atom([$$]++integer_to_list(Ix)),
+ MsM1 = MsM0#{K := MsK},
+ Rm1 = Rm0#{Rk := MsK},
+ M1 = M0#{Rk := maps:get(K,MsM0)},
+ Ms = [{MsM1,[],[Rm1]}],
+ {ok,M1,[],[]} = erlang:match_spec_test(Orig,Ms,table),
+ maps_check_loop(Orig,M1,MsM1,Rm1,Ks,Rks,Ix+1);
+maps_check_loop(_,_,_,_,[],[],_) -> ok.
+
+
empty_list(Config) when is_list(Config) ->
Val=[{'$1',[], [{message,'$1'},{message,{caller}},{return_trace}]}],
%% Did crash debug VM in faulty assert:
@@ -910,11 +932,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.
@@ -925,17 +947,17 @@ 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) ->
- 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) ->
- P = spawn(?MODULE, runner, [self(), RunFun]),
+ P = spawn_link(?MODULE, runner, [self(), RunFun]),
collect(P, ControlFun(P)).
collect(P, TMs) ->
@@ -946,36 +968,57 @@ 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
- M ->
- case if element(1, M) == trace_ts ->
- list_to_tuple(lists:reverse(
- tl(lists:reverse(tuple_to_list(M)))));
- true -> M
- end of
- TM ->
- ?t:format("Got: ~p~n", [M]),
- collect(TMs);
- _ ->
- ?t:format("Got unexpected: ~p~n", [M]),
- flush({got_unexpected,M})
+ %% We only look at trace messages with the same tracee
+ %% as the message we are looking for. This because
+ %% the order of trace messages is only guaranteed from
+ %% within a single process.
+ M0 when element(2, M0) =:= element(2, TM); is_function(TM, 1) ->
+ 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
+ after 15000 ->
+ flush(timeout)
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) ->
@@ -986,43 +1029,45 @@ 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) ->
+loop_runner_cont(Collector, _Fun, Laps, Laps) ->
receive
- {done, Collector} ->
- io:format("loop_runner ~p exit after ~p laps\n", [self(), Laps]),
- Collector ! {gone, self()}
- end;
+ {done, Collector} -> ok;
+ {abort, Collector} -> ok
+ end,
+ io:format("loop_runner ~p exit after ~p laps\n", [self(), Laps]),
+ Collector ! {gone, self()};
+
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.
@@ -1043,6 +1088,10 @@ fn(X, Y) ->
fn(X, Y, Z) ->
[X, Y, Z].
+fbinmatch(<<Int, Rest/binary>>, Acc) ->
+ fbinmatch(Rest, [?MODULE:f1(Int) | Acc]);
+fbinmatch(<<>>, Acc) -> Acc.
+
id(X) ->
X.
@@ -1050,7 +1099,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..7f0cbdd885
--- /dev/null
+++ b/erts/emulator/test/message_queue_data_SUITE.erl
@@ -0,0 +1,207 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2014-2017. 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, total_heap_size/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, total_heap_size].
+
+%%
+%%
+%% Test cases
+%%
+%%
+
+basic(Config) when is_list(Config) ->
+
+ basic_test(erlang:system_info(message_queue_data)),
+
+ {ok, Node1} = start_node(Config, "+hmqd off_heap"),
+ ok = rpc:call(Node1, ?MODULE, basic_test, [off_heap]),
+ stop_node(Node1),
+
+ {ok, Node2} = start_node(Config, "+hmqd on_heap"),
+ ok = rpc:call(Node2, ?MODULE, basic_test, [on_heap]),
+ stop_node(Node2),
+
+ ok.
+
+is_valid_mqd_value(off_heap) ->
+ true;
+is_valid_mqd_value(on_heap) ->
+ 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),
+ {'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),
+
+ {'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,
+ on_heap = 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, off_heap),
+ Tester ! third,
+
+ receive after infinity -> ok end
+ end,
+ [link, {message_queue_data, on_heap}]),
+
+ P1 ! "A",
+ receive first -> ok end,
+ P1 ! "B",
+ receive second -> ok end,
+ P1 ! "C",
+ receive third -> ok end,
+ P1 ! "D",
+
+ {messages, ["A", "B", "C", "D"]} = process_info(P1, messages),
+
+ P2 = spawn_opt(fun () ->
+ receive after 500 -> ok end,
+ on_heap = 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, off_heap),
+ Tester ! third,
+ 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,
+
+ Tester ! self()
+ end,
+ [link, {message_queue_data, on_heap}]),
+
+ P2 ! "A",
+ receive first -> ok end,
+ P2 ! "B",
+ receive second -> ok end,
+ P2 ! "C",
+ receive third -> ok end,
+ P2 ! "D",
+
+ receive
+ Msg ->
+ {messages, ["A", "B", "C", "D"]} = Msg
+ end,
+
+ receive P2 -> ok end,
+
+ ok.
+
+total_heap_size(_Config) ->
+
+ Fun = fun F() -> receive Pid when is_pid(Pid) -> Pid ! ok,F() end end,
+
+ %% Test that on_heap messages grow the heap even if they are not received
+ OnPid = spawn_opt(Fun, [{message_queue_data, on_heap},link]),
+ {total_heap_size, OnSize} = erlang:process_info(OnPid, total_heap_size),
+ [OnPid ! lists:duplicate(N,N) || N <- lists:seq(1,100)],
+ OnPid ! self(), receive ok -> ok end,
+ {total_heap_size, OnSizeAfter} = erlang:process_info(OnPid, total_heap_size),
+ ct:log("OnSize = ~p, OnSizeAfter = ~p",[OnSize, OnSizeAfter]),
+ true = OnSize < OnSizeAfter,
+
+ %% Test that off_heap messages do not grow the heap if they are not received
+ OffPid = spawn_opt(Fun, [{message_queue_data, off_heap},link]),
+ {total_heap_size, OffSize} = erlang:process_info(OffPid, total_heap_size),
+ [OffPid ! lists:duplicate(N,N) || N <- lists:seq(1,100)],
+ OffPid ! self(), receive ok -> ok end,
+ {total_heap_size, OffSizeAfter} = erlang:process_info(OffPid, total_heap_size),
+ ct:log("OffSize = ~p, OffSizeAfter = ~p",[OffSize, OffSizeAfter]),
+ true = OffSize == OffSizeAfter.
+
+%%
+%%
+%% helpers
+%%
+%%
+
+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(second))
+ ++ "-"
+ ++ 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 8a63d9fe3e..ba9b564fdc 100644
--- a/erts/emulator/test/module_info_SUITE.erl
+++ b/erts/emulator/test/module_info_SUITE.erl
@@ -1,77 +1,52 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2005-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2005-2016. 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.
+%% 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(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,
- exports/1,functions/1,native/1]).
+-export([all/0, suite/0,
+ exports/1,functions/1,deleted/1,native/1,info/1]).
%%-compile(native).
%% 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, native].
-
-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).
+modules() ->
+ [exports, functions, deleted, native, info].
%% 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() ->
@@ -81,40 +56,66 @@ all_functions() ->
%% Test that the list of exported functions from this module is correct.
exports(Config) when is_list(Config) ->
- ?line All = all_exported(),
- ?line All = lists:sort(?MODULE:module_info(exports)),
- ?line (catch ?MODULE:foo()),
- ?line All = lists:sort(?MODULE:module_info(exports)),
+ All = all_exported(),
+ All = lists:sort(?MODULE:module_info(exports)),
+ (catch ?MODULE:foo()),
+ All = lists:sort(?MODULE:module_info(exports)),
ok.
%% Test that the list of exported functions from this module is correct.
functions(Config) when is_list(Config) ->
- ?line All = all_functions(),
- ?line All = lists:sort(?MODULE:module_info(functions)),
+ All = all_functions(),
+ All = lists:sort(?MODULE:module_info(functions)),
+ ok.
+
+%% Test that deleted modules cause badarg
+deleted(Config) when is_list(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),
+ 17 = module_info_test:f(),
+ [_|_] = erlang:get_module_info(module_info_test, attributes),
+ [_|_] = erlang:get_module_info(module_info_test),
+
+ %% first delete it
+ true = erlang:delete_module(module_info_test),
+ {'EXIT',{undef, _}} = (catch module_info_test:f()),
+ {'EXIT',{badarg, _}} = (catch erlang:get_module_info(module_info_test,attributes)),
+ {'EXIT',{badarg, _}} = (catch erlang:get_module_info(module_info_test)),
+
+ %% then purge it
+ true = erlang:purge_module(module_info_test),
+ {'EXIT',{undef, _}} = (catch module_info_test:f()),
+ {'EXIT',{badarg, _}} = (catch erlang:get_module_info(module_info_test,attributes)),
+ {'EXIT',{badarg, _}} = (catch erlang:get_module_info(module_info_test)),
ok.
%% Test that the list of exported functions from this module is correct.
+%% Verify that module_info(native) works.
native(Config) when is_list(Config) ->
- ?line All = all_functions(),
- ?line case ?MODULE:module_info(native_addresses) of
- [] ->
- {comment,"no native functions"};
- L ->
- %% Verify that all functions have unique addresses.
- ?line S0 = sofs:set(L, [{name,arity,addr}]),
- ?line S1 = sofs:projection({external,fun ?MODULE:native_proj/1}, S0),
- ?line S2 = sofs:relation_to_family(S1),
- ?line S3 = sofs:family_specification(fun ?MODULE:native_filter/1, S2),
- ?line 0 = sofs:no_elements(S3),
- ?line S4 = sofs:range(S1),
-
- %% Verify that the set of function with native addresses
- %% is a subset of all functions in the module.
- ?line AllSet = sofs:set(All, [{name,arity}]),
- ?line true = sofs:is_subset(S4, AllSet),
-
- {comment,integer_to_list(sofs:no_elements(S0))++" native functions"}
- end.
+ All = all_functions(),
+ case ?MODULE:module_info(native_addresses) of
+ [] ->
+ false = ?MODULE:module_info(native),
+ {comment,"no native functions"};
+ L ->
+ true = ?MODULE:module_info(native),
+ %% Verify that all functions have unique addresses.
+ S0 = sofs:set(L, [{name,arity,addr}]),
+ S1 = sofs:projection({external,fun ?MODULE:native_proj/1}, S0),
+ S2 = sofs:relation_to_family(S1),
+ S3 = sofs:family_specification(fun ?MODULE:native_filter/1, S2),
+ 0 = sofs:no_elements(S3),
+ S4 = sofs:range(S1),
+
+ %% Verify that the set of function with native addresses
+ %% is a subset of all functions in the module.
+ AllSet = sofs:set(All, [{name,arity}]),
+ true = sofs:is_subset(S4, AllSet),
+
+ {comment,integer_to_list(sofs:no_elements(S0))++" native functions"}
+ end.
native_proj({Name,Arity,Addr}) ->
{Addr,{Name,Arity}}.
@@ -122,6 +123,22 @@ native_proj({Name,Arity,Addr}) ->
native_filter(Set) ->
sofs:no_elements(Set) =/= 1.
+%% Test that the module info of this module is correct. Use
+%% erlang:get_module_info(?MODULE) to avoid compiler optimization tricks.
+info(Config) when is_list(Config) ->
+ Info = erlang:get_module_info(?MODULE),
+ All = all_exported(),
+ {ok,{?MODULE,MD5}} = beam_lib:md5(code:which(?MODULE)),
+ {module, ?MODULE} = lists:keyfind(module, 1, Info),
+ {md5, MD5} = lists:keyfind(md5, 1, Info),
+ {exports, Exports} = lists:keyfind(exports, 1, Info),
+ All = lists:sort(Exports),
+ {attributes, Attrs} = lists:keyfind(attributes, 1, Info),
+ {vsn,_} = lists:keyfind(vsn, 1, Attrs),
+ {compile, Compile} = lists:keyfind(compile, 1, Info),
+ {options,_} = lists:keyfind(options, 1, Compile),
+ ok.
+
%% Helper functions (local).
add_arity(L) ->
diff --git a/erts/emulator/test/module_info_SUITE_data/module_info_test.erl b/erts/emulator/test/module_info_SUITE_data/module_info_test.erl
new file mode 100644
index 0000000000..6eaf21b9c9
--- /dev/null
+++ b/erts/emulator/test/module_info_SUITE_data/module_info_test.erl
@@ -0,0 +1,24 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 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%
+%%
+
+-module(module_info_test).
+-export([f/0]).
+
+f() ->
+ 17.
diff --git a/erts/emulator/test/monitor_SUITE.erl b/erts/emulator/test/monitor_SUITE.erl
index aec59867d8..9d772480d9 100644
--- a/erts/emulator/test/monitor_SUITE.erl
+++ b/erts/emulator/test/monitor_SUITE.erl
@@ -1,175 +1,149 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2011. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2017. 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.
+%% 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(monitor_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,
- 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]).
+-include_lib("common_test/include/ct.hrl").
+-include_lib("eunit/include/eunit.hrl").
--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,
demon_1, mon_1, mon_2, demon_2, demon_3,
demonitor_flush, {group, remove_monitor}, large_exit,
- list_cleanup, mixer, named_down, otp_5827].
+ list_cleanup, mixer, named_down, otp_5827,
+ monitor_time_offset].
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}|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
@@ -182,155 +156,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).
@@ -338,33 +299,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)}.
@@ -372,161 +333,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) ->
@@ -536,23 +489,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) ->
@@ -563,280 +516,341 @@ 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) ->
- ?line PA = filename:dirname(code:which(?MODULE)),
- ?line NN = [j0,j1,j2,j3],
-% ?line NN = [j0,j1],
- ?line NL0 = [begin
- {ok, J} = test_server:start_node
- (X, slave, [{args, "-pa " ++ PA}]),
- J
- end || X <- NN],
- ?line NL1 = lists:duplicate(2,node()) ++ NL0,
- ?line Perm = perm(NL1),
- ?line lists:foreach(
- fun(NL) ->
- ?line Js = [ start_jeeves({[],M}) || M <- (NL ++ NL) ],
- ?line [ask_jeeves(P,{monitor_process,self()}) || P <- Js],
- ?line {monitored_by,MB} =
- process_info(self(),monitored_by),
- ?line MBL = lists:sort(MB),
- ?line JsL = lists:sort(Js),
- ?line MBL = JsL,
- ?line {monitors,[]} = process_info(self(),monitors),
- ?line [tell_jeeves(P,{exit,flaff}) || P <- Js],
- ?line wait_for_m([],[],200)
- end,
- Perm),
- ?line lists:foreach(
- fun(NL) ->
- ?line Js = [ start_jeeves({[],M}) || M <- (NL ++ NL) ],
- ?line Rs = [begin
- {monitor_process,Ref} =
- ask_jeeves(P,{monitor_process,self()}),
- {P,Ref}
- end
- || P <- Js],
- ?line {monitored_by,MB} =
- process_info(self(),monitored_by),
- ?line MBL = lists:sort(MB),
- ?line JsL = lists:sort(Js),
- ?line MBL = JsL,
- ?line {monitors,[]} = process_info(self(),monitors),
- ?line [ask_jeeves(P,{demonitor,Ref}) || {P,Ref} <- Rs],
- ?line wait_for_m([],[],200),
- ?line [tell_jeeves(P,{exit,flaff}) || P <- Js]
- end,
- Perm),
- ?line lists:foreach(
- fun(NL) ->
- ?line Js = [ start_jeeves({[],M}) || M <- (NL ++ NL) ],
- ?line [ask_jeeves(P,{monitor_process,self()}) || P <- Js],
- ?line [erlang:monitor(process,P) || P <- Js],
- ?line {monitored_by,MB} =
- process_info(self(),monitored_by),
- ?line MBL = lists:sort(MB),
- ?line JsL = lists:sort(Js),
- ?line MBL = JsL,
- ?line {monitors,M} =
- process_info(self(),monitors),
- ?line ML = lists:sort([P||{process,P} <- M]),
- ?line ML = JsL,
- ?line [begin
- tell_jeeves(P,{exit,flaff}),
- receive {'DOWN',_,process,P,_} -> ok end
- end || P <- Js],
- ?line wait_for_m([],[],200)
- end,
- Perm),
- ?line lists:foreach(
- fun(NL) ->
- ?line Js = [ start_jeeves({[],M}) || M <- (NL ++ NL) ],
- ?line Rs = [begin
- {monitor_process,Ref} =
- ask_jeeves(P,{monitor_process,self()}),
- {P,Ref}
- end
- || P <- Js],
- ?line R2s = [{P,erlang:monitor(process,P)} || P <- Js],
- ?line {monitored_by,MB} =
- process_info(self(),monitored_by),
- ?line MBL = lists:sort(MB),
- ?line JsL = lists:sort(Js),
- ?line MBL = JsL,
- ?line {monitors,M} =
- process_info(self(),monitors),
- ?line ML = lists:sort([P||{process,P} <- M]),
- ?line ML = JsL,
- ?line [ask_jeeves(P,{demonitor,Ref}) || {P,Ref} <- Rs],
- ?line wait_for_m(lists:sort(M),[],200),
- ?line [erlang:demonitor(Ref) || {_P,Ref} <- R2s],
- ?line wait_for_m([],[],200),
- ?line [tell_jeeves(P,{exit,flaff}) || P <- Js]
- end,
- Perm),
- [test_server:stop_node(K) || K <- NL0 ],
+ PA = filename:dirname(code:which(?MODULE)),
+ NN = [j0,j1,j2],
+ NL0 = [begin
+ {ok, J} = test_server:start_node(X,slave,[{args, "-pa " ++ PA}]),
+ J
+ end || X <- NN],
+ NL1 = lists:duplicate(2,node()) ++ NL0,
+ Perm = perm(NL1),
+ lists:foreach(
+ fun(NL) ->
+ Js = [start_jeeves({[],M}) || M <- (NL ++ NL)],
+ [ask_jeeves(P,{monitor_process,self()}) || P <- Js],
+ {monitored_by,MB} = process_info(self(),monitored_by),
+ MBL = lists:sort(MB),
+ JsL = lists:sort(Js),
+ MBL = JsL,
+ {monitors,[]} = process_info(self(),monitors),
+ [tell_jeeves(P,{exit,flaff}) || P <- Js],
+ wait_for_m([],[],200)
+ end,
+ Perm),
+ lists:foreach(
+ fun(NL) ->
+ Js = [start_jeeves({[],M}) || M <- (NL ++ NL)],
+ Rs = [begin
+ {monitor_process,Ref} = ask_jeeves(P,{monitor_process,self()}),
+ {P,Ref}
+ end || P <- Js],
+ {monitored_by,MB} = process_info(self(),monitored_by),
+ MBL = lists:sort(MB),
+ JsL = lists:sort(Js),
+ MBL = JsL,
+ {monitors,[]} = process_info(self(),monitors),
+ [ask_jeeves(P,{demonitor,Ref}) || {P,Ref} <- Rs],
+ wait_for_m([],[],200),
+ [tell_jeeves(P,{exit,flaff}) || P <- Js]
+ end,
+ Perm),
+ lists:foreach(
+ fun(NL) ->
+ Js = [start_jeeves({[],M}) || M <- (NL ++ NL)],
+ [ask_jeeves(P,{monitor_process,self()}) || P <- Js],
+ [erlang:monitor(process,P) || P <- Js],
+ {monitored_by,MB} = process_info(self(),monitored_by),
+ MBL = lists:sort(MB),
+ JsL = lists:sort(Js),
+ MBL = JsL,
+ {monitors,M} = process_info(self(),monitors),
+ ML = lists:sort([P||{process,P} <- M]),
+ ML = JsL,
+ [begin
+ tell_jeeves(P,{exit,flaff}),
+ receive {'DOWN',_,process,P,_} -> ok end
+ end || P <- Js],
+ wait_for_m([],[],200)
+ end,
+ Perm),
+ lists:foreach(
+ fun(NL) ->
+ Js = [start_jeeves({[],M}) || M <- (NL ++ NL)],
+ Rs = [begin
+ {monitor_process,Ref} = ask_jeeves(P,{monitor_process,self()}),
+ {P,Ref}
+ end || P <- Js],
+ R2s = [{P,erlang:monitor(process,P)} || P <- Js],
+ {monitored_by,MB} = process_info(self(),monitored_by),
+ MBL = lists:sort(MB),
+ JsL = lists:sort(Js),
+ MBL = JsL,
+ {monitors,M} = process_info(self(),monitors),
+ ML = lists:sort([P||{process,P} <- M]),
+ ML = JsL,
+ [ask_jeeves(P,{demonitor,Ref}) || {P,Ref} <- Rs],
+ wait_for_m(lists:sort(M),[],200),
+ [erlang:demonitor(Ref) || {_P,Ref} <- R2s],
+ wait_for_m([],[],200),
+ [tell_jeeves(P,{exit,flaff}) || P <- Js]
+ end,
+ Perm),
+ [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 {A,B,C} = now(),
- ?line Name = list_to_atom(atom_to_list(?MODULE)
- ++ "-named_down-"
- ++ integer_to_list(A)
- ++ "-" ++ integer_to_list(B)
- ++ "-" ++ integer_to_list(C)),
- ?line Prio = process_flag(priority,high),
+ Name = list_to_atom(atom_to_list(?MODULE)
+ ++ "-named_down-"
+ ++ integer_to_list(erlang:system_time(second))
+ ++ "-" ++ 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),
+ ?assertEqual(true, register(Name, NamedProc)),
+ unlink(NamedProc),
+ exit(NamedProc, bang),
+ Mon = erlang:monitor(process, Name),
+ receive {'DOWN',Mon, _, _, bang} -> ok
+ after 3000 -> ?assert(false) end,
+ ?assertEqual(true, register(Name, self())),
+ ?assertEqual(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)),
+ lists:foreach(fun ({P, _M}) ->
+ P ! check_no_change_message
+ end, PMs),
+ lists:foreach(fun ({P, M}) ->
+ 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} ->
+ ct:fail(Reason)
+ end
+ end, PMs),
+ stop_node(Node),
+ ok.
+
+check_monitor_time_offset(Leader) ->
+ Mon1 = erlang:monitor(time_offset, clock_service),
+ Mon2 = erlang:monitor(time_offset, clock_service),
+ Mon3 = erlang:monitor(time_offset, clock_service),
+ 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)
+ after 0 ->
+ Leader ! {no_change_message_received, self()}
+ end,
+ receive after 100 -> ok end,
+ erlang:demonitor(Mon4, [flush]),
+ receive
+ {'CHANGE', Mon3, time_offset, clock_service, _} ->
+ ok
+ end,
+ receive
+ {'CHANGE', Mon6, time_offset, clock_service, _} ->
+ ok
+ end,
+ erlang:demonitor(Mon5, [flush]),
+ receive
+ {'CHANGE', Mon7, time_offset, clock_service, _} ->
+ ok
+ end,
+ receive
+ {'CHANGE', Mon1, time_offset, clock_service, _} ->
+ ok
+ end,
+ receive
+ {'CHANGE', _, time_offset, clock_service, _} ->
+ exit(unexpected_change_message_received)
+ after 1000 ->
+ ok
+ end,
+ Leader ! {change_messages_received, self()}.
+%%
+%% ...
+%%
wait_for_m(_,_,0) ->
exit(monitor_wait_timeout);
@@ -844,17 +858,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...
@@ -878,32 +892,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.
@@ -913,10 +927,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) ->
@@ -930,20 +944,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.
@@ -959,3 +973,22 @@ generate(_Fun, 0) ->
[];
generate(Fun, N) ->
[Fun() | generate(Fun, N-1)].
+
+start_node(Config, Args) ->
+ 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)),
+ test_server:start_node(Name,
+ 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 a492501959..843e917dfc 100644
--- a/erts/emulator/test/mtx_SUITE.erl
+++ b/erts/emulator/test/mtx_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2017. 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/.
+%% 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
%%
-%% 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.
+%% 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%
%%
@@ -28,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,
@@ -55,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} ->
@@ -70,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).
+end_per_testcase(_Func, _Config) ->
+ ok.
wait_deallocations() ->
try
@@ -89,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};
@@ -197,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,
@@ -342,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,
@@ -407,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 = now(),
- lists:foreach(fun (P) -> P ! go end, Ps),
- lists:foreach(fun (P) -> receive {done, P} -> ok end end, Ps),
- Stop = now(),
- lists:foreach(fun (P) ->
- unlink(P),
- exit(P, bang),
- M = erlang:monitor(process, P),
- receive
- {'DOWN', M, process, P, _} -> ok
- end
- end, Ps),
- Res = timer:now_diff(Stop, Start)/1000000,
- 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,second,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) ->
@@ -479,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/mtx_SUITE_data/Makefile.src b/erts/emulator/test/mtx_SUITE_data/Makefile.src
index 04412280c0..1816dc6798 100644
--- a/erts/emulator/test/mtx_SUITE_data/Makefile.src
+++ b/erts/emulator/test/mtx_SUITE_data/Makefile.src
@@ -1,18 +1,19 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2010-2013. All Rights Reserved.
+# Copyright Ericsson AB 2010-2016. 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.
+# 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%
#
diff --git a/erts/emulator/test/mtx_SUITE_data/mtx_SUITE.c b/erts/emulator/test/mtx_SUITE_data/mtx_SUITE.c
index 7c8137dc83..46ee8b5540 100644
--- a/erts/emulator/test/mtx_SUITE_data/mtx_SUITE.c
+++ b/erts/emulator/test/mtx_SUITE_data/mtx_SUITE.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2010-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2010-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
@@ -23,7 +24,7 @@
* Author: Rickard Green
*/
-#include "erl_nif.h"
+#include <erl_nif.h>
#ifdef __WIN32__
# ifndef WIN32_LEAN_AND_MEAN
diff --git a/erts/emulator/test/multi_load_SUITE.erl b/erts/emulator/test/multi_load_SUITE.erl
new file mode 100644
index 0000000000..edf3205812
--- /dev/null
+++ b/erts/emulator/test/multi_load_SUITE.erl
@@ -0,0 +1,181 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1999-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(multi_load_SUITE).
+-export([all/0, suite/0, 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].
+
+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,divide(Us1,Us2)]),
+ ok.
+
+divide(A,B) when B > 0 -> A div B;
+divide(_,_) -> inf.
+
+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 2cd67ebaae..f1b4c03ae4 100644
--- a/erts/emulator/test/nested_SUITE.erl
+++ b/erts/emulator/test/nested_SUITE.erl
@@ -1,108 +1,93 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2011. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2017. 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.
+%% 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(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, {minutes, 1}}].
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 b2da6f58af..4811244b98 100644
--- a/erts/emulator/test/nif_SUITE.erl
+++ b/erts/emulator/test/nif_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2014. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2017. 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/.
+%% 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
%%
-%% 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.
+%% 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%
%%
@@ -20,15 +21,24 @@
-module(nif_SUITE).
%%-define(line_trace,true).
--define(CHECK(Exp,Got), check(Exp,Got,?LINE)).
-%%-define(CHECK(Exp,Got), ?line Exp = Got).
-
--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,
- init_per_testcase/2,
- end_per_testcase/2, basic/1, reload/1, upgrade/1, heap_frag/1,
+-define(CHECK(Exp,Got), Exp = check(Exp,Got,?LINE)).
+%%-define(CHECK(Exp,Got), Exp = Got).
+
+-include_lib("common_test/include/ct.hrl").
+
+-export([all/0, suite/0, groups/0,
+ init_per_group/2, end_per_group/2,
+ init_per_testcase/2, end_per_testcase/2,
+ basic/1, reload_error/1, upgrade/1, heap_frag/1,
+ t_on_load/1,
+ select/1,
+ monitor_process_a/1,
+ monitor_process_b/1,
+ monitor_process_c/1,
+ monitor_process_d/1,
+ demonitor_process/1,
+ monitor_frenzy/1,
+ hipe/1,
types/1, many_args/1, binaries/1, get_string/1, get_atom/1,
maps/1,
api_macros/1,
@@ -37,209 +47,824 @@
threading/1, send/1, send2/1, send3/1, send_threaded/1, neg/1,
is_checks/1,
get_length/1, make_atom/1, make_string/1, reverse_list_test/1,
- otp_9668/1, consume_timeslice/1, dirty_nif/1, dirty_nif_send/1
+ otp_9828/1,
+ otp_9668/1, consume_timeslice/1, nif_schedule/1,
+ nif_exception/1, call_nif_exception/1,
+ nif_nan_and_inf/1, nif_atom_too_long/1,
+ nif_monotonic_time/1, nif_time_offset/1, nif_convert_time_unit/1,
+ nif_now_time/1, nif_cpu_time/1, nif_unique_integer/1,
+ nif_is_process_alive/1, nif_is_port_alive/1,
+ nif_term_to_binary/1, nif_binary_to_term/1,
+ nif_port_command/1,
+ nif_snprintf/1,
+ nif_internal_hash/1,
+ nif_internal_hash_salted/1,
+ nif_phash2/1,
+ nif_whereis/1, nif_whereis_parallel/1,
+ nif_whereis_threaded/1, nif_whereis_proxy/1,
+ nif_ioq/1
]).
-export([many_args_100/100]).
-
-%% -export([lib_version/0,call_history/0,hold_nif_mod_priv_data/1,nif_mod_call_history/0,
-%% list_seq/1,type_test/0,tuple_2_list/1,is_identical/2,compare/2,
-%% clone_bin/1,make_sub_bin/3,string_to_bin/2,atom_to_bin/2,macros/1,
-%% tuple_2_list_and_tuple/1,iolist_2_bin/1,get_resource_type/1,alloc_resource/2,
-%% make_resource/1,get_resource/2,release_resource/1,last_resource_dtor_call/0, suite/0,
-%% make_new_resource/2,make_new_resource_binary/1,send_list_seq/2,send_new_blob/2,
-%% alloc_msgenv/0,clear_msgenv/1,grow_blob/2,send_blob/2,send_blob_thread/3,
-%% join_send_thread/1]).
-
-
-define(nif_stub,nif_stub_error(?LINE)).
+-define(is_resource, is_reference).
+
suite() -> [{ct_hooks,[ts_install_cth]}].
-all() ->
- [basic, reload, upgrade, heap_frag, types, many_args,
+all() ->
+ [basic]
+ ++
+ [{group, G} || G <- api_groups()]
+ ++
+ [reload_error, heap_frag, types, many_args,
+ select,
+ {group, monitor},
+ monitor_frenzy,
+ hipe,
binaries, get_string, get_atom, maps, api_macros, from_array,
iolist_as_binary, resource, resource_binary,
- resource_takeover, threading, send, send2, send3,
+ threading, send, send2, send3,
send_threaded, neg, is_checks, get_length, make_atom,
make_string,reverse_list_test,
- otp_9668, consume_timeslice, dirty_nif, dirty_nif_send
- ].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
+ otp_9828,
+ otp_9668, consume_timeslice,
+ nif_schedule, nif_exception, nif_nan_and_inf, nif_atom_too_long,
+ nif_monotonic_time, nif_time_offset, nif_convert_time_unit,
+ nif_now_time, nif_cpu_time, nif_unique_integer,
+ nif_is_process_alive, nif_is_port_alive,
+ nif_term_to_binary, nif_binary_to_term,
+ nif_port_command,
+ nif_snprintf,
+ nif_internal_hash,
+ nif_internal_hash_salted,
+ nif_phash2,
+ nif_whereis, nif_whereis_parallel, nif_whereis_threaded,
+ nif_ioq].
+
+groups() ->
+ [{G, [], api_repeaters()} || G <- api_groups()]
+ ++
+ [{monitor, [], [monitor_process_a,
+ monitor_process_b,
+ monitor_process_c,
+ monitor_process_d,
+ demonitor_process]}].
+
+
+api_groups() -> [api_latest, api_2_4, api_2_0].
+
+api_repeaters() -> [upgrade, resource_takeover, t_on_load].
+
+init_per_group(api_2_4, Config) ->
+ [{nif_api_version, ".2_4"} | Config];
+init_per_group(api_2_0, Config) ->
+ case {os:type(),erlang:system_info({wordsize, internal})} of
+ {{win32,_}, 8} ->
+ %% ERL_NIF_TERM was declared as 32-bit 'long' until 2.3
+ {skip, "API 2.0 buggy on Windows 64-bit"};
+ _ ->
+ [{nif_api_version, ".2_0"} | Config]
+ end;
+init_per_group(_, Config) -> Config.
+
+end_per_group(_,_) -> ok.
+
+init_per_testcase(t_on_load, Config) ->
+ ets:new(nif_SUITE, [named_table]),
+ Config;
+init_per_testcase(hipe, Config) ->
+ case erlang:system_info(hipe_architecture) of
+ undefined -> {skip, "HiPE is disabled"};
+ _ -> Config
+ end;
+init_per_testcase(nif_whereis_threaded, Config) ->
+ case erlang:system_info(threads) of
+ true -> Config;
+ false -> {skip, "No thread support"}
+ end;
+init_per_testcase(select, Config) ->
+ case os:type() of
+ {win32,_} ->
+ {skip, "Test not yet implemented for windows"};
+ _ ->
+ Config
+ end;
init_per_testcase(_Case, Config) ->
-% ?line Dog = ?t:timetrap(?t:seconds(60*60*24)),
Config.
+end_per_testcase(t_on_load, _Config) ->
+ ets:delete(nif_SUITE),
+ testcase_cleanup();
end_per_testcase(_Func, _Config) ->
- %%Dog = ?config(watchdog, Config),
- %%?t:timetrap_cancel(Dog),
+ testcase_cleanup().
+
+testcase_cleanup() ->
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) -> [];
-reload(Config) when is_list(Config) ->
+%% Test old reload feature now always fails
+reload_error(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(),
+ {error, {reload, _}} = nif_mod:load_nif_lib(Config, 2),
+ 1 = nif_mod:lib_version(),
+ [{lib_version,1,3,103}] = 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(),
+ {error, {reload, _}} = nif_mod:load_nif_lib(Config, 1),
+ 1 = nif_mod:lib_version(),
+ [{lib_version,1,4,104}] = 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,5,105}] = 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) -> [];
-upgrade(Config) when is_list(Config) ->
+%% 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(),
+
+ 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(),
+
+ 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(),
+
+ 1 = nif_mod:lib_version(),
+ [{lib_version,1,8,108}] = nif_mod_call_history(),
+
+ true = erlang:delete_module(nif_mod),
+ [] = nif_mod_call_history(),
+
+ %% Repeat upgrade again but from old (deleted) instance
+ {module,nif_mod} = erlang:load_module(nif_mod,Bin),
+ undefined = nif_mod:lib_version(),
+ 1 = call(Pid,lib_version),
+ [{lib_version,1,9,109}] = nif_mod_call_history(),
+
+ ok = nif_mod:load_nif_lib(Config, 1),
+ 1 = nif_mod:lib_version(),
+ [{upgrade,1,10,110},{lib_version,1,11,111}] = nif_mod_call_history(),
+
+ upgraded = call(Pid,upgrade),
+ false = check_process_code(Pid, nif_mod),
+ true = erlang:purge_module(nif_mod),
+ [{unload,1,12,112}] = nif_mod_call_history(),
+
+ 1 = nif_mod:lib_version(),
+ [{lib_version,1,13,113}] = nif_mod_call_history(),
+
+ true = erlang:delete_module(nif_mod),
+ [] = 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,14,114}] = nif_mod_call_history(),
+
+ %% Module upgrade with different lib version
+ {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(),
+
+
+ %% Reverse upgrade but from old (deleted) instance
+ {module,nif_mod} = erlang:load_module(nif_mod,Bin),
+ undefined = nif_mod:lib_version(),
+ [] = nif_mod_call_history(),
+ 2 = call(Pid2,lib_version),
+ [{lib_version,2,4,204}] = nif_mod_call_history(),
+
+ ok = nif_mod:load_nif_lib(Config, 1),
+ 1 = nif_mod:lib_version(),
+ [{upgrade,1,1,101},{lib_version,1,2,102}] = nif_mod_call_history(),
+
+ 2 = call(Pid2,lib_version),
+ [{lib_version,2,5,205}] = nif_mod_call_history(),
+
+ upgraded = call(Pid2,upgrade),
+ false = check_process_code(Pid2, nif_mod),
+ true = erlang:purge_module(nif_mod),
+ [{unload,2,6,206}] = nif_mod_call_history(),
+
+ 1 = nif_mod:lib_version(),
+ [{lib_version,1,3,103}] = 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,1,4,104}] = 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.
+
+%% Test loading/upgrade in on_load
+t_on_load(Config) when is_list(Config) ->
+ TmpMem = tmpmem(),
+ ensure_lib_loaded(Config),
+
+ Data = proplists:get_value(data_dir, Config),
+ File = filename:join(Data, "nif_mod"),
+ {ok,nif_mod,Bin} = compile:file(File, [binary,return_errors,
+ {d,'USE_ON_LOAD'}]),
+
+ %% Use ETS to tell nif_mod:on_load what to do
+ ets:insert(nif_SUITE, {data_dir, Data}),
+ ets:insert(nif_SUITE, {lib_version, 1}),
+ API = proplists:get_value(nif_api_version, Config, ""),
+ ets:insert(nif_SUITE, {nif_api_version, API}),
+ {module,nif_mod} = code:load_binary(nif_mod,File,Bin),
+ 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(),
+
+ {Pid,MRef} = nif_mod:start(),
+ 1 = call(Pid,lib_version),
+ [{lib_version,1,3,103}] = nif_mod_call_history(),
+
+ %% Module upgrade with same lib-version
+ {module,nif_mod} = code:load_binary(nif_mod,File,Bin),
+ 1 = nif_mod:lib_version(),
+ 1 = call(Pid,lib_version),
+ [{upgrade,1,4,104},{lib_version,1,5,105},{lib_version,1,6,106}] = 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(),
+ upgraded = call(Pid,upgrade),
+ false = check_process_code(Pid, nif_mod),
+ true = code:soft_purge(nif_mod),
+ [{unload,1,7,107}] = 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(),
+ 1 = nif_mod:lib_version(),
+ [{lib_version,1,8,108}] = nif_mod_call_history(),
+
+ true = code:delete(nif_mod),
+ [] = nif_mod_call_history(),
- ?line 1 = nif_mod:lib_version(),
- ?line [{lib_version,1,8,108}] = nif_mod_call_history(),
+ %% Repeat upgrade again but from old (deleted) instance
+ {module,nif_mod} = code:load_binary(nif_mod,File,Bin),
+ [{upgrade,1,9,109}] = nif_mod_call_history(),
+ 1 = nif_mod:lib_version(),
+ 1 = call(Pid,lib_version),
+ [{lib_version,1,10,110},{lib_version,1,11,111}] = nif_mod_call_history(),
- ?line true = erlang:delete_module(nif_mod),
- ?line [] = nif_mod_call_history(),
+ upgraded = call(Pid,upgrade),
+ false = check_process_code(Pid, nif_mod),
+ true = code:soft_purge(nif_mod),
+ [{unload,1,12,112}] = 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(),
+ 1 = nif_mod:lib_version(),
+ [{lib_version,1,13,113}] = nif_mod_call_history(),
+
+ true = code:delete(nif_mod),
+ [] = nif_mod_call_history(),
+
+
+ Pid ! die,
+ {'DOWN', MRef, process, Pid, normal} = receive_any(),
+ false = check_process_code(Pid, nif_mod),
+ true = code:soft_purge(nif_mod),
+ [{unload,1,14,114}] = 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} = code:load_binary(nif_mod,File,Bin),
+ 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(),
+
+ 1 = nif_mod:lib_version(),
+ {Pid2,MRef2} = nif_mod:start(),
+ 1 = call(Pid2,lib_version),
+ [{lib_version,1,3,103},{lib_version,1,4,104}] = nif_mod_call_history(),
+
+ true = ets:insert(nif_SUITE,{lib_version,2}),
+ {module,nif_mod} = code:load_binary(nif_mod,File,Bin),
+ [{upgrade,2,1,201}] = nif_mod_call_history(),
+
+ 2 = nif_mod:lib_version(),
+ 1 = call(Pid2,lib_version),
+ [{lib_version,2,2,202},{lib_version,1,5,105}] = nif_mod_call_history(),
+
+ upgraded = call(Pid2,upgrade),
+ false = check_process_code(Pid2, nif_mod),
+ true = code:soft_purge(nif_mod),
+ [{unload,1,6,106}] = nif_mod_call_history(),
+
+ 2 = nif_mod:lib_version(),
+ 2 = call(Pid2,lib_version),
+ [{lib_version,2,3,203},{lib_version,2,4,204}] = nif_mod_call_history(),
+
+ true = code:delete(nif_mod),
+ [] = nif_mod_call_history(),
+
+ %% Reverse upgrade but from old (deleted) instance
+ ets:insert(nif_SUITE,{lib_version,1}),
+ {module,nif_mod} = code:load_binary(nif_mod,File,Bin),
+ [{upgrade,1,1,101}] = nif_mod_call_history(),
+
+ 1 = nif_mod:lib_version(),
+ 2 = call(Pid2,lib_version),
+ [{lib_version,1,2,102},{lib_version,2,5,205}] = nif_mod_call_history(),
+
+ upgraded = call(Pid2,upgrade),
+ false = check_process_code(Pid2, nif_mod),
+ true = code:soft_purge(nif_mod),
+ [{unload,2,6,206}] = nif_mod_call_history(),
+
+ 1 = nif_mod:lib_version(),
+ [{lib_version,1,3,103}] = nif_mod_call_history(),
+
+ true = code:delete(nif_mod),
+ [] = nif_mod_call_history(),
+
+
+ Pid2 ! die,
+ {'DOWN', MRef2, process, Pid2, normal} = receive_any(),
+ false= check_process_code(Pid2, nif_mod),
+ true = code:soft_purge(nif_mod),
+ [{unload,1,4,104}] = 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) -> [];
+-define(ERL_NIF_SELECT_READ, (1 bsl 0)).
+-define(ERL_NIF_SELECT_WRITE, (1 bsl 1)).
+-define(ERL_NIF_SELECT_STOP, (1 bsl 2)).
+
+-define(ERL_NIF_SELECT_STOP_CALLED, (1 bsl 0)).
+-define(ERL_NIF_SELECT_STOP_SCHEDULED, (1 bsl 1)).
+-define(ERL_NIF_SELECT_INVALID_EVENT, (1 bsl 2)).
+-define(ERL_NIF_SELECT_FAILED, (1 bsl 3)).
+
+
+select(Config) when is_list(Config) ->
+ ensure_lib_loaded(Config),
+
+ Ref = make_ref(),
+ Ref2 = make_ref(),
+ {{R, R_ptr}, {W, W_ptr}} = pipe_nif(),
+ ok = write_nif(W, <<"hej">>),
+ <<"hej">> = read_nif(R, 3),
+
+ %% Wait for read
+ eagain = read_nif(R, 3),
+ 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,null,Ref),
+ [] = flush(0),
+ ok = write_nif(W, <<"hej">>),
+ [{select, R, Ref, ready_input}] = flush(),
+ 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,self(),Ref2),
+ [{select, R, Ref2, ready_input}] = flush(),
+ Papa = self(),
+ Pid = spawn_link(fun() ->
+ [{select, R, Ref, ready_input}] = flush(),
+ Papa ! {self(), done}
+ end),
+ 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,Pid,Ref),
+ {Pid, done} = receive_any(1000),
+ <<"hej">> = read_nif(R, 3),
+
+ %% Wait for write
+ Written = write_full(W, $a),
+ 0 = select_nif(W,?ERL_NIF_SELECT_WRITE,W,self(),Ref),
+ [] = flush(0),
+ Written = read_nif(R,byte_size(Written)),
+ [{select, W, Ref, ready_output}] = flush(),
+
+ %% Close write and wait for EOF
+ eagain = read_nif(R, 1),
+ check_stop_ret(select_nif(W,?ERL_NIF_SELECT_STOP,W,null,Ref)),
+ [{fd_resource_stop, W_ptr, _}] = flush(),
+ {1, {W_ptr,_}} = last_fd_stop_call(),
+ true = is_closed_nif(W),
+ [] = flush(0),
+ 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,self(),Ref),
+ [{select, R, Ref, ready_input}] = flush(),
+ eof = read_nif(R,1),
+
+ check_stop_ret(select_nif(R,?ERL_NIF_SELECT_STOP,R,null,Ref)),
+ [{fd_resource_stop, R_ptr, _}] = flush(),
+ {1, {R_ptr,_}} = last_fd_stop_call(),
+ true = is_closed_nif(R),
+
+ select_2(Config).
+
+select_2(Config) ->
+ erlang:garbage_collect(),
+ {_,_,2} = last_resource_dtor_call(),
+
+ Ref1 = make_ref(),
+ Ref2 = make_ref(),
+ {{R, R_ptr}, {W, W_ptr}} = pipe_nif(),
+
+ %% Change ref
+ eagain = read_nif(R, 1),
+ 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,null,Ref1),
+ 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,self(),Ref2),
+
+ [] = flush(0),
+ ok = write_nif(W, <<"hej">>),
+ [{select, R, Ref2, ready_input}] = flush(),
+ <<"hej">> = read_nif(R, 3),
+
+ %% Change pid
+ eagain = read_nif(R, 1),
+ 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,null,Ref1),
+ Papa = self(),
+ spawn_link(fun() ->
+ 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,null,Ref1),
+ [] = flush(0),
+ Papa ! sync,
+ [{select, R, Ref1, ready_input}] = flush(),
+ <<"hej">> = read_nif(R, 3),
+ Papa ! done
+ end),
+ sync = receive_any(),
+ ok = write_nif(W, <<"hej">>),
+ done = receive_any(),
+ [] = flush(0),
+
+ check_stop_ret(select_nif(R,?ERL_NIF_SELECT_STOP,R,null,Ref1)),
+ [{fd_resource_stop, R_ptr, _}] = flush(),
+ {1, {R_ptr,_}} = last_fd_stop_call(),
+ true = is_closed_nif(R),
+
+ %% Stop without previous read/write select
+ ?ERL_NIF_SELECT_STOP_CALLED = select_nif(W,?ERL_NIF_SELECT_STOP,W,null,Ref1),
+ [{fd_resource_stop, W_ptr, 1}] = flush(),
+ {1, {W_ptr,1}} = last_fd_stop_call(),
+ true = is_closed_nif(W),
+
+ select_3(Config).
+
+select_3(_Config) ->
+ erlang:garbage_collect(),
+ {_,_,2} = last_resource_dtor_call(),
+ ok.
+
+check_stop_ret(?ERL_NIF_SELECT_STOP_CALLED) -> ok;
+check_stop_ret(?ERL_NIF_SELECT_STOP_SCHEDULED) -> ok.
+
+write_full(W, C) ->
+ write_full(W, C, <<>>).
+write_full(W, C, Acc) ->
+ case write_nif(W, <<C>>) of
+ ok ->
+ write_full(W, (C+1) band 255, <<Acc/binary, C>>);
+ {eagain,0} ->
+ Acc
+ end.
+
+%% Basic monitoring of one process that terminates
+monitor_process_a(Config) ->
+ ensure_lib_loaded(Config),
+
+ F = fun(Terminator, UseMsgEnv) ->
+ Pid = spawn(fun() ->
+ receive
+ {exit, Arg} -> exit(Arg);
+ return -> ok;
+ BadMatch -> goodmatch = BadMatch
+ end
+ end),
+ R_ptr = alloc_monitor_resource_nif(),
+ {0, Mon1} = monitor_process_nif(R_ptr, Pid, UseMsgEnv, self()),
+ [R_ptr] = monitored_by(Pid),
+ Terminator(Pid),
+ [{monitor_resource_down, R_ptr, Pid, Mon2}] = flush(),
+ 0 = compare_monitors_nif(Mon1, Mon2),
+ [] = last_resource_dtor_call(),
+ ok = release_resource(R_ptr),
+ {R_ptr, _, 1} = last_resource_dtor_call()
+ end,
+
+ T1 = fun(Pid) -> Pid ! {exit, 17} end,
+ T2 = fun(Pid) -> Pid ! return end,
+ T3 = fun(Pid) -> Pid ! badmatch end,
+ T4 = fun(Pid) -> exit(Pid, 18) end,
+
+ [F(T, UME) || T <- [T1,T2,T3,T4], UME <- [true, false]],
+
+ ok.
+
+%% Test auto-demonitoring at resource destruction
+monitor_process_b(Config) ->
+ ensure_lib_loaded(Config),
+
+ monitor_process_b_do(false),
+ case erlang:system_info(threads) of
+ true -> monitor_process_b_do(true);
+ false -> ok
+ end,
+ ok.
+
+
+monitor_process_b_do(FromThread) ->
+ Pid = spawn_link(fun() ->
+ receive
+ return -> ok
+ end
+ end),
+ R_ptr = alloc_monitor_resource_nif(),
+ {0,_} = monitor_process_nif(R_ptr, Pid, true, self()),
+ [R_ptr] = monitored_by(Pid),
+ case FromThread of
+ false -> ok = release_resource(R_ptr);
+ true -> ok = release_resource_from_thread(R_ptr)
+ end,
+ [] = flush(0),
+ {R_ptr, _, 1} = last_resource_dtor_call(),
+ [] = monitored_by(Pid),
+ Pid ! return,
+ ok.
+
+%% Test termination of monitored process holding last resource ref
+monitor_process_c(Config) ->
+ ensure_lib_loaded(Config),
+
+ Papa = self(),
+ Pid = spawn_link(fun() ->
+ R_ptr = alloc_monitor_resource_nif(),
+ {0,Mon} = monitor_process_nif(R_ptr, self(), true, Papa),
+ [R_ptr] = monitored_by(self()),
+ put(store, make_resource(R_ptr)),
+ ok = release_resource(R_ptr),
+ [] = last_resource_dtor_call(),
+ Papa ! {self(), done, R_ptr, Mon},
+ exit
+ end),
+ [{Pid, done, R_ptr, Mon1},
+ {monitor_resource_down, R_ptr, Pid, Mon2}] = flush(2),
+ compare_monitors_nif(Mon1, Mon2),
+ {R_ptr, _, 1} = last_resource_dtor_call(),
+ ok.
+
+%% Test race of resource dtor called when monitored process is exiting
+monitor_process_d(Config) ->
+ ensure_lib_loaded(Config),
+
+ Papa = self(),
+ {Target,TRef} = spawn_monitor(fun() ->
+ nothing = receive_any()
+ end),
+
+ R_ptr = alloc_monitor_resource_nif(),
+ {0,_} = monitor_process_nif(R_ptr, Target, true, self()),
+ [Papa, R_ptr] = monitored_by(Target),
+
+ exit(Target, die),
+ ok = release_resource(R_ptr),
+
+ [{'DOWN', TRef, process, Target, die}] = flush(), %% no monitor_resource_down
+ {R_ptr, _, 1} = last_resource_dtor_call(),
+
+ ok.
+
+%% Test basic demonitoring
+demonitor_process(Config) ->
+ ensure_lib_loaded(Config),
+
+ Pid = spawn_link(fun() ->
+ receive
+ return -> ok
+ end
+ end),
+ R_ptr = alloc_monitor_resource_nif(),
+ {0,MonBin1} = monitor_process_nif(R_ptr, Pid, true, self()),
+ [R_ptr] = monitored_by(Pid),
+ {0,MonBin2} = monitor_process_nif(R_ptr, Pid, true, self()),
+ [R_ptr, R_ptr] = monitored_by(Pid),
+ 0 = demonitor_process_nif(R_ptr, MonBin1),
+ [R_ptr] = monitored_by(Pid),
+ 1 = demonitor_process_nif(R_ptr, MonBin1),
+ 0 = demonitor_process_nif(R_ptr, MonBin2),
+ [] = monitored_by(Pid),
+ 1 = demonitor_process_nif(R_ptr, MonBin2),
+
+ ok = release_resource(R_ptr),
+ [] = flush(0),
+ {R_ptr, _, 1} = last_resource_dtor_call(),
+ [] = monitored_by(Pid),
+ Pid ! return,
+ ok.
+
+
+monitored_by(Pid) ->
+ {monitored_by, List0} = process_info(Pid, monitored_by),
+ List1 = lists:map(fun(E) when ?is_resource(E) ->
+ {Ptr, _} = get_resource(monitor_resource_type, E),
+ Ptr;
+ (E) -> E
+ end,
+ List0),
+ erlang:garbage_collect(),
+ lists:sort(List1).
+
+-define(FRENZY_RAND_BITS, 25).
+
+%% Exercise monitoring from NIF resources by randomly
+%% create/destruct processes, resources and monitors.
+monitor_frenzy(Config) ->
+ ensure_lib_loaded(Config),
+
+ Procs1 = processes(),
+ io:format("~p processes before: ~p\n", [length(Procs1), Procs1]),
+
+ %% Spawn first worker process
+ Master = self(),
+ spawn_link(fun() ->
+ SelfPix = monitor_frenzy_nif(init, ?FRENZY_RAND_BITS, 0, 0),
+ unlink(Master),
+ frenzy(SelfPix, {undefined, []})
+ end),
+ receive after 5*1000 -> ok end,
+
+ io:format("stats = ~p\n", [monitor_frenzy_nif(stats, 0, 0, 0)]),
+
+ Pids = monitor_frenzy_nif(stop, 0, 0, 0),
+ io:format("stats = ~p\n", [monitor_frenzy_nif(stats, 0, 0, 0)]),
+
+ lists:foreach(fun(P) ->
+ MRef = monitor(process, P),
+ exit(P, stop),
+ {'DOWN', MRef, process, P, _} = receive_any()
+ end,
+ Pids),
+
+ io:format("stats = ~p\n", [monitor_frenzy_nif(stats, 0, 0, 0)]),
+
+ Procs2 = processes(),
+ io:format("~p processes after: ~p\n", [length(Procs2), Procs2]),
+ ok.
+
+
+frenzy(_SelfPix, done) ->
+ ok;
+frenzy(SelfPix, State0) ->
+ Rnd = rand:uniform(1 bsl (?FRENZY_RAND_BITS+2)) - 1,
+ Op = Rnd band 3,
+ State1 = frenzy_do_op(SelfPix, Op, (Rnd bsr 2), State0),
+ frenzy(SelfPix, State1).
+
+frenzy_do_op(SelfPix, Op, Rnd, {Pid0,RBins}=State0) ->
+ case Op of
+ 0 -> % add/remove process
+ Papa = self(),
+ NewPid = case Pid0 of
+ undefined -> % Prepare new process to be added
+ spawn(fun() ->
+ MRef = monitor(process, Papa),
+ case receive_any() of
+ {go, MyPix, MyState} ->
+ demonitor(MRef, [flush]),
+ frenzy(MyPix, MyState);
+ {'DOWN', MRef, process, Papa, _} ->
+ ok
+ end
+ end);
+ _ ->
+ Pid0
+ end,
+ case monitor_frenzy_nif(Op, Rnd, SelfPix, NewPid) of
+ NewPix when is_integer(NewPix) ->
+ NewPid ! {go, NewPix, {undefined, []}},
+ {undefined, RBins};
+ ExitPid when is_pid(ExitPid) ->
+ false = (ExitPid =:= self()),
+ exit(ExitPid,die),
+ {NewPid, RBins};
+ done ->
+ done
+ end;
+
+ 3 ->
+ %% Try provoke revival-race of resource from magic ref external format
+ _ = [binary_to_term(B) || B <- RBins],
+ {Pid0, []};
+ _ ->
+ case monitor_frenzy_nif(Op, Rnd, SelfPix, undefined) of
+ Rsrc when ?is_resource(Rsrc) ->
+ %% Store resource in ext format only, for later revival
+ State1 = {Pid0, [term_to_binary(Rsrc) | RBins]},
+ gc_and_return(State1);
+ ok -> State0;
+ 0 -> State0;
+ 1 -> State0;
+ done -> done
+ end
+ end.
+
+gc_and_return(RetVal) ->
+ erlang:garbage_collect(),
+ RetVal.
+
+hipe(Config) when is_list(Config) ->
+ Data = proplists:get_value(data_dir, Config),
+ Priv = proplists:get_value(priv_dir, Config),
+ Src = filename:join(Data, "hipe_compiled"),
+ {ok,hipe_compiled} = c:c(Src, [{outdir,Priv},native]),
+ true = code:is_module_native(hipe_compiled),
+ {error, {notsup,_}} = hipe_compiled:try_load_nif(),
+ true = code:delete(hipe_compiled),
+ false = code:purge(hipe_compiled),
+ ok.
+
+
+%% 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 ->
@@ -250,12 +875,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)
@@ -280,18 +904,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() ->
@@ -319,15 +943,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
@@ -335,47 +959,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,
@@ -388,56 +1010,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"}] ++
@@ -447,7 +1066,7 @@ maps(Config) when is_list(Config) ->
M = maps_from_list_nif(Pairs),
R = {RIs,Is} = sorted_list_from_maps_nif(M),
io:format("Pairs: ~p~nMap: ~p~nReturned: ~p~n", [lists:sort(Pairs),M,R]),
- Is = lists:sort(Pairs),
+ true = (lists:sort(Is) =:= lists:sort(Pairs)),
Is = lists:reverse(RIs),
#{} = maps_from_list_nif([]),
@@ -482,33 +1101,31 @@ maps(Config) when is_list(Config) ->
{1, M2} = make_map_remove_nif(M2, "key3"),
{0, undefined} = make_map_remove_nif(self(), key),
+ verify_tmpmem(TmpMem),
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],
@@ -517,18 +1134,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),
@@ -538,76 +1154,76 @@ 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),
+ true = is_reference(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),
+ true = is_reference(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),
+ true = is_reference(ResA),
+ true = is_reference(ResB),
+ true = (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}}.
@@ -616,22 +1232,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),
@@ -639,58 +1254,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 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"),
@@ -710,91 +1324,94 @@ 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}
- ]),
- ?CHECK([{reload,2,1,201}], nif_mod_call_history()),
-
- ?line BinA2 = read_resource(0,A2),
- ?line ok = forget_resource(A2),
+ {module,nif_mod} = erlang:load_module(nif_mod,ModBin),
+ 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([{upgrade,2,1,201}], nif_mod_call_history()),
+ true = erlang:purge_module(nif_mod),
+ ?CHECK([], nif_mod_call_history()), % BGX2 keeping lib loaded
+
+ 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
- ?CHECK([{{resource_dtor_B_v1,BinBGX2},1,6,106}], nif_mod_call_history()),
- % How to test that lib v1 is closed here?
+ ok = forget_resource(BGX2), % calling dtor in orphan library v1 still loaded
+ ?CHECK([{{resource_dtor_B_v1,BinBGX2},1,6,106}, {unload,1,7,107}],
+ nif_mod_call_history()),
- ?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"),
@@ -804,19 +1421,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,
@@ -827,28 +1444,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(),
%%
@@ -970,11 +1587,11 @@ 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"),
+ {AN7,_BinAN7} = make_resource(1, Holder, "AN7"),
ok = forget_resource(NA7),
[{{resource_dtor_A_v1,BinNA7},1,_,_}] = nif_mod_call_history(),
@@ -982,15 +1599,18 @@ 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 = erlang:delete_module(nif_mod),
+ true = erlang:purge_module(nif_mod),
+
+ 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) ->
@@ -1017,7 +1637,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]);
@@ -1039,7 +1659,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);
@@ -1047,53 +1667,61 @@ 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),
+
+ ok = tester:load_nif_lib(Config, "basic"),
+ ok = tester:run(),
- ?line ok = tester:load_nif_lib(Config, "basic"),
- ?line ok = tester:run(),
+ erlang:load_module(tester,ModBin),
+ erlang:purge_module(tester),
+ ok = tester:load_nif_lib(Config, "rwlock"),
+ ok = tester:run(),
- ?line ok = tester:load_nif_lib(Config, "rwlock"),
- ?line ok = tester:run(),
+ erlang:load_module(tester,ModBin),
+ erlang:purge_module(tester),
+ ok = tester:load_nif_lib(Config, "tsd"),
+ ok = tester:run(),
- ?line ok = tester:load_nif_lib(Config, "tsd"),
- ?line ok = tester:run().
+ erlang:delete_module(tester),
+ erlang:purge_module(tester).
-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 ->
@@ -1114,44 +1742,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) ->
@@ -1179,19 +1807,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 = now(),
- 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).
@@ -1219,13 +1846,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;
@@ -1251,7 +1878,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);
@@ -1283,7 +1910,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
@@ -1295,28 +1922,32 @@ 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
+ case (N band 3) of
0 -> {term,copy_blob(MsgEnv)};
- 1 -> {msgenv,MsgEnv}
+ 1 -> {copy,copy_blob(MsgEnv)};
+ _ -> {msgenv,MsgEnv}
end
end.
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.
send3_send_nif(Pid, {term,Blob}) ->
%%io:format("~p send term nif\n",[self()]),
send_term(Pid, {blob, Blob}) =:= 1;
+send3_send_nif(Pid, {copy,Blob}) ->
+ %%io:format("~p send term nif\n",[self()]),
+ send_copy_term(Pid, {blob, Blob}) =:= 1;
send3_send_nif(Pid, {msgenv,MsgEnv}) ->
%%io:format("~p send blob nif\n",[self()]),
send3_blob(MsgEnv, Pid, blob) =:= 1.
@@ -1325,109 +1956,115 @@ send3_send_bang(Pid, {term,Blob}) ->
%%io:format("~p send term bang\n",[self()]),
Pid ! {blob, Blob},
true;
+send3_send_bang(Pid, {copy,Blob}) ->
+ %%io:format("~p send term bang\n",[self()]),
+ Pid ! {blob, Blob},
+ true;
send3_send_bang(Pid, {msgenv,MsgEnv}) ->
%%io:format("~p send blob bang\n",[self()]),
Pid ! {blob, copy_blob(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)),
- ?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),
-
- ?line {error,{bad_lib,_}} = nif_mod:load_nif_lib(Config, no_init),
- ?line verify_tmpmem(TmpMem),
- ?line ok.
+ 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),
+
+ {error,{load_failed,_}} = nif_mod:load_nif_lib(Config, 0),
+ {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 error = 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
- undefined ->
- ?line Path = ?config(data_dir, Config),
- ?line Lib = "nif_SUITE." ++ integer_to_list(Ver),
- ?line ok = erlang:load_nif(filename:join(Path,Lib), []);
- Ver when is_integer(Ver) ->
- ok
- end.
+ Path = ?config(data_dir, Config),
+ case lib_version() of
+ undefined ->
+ Lib = "nif_SUITE." ++ integer_to_list(Ver),
+ ok = erlang:load_nif(filename:join(Path,Lib), []);
+ Ver when is_integer(Ver) ->
+ ok
+ end,
+ erl_ddll:try_load(Path, echo_drv, []),
+ ok.
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(),
@@ -1437,79 +2074,104 @@ 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.
+%% Copy of writable binary
+otp_9828(Config) ->
+ ensure_lib_loaded(Config, 1),
+ otp_9828_loop(<<"I'm alive!">>, 1000).
+
+otp_9828_loop(_Bin, 0) ->
+ ok;
+otp_9828_loop(Bin, Val) ->
+ WrtBin = <<Bin/binary, Val:32>>,
+ ok = otp_9828_nif(WrtBin),
+ otp_9828_loop(WrtBin, Val-1).
+
+
consume_timeslice(Config) when is_list(Config) ->
- CONTEXT_REDS = 2000,
+ case {erlang:system_info(debug_compiled),
+ erlang:system_info(lock_checking)} of
+ {false, false} ->
+ consume_timeslice_test(Config);
+ {false, true} ->
+ {skipped, "Lock checking enabled"};
+ _ ->
+ {skipped, "Debug compiled"}
+ end.
+
+consume_timeslice_test(Config) when is_list(Config) ->
+ ensure_lib_loaded(Config),
+ CONTEXT_REDS = 4000,
Me = self(),
Go = make_ref(),
RedDiff = make_ref(),
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
@@ -1517,60 +2179,99 @@ 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, ExpReds})
end,
none = next_msg(P),
ok.
-dirty_nif(Config) when is_list(Config) ->
- try erlang:system_info(dirty_cpu_schedulers) of
- N when is_integer(N) ->
- ensure_lib_loaded(Config),
- Val1 = 42,
- Val2 = "Erlang",
- Val3 = list_to_binary([Val2, 0]),
- {Val1, Val2, Val3} = call_dirty_nif(Val1, Val2, Val3),
+nif_schedule(Config) when is_list(Config) ->
+ ensure_lib_loaded(Config),
+ A = "this is a string",
+ B = {this,is,a,tuple},
+ {B,A} = call_nif_schedule(A, B),
+ ok = try call_nif_schedule(1, 2)
+ catch
+ error:badarg ->
+ [{?MODULE,call_nif_schedule,[1,2],_}|_] =
+ erlang:get_stacktrace(),
+ ok
+ end,
+ ok.
+
+nif_exception(Config) when is_list(Config) ->
+ ensure_lib_loaded(Config),
+ try
+ %% this checks that the expected exception occurs when the NIF
+ %% calls enif_make_badarg at some point but then tries to return a
+ %% value that isn't an exception
+ call_nif_exception(0),
+ ct:fail(expected_badarg)
+ catch
+ error:badarg ->
+ ok
+ end,
+ %% this checks that a NIF can raise various terms as exceptions
+ ok = nif_raise_exceptions(call_nif_exception),
+ ok.
+
+nif_nan_and_inf(Config) when is_list(Config) ->
+ ensure_lib_loaded(Config),
+ try
+ call_nif_nan_or_inf(nan),
+ ct:fail(expected_badarg)
+ catch
+ error:badarg ->
+ ok
+ end,
+ try
+ call_nif_nan_or_inf(inf),
+ ct:fail(expected_badarg)
+ catch
+ error:badarg ->
ok
+ end,
+ try
+ call_nif_nan_or_inf(tuple),
+ ct:fail(expected_badarg)
catch
error:badarg ->
- {skipped,"No dirty scheduler support"}
+ ok
end.
-dirty_nif_send(Config) when is_list(Config) ->
- try erlang:system_info(dirty_cpu_schedulers) of
- N when is_integer(N) ->
- ensure_lib_loaded(Config),
- Parent = self(),
- Pid = spawn_link(fun() ->
- Self = self(),
- {ok, Self} = receive_any(),
- Parent ! {ok, Self}
- end),
- {ok, Pid} = send_from_dirty_nif(Pid),
- {ok, Pid} = receive_any(),
+nif_atom_too_long(Config) when is_list(Config) ->
+ ensure_lib_loaded(Config),
+ try
+ call_nif_atom_too_long(all),
+ ct:fail(expected_badarg)
+ catch
+ error:badarg ->
ok
+ end,
+ try
+ call_nif_atom_too_long(len),
+ ct:fail(expected_badarg)
catch
error:badarg ->
- {skipped,"No dirty scheduler support"}
+ ok
end.
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.
@@ -1580,7 +2281,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]
@@ -1608,9 +2311,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) ->
@@ -1623,6 +2324,25 @@ call(Pid,Cmd) ->
receive_any() ->
receive M -> M end.
+receive_any(Timeout) ->
+ receive M -> M
+ after Timeout -> timeout end.
+
+flush() ->
+ flush(1).
+
+flush(0) ->
+ flush(0, 10); % don't waste too much time waiting for nothing
+flush(N) ->
+ flush(N, 1000).
+
+flush(N, Timeout) ->
+ receive M ->
+ [M | flush(N-1)]
+ after Timeout ->
+ []
+ end.
+
repeat(0, _, Arg) ->
Arg;
repeat(N, Fun, Arg0) ->
@@ -1632,10 +2352,787 @@ check(Exp,Got,Line) ->
case Got of
Exp -> Exp;
_ ->
- io:format("CHECK at ~p: Expected ~p but got ~p\n",[Line,Exp,Got]),
+ io:format("CHECK at line ~p\nExpected: ~p\nGot : ~p\n",
+ [Line,Exp,Got]),
Got
end.
-
+
+nif_raise_exceptions(NifFunc) ->
+ ExcTerms = [{error, test}, "a string", <<"a binary">>,
+ 42, [1,2,3,4,5], [{p,1},{p,2},{p,3}]],
+ lists:foldl(fun(Term, ok) ->
+ 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, [second, millisecond, microsecond, nanosecond]).
+
+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, second, invalid_time_unit),
+ ?ERL_NIF_TIME_ERROR = convert_time_unit(0, invalid_time_unit, second),
+ ?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(nanosecond)),
+ 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, nanosecond, 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.
+
+nif_now_time(Config) ->
+ ensure_lib_loaded(Config),
+
+ N1 = now(),
+ NifN1 = now_time(),
+ NifN2 = now_time(),
+ N2 = now(),
+ true = N1 < NifN1,
+ true = NifN1 < NifN2,
+ true = NifN2 < N2.
+
+nif_cpu_time(Config) ->
+ ensure_lib_loaded(Config),
+
+ try cpu_time() of
+ {_, _, _} ->
+ ok
+ catch error:badarg ->
+ {comment, "cpu_time not supported"}
+ end.
+
+nif_unique_integer(Config) ->
+ ensure_lib_loaded(Config),
+
+ UM1 = erlang:unique_integer([monotonic]),
+ UM2 = unique_integer_nif([monotonic]),
+ UM3 = erlang:unique_integer([monotonic]),
+
+ true = UM1 < UM2,
+ true = UM2 < UM3,
+
+ UMP1 = erlang:unique_integer([monotonic, positive]),
+ UMP2 = unique_integer_nif([monotonic, positive]),
+ UMP3 = erlang:unique_integer([monotonic, positive]),
+
+ true = 0 =< UMP1,
+ true = UMP1 < UMP2,
+ true = UMP2 < UMP3,
+
+ UP1 = erlang:unique_integer([positive]),
+ UP2 = unique_integer_nif([positive]),
+ UP3 = erlang:unique_integer([positive]),
+
+ true = 0 =< UP1,
+ true = 0 =< UP2,
+ true = 0 =< UP3,
+
+ true = is_integer(unique_integer_nif([])),
+ true = is_integer(unique_integer_nif([])),
+ true = is_integer(unique_integer_nif([])).
+
+nif_is_process_alive(Config) ->
+ ensure_lib_loaded(Config),
+
+ {Pid,_} = spawn_monitor(fun() -> receive ok -> nok end end),
+ true = is_process_alive_nif(Pid),
+ exit(Pid, die),
+ receive _ -> ok end, %% Clear monitor
+ false = is_process_alive_nif(Pid).
+
+nif_is_port_alive(Config) ->
+ ensure_lib_loaded(Config),
+
+ Port = open_port({spawn,echo_drv},[eof]),
+ true = is_port_alive_nif(Port),
+ port_close(Port),
+ false = is_port_alive_nif(Port).
+
+nif_term_to_binary(Config) ->
+ ensure_lib_loaded(Config),
+ T = {#{ok => nok}, <<0:8096>>, lists:seq(1,100)},
+ Bin = term_to_binary(T),
+ ct:log("~p",[Bin]),
+ Bin = term_to_binary_nif(T, undefined),
+ true = term_to_binary_nif(T, self()),
+ receive Bin -> ok end.
+
+-define(ERL_NIF_BIN2TERM_SAFE, 16#20000000).
+
+nif_binary_to_term(Config) ->
+ ensure_lib_loaded(Config),
+ T = {#{ok => nok}, <<0:8096>>, lists:seq(1,100)},
+ Bin = term_to_binary(T),
+ Len = byte_size(Bin),
+ {Len,T} = binary_to_term_nif(Bin, undefined, 0),
+ Len = binary_to_term_nif(Bin, self(), 0),
+ T = receive M -> M after 1000 -> timeout end,
+
+ {Len, T} = binary_to_term_nif(Bin, undefined, ?ERL_NIF_BIN2TERM_SAFE),
+ false = binary_to_term_nif(<<131,100,0,14,"undefined_atom">>,
+ undefined, ?ERL_NIF_BIN2TERM_SAFE),
+ false = binary_to_term_nif(Bin, undefined, 1),
+ ok.
+
+nif_port_command(Config) ->
+ ensure_lib_loaded(Config),
+
+ Port = open_port({spawn,echo_drv},[eof]),
+ true = port_command_nif(Port, "hello\n"),
+ receive {Port,{data,"hello\n"}} -> ok
+ after 1000 -> ct:fail(timeout) end,
+
+ RefcBin = lists:flatten([lists:duplicate(100, "hello"),"\n"]),
+ true = port_command_nif(Port, iolist_to_binary(RefcBin)),
+ receive {Port,{data,RefcBin}} -> ok
+ after 1000 -> ct:fail(timeout) end,
+
+ %% Test that invalid arguments correctly returns
+ %% badarg and that the port survives.
+ {'EXIT', {badarg, _}} = (catch port_command_nif(Port, [ok])),
+
+ IoList = [lists:duplicate(100,<<"hello">>),"\n"],
+ true = port_command_nif(Port, [IoList]),
+ FlatIoList = binary_to_list(iolist_to_binary(IoList)),
+ receive {Port,{data,FlatIoList}} -> ok
+ after 1000 -> ct:fail(timeout) end,
+
+ port_close(Port),
+
+ {'EXIT', {badarg, _}} = (catch port_command_nif(Port, "hello\n")),
+ ok.
+
+nif_snprintf(Config) ->
+ ensure_lib_loaded(Config),
+ <<"ok",0>> = format_term_nif(3,ok),
+ <<"o",0>> = format_term_nif(2,ok),
+ <<"\"hello world\"",0>> = format_term_nif(14,"hello world"),
+ <<"{{hello,world,-33},3.14",_/binary>> = format_term_nif(50,{{hello,world, -33}, 3.14, self()}),
+ <<"{{hello,world,-33},",0>> = format_term_nif(20,{{hello,world, -33}, 3.14, self()}),
+ ok.
+
+nif_internal_hash(Config) ->
+ ensure_lib_loaded(Config),
+ HashValueBitSize = nif_hash_result_bitsize(internal),
+ Terms = unique([random_term() || _ <- lists:seq(1, 500)]),
+ HashValues = [hash_nif(internal, Term, 0) || Term <- Terms],
+ test_bit_distribution_fitness(HashValues, HashValueBitSize).
+
+nif_internal_hash_salted(Config) ->
+ ensure_lib_loaded(Config),
+ test_salted_nif_hash(internal).
+
+nif_phash2(Config) ->
+ ensure_lib_loaded(Config),
+ HashValueBitSize = nif_hash_result_bitsize(phash2),
+ Terms = unique([random_term() || _ <- lists:seq(1, 500)]),
+ HashValues =
+ lists:map(
+ fun (Term) ->
+ HashValue = erlang:phash2(Term),
+ Salt = random_uint32(), % phash2 should ignore salt
+ NifHashValue = hash_nif(phash2, Term, Salt),
+ (HashValue =:= NifHashValue
+ orelse ct:fail("Expected: ~p\nActual: ~p",
+ [HashValue, NifHashValue])),
+ HashValue
+ end,
+ Terms),
+ test_bit_distribution_fitness(HashValues, HashValueBitSize).
+
+test_salted_nif_hash(HashType) ->
+ HashValueBitSize = nif_hash_result_bitsize(HashType),
+ Terms = unique([random_term() || _ <- lists:seq(1, 500)]),
+ Salts = unique([random_uint32() || _ <- lists:seq(1, 50)]),
+ {HashValuesPerSalt, HashValuesPerTerm} =
+ lists:mapfoldl(
+ fun (Salt, Acc) ->
+ {HashValues, NewAcc} =
+ lists:mapfoldl(
+ fun (Term, AccB) ->
+ HashValue = hash_nif(HashType, Term, Salt),
+ NewAccB = dict:append(Term, HashValue, AccB),
+ {HashValue, NewAccB}
+ end,
+ Acc,
+ Terms),
+ {{Salt, HashValues}, NewAcc}
+ end,
+ dict:new(),
+ Salts),
+
+ % Test per-salt hash distribution of different terms
+ lists:foreach(
+ fun ({_Salt, HashValues}) ->
+ test_bit_distribution_fitness(HashValues, HashValueBitSize)
+ end,
+ HashValuesPerSalt),
+
+ % Test per-term hash distribution of different salts
+ dict:fold(
+ fun (_Term, HashValues, Acc) ->
+ test_bit_distribution_fitness(HashValues, HashValueBitSize),
+ Acc
+ end,
+ ok,
+ HashValuesPerTerm).
+
+test_bit_distribution_fitness(Integers, BitSize) ->
+ MaxInteger = (1 bsl BitSize) - 1,
+ OnesPerBit =
+ lists:foldl(
+ fun (Integer, Acc) when Integer >= 0, Integer =< MaxInteger ->
+ lists:foldl(
+ fun (BitIndex, AccB) ->
+ BitValue = (Integer band (1 bsl BitIndex)) bsr BitIndex,
+ orddict:update_counter(BitIndex, BitValue, AccB)
+ end,
+ Acc,
+ lists:seq(0, BitSize - 1))
+ end,
+ orddict:new(),
+ Integers),
+
+ N = length(Integers),
+ ExpectedNrOfOnes = N div 2,
+ %% ExpectedNrOfOnes should have a binomial distribution
+ %% with a standard deviation as:
+ ExpectedStdDev = math:sqrt(N) / 2,
+ %% which can be approximated as a normal distribution
+ %% where we allow a deviation of 6 std.devs
+ %% for a fail probability of 0.000000002:
+ MaxStdDevs = 6,
+
+ FailureText =
+ orddict:fold(
+ fun (BitIndex, NrOfOnes, Acc) ->
+ Deviation = abs(NrOfOnes - ExpectedNrOfOnes) / ExpectedStdDev,
+ case Deviation >= MaxStdDevs of
+ false ->
+ Acc;
+ true ->
+ [Acc,
+ io_lib:format(
+ "Unreasonable deviation on number of set bits (i=~p): "
+ "expected ~p, got ~p (# std.dev ~.3f > ~p)~n",
+ [BitIndex, ExpectedNrOfOnes, NrOfOnes, Deviation, MaxStdDevs])]
+ end
+ end,
+ [],
+ OnesPerBit),
+
+ (FailureText =:= [] orelse ct:fail(FailureText)).
+
+nif_hash_result_bitsize(internal) -> 32;
+nif_hash_result_bitsize(phash2) -> 27.
+
+unique(List) ->
+ lists:usort(List).
+
+random_uint32() ->
+ rand:uniform(1 bsl 32) - 1.
+
+random_term() ->
+ case rand:uniform(6) of
+ 1 -> rand:uniform(1 bsl 27) - 1; % small
+ 2 -> (1 bsl 27) + rand:uniform(1 bsl 128); % big
+ 3 -> random_sign() * (rand:uniform() * (1 bsl 53)); % float
+ 4 -> random_binary();
+ 5 -> random_pid();
+ 6 ->
+ Length = rand:uniform(10),
+ List = [random_term() || _ <- lists:seq(1, Length)],
+ case rand:uniform(2) of
+ 1 ->
+ List;
+ 2 ->
+ list_to_tuple(List)
+ end
+ end.
+
+random_sign() ->
+ case rand:uniform(2) of
+ 1 -> -1.0;
+ 2 -> 1.0
+ end.
+
+random_binary() ->
+ list_to_binary(random_bytes(rand:uniform(32) - 1)).
+
+random_bytes(0) ->
+ [];
+random_bytes(N) when N > 0 ->
+ [rand:uniform(256) - 1 | random_bytes(N - 1)].
+
+random_pid() ->
+ Processes = erlang:processes(),
+ lists:nth(rand:uniform(length(Processes)), Processes).
+
+%% Test enif_whereis_...
+
+nif_whereis(Config) when is_list(Config) ->
+ ensure_lib_loaded(Config),
+
+ RegName = nif_whereis_test_thing,
+ undefined = erlang:whereis(RegName),
+ false = whereis_term(pid, RegName),
+
+ Mgr = self(),
+ Ref = make_ref(),
+ ProcMsg = {Ref, ?LINE},
+ PortMsg = ?MODULE_STRING " whereis hello\n",
+
+ {Pid, Mon} = spawn_monitor(?MODULE, nif_whereis_proxy, [Ref]),
+ true = register(RegName, Pid),
+ Pid = erlang:whereis(RegName),
+ Pid = whereis_term(pid, RegName),
+ false = whereis_term(port, RegName),
+ false = whereis_term(pid, [RegName]),
+
+ ok = whereis_send(pid, RegName, {forward, Mgr, ProcMsg}),
+ ok = receive ProcMsg -> ok end,
+
+ Pid ! {Ref, quit},
+ ok = receive {'DOWN', Mon, process, Pid, normal} -> ok end,
+ undefined = erlang:whereis(RegName),
+ false = whereis_term(pid, RegName),
+
+ Port = open_port({spawn, echo_drv}, [eof]),
+ true = register(RegName, Port),
+ Port = erlang:whereis(RegName),
+ Port = whereis_term(port, RegName),
+ false = whereis_term(pid, RegName),
+ false = whereis_term(port, [RegName]),
+
+ ok = whereis_send(port, RegName, PortMsg),
+ ok = receive {Port, {data, PortMsg}} -> ok end,
+
+ port_close(Port),
+ undefined = erlang:whereis(RegName),
+ false = whereis_term(port, RegName),
+ ok.
+
+nif_whereis_parallel(Config) when is_list(Config) ->
+ ensure_lib_loaded(Config),
+
+ %% try to be at least a little asymetric
+ NProcs = trunc(3.7 * erlang:system_info(schedulers)),
+ NSeq = lists:seq(1, NProcs),
+ Names = [list_to_atom("nif_whereis_proc_" ++ integer_to_list(N))
+ || N <- NSeq],
+ Mgr = self(),
+ Ref = make_ref(),
+
+ NotReg = fun(Name) ->
+ erlang:whereis(Name) == undefined
+ end,
+ PidReg = fun({Name, Pid, _Mon}) ->
+ erlang:whereis(Name) == Pid andalso whereis_term(pid, Name) == Pid
+ end,
+ RecvDown = fun({_Name, Pid, Mon}) ->
+ receive {'DOWN', Mon, process, Pid, normal} -> true
+ after 1500 -> false end
+ end,
+ RecvNum = fun(N) ->
+ receive {N, Ref} -> true
+ after 1500 -> false end
+ end,
+
+ true = lists:all(NotReg, Names),
+
+ %% {Name, Pid, Mon}
+ Procs = lists:map(
+ fun(N) ->
+ Name = lists:nth(N, Names),
+ Prev = lists:nth((if N == 1 -> NProcs; true -> (N - 1) end), Names),
+ Next = lists:nth((if N == NProcs -> 1; true -> (N + 1) end), Names),
+ {Pid, Mon} = spawn_monitor(
+ ?MODULE, nif_whereis_proxy, [{N, Ref, Mgr, [Prev, Next]}]),
+ true = register(Name, Pid),
+ {Name, Pid, Mon}
+ end, NSeq),
+
+ true = lists:all(PidReg, Procs),
+
+ %% tell them all to 'fire' as fast as we can
+ repeat(10, fun(_) ->
+ [P ! {Ref, send_proc} || {_, P, _} <- Procs]
+ end, void),
+
+ %% each gets forwarded through two processes
+ repeat(10, fun(_) ->
+ true = lists:all(RecvNum, NSeq),
+ true = lists:all(RecvNum, NSeq)
+ end, void),
+
+ %% tell them all to 'quit' by name
+ [N ! {Ref, quit} || {N, _, _} <- Procs],
+ true = lists:all(RecvDown, Procs),
+ true = lists:all(NotReg, Names),
+ ok.
+
+nif_whereis_threaded(Config) when is_list(Config) ->
+ ensure_lib_loaded(Config),
+
+ RegName = nif_whereis_test_threaded,
+ undefined = erlang:whereis(RegName),
+
+ Ref = make_ref(),
+ {Pid, Mon} = spawn_monitor(?MODULE, nif_whereis_proxy, [Ref]),
+ true = register(RegName, Pid),
+
+ {ok, ProcThr} = whereis_thd_lookup(pid, RegName),
+ {ok, Pid} = whereis_thd_result(ProcThr),
+
+ Pid ! {Ref, quit},
+ ok = receive {'DOWN', Mon, process, Pid, normal} -> ok end,
+
+ Port = open_port({spawn, echo_drv}, [eof]),
+ true = register(RegName, Port),
+
+ {ok, PortThr} = whereis_thd_lookup(port, RegName),
+ {ok, Port} = whereis_thd_result(PortThr),
+
+ port_close(Port),
+ ok.
+
+%% exported to be spawned by MFA by whereis tests
+nif_whereis_proxy({N, Ref, Mgr, Targets} = Args) ->
+ receive
+ {forward, To, Data} ->
+ To ! Data,
+ nif_whereis_proxy(Args);
+ {Ref, quit} ->
+ ok;
+ {Ref, send_port} ->
+ Msg = ?MODULE_STRING " whereis " ++ integer_to_list(N) ++ "\n",
+ lists:foreach(
+ fun(T) ->
+ ok = whereis_send(port, T, Msg)
+ end, Targets),
+ nif_whereis_proxy(Args);
+ {Ref, send_proc} ->
+ lists:foreach(
+ fun(T) ->
+ ok = whereis_send(pid, T, {forward, Mgr, {N, Ref}})
+ end, Targets),
+ nif_whereis_proxy(Args)
+ end;
+nif_whereis_proxy(Ref) ->
+ receive
+ {forward, To, Data} ->
+ To ! Data,
+ nif_whereis_proxy(Ref);
+ {Ref, quit} ->
+ ok
+ end.
+nif_ioq(Config) ->
+ ensure_lib_loaded(Config),
+
+ Script =
+ [{create, a},
+
+ %% Test enq of erlang term binary
+ {enqb, a},
+ {enqb, a, 3},
+
+ %% Test enq of non-erlang term binary
+ {enqbraw,a},
+ {enqbraw,a, 5},
+ {peek, a},
+ {deq, a, 42},
+
+ %% Test enqv
+ {enqv, a, 2, 100},
+ {deq, a, all},
+
+ %% This skips all elements but one in the iolist
+ {enqv, a, 5, iolist_size(nif_ioq_payload(5)) - 1},
+ {peek, a},
+
+ %% Test to enqueue a bunch of refc binaries
+ {enqv, a, [nif_ioq_payload(refcbin) || _ <- lists:seq(1,20)], 0},
+
+ %% Enq stuff to destroy with data in queue
+ {enqv, a, 2, 100},
+ {destroy,a},
+
+ %% Test destroy of new queue
+ {create, a},
+ {destroy,a}
+ ],
+
+ nif_ioq_run(Script),
+
+ %% Test that only enif_inspect_as_vec works
+ Payload = nif_ioq_payload(5),
+ PayloadBin = iolist_to_binary(Payload),
+
+ [begin
+ PayloadBin = iolist_to_binary(ioq_nif(inspect,Payload,Stack,Env)),
+ <<>> = iolist_to_binary(ioq_nif(inspect,[],Stack,Env))
+ end || Stack <- [no_stack, use_stack], Env <- [use_env, no_env]],
+
+ %% Test error cases
+
+ Q = ioq_nif(create),
+
+ {'EXIT', {badarg, _}} = (catch ioq_nif(deq, Q, 1)),
+ {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, 1, 1234)),
+
+ {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [atom_in_list], 0)),
+ {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [make_ref()], 0)),
+ {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [256], 0)),
+ {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [-1], 0)),
+ {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [#{}], 0)),
+ {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [1 bsl 64], 0)),
+ {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [{tuple}], 0)),
+
+ {'EXIT', {badarg, _}} = (catch ioq_nif(inspect, [atom_in_list], use_stack)),
+ {'EXIT', {badarg, _}} = (catch ioq_nif(inspect, [make_ref()], no_stack)),
+ {'EXIT', {badarg, _}} = (catch ioq_nif(inspect, [256], use_stack)),
+ {'EXIT', {badarg, _}} = (catch ioq_nif(inspect, [-1], no_stack)),
+ {'EXIT', {badarg, _}} = (catch ioq_nif(inspect, [#{}], use_stack)),
+ {'EXIT', {badarg, _}} = (catch ioq_nif(inspect, [1 bsl 64], no_stack)),
+ {'EXIT', {badarg, _}} = (catch ioq_nif(inspect, [{tuple}], use_stack)),
+ {'EXIT', {badarg, _}} = (catch ioq_nif(inspect, <<"binary">>, use_stack)),
+
+ ioq_nif(destroy, Q),
+
+ %% Test that the example in the docs works
+ ExampleQ = ioq_nif(create),
+ true = ioq_nif(example, ExampleQ, nif_ioq_payload(5)),
+ ioq_nif(destroy, ExampleQ),
+
+ ok.
+
+
+nif_ioq_run(Script) ->
+ nif_ioq_run(Script, #{}).
+
+nif_ioq_run([{Action, Name}|T], State)
+ when Action =:= enqb; Action =:= enqbraw ->
+ nif_ioq_run([{Action, Name, heapbin}|T], State);
+nif_ioq_run([{Action, Name, Skip}|T], State)
+ when Action =:= enqb, is_integer(Skip);
+ Action =:= enqbraw, is_integer(Skip) ->
+ nif_ioq_run([{Action, Name, heapbin, Skip}|T], State);
+nif_ioq_run([{Action, Name, N}|T], State)
+ when Action =:= enqv; Action =:= enqb; Action =:= enqbraw ->
+ nif_ioq_run([{Action, Name, N, 0}|T], State);
+nif_ioq_run([{Action, Name, N, Skip}|T], State)
+ when Action =:= enqv; Action =:= enqb; Action =:= enqbraw ->
+
+ #{ q := IOQ, b := B } = Q = maps:get(Name, State),
+ true = ioq_nif(size, IOQ) == iolist_size(B),
+
+ %% Sanitize the log output a bit so that it doesn't become too large.
+ H = {Action, Name, try iolist_size(N) of Sz -> Sz catch _:_ -> N end, Skip},
+ ct:log("~p", [H]),
+
+ Data = nif_ioq_payload(N),
+ ioq_nif(Action, IOQ, Data, Skip),
+
+ <<_:Skip/binary, SkippedData/binary>> = iolist_to_binary(Data),
+
+ true = ioq_nif(size, IOQ) == (iolist_size([B|SkippedData])),
+
+ nif_ioq_run(T, State#{ Name := Q#{ b := [B|SkippedData]}});
+nif_ioq_run([{peek, Name} = H|T], State) ->
+ #{ q := IOQ, b := B } = maps:get(Name, State),
+ true = ioq_nif(size, IOQ) == iolist_size(B),
+
+ ct:log("~p", [H]),
+
+ Data = ioq_nif(peek, IOQ, ioq_nif(size, IOQ)),
+
+ true = iolist_to_binary(B) == iolist_to_binary(Data),
+ nif_ioq_run(T, State);
+nif_ioq_run([{deq, Name, all}|T], State) ->
+ #{ q := IOQ, b := B } = maps:get(Name, State),
+ Size = ioq_nif(size, IOQ),
+ true = Size == iolist_size(B),
+ nif_ioq_run([{deq, Name, Size}|T], State);
+nif_ioq_run([{deq, Name, N} = H|T], State) ->
+ #{ q := IOQ, b := B } = Q = maps:get(Name, State),
+ true = ioq_nif(size, IOQ) == iolist_size(B),
+
+ ct:log("~p", [H]),
+
+ <<_:N/binary,Remain/binary>> = iolist_to_binary(B),
+ NewQ = Q#{ b := Remain },
+
+ Sz = ioq_nif(deq, IOQ, N),
+
+ true = Sz == iolist_size(Remain),
+ true = ioq_nif(size, IOQ) == iolist_size(Remain),
+
+ nif_ioq_run(T, State#{ Name := NewQ });
+nif_ioq_run([{create, Name} = H|T], State) ->
+ ct:log("~p", [H]),
+ nif_ioq_run(T, State#{ Name => #{ q => ioq_nif(create), b => [] } });
+nif_ioq_run([{destroy, Name} = H|T], State) ->
+ #{ q := IOQ, b := B } = maps:get(Name, State),
+ true = ioq_nif(size, IOQ) == iolist_size(B),
+
+ ct:log("~p", [H]),
+
+ ioq_nif(destroy, IOQ),
+
+ nif_ioq_run(T, maps:remove(Name, State));
+nif_ioq_run([], State) ->
+ State.
+
+nif_ioq_payload(N) when is_integer(N) ->
+ Tail = if N > 3 -> nif_ioq_payload(N-3); true -> [] end,
+ Head = element(1, lists:split(N,[nif_ioq_payload(subbin),
+ nif_ioq_payload(heapbin),
+ nif_ioq_payload(refcbin) | Tail])),
+ erlang:iolist_to_iovec(Head);
+nif_ioq_payload(subbin) ->
+ Bin = nif_ioq_payload(refcbin),
+ Sz = size(Bin) - 1,
+ <<_:8,SubBin:Sz/binary,_/bits>> = Bin,
+ SubBin;
+nif_ioq_payload(heapbin) ->
+ <<"a literal heap binary">>;
+nif_ioq_payload(refcbin) ->
+ iolist_to_binary([lists:seq(1,255) || _ <- lists:seq(1,255)]);
+nif_ioq_payload(Else) ->
+ Else.
%% The NIFs:
lib_version() -> undefined.
@@ -1647,6 +3144,7 @@ type_test() -> ?nif_stub.
tuple_2_list(_) -> ?nif_stub.
is_identical(_,_) -> ?nif_stub.
compare(_,_) -> ?nif_stub.
+hash_nif(_Type, _Term, _Salt) -> ?nif_stub.
many_args_100(_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_) -> ?nif_stub.
clone_bin(_) -> ?nif_stub.
make_sub_bin(_,_,_) -> ?nif_stub.
@@ -1660,11 +3158,12 @@ alloc_resource(_,_) -> ?nif_stub.
make_resource(_) -> ?nif_stub.
get_resource(_,_) -> ?nif_stub.
release_resource(_) -> ?nif_stub.
+release_resource_from_thread(_) -> ?nif_stub.
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.
@@ -1680,13 +3179,45 @@ send_blob_thread(_,_,_) -> ?nif_stub.
join_send_thread(_) -> ?nif_stub.
copy_blob(_) -> ?nif_stub.
send_term(_,_) -> ?nif_stub.
+send_copy_term(_,_) -> ?nif_stub.
reverse_list(_) -> ?nif_stub.
echo_int(_) -> ?nif_stub.
type_sizes() -> ?nif_stub.
otp_9668_nif(_) -> ?nif_stub.
+otp_9828_nif(_) -> ?nif_stub.
consume_timeslice_nif(_,_) -> ?nif_stub.
-call_dirty_nif(_,_,_) -> ?nif_stub.
-send_from_dirty_nif(_) -> ?nif_stub.
+call_nif_schedule(_,_) -> ?nif_stub.
+call_nif_exception(_) -> ?nif_stub.
+call_nif_nan_or_inf(_) -> ?nif_stub.
+call_nif_atom_too_long(_) -> ?nif_stub.
+unique_integer_nif(_) -> ?nif_stub.
+is_process_alive_nif(_) -> ?nif_stub.
+is_port_alive_nif(_) -> ?nif_stub.
+term_to_binary_nif(_, _) -> ?nif_stub.
+binary_to_term_nif(_, _, _) -> ?nif_stub.
+port_command_nif(_, _) -> ?nif_stub.
+format_term_nif(_,_) -> ?nif_stub.
+select_nif(_,_,_,_,_) -> ?nif_stub.
+pipe_nif() -> ?nif_stub.
+write_nif(_,_) -> ?nif_stub.
+read_nif(_,_) -> ?nif_stub.
+is_closed_nif(_) -> ?nif_stub.
+last_fd_stop_call() -> ?nif_stub.
+alloc_monitor_resource_nif() -> ?nif_stub.
+monitor_process_nif(_,_,_,_) -> ?nif_stub.
+demonitor_process_nif(_,_) -> ?nif_stub.
+compare_monitors_nif(_,_) -> ?nif_stub.
+monitor_frenzy_nif(_,_,_,_) -> ?nif_stub.
+ioq_nif(_) -> ?nif_stub.
+ioq_nif(_,_) -> ?nif_stub.
+ioq_nif(_,_,_) -> ?nif_stub.
+ioq_nif(_,_,_,_) -> ?nif_stub.
+
+%% whereis
+whereis_send(_Type,_Name,_Msg) -> ?nif_stub.
+whereis_term(_Type,_Name) -> ?nif_stub.
+whereis_thd_lookup(_Type,_Name) -> ?nif_stub.
+whereis_thd_result(_Thd) -> ?nif_stub.
%% maps
is_map_nif(_) -> ?nif_stub.
@@ -1699,6 +3230,12 @@ 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.
+now_time() -> ?nif_stub.
+cpu_time() -> ?nif_stub.
nif_stub_error(Line) ->
exit({nif_not_loaded,module,?MODULE,line,Line}).
diff --git a/erts/emulator/test/nif_SUITE_data/Makefile.src b/erts/emulator/test/nif_SUITE_data/Makefile.src
index ab4ff77add..de06026780 100644
--- a/erts/emulator/test/nif_SUITE_data/Makefile.src
+++ b/erts/emulator/test/nif_SUITE_data/Makefile.src
@@ -2,10 +2,15 @@
NIF_LIBS = nif_SUITE.1@dll@ \
nif_mod.1@dll@ \
nif_mod.2@dll@ \
- nif_mod.3@dll@
-
-all: $(NIF_LIBS) basic@dll@ rwlock@dll@ tsd@dll@
-
+ nif_mod.3@dll@ \
+ nif_mod.1.2_0@dll@ \
+ nif_mod.2.2_0@dll@ \
+ nif_mod.3.2_0@dll@ \
+ nif_mod.1.2_4@dll@ \
+ nif_mod.2.2_4@dll@ \
+ nif_mod.3.2_4@dll@
+
+all: $(NIF_LIBS) basic@dll@ rwlock@dll@ tsd@dll@ echo_drv@dll@
@SHLIB_RULES@
diff --git a/erts/emulator/test/nif_SUITE_data/echo_drv.c b/erts/emulator/test/nif_SUITE_data/echo_drv.c
new file mode 100644
index 0000000000..2b3510c641
--- /dev/null
+++ b/erts/emulator/test/nif_SUITE_data/echo_drv.c
@@ -0,0 +1,62 @@
+#include <stdio.h>
+#include "erl_driver.h"
+
+static ErlDrvPort erlang_port;
+static ErlDrvData echo_start(ErlDrvPort, char *);
+static void from_erlang(ErlDrvData, char*, ErlDrvSizeT);
+static ErlDrvSSizeT echo_call(ErlDrvData drv_data, unsigned int command,
+ char *buf, ErlDrvSizeT len,
+ char **rbuf, ErlDrvSizeT rlen, unsigned *ret_flags);
+static ErlDrvEntry echo_driver_entry = {
+ NULL, /* Init */
+ echo_start,
+ NULL, /* Stop */
+ from_erlang,
+ NULL, /* Ready input */
+ NULL, /* Ready output */
+ "echo_drv",
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ echo_call,
+ NULL,
+ ERL_DRV_EXTENDED_MARKER,
+ ERL_DRV_EXTENDED_MAJOR_VERSION,
+ ERL_DRV_EXTENDED_MINOR_VERSION,
+ 0,
+ NULL,
+ NULL,
+ NULL
+};
+
+DRIVER_INIT(echo_drv)
+{
+ return &echo_driver_entry;
+}
+
+static ErlDrvData
+echo_start(ErlDrvPort port, char *buf)
+{
+ return (ErlDrvData) port;
+}
+
+static void
+from_erlang(ErlDrvData data, char *buf, ErlDrvSizeT count)
+{
+ driver_output((ErlDrvPort) data, buf, count);
+}
+
+static ErlDrvSSizeT
+echo_call(ErlDrvData drv_data, unsigned int command,
+ char *buf, ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen,
+ unsigned *ret_flags)
+{
+ *rbuf = buf;
+ *ret_flags |= DRIVER_CALL_KEEP_BUFFER;
+ return len;
+}
+
diff --git a/erts/emulator/test/nif_SUITE_data/hipe_compiled.erl b/erts/emulator/test/nif_SUITE_data/hipe_compiled.erl
new file mode 100644
index 0000000000..84ddbc8d63
--- /dev/null
+++ b/erts/emulator/test/nif_SUITE_data/hipe_compiled.erl
@@ -0,0 +1,6 @@
+-module(hipe_compiled).
+
+-export([try_load_nif/0]).
+
+try_load_nif() ->
+ erlang:load_nif("doesn't matter", 0).
diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
index 955dc64189..b47d013bd2 100644
--- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
+++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
@@ -1,39 +1,95 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2009-2014. All Rights Reserved.
+ * Copyright Ericsson AB 2009-2017. 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/.
+ * 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
*
- * 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.
+ * 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 "erl_nif.h"
+#include <erl_nif.h>
#include <stdio.h>
#include <string.h>
#include <assert.h>
#include <limits.h>
+#include <errno.h>
+#ifndef __WIN32__
+#include <unistd.h>
+#include <fcntl.h>
+#endif
#include "nif_mod.h"
+#if 0
+static ErlNifMutex* dbg_trace_lock;
+#define DBG_TRACE_INIT dbg_trace_lock = enif_mutex_create("nif_SUITE.DBG_TRACE")
+#define DBG_TRACE_FINI enif_mutex_destroy(dbg_trace_lock)
+#define DBG_TRACE_LOCK enif_mutex_lock(dbg_trace_lock)
+#define DBG_TRACE_UNLOCK enif_mutex_unlock(dbg_trace_lock)
+#define DBG_TRACE0(FMT) do {DBG_TRACE_LOCK; enif_fprintf(stderr, FMT); DBG_TRACE_UNLOCK; }while(0)
+#define DBG_TRACE1(FMT, A) do {DBG_TRACE_LOCK; enif_fprintf(stderr, FMT, A); DBG_TRACE_UNLOCK; }while(0)
+#define DBG_TRACE2(FMT, A, B) do {DBG_TRACE_LOCK; enif_fprintf(stderr, FMT, A, B); DBG_TRACE_UNLOCK; }while(0)
+#define DBG_TRACE3(FMT, A, B, C) do {DBG_TRACE_LOCK; enif_fprintf(stderr, FMT, A, B, C); DBG_TRACE_UNLOCK; }while(0)
+#define DBG_TRACE4(FMT, A, B, C, D) do {DBG_TRACE_LOCK; enif_fprintf(stderr, FMT, A, B, C, D); DBG_TRACE_UNLOCK; }while(0)
+#else
+#define DBG_TRACE_INIT
+#define DBG_TRACE_FINI
+#define DBG_TRACE0(FMT)
+#define DBG_TRACE1(FMT, A)
+#define DBG_TRACE2(FMT, A, B)
+#define DBG_TRACE3(FMT, A, B, C)
+#define DBG_TRACE4(FMT, A, B, C, D)
+#endif
+
+/*
+ * Hack to get around this function missing from the NIF API.
+ * TODO: Add this function/macro in the appropriate place, probably with
+ * enif_make_pid() in erl_nif_api_funcs.h
+ */
+#ifndef enif_make_port
+#define enif_make_port(ENV, PORT) ((void)(ENV),(const ERL_NIF_TERM)((PORT)->port_id))
+#endif
+
static int static_cntA; /* zero by default */
static int static_cntB = NIF_SUITE_LIB_VER * 100;
static ERL_NIF_TERM atom_false;
+static ERL_NIF_TERM atom_true;
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_second;
+static ERL_NIF_TERM atom_millisecond;
+static ERL_NIF_TERM atom_microsecond;
+static ERL_NIF_TERM atom_nanosecond;
+static ERL_NIF_TERM atom_eagain;
+static ERL_NIF_TERM atom_eof;
+static ERL_NIF_TERM atom_error;
+static ERL_NIF_TERM atom_fd_resource_stop;
+static ERL_NIF_TERM atom_monitor_resource_type;
+static ERL_NIF_TERM atom_monitor_resource_down;
+static ERL_NIF_TERM atom_init;
+static ERL_NIF_TERM atom_stats;
+static ERL_NIF_TERM atom_done;
+static ERL_NIF_TERM atom_stop;
+static ERL_NIF_TERM atom_null;
+static ERL_NIF_TERM atom_pid;
+static ERL_NIF_TERM atom_port;
+static ERL_NIF_TERM atom_send;
+static ERL_NIF_TERM atom_lookup;
+static ERL_NIF_TERM atom_badarg;
typedef struct
{
@@ -93,23 +149,69 @@ struct binary_resource {
unsigned size;
};
+static ErlNifResourceType* fd_resource_type;
+static void fd_resource_dtor(ErlNifEnv* env, void* obj);
+static void fd_resource_stop(ErlNifEnv* env, void* obj, ErlNifEvent, int);
+static ErlNifResourceTypeInit fd_rt_init = {
+ fd_resource_dtor,
+ fd_resource_stop
+};
+struct fd_resource {
+ ErlNifEvent fd;
+ int was_selected;
+ ErlNifPid pid;
+};
+
+static ErlNifResourceType* monitor_resource_type;
+static void monitor_resource_dtor(ErlNifEnv* env, void* obj);
+static void monitor_resource_down(ErlNifEnv*, void* obj, ErlNifPid*, ErlNifMonitor*);
+static ErlNifResourceTypeInit monitor_rt_init = {
+ monitor_resource_dtor,
+ NULL,
+ monitor_resource_down
+};
+struct monitor_resource {
+ ErlNifPid receiver;
+ int use_msgenv;
+};
+
+static ErlNifResourceType* frenzy_resource_type;
+static void frenzy_resource_dtor(ErlNifEnv* env, void* obj);
+static void frenzy_resource_down(ErlNifEnv*, void* obj, ErlNifPid*, ErlNifMonitor*);
+static ErlNifResourceTypeInit frenzy_rt_init = {
+ frenzy_resource_dtor,
+ NULL,
+ frenzy_resource_down
+};
+
+static ErlNifResourceType* whereis_resource_type;
+static void whereis_thread_resource_dtor(ErlNifEnv* env, void* obj);
+static ErlNifResourceType* ioq_resource_type;
+
+static void ioq_resource_dtor(ErlNifEnv* env, void* obj);
+struct ioq_resource {
+ ErlNifIOQueue *q;
+};
+
static int get_pointer(ErlNifEnv* env, ERL_NIF_TERM term, void** pp)
{
- ErlNifUInt64 i64;
- int r = enif_get_uint64(env, term, &i64);
+ ErlNifBinary bin;
+ int r = enif_inspect_binary(env, term, &bin);
if (r) {
- *pp = (void*)i64;
+ *pp = *(void**)bin.data;
}
return r;
}
static ERL_NIF_TERM make_pointer(ErlNifEnv* env, void* p)
{
- ErlNifUInt64 i64 = (ErlNifUInt64) p;
- return enif_make_uint64(env, i64);
+ void** bin_data;
+ ERL_NIF_TERM res;
+ bin_data = (void**)enif_make_new_binary(env, sizeof(void*), &res);
+ *bin_data = p;
+ return res;
}
-
static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info)
{
PrivData* data = enif_alloc(sizeof(PrivData));
@@ -118,6 +220,8 @@ static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info)
data->call_history = NULL;
data->nif_mod = NULL;
+ DBG_TRACE_INIT;
+
add_call(env, data, "load");
data->rt_arr[0].t = enif_open_resource_type(env,NULL,"Gold",resource_dtor,
@@ -132,11 +236,49 @@ static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info)
msgenv_resource_type = enif_open_resource_type(env,NULL,"nif_SUITE.msgenv",
msgenv_dtor,
ERL_NIF_RT_CREATE, NULL);
+ fd_resource_type = enif_open_resource_type_x(env, "nif_SUITE.fd",
+ &fd_rt_init,
+ ERL_NIF_RT_CREATE, NULL);
+ monitor_resource_type = enif_open_resource_type_x(env, "nif_SUITE.monitor",
+ &monitor_rt_init,
+ ERL_NIF_RT_CREATE, NULL);
+ frenzy_resource_type = enif_open_resource_type_x(env, "nif_SUITE.monitor_frenzy",
+ &frenzy_rt_init,
+ ERL_NIF_RT_CREATE, NULL);
+
+ whereis_resource_type = enif_open_resource_type(env, NULL, "nif_SUITE.whereis",
+ whereis_thread_resource_dtor, ERL_NIF_RT_CREATE, NULL);
+
+ ioq_resource_type = enif_open_resource_type(env,NULL,"ioq",
+ ioq_resource_dtor,
+ ERL_NIF_RT_CREATE, NULL);
+
atom_false = enif_make_atom(env,"false");
+ atom_true = enif_make_atom(env,"true");
atom_self = enif_make_atom(env,"self");
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_second = enif_make_atom(env,"second");
+ atom_millisecond = enif_make_atom(env,"millisecond");
+ atom_microsecond = enif_make_atom(env,"microsecond");
+ atom_nanosecond = enif_make_atom(env,"nanosecond");
+ atom_eagain = enif_make_atom(env, "eagain");
+ atom_eof = enif_make_atom(env, "eof");
+ atom_error = enif_make_atom(env, "error");
+ atom_fd_resource_stop = enif_make_atom(env, "fd_resource_stop");
+ atom_monitor_resource_type = enif_make_atom(env, "monitor_resource_type");
+ atom_monitor_resource_down = enif_make_atom(env, "monitor_resource_down");
+ atom_init = enif_make_atom(env,"init");
+ atom_stats = enif_make_atom(env,"stats");
+ atom_done = enif_make_atom(env,"done");
+ atom_stop = enif_make_atom(env,"stop");
+ atom_null = enif_make_atom(env,"null");
+ atom_pid = enif_make_atom(env, "pid");
+ atom_port = enif_make_atom(env, "port");
+ atom_send = enif_make_atom(env, "send");
+ atom_lookup = enif_make_atom(env, "lookup");
+ atom_badarg = enif_make_atom(env, "badarg");
*priv_data = data;
return 0;
@@ -170,14 +312,6 @@ static void resource_takeover(ErlNifEnv* env, PrivData* priv)
msgenv_resource_type = rt;
}
-static int reload(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info)
-{
- PrivData* priv = (PrivData*) *priv_data;
- add_call(env, priv, "reload");
- resource_takeover(env,priv);
- return 0;
-}
-
static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info)
{
PrivData* priv = (PrivData*) *old_priv_data;
@@ -198,6 +332,7 @@ static void unload(ErlNifEnv* env, void* priv_data)
}
enif_free(priv_data);
}
+ DBG_TRACE_FINI;
}
static ERL_NIF_TERM lib_version(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
@@ -502,6 +637,7 @@ static ERL_NIF_TERM type_test(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[
goto error;
}
}
+
ref1 = enif_make_ref(env);
ref2 = enif_make_ref(env);
if (!enif_is_ref(env,ref1) || !enif_is_ref(env,ref2)
@@ -586,6 +722,31 @@ static ERL_NIF_TERM compare(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
return enif_make_int(env, enif_compare(argv[0],argv[1]));
}
+static ERL_NIF_TERM hash_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ if (argc != 3) {
+ return enif_make_badarg(env);
+ }
+
+ ErlNifHash type;
+ if (enif_is_identical(argv[0], enif_make_atom(env, "internal"))) {
+ type = ERL_NIF_INTERNAL_HASH;
+ }
+ else if (enif_is_identical(argv[0], enif_make_atom(env, "phash2"))) {
+ type = ERL_NIF_PHASH2;
+ }
+ else {
+ return enif_make_badarg(env);
+ }
+
+ ErlNifUInt64 salt;
+ if (! enif_get_uint64(env, argv[2], &salt)) {
+ return enif_make_badarg(env);
+ }
+
+ return enif_make_uint64(env, enif_hash(type, argv[1], salt));
+}
+
static ERL_NIF_TERM many_args_100(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
int i, k;
@@ -820,6 +981,9 @@ static ERL_NIF_TERM get_resource(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar
if (enif_is_identical(argv[0], atom_binary_resource_type)) {
type.t = binary_resource_type;
}
+ else if (enif_is_identical(argv[0], atom_monitor_resource_type)) {
+ type.t = monitor_resource_type;
+ }
else {
get_pointer(env, argv[0], &type.vp);
}
@@ -843,6 +1007,30 @@ static ERL_NIF_TERM release_resource(ErlNifEnv* env, int argc, const ERL_NIF_TER
return enif_make_atom(env,"ok");
}
+static void* threaded_release_resource(void* resource)
+{
+ enif_release_resource(resource);
+}
+
+static ERL_NIF_TERM release_resource_from_thread(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ void* resource;
+ ErlNifTid tid;
+ int err;
+
+ if (!get_pointer(env, argv[0], &resource)) {
+ return enif_make_badarg(env);
+ }
+ if (enif_thread_create("nif_SUITE:release_resource_from_thread", &tid,
+ threaded_release_resource, resource, NULL) != 0) {
+ return enif_make_badarg(env);
+ }
+ err = enif_thread_join(tid, NULL);
+ assert(err == 0);
+ return atom_ok;
+}
+
+
/*
* argv[0] an atom
* argv[1] a binary
@@ -881,15 +1069,19 @@ static ERL_NIF_TERM check_is(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]
*
* This function is separate from check_is because it calls enif_make_badarg
* and so it must return the badarg exception as its return value. Thus, the
- * badarg exception indicates success. Failure is indicated by returning an
- * error atom.
+ * badarg exception indicates success.
*/
static ERL_NIF_TERM check_is_exception(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
+ ERL_NIF_TERM badarg, exc_term;
ERL_NIF_TERM error_atom = enif_make_atom(env, "error");
- ERL_NIF_TERM badarg = enif_make_badarg(env);
- if (enif_is_exception(env, error_atom)) return error_atom;
- if (!enif_is_exception(env, badarg)) return error_atom;
+ ERL_NIF_TERM badarg_atom = enif_make_atom(env, "badarg");
+ assert(!enif_is_exception(env, error_atom));
+ badarg = enif_make_badarg(env);
+ assert(enif_is_exception(env, badarg));
+ assert(enif_has_pending_exception(env, NULL));
+ assert(enif_has_pending_exception(env, &exc_term));
+ assert(enif_is_identical(exc_term, badarg_atom));
return badarg;
}
@@ -899,6 +1091,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[])
{
@@ -919,6 +1112,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");
}
@@ -1000,15 +1196,248 @@ static void fill(void* dst, unsigned bytes, int seed)
}
}
+/* enif_whereis_... tests */
+
+enum {
+ /* results */
+ WHEREIS_SUCCESS,
+ WHEREIS_ERROR_TYPE,
+ WHEREIS_ERROR_LOOKUP,
+ WHEREIS_ERROR_SEND,
+ /* types */
+ WHEREIS_LOOKUP_PID, /* enif_whereis_pid() */
+ WHEREIS_LOOKUP_PORT /* enif_whereis_port() */
+};
+
+typedef union {
+ ErlNifPid pid;
+ ErlNifPort port;
+} whereis_term_data_t;
+
+/* single use, no cross-thread access/serialization */
+typedef struct {
+ ErlNifEnv* env;
+ ERL_NIF_TERM name;
+ whereis_term_data_t res;
+ ErlNifTid tid;
+ int type;
+} whereis_thread_resource_t;
+
+static whereis_thread_resource_t* whereis_thread_resource_create(void)
+{
+ whereis_thread_resource_t* rp = (whereis_thread_resource_t*)
+ enif_alloc_resource(whereis_resource_type, sizeof(*rp));
+ memset(rp, 0, sizeof(*rp));
+ rp->env = enif_alloc_env();
+
+ return rp;
+}
+
+static void whereis_thread_resource_dtor(ErlNifEnv* env, void* obj)
+{
+ whereis_thread_resource_t* rp = (whereis_thread_resource_t*) obj;
+ enif_free_env(rp->env);
+}
+
+static int whereis_type(ERL_NIF_TERM type)
+{
+ if (enif_is_identical(type, atom_pid))
+ return WHEREIS_LOOKUP_PID;
+
+ if (enif_is_identical(type, atom_port))
+ return WHEREIS_LOOKUP_PORT;
+
+ return WHEREIS_ERROR_TYPE;
+}
+
+static int whereis_lookup_internal(
+ ErlNifEnv* env, int type, ERL_NIF_TERM name, whereis_term_data_t* out)
+{
+ if (type == WHEREIS_LOOKUP_PID)
+ return enif_whereis_pid(env, name, & out->pid)
+ ? WHEREIS_SUCCESS : WHEREIS_ERROR_LOOKUP;
+
+ if (type == WHEREIS_LOOKUP_PORT)
+ return enif_whereis_port(env, name, & out->port)
+ ? WHEREIS_SUCCESS : WHEREIS_ERROR_LOOKUP;
+
+ return WHEREIS_ERROR_TYPE;
+}
+
+static int whereis_send_internal(
+ ErlNifEnv* env, int type, whereis_term_data_t* to, ERL_NIF_TERM msg)
+{
+ if (type == WHEREIS_LOOKUP_PID)
+ return enif_send(env, & to->pid, NULL, msg)
+ ? WHEREIS_SUCCESS : WHEREIS_ERROR_SEND;
+
+ if (type == WHEREIS_LOOKUP_PORT)
+ return enif_port_command(env, & to->port, NULL, msg)
+ ? WHEREIS_SUCCESS : WHEREIS_ERROR_SEND;
+
+ return WHEREIS_ERROR_TYPE;
+}
+
+static int whereis_resolved_term(
+ ErlNifEnv* env, int type, whereis_term_data_t* res, ERL_NIF_TERM* out)
+{
+ switch (type) {
+ case WHEREIS_LOOKUP_PID:
+ *out = enif_make_pid(env, & res->pid);
+ break;
+ case WHEREIS_LOOKUP_PORT:
+ *out = enif_make_port(env, & res->port);
+ break;
+ default:
+ return WHEREIS_ERROR_TYPE;
+ }
+ return WHEREIS_SUCCESS;
+}
+
+static ERL_NIF_TERM whereis_result_term(ErlNifEnv* env, int result)
+{
+ ERL_NIF_TERM err;
+ switch (result)
+ {
+ case WHEREIS_SUCCESS:
+ return atom_ok;
+ case WHEREIS_ERROR_LOOKUP:
+ err = atom_lookup;
+ break;
+ case WHEREIS_ERROR_SEND:
+ err = atom_send;
+ break;
+ case WHEREIS_ERROR_TYPE:
+ err = atom_badarg;
+ break;
+ default:
+ err = enif_make_int(env, -result);
+ break;
+ }
+ return enif_make_tuple2(env, atom_error, err);
+}
+
+static void* whereis_lookup_thread(void* arg)
+{
+ whereis_thread_resource_t* rp = (whereis_thread_resource_t*) arg;
+ int rc;
+
+ /* enif_whereis_xxx should work with allocated or null env */
+ rc = whereis_lookup_internal(
+ ((rp->type == WHEREIS_LOOKUP_PID) ? NULL : rp->env),
+ rp->type, rp->name, & rp->res);
+
+ return (((char*) NULL) + rc);
+}
+
+/* whereis_term(Type, Name) -> pid() | port() | false */
+static ERL_NIF_TERM
+whereis_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ whereis_term_data_t res;
+ ERL_NIF_TERM ret;
+ int type, rc;
+
+ if (argc != 2) /* allow non-atom name for testing */
+ return enif_make_badarg(env);
+
+ if ((type = whereis_type(argv[0])) == WHEREIS_ERROR_TYPE)
+ return enif_make_badarg(env);
+
+ rc = whereis_lookup_internal(env, type, argv[1], & res);
+ if (rc == WHEREIS_SUCCESS) {
+ rc = whereis_resolved_term(env, type, & res, & ret);
+ }
+ return (rc == WHEREIS_SUCCESS) ? ret : atom_false;
+}
+
+/* whereis_send(Type, Name, Message) -> ok | {error, Reason} */
+static ERL_NIF_TERM
+whereis_send(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ whereis_term_data_t to;
+ int type, rc;
+
+ if (argc != 3 || !enif_is_atom(env, argv[1]))
+ return enif_make_badarg(env);
+
+ if ((type = whereis_type(argv[0])) == WHEREIS_ERROR_TYPE)
+ return enif_make_badarg(env);
+
+ rc = whereis_lookup_internal(env, type, argv[1], & to);
+ if (rc == WHEREIS_SUCCESS)
+ rc = whereis_send_internal(env, type, & to, argv[2]);
+
+ return whereis_result_term(env, rc);
+}
+
+/* whereis_thd_lookup(Type, Name) -> {ok, Resource} | {error, SysErrno} */
+static ERL_NIF_TERM
+whereis_thd_lookup(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ whereis_thread_resource_t* rp;
+ int type, rc;
+
+ if (argc != 2 || !enif_is_atom(env, argv[1]))
+ return enif_make_badarg(env);
+
+ if ((type = whereis_type(argv[0])) == WHEREIS_ERROR_TYPE)
+ return enif_make_badarg(env);
+
+ rp = whereis_thread_resource_create();
+ rp->type = type;
+ rp->name = enif_make_copy(rp->env, argv[1]);
+
+ rc = enif_thread_create(
+ "nif_SUITE:whereis_thd", & rp->tid, whereis_lookup_thread, rp, NULL);
+
+ if (rc == 0) {
+ return enif_make_tuple2(env, atom_ok, enif_make_resource(env, rp));
+ }
+ else {
+ enif_release_resource(rp);
+ return enif_make_tuple2(env, atom_error, enif_make_int(env, rc));
+ }
+}
+
+/* whereis_thd_result(Resource) -> {ok, pid() | port()} | {error, ErrNum} */
+static ERL_NIF_TERM
+whereis_thd_result(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ whereis_thread_resource_t* rp;
+ ERL_NIF_TERM ret;
+ char* thdret; /* so we can keep compilers happy converting to int */
+ int rc;
+
+ if (argc != 1
+ || !enif_get_resource(env, argv[0], whereis_resource_type, (void**) & rp))
+ return enif_make_badarg(env);
+
+ if ((rc = enif_thread_join(rp->tid, (void**) & thdret)) != 0)
+ return enif_make_tuple2(env, atom_error, enif_make_int(env, rc));
+
+ rc = (int)(thdret - ((char*) NULL));
+ if (rc == WHEREIS_SUCCESS) {
+ rc = whereis_resolved_term(env, rp->type, & rp->res, & ret);
+ }
+ ret = (rc == WHEREIS_SUCCESS)
+ ? enif_make_tuple2(env, atom_ok, ret) : whereis_result_term(env, rc);
+
+ enif_release_resource(rp);
+ return ret;
+}
+
#define MAKE_TERM_REUSE_LEN 16
struct make_term_info
{
ErlNifEnv* caller_env;
ErlNifEnv* dst_env;
+ int dst_env_valid;
ERL_NIF_TERM reuse[MAKE_TERM_REUSE_LEN];
unsigned reuse_push;
unsigned reuse_pull;
ErlNifResourceType* resource_type;
+ void *resource;
ERL_NIF_TERM other_term;
ERL_NIF_TERM blob;
ErlNifPid to_pid;
@@ -1034,6 +1463,7 @@ static ERL_NIF_TERM pull_term(struct make_term_info* mti)
mti->reuse_push < MAKE_TERM_REUSE_LEN) {
mti->reuse_pull = 0;
if (mti->reuse_push == 0) {
+ assert(mti->dst_env_valid);
mti->reuse[0] = enif_make_list(mti->dst_env, 0);
}
}
@@ -1087,10 +1517,6 @@ static ERL_NIF_TERM make_term_string(struct make_term_info* mti, int n)
{
return enif_make_string(mti->dst_env, "Hello!", ERL_NIF_LATIN1);
}
-static ERL_NIF_TERM make_term_ref(struct make_term_info* mti, int n)
-{
- return enif_make_ref(mti->dst_env);
-}
static ERL_NIF_TERM make_term_sub_binary(struct make_term_info* mti, int n)
{
ERL_NIF_TERM orig;
@@ -1120,12 +1546,7 @@ static ERL_NIF_TERM make_term_list0(struct make_term_info* mti, int n)
}
static ERL_NIF_TERM make_term_resource(struct make_term_info* mti, int n)
{
- void* resource = enif_alloc_resource(mti->resource_type, 10);
- ERL_NIF_TERM term;
- fill(resource, 10, n);
- term = enif_make_resource(mti->dst_env, resource);
- enif_release_resource(resource);
- return term;
+ return enif_make_resource(mti->dst_env, mti->resource);
}
static ERL_NIF_TERM make_term_new_binary(struct make_term_info* mti, int n)
{
@@ -1198,7 +1619,6 @@ static Make_term_Func* make_funcs[] = {
make_term_atom,
make_term_existing_atom,
make_term_string,
- //make_term_ref,
make_term_sub_binary,
make_term_uint,
make_term_long,
@@ -1222,6 +1642,7 @@ static unsigned num_of_make_funcs()
static int make_term_n(struct make_term_info* mti, int n, ERL_NIF_TERM* res)
{
if (n < num_of_make_funcs()) {
+ assert(mti->dst_env_valid);
*res = make_funcs[n](mti, n);
push_term(mti, *res);
return 1;
@@ -1229,22 +1650,39 @@ static int make_term_n(struct make_term_info* mti, int n, ERL_NIF_TERM* res)
return 0;
}
-static ERL_NIF_TERM make_blob(ErlNifEnv* caller_env, ErlNifEnv* dst_env,
- ERL_NIF_TERM other_term)
+
+static void
+init_make_blob(struct make_term_info *mti,
+ ErlNifEnv* caller_env,
+ ERL_NIF_TERM other_term)
{
PrivData* priv = (PrivData*) enif_priv_data(caller_env);
+ mti->caller_env = caller_env;
+ mti->resource_type = priv->rt_arr[0].t;
+ mti->resource = enif_alloc_resource(mti->resource_type, 10);
+ fill(mti->resource, 10, 17);
+ mti->other_term = other_term;
+}
+
+static void
+fini_make_blob(struct make_term_info *mti)
+{
+ enif_release_resource(mti->resource);
+}
+
+static ERL_NIF_TERM make_blob(struct make_term_info *mti,
+ ErlNifEnv* dst_env)
+{
ERL_NIF_TERM term, list;
int n = 0;
- struct make_term_info mti;
- mti.caller_env = caller_env;
- mti.dst_env = dst_env;
- mti.reuse_push = 0;
- mti.reuse_pull = 0;
- mti.resource_type = priv->rt_arr[0].t;
- mti.other_term = other_term;
+
+ mti->reuse_push = 0;
+ mti->reuse_pull = 0;
+ mti->dst_env = dst_env;
+ mti->dst_env_valid = 1;
list = enif_make_list(dst_env, 0);
- while (make_term_n(&mti, n++, &term)) {
+ while (make_term_n(mti, n++, &term)) {
list = enif_make_list_cell(dst_env, term, list);
}
return list;
@@ -1256,13 +1694,16 @@ static ERL_NIF_TERM send_new_blob(ErlNifEnv* env, int argc, const ERL_NIF_TERM a
ERL_NIF_TERM msg, copy;
ErlNifEnv* msg_env;
int res;
+ struct make_term_info mti;
if (!enif_get_local_pid(env, argv[0], &to)) {
return enif_make_badarg(env);
}
msg_env = enif_alloc_env();
- msg = make_blob(env,msg_env, argv[1]);
- copy = make_blob(env,env, argv[1]);
+ init_make_blob(&mti, env, argv[1]);
+ msg = make_blob(&mti,msg_env);
+ copy = make_blob(&mti,env);
+ fini_make_blob(&mti);
res = enif_send(env, &to, msg_env, msg);
enif_free_env(msg_env);
return enif_make_tuple3(env, atom_ok, enif_make_int(env,res), copy);
@@ -1278,9 +1719,12 @@ static ERL_NIF_TERM alloc_msgenv(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar
sizeof(*mti));
mti->caller_env = NULL;
mti->dst_env = enif_alloc_env();
+ mti->dst_env_valid = 1;
mti->reuse_push = 0;
mti->reuse_pull = 0;
mti->resource_type = priv->rt_arr[0].t;
+ mti->resource = enif_alloc_resource(mti->resource_type, 10);
+ fill(mti->resource, 10, 17);
mti->other_term = enif_make_list(mti->dst_env, 0);
mti->blob = enif_make_list(mti->dst_env, 0);
mti->mtx = enif_mutex_create("nif_SUITE:mtx");
@@ -1298,6 +1742,7 @@ static void msgenv_dtor(ErlNifEnv* env, void* obj)
if (mti->dst_env != NULL) {
enif_free_env(mti->dst_env);
}
+ enif_release_resource(mti->resource);
enif_mutex_destroy(mti->mtx);
enif_cond_destroy(mti->cond);
}
@@ -1309,6 +1754,7 @@ static ERL_NIF_TERM clear_msgenv(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar
return enif_make_badarg(env);
}
enif_clear_env(mti.p->dst_env);
+ mti.p->dst_env_valid = 1;
mti.p->reuse_pull = 0;
mti.p->reuse_push = 0;
mti.p->blob = enif_make_list(mti.p->dst_env, 0);
@@ -1343,6 +1789,8 @@ static ERL_NIF_TERM send_blob(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[
}
copy = enif_make_copy(env, mti.p->blob);
res = enif_send(env, &to, mti.p->dst_env, mti.p->blob);
+ if (res)
+ mti.p->dst_env_valid = 0;
return enif_make_tuple3(env, atom_ok, enif_make_int(env,res), copy);
}
@@ -1350,7 +1798,6 @@ static ERL_NIF_TERM send3_blob(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv
{
mti_t mti;
ErlNifPid to;
- ERL_NIF_TERM copy;
int res;
if (!enif_get_resource(env, argv[0], msgenv_resource_type, &mti.vp)
|| !enif_get_local_pid(env, argv[1], &to)) {
@@ -1360,6 +1807,8 @@ static ERL_NIF_TERM send3_blob(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv
enif_make_copy(mti.p->dst_env, argv[2]),
mti.p->blob);
res = enif_send(env, &to, mti.p->dst_env, mti.p->blob);
+ if (res)
+ mti.p->dst_env_valid = 0;
return enif_make_int(env,res);
}
@@ -1376,6 +1825,8 @@ void* threaded_sender(void *arg)
mti.p->send_it = 0;
enif_mutex_unlock(mti.p->mtx);
mti.p->send_res = enif_send(NULL, &mti.p->to_pid, mti.p->dst_env, mti.p->blob);
+ if (mti.p->send_res)
+ mti.p->dst_env_valid = 0;
return NULL;
}
@@ -1445,6 +1896,17 @@ static ERL_NIF_TERM send_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[
return enif_make_int(env, ret);
}
+static ERL_NIF_TERM send_copy_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ErlNifPid pid;
+ int ret;
+ if (!enif_get_local_pid(env, argv[0], &pid)) {
+ return enif_make_badarg(env);
+ }
+ ret = enif_send(env, &pid, NULL, argv[1]);
+ return enif_make_int(env, ret);
+}
+
static ERL_NIF_TERM reverse_list(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {
ERL_NIF_TERM rev_list;
@@ -1473,6 +1935,26 @@ static ERL_NIF_TERM otp_9668_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar
return atom_ok;
}
+static ERL_NIF_TERM otp_9828_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ /* copy a writable binary could reallocate it due to "emasculation"
+ and thereby render a previous inspection invalid.
+ */
+ ErlNifBinary bin1;
+ ErlNifEnv* myenv;
+
+ if (!enif_inspect_binary(env, argv[0], &bin1)) {
+ return enif_make_badarg(env);
+ }
+
+ myenv = enif_alloc_env();
+ enif_make_copy(myenv, argv[0]);
+ enif_free_env(myenv);
+
+ return memcmp(bin1.data, "I'm alive!", 10)==0 ? atom_ok : atom_false;
+}
+
+
static ERL_NIF_TERM consume_timeslice_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
int percent;
@@ -1493,78 +1975,127 @@ static ERL_NIF_TERM consume_timeslice_nif(ErlNifEnv* env, int argc, const ERL_NI
}
}
-#ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT
-static ERL_NIF_TERM dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+static ERL_NIF_TERM nif_sched2(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
- int n;
- char s[10];
- ErlNifBinary b;
- ERL_NIF_TERM result;
- if (enif_have_dirty_schedulers()) {
- assert(enif_is_on_dirty_scheduler(env));
- }
- assert(argc == 3);
- enif_get_int(env, argv[0], &n);
- enif_get_string(env, argv[1], s, sizeof s, ERL_NIF_LATIN1);
- enif_inspect_binary(env, argv[2], &b);
- result = enif_make_tuple3(env,
- enif_make_int(env, n),
- enif_make_string(env, s, ERL_NIF_LATIN1),
- enif_make_binary(env, &b));
- return enif_schedule_dirty_nif_finalizer(env, result, enif_dirty_nif_finalizer);
+ char s[64];
+ if (!enif_get_string(env, argv[2], s, sizeof s, ERL_NIF_LATIN1))
+ return enif_make_badarg(env);
+ return enif_make_tuple2(env, argv[3], argv[2]);
}
-static ERL_NIF_TERM call_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+static ERL_NIF_TERM nif_sched1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
- int n;
- char s[10];
- ErlNifBinary b;
- assert(!enif_is_on_dirty_scheduler(env));
- if (argc != 3)
- return enif_make_badarg(env);
- if (enif_have_dirty_schedulers()) {
- if (enif_get_int(env, argv[0], &n) &&
- enif_get_string(env, argv[1], s, sizeof s, ERL_NIF_LATIN1) &&
- enif_inspect_binary(env, argv[2], &b))
- return enif_schedule_dirty_nif(env, ERL_NIF_DIRTY_JOB_CPU_BOUND, dirty_nif, argc, argv);
- else
- return enif_make_badarg(env);
+ ERL_NIF_TERM new_argv[4];
+ new_argv[0] = enif_make_atom(env, "garbage0");
+ new_argv[1] = enif_make_atom(env, "garbage1");
+ new_argv[2] = argv[0];
+ new_argv[3] = argv[1];
+ return enif_schedule_nif(env, "nif_sched2", 0, nif_sched2, 4, new_argv);
+}
+
+static ERL_NIF_TERM call_nif_schedule(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ERL_NIF_TERM result;
+ if (argc != 2)
+ return enif_make_atom(env, "false");
+ result = enif_schedule_nif(env, "nif_sched1", 0, nif_sched1, argc, argv);
+ assert(!enif_is_exception(env, result));
+ return result;
+}
+
+/*
+ * If argv[0] is the integer 0, call enif_make_badarg, but don't return its
+ * return value. Instead, return ok. Result should still be a badarg
+ * exception for the erlang caller.
+ *
+ * For any other value of argv[0], use it as an exception term and return
+ * the exception.
+ */
+static ERL_NIF_TERM call_nif_exception(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ERL_NIF_TERM exc_term;
+ ERL_NIF_TERM badarg_atom = enif_make_atom(env, "badarg");
+ int arg;
+
+ if (enif_get_int(env, argv[0], &arg) && arg == 0) {
+ /* ignore return value */ enif_make_badarg(env);
+ assert(enif_has_pending_exception(env, NULL));
+ assert(enif_has_pending_exception(env, &exc_term));
+ assert(enif_is_identical(badarg_atom, exc_term));
+ return enif_make_atom(env, "ok");
} else {
- return dirty_nif(env, argc, argv);
+ ERL_NIF_TERM exc_retval = enif_raise_exception(env, argv[0]);
+ assert(enif_has_pending_exception(env, NULL));
+ assert(enif_has_pending_exception(env, &exc_term));
+ assert(enif_is_identical(argv[0], exc_term));
+ return exc_retval;
}
}
-static ERL_NIF_TERM dirty_sender(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+#if !defined(NAN) || !defined(INFINITY)
+double zero(void)
{
- ERL_NIF_TERM result;
- ErlNifPid pid;
- ErlNifEnv* menv;
- int res;
+ return 0.0;
+}
+#endif
- enif_get_local_pid(env, argv[0], &pid);
- result = enif_make_tuple2(env, enif_make_atom(env, "ok"), enif_make_pid(env, &pid));
- menv = enif_alloc_env();
- res = enif_send(env, &pid, menv, result);
- enif_free_env(menv);
- if (!res)
- /* Note the next line will crash, since dirty nifs can't return exceptions.
- * This is intentional, since enif_send should not fail if the test succeeds.
- */
- return enif_schedule_dirty_nif_finalizer(env, enif_make_badarg(env), enif_dirty_nif_finalizer);
- else
- return enif_schedule_dirty_nif_finalizer(env, result, enif_dirty_nif_finalizer);
+static ERL_NIF_TERM call_nif_nan_or_inf(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ double val;
+ char arg[6];
+ ERL_NIF_TERM res;
+
+ assert(argc == 1);
+ enif_get_atom(env, argv[0], arg, sizeof arg, ERL_NIF_LATIN1);
+ if (strcmp(arg, "nan") == 0) {
+ /* Verify that enif_make_double raises a badarg for NaN */
+#ifdef NAN
+ val = NAN;
+#else
+ val = 0.0/zero();
+#endif
+ } else {
+ /* Verify that enif_make_double raises a badarg for NaN and infinity */
+#ifdef INFINITY
+ val = INFINITY;
+#else
+ val = 1.0/zero();
+#endif
+ }
+ res = enif_make_double(env, val);
+ assert(enif_is_exception(env, res));
+ assert(enif_has_pending_exception(env, NULL));
+ if (strcmp(arg, "tuple") == 0) {
+ return enif_make_tuple2(env, argv[0], res);
+ } else {
+ return res;
+ }
}
-static ERL_NIF_TERM send_from_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+static ERL_NIF_TERM call_nif_atom_too_long(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
- ERL_NIF_TERM result;
- ErlNifPid pid;
+ char str[257];
+ char arg[4];
+ size_t len;
+ int i;
+ ERL_NIF_TERM res;
- if (!enif_get_local_pid(env, argv[0], &pid))
- return enif_make_badarg(env);
- return enif_schedule_dirty_nif(env, ERL_NIF_DIRTY_JOB_CPU_BOUND, dirty_sender, argc, argv);
+ assert(argc == 1);
+ enif_get_atom(env, argv[0], arg, sizeof arg, ERL_NIF_LATIN1);
+ /* Verify that creating an atom from a string that's too long results in a badarg */
+ for (i = 0; i < sizeof str; ++i) {
+ str[i] = 'a';
+ }
+ str[256] = '\0';
+ if (strcmp(arg, "len") == 0) {
+ len = strlen(str);
+ res = enif_make_atom_len(env, str, len);
+ } else {
+ res = enif_make_atom(env, str);
+ }
+ assert(enif_is_exception(env, res));
+ return res;
}
-#endif
static ERL_NIF_TERM is_map_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
@@ -1642,12 +2173,13 @@ static ERL_NIF_TERM sorted_list_from_maps_nif(ErlNifEnv* env, int argc, const ER
if (argc != 1 && !enif_is_map(env, map))
return enif_make_int(env, __LINE__);
- if(!enif_map_iterator_create(env, map, &iter_f, ERL_NIF_MAP_ITERATOR_HEAD))
+ if(!enif_map_iterator_create(env, map, &iter_f, ERL_NIF_MAP_ITERATOR_FIRST))
return enif_make_int(env, __LINE__);
cnt = 0;
+ next_ret = 1;
while(enif_map_iterator_get_pair(env,&iter_f,&key,&value)) {
- if (cnt && !next_ret)
+ if (!next_ret)
return enif_make_int(env, __LINE__);
list_f = enif_make_list_cell(env, enif_make_tuple2(env, key, value), list_f);
next_ret = enif_map_iterator_next(env,&iter_f);
@@ -1656,12 +2188,13 @@ static ERL_NIF_TERM sorted_list_from_maps_nif(ErlNifEnv* env, int argc, const ER
if (cnt && next_ret)
return enif_make_int(env, __LINE__);
- if(!enif_map_iterator_create(env, map, &iter_b, ERL_NIF_MAP_ITERATOR_TAIL))
+ if(!enif_map_iterator_create(env, map, &iter_b, ERL_NIF_MAP_ITERATOR_LAST))
return enif_make_int(env, __LINE__);
cnt = 0;
+ prev_ret = 1;
while(enif_map_iterator_get_pair(env,&iter_b,&key,&value)) {
- if (cnt && !prev_ret)
+ if (!prev_ret)
return enif_make_int(env, __LINE__);
/* Test that iter_f can step "backwards" */
@@ -1673,6 +2206,7 @@ static ERL_NIF_TERM sorted_list_from_maps_nif(ErlNifEnv* env, int argc, const ER
list_b = enif_make_list_cell(env, enif_make_tuple2(env, key, value), list_b);
prev_ret = enif_map_iterator_prev(env,&iter_b);
+ cnt++;
}
if (cnt) {
@@ -1692,6 +2226,1173 @@ 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_second) == 0)
+ time_unit = ERL_NIF_SEC;
+ else if (enif_compare(argv[0], atom_millisecond) == 0)
+ time_unit = ERL_NIF_MSEC;
+ else if (enif_compare(argv[0], atom_microsecond) == 0)
+ time_unit = ERL_NIF_USEC;
+ else if (enif_compare(argv[0], atom_nanosecond) == 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_second) == 0)
+ time_unit = ERL_NIF_SEC;
+ else if (enif_compare(argv[0], atom_millisecond) == 0)
+ time_unit = ERL_NIF_MSEC;
+ else if (enif_compare(argv[0], atom_microsecond) == 0)
+ time_unit = ERL_NIF_USEC;
+ else if (enif_compare(argv[0], atom_nanosecond) == 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_second) == 0)
+ from = ERL_NIF_SEC;
+ else if (enif_compare(argv[1], atom_millisecond) == 0)
+ from = ERL_NIF_MSEC;
+ else if (enif_compare(argv[1], atom_microsecond) == 0)
+ from = ERL_NIF_USEC;
+ else if (enif_compare(argv[1], atom_nanosecond) == 0)
+ from = ERL_NIF_NSEC;
+ else
+ from = 4711; /* invalid time unit */
+
+ if (enif_compare(argv[2], atom_second) == 0)
+ to = ERL_NIF_SEC;
+ else if (enif_compare(argv[2], atom_millisecond) == 0)
+ to = ERL_NIF_MSEC;
+ else if (enif_compare(argv[2], atom_microsecond) == 0)
+ to = ERL_NIF_USEC;
+ else if (enif_compare(argv[2], atom_nanosecond) == 0)
+ to = ERL_NIF_NSEC;
+ else
+ to = 4711; /* invalid time unit */
+
+ return enif_make_int64(env, enif_convert_time_unit(val, from, to));
+}
+
+static ERL_NIF_TERM now_time(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ return enif_now_time(env);
+}
+
+static ERL_NIF_TERM cpu_time(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ return enif_cpu_time(env);
+}
+
+static ERL_NIF_TERM unique_integer(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ERL_NIF_TERM atom_pos = enif_make_atom(env,"positive"),
+ atom_mon = enif_make_atom(env,"monotonic");
+ ERL_NIF_TERM opts = argv[0], opt;
+ ErlNifUniqueInteger properties = 0;
+
+ while (!enif_is_empty_list(env, opts)) {
+ if (!enif_get_list_cell(env, opts, &opt, &opts))
+ return enif_make_badarg(env);
+
+ if (enif_compare(opt, atom_pos) == 0)
+ properties |= ERL_NIF_UNIQUE_POSITIVE;
+ if (enif_compare(opt, atom_mon) == 0)
+ properties |= ERL_NIF_UNIQUE_MONOTONIC;
+ }
+
+ return enif_make_unique_integer(env, properties);
+}
+
+static ERL_NIF_TERM is_process_alive(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ErlNifPid pid;
+ if (!enif_get_local_pid(env, argv[0], &pid))
+ return enif_make_badarg(env);
+ if (enif_is_process_alive(env, &pid))
+ return atom_true;
+ return atom_false;
+}
+
+static ERL_NIF_TERM is_port_alive(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ErlNifPort port;
+ if (!enif_get_local_port(env, argv[0], &port))
+ return enif_make_badarg(env);
+ if (enif_is_port_alive(env, &port))
+ return atom_true;
+ return atom_false;
+}
+
+static ERL_NIF_TERM term_to_binary(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ErlNifBinary bin;
+ ErlNifPid pid;
+ ErlNifEnv *msg_env = env;
+ ERL_NIF_TERM term;
+
+ if (enif_get_local_pid(env, argv[1], &pid))
+ msg_env = enif_alloc_env();
+
+ if (!enif_term_to_binary(msg_env, argv[0], &bin))
+ return enif_make_badarg(env);
+
+ term = enif_make_binary(msg_env, &bin);
+
+ if (msg_env != env) {
+ enif_send(env, &pid, msg_env, term);
+ enif_free_env(msg_env);
+ return atom_true;
+ } else {
+ return term;
+ }
+}
+
+static ERL_NIF_TERM binary_to_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ErlNifBinary bin;
+ ERL_NIF_TERM term, ret_term;
+ ErlNifPid pid;
+ ErlNifEnv *msg_env = env;
+ unsigned int opts;
+ ErlNifUInt64 ret;
+
+ if (enif_get_local_pid(env, argv[1], &pid))
+ msg_env = enif_alloc_env();
+
+ if (!enif_inspect_binary(env, argv[0], &bin)
+ || !enif_get_uint(env, argv[2], &opts))
+ return enif_make_badarg(env);
+
+ ret = enif_binary_to_term(msg_env, bin.data, bin.size, &term,
+ (ErlNifBinaryToTerm)opts);
+ if (!ret)
+ return atom_false;
+
+ ret_term = enif_make_uint64(env, ret);
+ if (msg_env != env) {
+ enif_send(env, &pid, msg_env, term);
+ enif_free_env(msg_env);
+ return ret_term;
+ } else {
+ return enif_make_tuple2(env, ret_term, term);
+ }
+}
+
+static ERL_NIF_TERM port_command(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ErlNifPort port;
+
+ if (!enif_get_local_port(env, argv[0], &port))
+ return enif_make_badarg(env);
+
+ if (!enif_port_command(env, &port, NULL, argv[1]))
+ return enif_make_badarg(env);
+ return atom_true;
+}
+
+static ERL_NIF_TERM format_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ErlNifBinary obin;
+ unsigned int size;
+
+ if (!enif_get_uint(env, argv[0], &size))
+ return enif_make_badarg(env);
+ if (!enif_alloc_binary(size,&obin))
+ return enif_make_badarg(env);
+
+ if (enif_snprintf((char*)obin.data, (size_t)size, "%T", argv[1]) < 0)
+ return atom_false;
+
+ return enif_make_binary(env,&obin);
+}
+
+static int get_fd(ErlNifEnv* env, ERL_NIF_TERM term, struct fd_resource** rsrc)
+{
+ if (!enif_get_resource(env, term, fd_resource_type, (void**)rsrc)) {
+ return 0;
+ }
+ return 1;
+}
+
+static ERL_NIF_TERM select_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ struct fd_resource* fdr;
+ enum ErlNifSelectFlags mode;
+ void* obj;
+ ErlNifPid nifpid, *pid = NULL;
+ ERL_NIF_TERM ref;
+ int retval;
+
+ if (!get_fd(env, argv[0], &fdr)
+ || !enif_get_uint(env, argv[1], (unsigned int*)&mode)
+ || !enif_get_resource(env, argv[2], fd_resource_type, &obj))
+ {
+ return enif_make_badarg(env);
+ }
+
+ if (argv[3] != atom_null) {
+ if (!enif_get_local_pid(env, argv[3], &nifpid))
+ return enif_make_badarg(env);
+ pid = &nifpid;
+ }
+ ref = argv[4];
+
+ fdr->was_selected = 1;
+ enif_self(env, &fdr->pid);
+ retval = enif_select(env, fdr->fd, mode, obj, pid, ref);
+
+ return enif_make_int(env, retval);
+}
+
+#ifndef __WIN32__
+static ERL_NIF_TERM pipe_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ struct fd_resource* read_rsrc;
+ struct fd_resource* write_rsrc;
+ ERL_NIF_TERM read_fd, write_fd;
+ int fds[2], flags;
+
+ if (pipe(fds) < 0)
+ return enif_make_string(env, "pipe failed", ERL_NIF_LATIN1);
+
+ if ((flags = fcntl(fds[0], F_GETFL, 0)) < 0
+ || fcntl(fds[0], F_SETFL, flags|O_NONBLOCK) < 0
+ || (flags = fcntl(fds[1], F_GETFL, 0)) < 0
+ || fcntl(fds[1], F_SETFL, flags|O_NONBLOCK) < 0) {
+ close(fds[0]);
+ close(fds[1]);
+ return enif_make_string(env, "fcntl failed on pipe", ERL_NIF_LATIN1);
+ }
+
+ read_rsrc = enif_alloc_resource(fd_resource_type, sizeof(struct fd_resource));
+ write_rsrc = enif_alloc_resource(fd_resource_type, sizeof(struct fd_resource));
+ read_rsrc->fd = fds[0];
+ read_rsrc->was_selected = 0;
+ write_rsrc->fd = fds[1];
+ write_rsrc->was_selected = 0;
+ read_fd = enif_make_resource(env, read_rsrc);
+ write_fd = enif_make_resource(env, write_rsrc);
+ enif_release_resource(read_rsrc);
+ enif_release_resource(write_rsrc);
+
+ return enif_make_tuple2(env,
+ enif_make_tuple2(env, read_fd, make_pointer(env, read_rsrc)),
+ enif_make_tuple2(env, write_fd, make_pointer(env, write_rsrc)));
+}
+
+static ERL_NIF_TERM write_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ struct fd_resource* fdr;
+ ErlNifBinary bin;
+ int n, written = 0;
+
+ if (!get_fd(env, argv[0], &fdr)
+ || !enif_inspect_binary(env, argv[1], &bin))
+ return enif_make_badarg(env);
+
+ for (;;) {
+ n = write(fdr->fd, bin.data + written, bin.size - written);
+ if (n >= 0) {
+ written += n;
+ if (written == bin.size) {
+ return atom_ok;
+ }
+ }
+ else if (errno == EAGAIN) {
+ return enif_make_tuple2(env, atom_eagain, enif_make_int(env, written));
+ }
+ else if (errno == EINTR) {
+ continue;
+ }
+ else {
+ return enif_make_tuple2(env, atom_error, enif_make_int(env, errno));
+ }
+ }
+}
+
+static ERL_NIF_TERM read_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ struct fd_resource* fdr;
+ unsigned char* buf;
+ int n, count;
+ ERL_NIF_TERM res;
+
+ if (!get_fd(env, argv[0], &fdr)
+ || !enif_get_int(env, argv[1], &count) || count < 1)
+ return enif_make_badarg(env);
+
+ buf = enif_make_new_binary(env, count, &res);
+
+ for (;;) {
+ n = read(fdr->fd, buf, count);
+ if (n > 0) {
+ if (n < count) {
+ res = enif_make_sub_binary(env, res, 0, n);
+ }
+ return res;
+ }
+ else if (n == 0) {
+ return atom_eof;
+ }
+ else if (errno == EAGAIN) {
+ return atom_eagain;
+ }
+ else if (errno == EINTR) {
+ continue;
+ }
+ else {
+ return enif_make_tuple2(env, atom_error, enif_make_int(env, errno));
+ }
+ }
+}
+
+static ERL_NIF_TERM is_closed_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ struct fd_resource* fdr;
+
+ if (!get_fd(env, argv[0], &fdr))
+ return enif_make_badarg(env);
+
+ return fdr->fd < 0 ? atom_true : atom_false;
+}
+#endif /* !__WIN32__ */
+
+
+static void fd_resource_dtor(ErlNifEnv* env, void* obj)
+{
+ struct fd_resource* fdr = (struct fd_resource*)obj;
+ resource_dtor(env, obj);
+#ifdef __WIN32__
+ abort();
+#else
+ if (fdr->fd >= 0) {
+ assert(!fdr->was_selected);
+ close(fdr->fd);
+ }
+#endif
+}
+
+static struct {
+ void* obj;
+ int was_direct_call;
+}last_fd_stop;
+int fd_stop_cnt = 0;
+
+static void fd_resource_stop(ErlNifEnv* env, void* obj, ErlNifEvent fd,
+ int is_direct_call)
+{
+ struct fd_resource* fdr = (struct fd_resource*)obj;
+ assert(fd == fdr->fd);
+ assert(fd >= 0);
+
+ last_fd_stop.obj = obj;
+ last_fd_stop.was_direct_call = is_direct_call;
+ fd_stop_cnt++;
+
+ close(fd);
+ fdr->fd = -1; /* thread safety ? */
+ fdr->was_selected = 0;
+
+ {
+ ErlNifEnv* msg_env = enif_alloc_env();
+ ERL_NIF_TERM msg;
+ msg = enif_make_tuple3(msg_env,
+ atom_fd_resource_stop,
+ make_pointer(msg_env, obj),
+ enif_make_int(msg_env, is_direct_call));
+
+ enif_send(env, &fdr->pid, msg_env, msg);
+ enif_free_env(msg_env);
+ }
+}
+
+static ERL_NIF_TERM last_fd_stop_call(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ERL_NIF_TERM last, ret;
+ last = enif_make_tuple2(env, make_pointer(env, last_fd_stop.obj),
+ enif_make_int(env, last_fd_stop.was_direct_call));
+ ret = enif_make_tuple2(env, enif_make_int(env, fd_stop_cnt), last);
+ fd_stop_cnt = 0;
+ return ret;
+}
+
+
+static void monitor_resource_dtor(ErlNifEnv* env, void* obj)
+{
+ resource_dtor(env, obj);
+}
+
+static ERL_NIF_TERM make_monitor(ErlNifEnv* env, const ErlNifMonitor* mon)
+{
+ ERL_NIF_TERM mon_bin;
+ memcpy(enif_make_new_binary(env, sizeof(ErlNifMonitor), &mon_bin),
+ mon, sizeof(ErlNifMonitor));
+ return mon_bin;
+}
+
+static int get_monitor(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifMonitor* mon)
+{
+ ErlNifBinary bin;
+ if (!enif_inspect_binary(env, term, &bin)
+ || bin.size != sizeof(ErlNifMonitor))
+ return 0;
+ memcpy(mon, bin.data, bin.size);
+ return 1;
+}
+
+static void monitor_resource_down(ErlNifEnv* env, void* obj, ErlNifPid* pid,
+ ErlNifMonitor* mon)
+{
+ struct monitor_resource* rsrc = (struct monitor_resource*)obj;
+ ErlNifEnv* build_env;
+ ErlNifEnv* msg_env;
+ ERL_NIF_TERM msg;
+
+ if (rsrc->use_msgenv) {
+ msg_env = enif_alloc_env();
+ build_env = msg_env;
+ }
+ else {
+ msg_env = NULL;
+ build_env = env;
+ }
+
+ msg = enif_make_tuple4(build_env,
+ atom_monitor_resource_down,
+ make_pointer(build_env, obj),
+ enif_make_pid(build_env, pid),
+ make_monitor(build_env, mon));
+
+ enif_send(env, &rsrc->receiver, msg_env, msg);
+ if (msg_env)
+ enif_free_env(msg_env);
+}
+
+static ERL_NIF_TERM alloc_monitor_resource_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ struct monitor_resource* rsrc;
+
+ rsrc = enif_alloc_resource(monitor_resource_type, sizeof(struct monitor_resource));
+
+ return make_pointer(env,rsrc);
+}
+
+static ERL_NIF_TERM monitor_process_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ struct monitor_resource* rsrc;
+ ErlNifPid target;
+ ErlNifMonitor mon;
+ int res;
+
+ if (!get_pointer(env, argv[0], (void**)&rsrc)
+ || !enif_get_local_pid(env, argv[1], &target)
+ || !enif_get_local_pid(env, argv[3], &rsrc->receiver)) {
+ return enif_make_badarg(env);
+ }
+
+ rsrc->use_msgenv = (argv[2] == atom_true);
+ res = enif_monitor_process(env, rsrc, &target, &mon);
+
+ return enif_make_tuple2(env, enif_make_int(env, res), make_monitor(env, &mon));
+}
+
+static ERL_NIF_TERM demonitor_process_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ struct monitor_resource* rsrc;
+ ErlNifMonitor mon;
+ int res;
+
+ if (!get_pointer(env, argv[0], (void**)&rsrc)
+ || !get_monitor(env, argv[1], &mon)) {
+ return enif_make_badarg(env);
+ }
+
+ res = enif_demonitor_process(env, rsrc, &mon);
+
+ return enif_make_int(env, res);
+}
+
+static ERL_NIF_TERM compare_monitors_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ErlNifMonitor m1, m2;
+ if (!get_monitor(env, argv[0], &m1)
+ || !get_monitor(env, argv[1], &m2)) {
+ return enif_make_badarg(env);
+ }
+
+ return enif_make_int(env, enif_compare_monitors(&m1, &m2));
+}
+
+
+/*********** monitor_frenzy ************/
+
+struct frenzy_rand_bits
+{
+ unsigned int source;
+ unsigned int bits_consumed;
+};
+
+static unsigned int frenzy_rand_bits_max;
+
+unsigned rand_bits(struct frenzy_rand_bits* rnd, unsigned int nbits)
+{
+ unsigned int res;
+
+ rnd->bits_consumed += nbits;
+ assert(rnd->bits_consumed <= frenzy_rand_bits_max);
+ res = rnd->source & ((1 << nbits)-1);
+ rnd->source >>= nbits;
+ return res;
+}
+
+#define FRENZY_PROCS_MAX_BITS 4
+#define FRENZY_PROCS_MAX (1 << FRENZY_PROCS_MAX_BITS)
+
+#define FRENZY_RESOURCES_MAX_BITS 4
+#define FRENZY_RESOURCES_MAX (1 << FRENZY_RESOURCES_MAX_BITS)
+
+#define FRENZY_MONITORS_MAX_BITS 4
+#define FRENZY_MONITORS_MAX (1 << FRENZY_MONITORS_MAX_BITS)
+
+struct frenzy_monitor {
+ ErlNifMutex* lock;
+ enum {
+ MON_FREE, MON_FREE_DOWN, MON_FREE_DEMONITOR,
+ MON_TRYING, MON_ACTIVE, MON_PENDING
+ } state;
+ ErlNifMonitor mon;
+ ErlNifPid pid;
+ unsigned int use_cnt;
+};
+
+struct frenzy_resource {
+ unsigned int rix;
+ struct frenzy_monitor monv[FRENZY_MONITORS_MAX];
+};
+struct frenzy_reslot {
+ ErlNifMutex* lock;
+ int stopped;
+ struct frenzy_resource* obj;
+ unsigned long alloc_cnt;
+ unsigned long release_cnt;
+ unsigned long dtor_cnt;
+};
+static struct frenzy_reslot resv[FRENZY_RESOURCES_MAX];
+
+static ERL_NIF_TERM monitor_frenzy_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ struct frenzy_proc {
+ ErlNifPid pid;
+ int is_free;
+ };
+ static struct frenzy_proc procs[FRENZY_PROCS_MAX];
+ static struct frenzy_proc* proc_refs[FRENZY_PROCS_MAX];
+ static unsigned int nprocs, old_nprocs;
+ static ErlNifMutex* procs_lock;
+ static unsigned long spawn_cnt = 0;
+ static unsigned long kill_cnt = 0;
+ static unsigned long proc_histogram[FRENZY_PROCS_MAX];
+ static int initialized = 0;
+
+ static const unsigned int primes[] = {7, 13, 17, 19};
+
+ struct frenzy_resource* r;
+ struct frenzy_rand_bits rnd;
+ unsigned int op, inc, my_nprocs;
+ unsigned int mix; /* r->monv[] index */
+ unsigned int rix; /* resv[] index */
+ unsigned int pix; /* procs[] index */
+ unsigned int ref_ix; /* proc_refs[] index */
+ int self_pix, rv;
+ ERL_NIF_TERM retval = atom_error;
+ const ERL_NIF_TERM Op = argv[0];
+ const ERL_NIF_TERM Rnd = argv[1];
+ const ERL_NIF_TERM SelfPix = argv[2];
+ const ERL_NIF_TERM NewPid = argv[3];
+
+ if (enif_is_atom(env, Op)) {
+ if (Op == atom_init) {
+ if (initialized || !enif_get_uint(env, Rnd, &frenzy_rand_bits_max))
+ return enif_make_badarg(env);
+
+ procs_lock = enif_mutex_create("nif_SUITE:monitor_frenzy.procs");
+ nprocs = 0;
+ old_nprocs = 0;
+ for (pix = 0; pix < FRENZY_PROCS_MAX; pix++) {
+ proc_refs[pix] = &procs[pix];
+ procs[pix].is_free = 1;
+ proc_histogram[pix] = 0;
+ }
+ for (rix = 0; rix < FRENZY_RESOURCES_MAX; rix++) {
+ resv[rix].lock = enif_mutex_create("nif_SUITE:monitor_frenzy.resv.lock");
+ resv[rix].obj = NULL;
+ resv[rix].stopped = 0;
+ resv[rix].alloc_cnt = 0;
+ resv[rix].release_cnt = 0;
+ resv[rix].dtor_cnt = 0;
+ }
+
+ /* Add self as first process */
+ enif_self(env, &procs[0].pid);
+ procs[0].is_free = 0;
+ old_nprocs = ++nprocs;
+
+ spawn_cnt = 1;
+ kill_cnt = 0;
+ initialized = 1;
+ return enif_make_uint(env, 0); /* SelfPix */
+ }
+ else if (Op == atom_stats) {
+ ERL_NIF_TERM hist[FRENZY_PROCS_MAX];
+ unsigned long res_alloc_cnt = 0;
+ unsigned long res_release_cnt = 0;
+ unsigned long res_dtor_cnt = 0;
+ for (ref_ix = 0; ref_ix < FRENZY_PROCS_MAX; ref_ix++) {
+ hist[ref_ix] = enif_make_ulong(env, proc_histogram[ref_ix]);
+ }
+ for (rix = 0; rix < FRENZY_RESOURCES_MAX; rix++) {
+ res_alloc_cnt += resv[rix].alloc_cnt;
+ res_release_cnt += resv[rix].release_cnt;
+ res_dtor_cnt += resv[rix].dtor_cnt;
+ }
+
+ return
+ enif_make_list4(env,
+ enif_make_tuple2(env, enif_make_string(env, "proc_histogram", ERL_NIF_LATIN1),
+ enif_make_list_from_array(env, hist, FRENZY_PROCS_MAX)),
+ enif_make_tuple2(env, enif_make_string(env, "spawn_cnt", ERL_NIF_LATIN1),
+ enif_make_ulong(env, spawn_cnt)),
+ enif_make_tuple2(env, enif_make_string(env, "kill_cnt", ERL_NIF_LATIN1),
+ enif_make_ulong(env, kill_cnt)),
+ enif_make_tuple4(env, enif_make_string(env, "resource_alloc", ERL_NIF_LATIN1),
+ enif_make_ulong(env, res_alloc_cnt),
+ enif_make_ulong(env, res_release_cnt),
+ enif_make_ulong(env, res_dtor_cnt)));
+
+ }
+ else if (Op == atom_stop && initialized) { /* stop all */
+
+ /* Release all resources */
+ for (rix = 0; rix < FRENZY_RESOURCES_MAX; rix++) {
+ enif_mutex_lock(resv[rix].lock);
+ r = resv[rix].obj;
+ if (r) {
+ resv[rix].obj = NULL;
+ resv[rix].release_cnt++;
+ }
+ resv[rix].stopped = 1;
+ enif_mutex_unlock(resv[rix].lock);
+ if (r)
+ enif_release_resource(r);
+ }
+
+ /* Remove and return all pids */
+ retval = enif_make_list(env, 0);
+ enif_mutex_lock(procs_lock);
+ for (ref_ix = 0; ref_ix < nprocs; ref_ix++) {
+ assert(!proc_refs[ref_ix]->is_free);
+ retval = enif_make_list_cell(env, enif_make_pid(env, &proc_refs[ref_ix]->pid),
+ retval);
+ proc_refs[ref_ix]->is_free = 1;
+ }
+ kill_cnt += nprocs;
+ nprocs = 0;
+ old_nprocs = 0;
+ enif_mutex_unlock(procs_lock);
+
+ return retval;
+ }
+ return enif_make_badarg(env);
+ }
+
+ if (!enif_get_int(env, SelfPix, &self_pix) ||
+ !enif_get_uint(env, Op, &op) ||
+ !enif_get_uint(env, Rnd, &rnd.source))
+ return enif_make_badarg(env);
+
+ rnd.bits_consumed = 0;
+ switch (op) {
+ case 0: { /* add/remove process */
+ ErlNifPid self;
+ enif_self(env, &self);
+
+ ref_ix = rand_bits(&rnd, FRENZY_PROCS_MAX_BITS) % FRENZY_PROCS_MAX;
+ enif_mutex_lock(procs_lock);
+ if (procs[self_pix].is_free || procs[self_pix].pid.pid != self.pid) {
+ /* Some one already removed me */
+ enif_mutex_unlock(procs_lock);
+ return atom_done;
+ }
+ if (ref_ix >= nprocs || nprocs < 2) { /* add process */
+ ref_ix = nprocs++;
+ pix = proc_refs[ref_ix] - procs;
+ assert(procs[pix].is_free);
+ if (!enif_get_local_pid(env, NewPid, &procs[pix].pid))
+ abort();
+ procs[pix].is_free = 0;
+ spawn_cnt++;
+ proc_histogram[ref_ix]++;
+ old_nprocs = nprocs;
+ enif_mutex_unlock(procs_lock);
+ DBG_TRACE2("Add pid %T, nprocs = %u\n", NewPid, nprocs);
+ retval = enif_make_uint(env, pix);
+ }
+ else { /* remove process */
+ pix = proc_refs[ref_ix] - procs;
+ if (pix == self_pix) {
+ ref_ix = (ref_ix + 1) % nprocs;
+ pix = proc_refs[ref_ix] - procs;
+ }
+ assert(procs[pix].pid.pid != self.pid);
+ assert(!procs[pix].is_free);
+ retval = enif_make_pid(env, &procs[pix].pid);
+ --nprocs;
+ assert(!proc_refs[nprocs]->is_free);
+ if (ref_ix != nprocs) {
+ struct frenzy_proc* tmp = proc_refs[ref_ix];
+ proc_refs[ref_ix] = proc_refs[nprocs];
+ proc_refs[nprocs] = tmp;
+ }
+ procs[pix].is_free = 1;
+ proc_histogram[nprocs]++;
+ kill_cnt++;
+ enif_mutex_unlock(procs_lock);
+ DBG_TRACE2("Removed pid %T, nprocs = %u\n", retval, nprocs);
+ }
+ break;
+ }
+ case 1:
+ case 2: /* create/delete/lookup resource */
+ rix = rand_bits(&rnd, FRENZY_RESOURCES_MAX_BITS) % FRENZY_RESOURCES_MAX;
+ inc = primes[rand_bits(&rnd, 2)];
+ while (enif_mutex_trylock(resv[rix].lock) == EBUSY) {
+ rix = (rix + inc) % FRENZY_RESOURCES_MAX;
+ }
+ if (resv[rix].stopped) {
+ retval = atom_done;
+ enif_mutex_unlock(resv[rix].lock);
+ break;
+ }
+ else if (resv[rix].obj == NULL) {
+ r = enif_alloc_resource(frenzy_resource_type,
+ sizeof(struct frenzy_resource));
+ resv[rix].obj = r;
+ resv[rix].alloc_cnt++;
+ r->rix = rix;
+ for (mix = 0; mix < FRENZY_MONITORS_MAX; mix++) {
+ r->monv[mix].lock = enif_mutex_create("nif_SUITE:monitor_frenzy.monv.lock");
+ r->monv[mix].state = MON_FREE;
+ r->monv[mix].use_cnt = 0;
+ r->monv[mix].pid.pid = 0; /* null-pid */
+ }
+ DBG_TRACE2("New resource at r=%p rix=%u\n", r, rix);
+ }
+ else {
+ unsigned int resource_op = rand_bits(&rnd, 3);
+ r = resv[rix].obj;
+ if (resource_op == 0) { /* delete resource */
+ resv[rix].obj = NULL;
+ resv[rix].release_cnt++;
+ enif_mutex_unlock(resv[rix].lock);
+ DBG_TRACE2("Delete resource at r=%p rix=%u\n", r, rix);
+ enif_release_resource(r);
+ retval = atom_ok;
+ break;
+ }
+ else if (resource_op == 1) { /* return resource */
+ retval = enif_make_resource(env, r);
+ enif_mutex_unlock(resv[rix].lock);
+ break;
+ }
+ }
+ enif_keep_resource(r);
+ enif_mutex_unlock(resv[rix].lock);
+
+ /* monitor/demonitor */
+
+ mix = rand_bits(&rnd, FRENZY_MONITORS_MAX_BITS) % FRENZY_MONITORS_MAX;
+ inc = primes[rand_bits(&rnd, 2)];
+ while (enif_mutex_trylock(r->monv[mix].lock) == EBUSY) {
+ mix = (mix + inc) % FRENZY_MONITORS_MAX;
+ }
+ switch (r->monv[mix].state) {
+ case MON_FREE:
+ case MON_FREE_DOWN:
+ case MON_FREE_DEMONITOR: { /* do monitor */
+ /*
+ * Use an old possibly larger value of 'nprocs', to increase
+ * probability of monitoring an already terminated process
+ */
+ my_nprocs = old_nprocs;
+ if (my_nprocs > 0) {
+ int save_state = r->monv[mix].state;
+ ref_ix = rand_bits(&rnd, FRENZY_PROCS_MAX_BITS) % my_nprocs;
+ pix = proc_refs[ref_ix] - procs;
+ r->monv[mix].pid.pid = procs[pix].pid.pid; /* "atomic" */
+ r->monv[mix].state = MON_TRYING;
+ rv = enif_monitor_process(env, r, &r->monv[mix].pid, &r->monv[mix].mon);
+ if (rv == 0) {
+ r->monv[mix].state = MON_ACTIVE;
+ r->monv[mix].use_cnt++;
+ DBG_TRACE3("Monitor from r=%p rix=%u to %T\n",
+ r, r->rix, r->monv[mix].pid.pid);
+ }
+ else {
+ r->monv[mix].state = save_state;
+ DBG_TRACE4("Monitor from r=%p rix=%u to %T FAILED with %d\n",
+ r, r->rix, r->monv[mix].pid.pid, rv);
+ }
+ retval = enif_make_int(env,rv);
+ }
+ else {
+ DBG_TRACE0("No pids to monitor\n");
+ retval = atom_ok;
+ }
+ break;
+ }
+ case MON_ACTIVE: /* do demonitor */
+ rv = enif_demonitor_process(env, r, &r->monv[mix].mon);
+ if (rv == 0) {
+ DBG_TRACE3("Demonitor from r=%p rix=%u to %T\n",
+ r, r->rix, r->monv[mix].pid.pid);
+ r->monv[mix].state = MON_FREE_DEMONITOR;
+ }
+ else {
+ DBG_TRACE4("Demonitor from r=%p rix=%u to %T FAILED with %d\n",
+ r, r->rix, r->monv[mix].pid.pid, rv);
+ r->monv[mix].state = MON_PENDING;
+ }
+ retval = enif_make_int(env,rv);
+ break;
+
+ case MON_PENDING: /* waiting for 'down' callback, do nothing */
+ retval = atom_ok;
+ break;
+ default:
+ abort();
+ break;
+ }
+ enif_mutex_unlock(r->monv[mix].lock);
+ enif_release_resource(r);
+ break;
+
+ case 3: /* no-op */
+ retval = atom_ok;
+ break;
+ }
+
+ {
+ int percent = (rand_bits(&rnd, 6) + 1) * 2; /* 2 to 128 */
+ if (percent <= 100)
+ enif_consume_timeslice(env, percent);
+ }
+
+ return retval;
+}
+
+static void frenzy_resource_dtor(ErlNifEnv* env, void* obj)
+{
+ struct frenzy_resource* r = (struct frenzy_resource*) obj;
+ unsigned int mix;
+
+ DBG_TRACE2("DTOR r=%p rix=%u\n", r, r->rix);
+
+ enif_mutex_lock(resv[r->rix].lock);
+ resv[r->rix].dtor_cnt++;
+ enif_mutex_unlock(resv[r->rix].lock);
+
+ for (mix = 0; mix < FRENZY_MONITORS_MAX; mix++) {
+ assert(r->monv[mix].state != MON_PENDING);
+ enif_mutex_destroy(r->monv[mix].lock);
+ r->monv[mix].lock = NULL;
+ }
+
+}
+
+static void frenzy_resource_down(ErlNifEnv* env, void* obj, ErlNifPid* pid,
+ ErlNifMonitor* mon)
+{
+ struct frenzy_resource* r = (struct frenzy_resource*) obj;
+ unsigned int mix;
+
+ DBG_TRACE3("DOWN pid=%T, r=%p rix=%u\n", pid->pid, r, r->rix);
+
+ for (mix = 0; mix < FRENZY_MONITORS_MAX; mix++) {
+ if (r->monv[mix].pid.pid == pid->pid && r->monv[mix].state >= MON_TRYING) {
+ enif_mutex_lock(r->monv[mix].lock);
+ if (enif_compare_monitors(mon, &r->monv[mix].mon) == 0) {
+ assert(r->monv[mix].state >= MON_ACTIVE);
+ r->monv[mix].state = MON_FREE_DOWN;
+ enif_mutex_unlock(r->monv[mix].lock);
+ return;
+ }
+ enif_mutex_unlock(r->monv[mix].lock);
+ }
+ }
+ enif_fprintf(stderr, "DOWN called for unknown monitor\n");
+ abort();
+}
+
+/*********** testing ioq ************/
+
+static void ioq_resource_dtor(ErlNifEnv* env, void* obj) {
+
+}
+
+#ifndef __WIN32__
+static int writeiovec(ErlNifEnv *env, ERL_NIF_TERM term, ERL_NIF_TERM *tail, ErlNifIOQueue *q, int fd) {
+ ErlNifIOVec vec, *iovec = &vec;
+ SysIOVec *sysiovec;
+ int saved_errno;
+ int iovcnt, n;
+
+ if (!enif_inspect_iovec(env, 64, term, tail, &iovec))
+ return -2;
+
+ if (enif_ioq_size(q) > 0) {
+ /* If the I/O queue contains data we enqueue the iovec and then
+ peek the data to write out of the queue. */
+ if (!enif_ioq_enqv(q, iovec, 0))
+ return -3;
+
+ sysiovec = enif_ioq_peek(q, &iovcnt);
+ } else {
+ /* If the I/O queue is empty we skip the trip through it. */
+ iovcnt = iovec->iovcnt;
+ sysiovec = iovec->iov;
+ }
+
+ /* Attempt to write the data */
+ n = writev(fd, sysiovec, iovcnt);
+ saved_errno = errno;
+
+ if (enif_ioq_size(q) == 0) {
+ /* If the I/O queue was initially empty we enqueue any
+ remaining data into the queue for writing later. */
+ if (n >= 0 && !enif_ioq_enqv(q, iovec, n))
+ return -3;
+ } else {
+ /* Dequeue any data that was written from the queue. */
+ if (n > 0 && !enif_ioq_deq(q, n, NULL))
+ return -4;
+ }
+
+ /* return n, which is either number of bytes written or -1 if
+ some error happened */
+ errno = saved_errno;
+ return n;
+}
+#endif
+
+static ERL_NIF_TERM ioq(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ struct ioq_resource *ioq;
+ ERL_NIF_TERM ret;
+ if (enif_is_identical(argv[0], enif_make_atom(env, "create"))) {
+ ErlNifIOQueue *q = enif_ioq_create(ERL_NIF_IOQ_NORMAL);
+ ioq = (struct ioq_resource *)enif_alloc_resource(ioq_resource_type,
+ sizeof(*ioq));
+ ioq->q = q;
+ ret = enif_make_resource(env, ioq);
+ enif_release_resource(ioq);
+ return ret;
+ } else if (enif_is_identical(argv[0], enif_make_atom(env, "inspect"))) {
+ ErlNifIOVec vec, *iovec = NULL;
+ int i, iovcnt;
+ ERL_NIF_TERM *elems, tail, list;
+ ErlNifEnv *myenv = NULL;
+
+ if (enif_is_identical(argv[2], enif_make_atom(env, "use_stack")))
+ iovec = &vec;
+ if (enif_is_identical(argv[3], enif_make_atom(env, "use_env")))
+ myenv = env;
+ if (!enif_inspect_iovec(myenv, ~(size_t)0, argv[1], &tail, &iovec))
+ return enif_make_badarg(env);
+
+ iovcnt = iovec->iovcnt;
+ elems = enif_alloc(sizeof(ERL_NIF_TERM) * iovcnt);
+
+ for (i = 0; i < iovcnt; i++) {
+ ErlNifBinary bin;
+ if (!enif_alloc_binary(iovec->iov[i].iov_len, &bin)) {
+ enif_free_iovec(iovec);
+ enif_free(elems);
+ return enif_make_badarg(env);
+ }
+ memcpy(bin.data, iovec->iov[i].iov_base, iovec->iov[i].iov_len);
+ elems[i] = enif_make_binary(env, &bin);
+ }
+
+ if (!myenv)
+ enif_free_iovec(iovec);
+
+ list = enif_make_list_from_array(env, elems, iovcnt);
+ enif_free(elems);
+ return list;
+ } else {
+ unsigned skip;
+ if (!enif_get_resource(env, argv[1], ioq_resource_type, (void**)&ioq)
+ || !ioq->q)
+ return enif_make_badarg(env);
+
+ if (enif_is_identical(argv[0], enif_make_atom(env, "example"))) {
+#ifndef __WIN32__
+ int fd[2], res = 0, cnt = 0, queue_cnt;
+ ERL_NIF_TERM tail;
+ char buff[255];
+ pipe(fd);
+ fcntl(fd[0], F_SETFL, fcntl(fd[0], F_GETFL) | O_NONBLOCK);
+ fcntl(fd[1], F_SETFL, fcntl(fd[1], F_GETFL) | O_NONBLOCK);
+
+ /* Write until the pipe buffer is full, which should result in data
+ * being queued up. */
+ for (res = 0; res >= 0; ) {
+ cnt += res;
+ res = writeiovec(env, argv[2], &tail, ioq->q, fd[1]);
+ }
+
+ /* Flush the queue while reading from the other end of the pipe. */
+ tail = enif_make_list(env, 0);
+ while (enif_ioq_size(ioq->q) > 0) {
+ res = writeiovec(env, tail, &tail, ioq->q, fd[1]);
+
+ if (res < 0 && errno != EAGAIN) {
+ break;
+ } else if (res > 0) {
+ cnt += res;
+ }
+
+ for (res = 0; res >= 0; ) {
+ cnt -= res;
+ res = read(fd[0], buff, sizeof(buff));
+ }
+ }
+
+ close(fd[0]);
+ close(fd[1]);
+
+ /* Check that we read as much as we wrote */
+ if (cnt == 0 && enif_ioq_size(ioq->q) == 0)
+ return enif_make_atom(env, "true");
+
+ return enif_make_int(env, cnt);
+#else
+ return enif_make_atom(env, "true");
+#endif
+ }
+ if (enif_is_identical(argv[0], enif_make_atom(env, "destroy"))) {
+ enif_ioq_destroy(ioq->q);
+ ioq->q = NULL;
+ return enif_make_atom(env, "false");
+ } else if (enif_is_identical(argv[0], enif_make_atom(env, "enqv"))) {
+ ErlNifIOVec vec, *iovec = &vec;
+ ERL_NIF_TERM tail;
+
+ if (!enif_get_uint(env, argv[3], &skip))
+ return enif_make_badarg(env);
+ if (!enif_inspect_iovec(env, ~0ul, argv[2], &tail, &iovec))
+ return enif_make_badarg(env);
+ if (!enif_ioq_enqv(ioq->q, iovec, skip))
+ return enif_make_badarg(env);
+
+ return enif_make_atom(env, "true");
+ } else if (enif_is_identical(argv[0], enif_make_atom(env, "enqb"))) {
+ ErlNifBinary bin;
+ if (!enif_get_uint(env, argv[3], &skip) ||
+ !enif_inspect_binary(env, argv[2], &bin))
+ return enif_make_badarg(env);
+
+ if (!enif_ioq_enq_binary(ioq->q, &bin, skip))
+ return enif_make_badarg(env);
+
+ return enif_make_atom(env, "true");
+ } else if (enif_is_identical(argv[0], enif_make_atom(env, "enqbraw"))) {
+ ErlNifBinary bin;
+ ErlNifBinary localbin;
+ int i;
+ if (!enif_get_uint(env, argv[3], &skip) ||
+ !enif_inspect_binary(env, argv[2], &bin) ||
+ !enif_alloc_binary(bin.size, &localbin))
+ return enif_make_badarg(env);
+
+ memcpy(localbin.data, bin.data, bin.size);
+ i = enif_ioq_enq_binary(ioq->q, &localbin, skip);
+ if (!i)
+ return enif_make_badarg(env);
+ else
+ return enif_make_atom(env, "true");
+ } else if (enif_is_identical(argv[0], enif_make_atom(env, "peek"))) {
+ int iovlen, num, i, off = 0;
+ SysIOVec *iov = enif_ioq_peek(ioq->q, &iovlen);
+ ErlNifBinary bin;
+
+ if (!enif_get_int(env, argv[2], &num) || !enif_alloc_binary(num, &bin))
+ return enif_make_badarg(env);
+
+ for (i = 0; i < iovlen && num > 0; i++) {
+ int to_copy = num < iov[i].iov_len ? num : iov[i].iov_len;
+ memcpy(bin.data + off, iov[i].iov_base, to_copy);
+ num -= to_copy;
+ off += to_copy;
+ }
+
+ return enif_make_binary(env, &bin);
+ } else if (enif_is_identical(argv[0], enif_make_atom(env, "deq"))) {
+ int num;
+ size_t sz;
+ ErlNifUInt64 sz64;
+ if (!enif_get_int(env, argv[2], &num))
+ return enif_make_badarg(env);
+
+ if (!enif_ioq_deq(ioq->q, num, &sz))
+ return enif_make_badarg(env);
+
+ sz64 = sz;
+
+ return enif_make_uint64(env, sz64);
+ } else if (enif_is_identical(argv[0], enif_make_atom(env, "size"))) {
+ ErlNifUInt64 size = enif_ioq_size(ioq->q);
+ return enif_make_uint64(env, size);
+ }
+ }
+
+ return enif_make_badarg(env);
+}
+
static ErlNifFunc nif_funcs[] =
{
{"lib_version", 0, lib_version},
@@ -1703,6 +3404,7 @@ static ErlNifFunc nif_funcs[] =
{"tuple_2_list", 1, tuple_2_list},
{"is_identical",2,is_identical},
{"compare",2,compare},
+ {"hash_nif",3,hash_nif},
{"many_args_100", 100, many_args_100},
{"clone_bin", 1, clone_bin},
{"make_sub_bin", 3, make_sub_bin},
@@ -1716,11 +3418,12 @@ static ErlNifFunc nif_funcs[] =
{"make_resource", 1, make_resource},
{"get_resource", 2, get_resource},
{"release_resource", 1, release_resource},
+ {"release_resource_from_thread", 1, release_resource_from_thread},
{"last_resource_dtor_call", 0, last_resource_dtor_call},
{"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},
@@ -1737,15 +3440,17 @@ static ErlNifFunc nif_funcs[] =
{"join_send_thread", 1, join_send_thread},
{"copy_blob", 1, copy_blob},
{"send_term", 2, send_term},
+ {"send_copy_term", 2, send_copy_term},
{"reverse_list",1, reverse_list},
{"echo_int", 1, echo_int},
{"type_sizes", 0, type_sizes},
{"otp_9668_nif", 1, otp_9668_nif},
+ {"otp_9828_nif", 1, otp_9828_nif},
{"consume_timeslice_nif", 2, consume_timeslice_nif},
-#ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT
- {"call_dirty_nif", 3, call_dirty_nif},
- {"send_from_dirty_nif", 1, send_from_dirty_nif},
-#endif
+ {"call_nif_schedule", 2, call_nif_schedule},
+ {"call_nif_exception", 1, call_nif_exception},
+ {"call_nif_nan_or_inf", 1, call_nif_nan_or_inf},
+ {"call_nif_atom_too_long", 1, call_nif_atom_too_long},
{"is_map_nif", 1, is_map_nif},
{"get_map_size_nif", 1, get_map_size_nif},
{"make_new_map_nif", 0, make_new_map_nif},
@@ -1754,8 +3459,40 @@ 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},
+ {"now_time", 0, now_time},
+ {"cpu_time", 0, cpu_time},
+ {"unique_integer_nif", 1, unique_integer},
+ {"is_process_alive_nif", 1, is_process_alive},
+ {"is_port_alive_nif", 1, is_port_alive},
+ {"term_to_binary_nif", 2, term_to_binary},
+ {"binary_to_term_nif", 3, binary_to_term},
+ {"port_command_nif", 2, port_command},
+ {"format_term_nif", 2, format_term},
+ {"select_nif", 5, select_nif},
+#ifndef __WIN32__
+ {"pipe_nif", 0, pipe_nif},
+ {"write_nif", 2, write_nif},
+ {"read_nif", 2, read_nif},
+ {"is_closed_nif", 1, is_closed_nif},
+#endif
+ {"last_fd_stop_call", 0, last_fd_stop_call},
+ {"alloc_monitor_resource_nif", 0, alloc_monitor_resource_nif},
+ {"monitor_process_nif", 4, monitor_process_nif},
+ {"demonitor_process_nif", 2, demonitor_process_nif},
+ {"compare_monitors_nif", 2, compare_monitors_nif},
+ {"monitor_frenzy_nif", 4, monitor_frenzy_nif},
+ {"whereis_send", 3, whereis_send},
+ {"whereis_term", 2, whereis_term},
+ {"whereis_thd_lookup", 2, whereis_thd_lookup},
+ {"whereis_thd_result", 1, whereis_thd_result},
+ {"ioq_nif", 1, ioq},
+ {"ioq_nif", 2, ioq},
+ {"ioq_nif", 3, ioq},
+ {"ioq_nif", 4, ioq}
};
-ERL_NIF_INIT(nif_SUITE,nif_funcs,load,reload,upgrade,unload)
-
+ERL_NIF_INIT(nif_SUITE,nif_funcs,load,NULL,upgrade,unload)
diff --git a/erts/emulator/test/nif_SUITE_data/nif_api_2_0/README b/erts/emulator/test/nif_SUITE_data/nif_api_2_0/README
new file mode 100644
index 0000000000..a6ed36f634
--- /dev/null
+++ b/erts/emulator/test/nif_SUITE_data/nif_api_2_0/README
@@ -0,0 +1,5 @@
+These are old genuine header files
+checked out from tag OTP_R14A c1e94fa9a6fe4ae717d35.
+
+I choose this API version (2.0) to test as it's
+before the addition of vm_variant in ErlNifEntry.
diff --git a/erts/emulator/sys/ose/driver_int.h b/erts/emulator/test/nif_SUITE_data/nif_api_2_0/erl_drv_nif.h
index 2c9ac955d8..3e5435e353 100644
--- a/erts/emulator/sys/ose/driver_int.h
+++ b/erts/emulator/test/nif_SUITE_data/nif_api_2_0/erl_drv_nif.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1997-2009. All Rights Reserved.
+ * Copyright Ericsson AB 2010-2017. 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
@@ -16,26 +16,33 @@
*
* %CopyrightEnd%
*/
+
/*
- * System dependant driver declarations
+ * Common structures for both erl_driver.h and erl_nif.h
*/
-#ifndef __DRIVER_INT_H__
-#define __DRIVER_INT_H__
+#ifndef __ERL_DRV_NIF_H__
+#define __ERL_DRV_NIF_H__
-#ifdef HAVE_SYS_UIO_H
-#include <sys/types.h>
-#include <sys/uio.h>
+typedef struct {
+ int driver_major_version;
+ int driver_minor_version;
+ char *erts_version;
+ char *otp_release;
+ int thread_support;
+ int smp_support;
+ int async_threads;
+ int scheduler_threads;
+ int nif_major_version;
+ int nif_minor_version;
+} ErlDrvSysInfo;
-typedef struct iovec SysIOVec;
+typedef struct {
+ int suggested_stack_size;
+} ErlDrvThreadOpts;
+
+#endif /* __ERL_DRV_NIF_H__ */
-#else
-typedef struct {
- char* iov_base;
- int iov_len;
-} SysIOVec;
-#endif
-#endif
diff --git a/erts/emulator/test/nif_SUITE_data/nif_api_2_0/erl_nif.h b/erts/emulator/test/nif_SUITE_data/nif_api_2_0/erl_nif.h
new file mode 100644
index 0000000000..4b2b7550e5
--- /dev/null
+++ b/erts/emulator/test/nif_SUITE_data/nif_api_2_0/erl_nif.h
@@ -0,0 +1,206 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2009-2017. 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%
+ */
+
+/* Include file for writers of Native Implemented Functions.
+*/
+
+#ifndef __ERL_NIF_H__
+#define __ERL_NIF_H__
+
+
+#include "erl_drv_nif.h"
+
+/* Version history:
+** 0.1: R13B03
+** 1.0: R13B04
+** 2.0: R14A
+*/
+#define ERL_NIF_MAJOR_VERSION 2
+#define ERL_NIF_MINOR_VERSION 0
+
+#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
+
+#ifdef HALFWORD_HEAP_EMULATOR
+typedef unsigned int ERL_NIF_TERM;
+#else
+typedef unsigned long ERL_NIF_TERM;
+#endif
+
+struct enif_environment_t;
+typedef struct enif_environment_t ErlNifEnv;
+
+typedef struct
+{
+ const char* name;
+ unsigned arity;
+ ERL_NIF_TERM (*fptr)(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+}ErlNifFunc;
+
+typedef struct enif_entry_t
+{
+ int major;
+ int minor;
+ const char* name;
+ int num_of_funcs;
+ ErlNifFunc* funcs;
+ int (*load) (ErlNifEnv*, void** priv_data, ERL_NIF_TERM load_info);
+ int (*reload) (ErlNifEnv*, void** priv_data, ERL_NIF_TERM load_info);
+ int (*upgrade)(ErlNifEnv*, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info);
+ void (*unload) (ErlNifEnv*, void* priv_data);
+}ErlNifEntry;
+
+
+
+typedef struct
+{
+ size_t size;
+ unsigned char* data;
+
+ /* Internals (avert your eyes) */
+ ERL_NIF_TERM bin_term;
+ void* ref_bin;
+}ErlNifBinary;
+
+typedef struct enif_resource_type_t ErlNifResourceType;
+typedef void ErlNifResourceDtor(ErlNifEnv*, void*);
+typedef enum
+{
+ ERL_NIF_RT_CREATE = 1,
+ ERL_NIF_RT_TAKEOVER = 2
+}ErlNifResourceFlags;
+
+typedef enum
+{
+ ERL_NIF_LATIN1 = 1
+}ErlNifCharEncoding;
+
+typedef struct
+{
+ ERL_NIF_TERM pid; /* internal, may change */
+}ErlNifPid;
+
+typedef ErlDrvSysInfo ErlNifSysInfo;
+
+typedef struct ErlDrvTid_ *ErlNifTid;
+typedef struct ErlDrvMutex_ ErlNifMutex;
+typedef struct ErlDrvCond_ ErlNifCond;
+typedef struct ErlDrvRWLock_ ErlNifRWLock;
+typedef int ErlNifTSDKey;
+
+typedef ErlDrvThreadOpts ErlNifThreadOpts;
+
+#if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_))
+# define ERL_NIF_API_FUNC_DECL(RET_TYPE, NAME, ARGS) RET_TYPE (*NAME) ARGS
+typedef struct {
+# include "erl_nif_api_funcs.h"
+} TWinDynNifCallbacks;
+extern TWinDynNifCallbacks WinDynNifCallbacks;
+# undef ERL_NIF_API_FUNC_DECL
+#endif
+
+#if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_)) && !defined(STATIC_ERLANG_DRIVER)
+# define ERL_NIF_API_FUNC_MACRO(NAME) (WinDynNifCallbacks.NAME)
+# include "erl_nif_api_funcs.h"
+/* note that we have to keep ERL_NIF_API_FUNC_MACRO defined */
+
+#else /* non windows or included from emulator itself */
+
+# define ERL_NIF_API_FUNC_DECL(RET_TYPE, NAME, ARGS) extern RET_TYPE NAME ARGS
+# include "erl_nif_api_funcs.h"
+# undef ERL_NIF_API_FUNC_DECL
+#endif
+
+
+#if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_))
+# define ERL_NIF_INIT_GLOB TWinDynNifCallbacks WinDynNifCallbacks;
+# define ERL_NIF_INIT_DECL(MODNAME) __declspec(dllexport) ErlNifEntry* nif_init(TWinDynNifCallbacks* callbacks)
+# define ERL_NIF_INIT_BODY memcpy(&WinDynNifCallbacks,callbacks,sizeof(TWinDynNifCallbacks))
+#else
+# define ERL_NIF_INIT_GLOB
+# define ERL_NIF_INIT_BODY
+# if defined(VXWORKS)
+# define ERL_NIF_INIT_DECL(MODNAME) ErlNifEntry* MODNAME ## _init(void)
+# else
+# define ERL_NIF_INIT_DECL(MODNAME) ErlNifEntry* nif_init(void)
+# endif
+#endif
+
+
+#ifdef __cplusplus
+}
+# define ERL_NIF_INIT_PROLOGUE extern "C" {
+# define ERL_NIF_INIT_EPILOGUE }
+#else
+# define ERL_NIF_INIT_PROLOGUE
+# define ERL_NIF_INIT_EPILOGUE
+#endif
+
+
+#define ERL_NIF_INIT(NAME, FUNCS, LOAD, RELOAD, UPGRADE, UNLOAD) \
+ERL_NIF_INIT_PROLOGUE \
+ERL_NIF_INIT_GLOB \
+ERL_NIF_INIT_DECL(NAME) \
+{ \
+ static ErlNifEntry entry = \
+ { \
+ ERL_NIF_MAJOR_VERSION, \
+ ERL_NIF_MINOR_VERSION, \
+ #NAME, \
+ sizeof(FUNCS) / sizeof(*FUNCS), \
+ FUNCS, \
+ LOAD, RELOAD, UPGRADE, UNLOAD \
+ }; \
+ ERL_NIF_INIT_BODY; \
+ return &entry; \
+} \
+ERL_NIF_INIT_EPILOGUE
+
+
+#endif /* __ERL_NIF_H__ */
+
diff --git a/erts/emulator/test/nif_SUITE_data/nif_api_2_0/erl_nif_api_funcs.h b/erts/emulator/test/nif_SUITE_data/nif_api_2_0/erl_nif_api_funcs.h
new file mode 100644
index 0000000000..302973fcca
--- /dev/null
+++ b/erts/emulator/test/nif_SUITE_data/nif_api_2_0/erl_nif_api_funcs.h
@@ -0,0 +1,257 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2009-2017. 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%
+ */
+
+#if !defined(ERL_NIF_API_FUNC_DECL) && !defined(ERL_NIF_API_FUNC_MACRO)
+# error This file should not be included directly
+#endif
+
+#ifdef ERL_NIF_API_FUNC_DECL
+ERL_NIF_API_FUNC_DECL(void*,enif_priv_data,(ErlNifEnv*));
+ERL_NIF_API_FUNC_DECL(void*,enif_alloc,(size_t size));
+ERL_NIF_API_FUNC_DECL(void,enif_free,(void* ptr));
+ERL_NIF_API_FUNC_DECL(int,enif_is_atom,(ErlNifEnv*, ERL_NIF_TERM term));
+ERL_NIF_API_FUNC_DECL(int,enif_is_binary,(ErlNifEnv*, ERL_NIF_TERM term));
+ERL_NIF_API_FUNC_DECL(int,enif_is_ref,(ErlNifEnv*, ERL_NIF_TERM term));
+ERL_NIF_API_FUNC_DECL(int,enif_inspect_binary,(ErlNifEnv*, ERL_NIF_TERM bin_term, ErlNifBinary* bin));
+ERL_NIF_API_FUNC_DECL(int,enif_alloc_binary,(size_t size, ErlNifBinary* bin));
+ERL_NIF_API_FUNC_DECL(int,enif_realloc_binary,(ErlNifBinary* bin, size_t size));
+ERL_NIF_API_FUNC_DECL(void,enif_release_binary,(ErlNifBinary* bin));
+ERL_NIF_API_FUNC_DECL(int,enif_get_int,(ErlNifEnv*, ERL_NIF_TERM term, int* ip));
+ERL_NIF_API_FUNC_DECL(int,enif_get_ulong,(ErlNifEnv*, ERL_NIF_TERM term, unsigned long* ip));
+ERL_NIF_API_FUNC_DECL(int,enif_get_double,(ErlNifEnv*, ERL_NIF_TERM term, double* dp));
+ERL_NIF_API_FUNC_DECL(int,enif_get_list_cell,(ErlNifEnv* env, ERL_NIF_TERM term, ERL_NIF_TERM* head, ERL_NIF_TERM* tail));
+ERL_NIF_API_FUNC_DECL(int,enif_get_tuple,(ErlNifEnv* env, ERL_NIF_TERM tpl, int* arity, const ERL_NIF_TERM** array));
+ERL_NIF_API_FUNC_DECL(int,enif_is_identical,(ERL_NIF_TERM lhs, ERL_NIF_TERM rhs));
+ERL_NIF_API_FUNC_DECL(int,enif_compare,(ERL_NIF_TERM lhs, ERL_NIF_TERM rhs));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_binary,(ErlNifEnv* env, ErlNifBinary* bin));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_badarg,(ErlNifEnv* env));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_int,(ErlNifEnv* env, int i));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_ulong,(ErlNifEnv* env, unsigned long i));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_double,(ErlNifEnv* env, double d));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_atom,(ErlNifEnv* env, const char* name));
+ERL_NIF_API_FUNC_DECL(int,enif_make_existing_atom,(ErlNifEnv* env, const char* name, ERL_NIF_TERM* atom, ErlNifCharEncoding));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_tuple,(ErlNifEnv* env, unsigned cnt, ...));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_list,(ErlNifEnv* env, unsigned cnt, ...));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_list_cell,(ErlNifEnv* env, ERL_NIF_TERM car, ERL_NIF_TERM cdr));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_string,(ErlNifEnv* env, const char* string, ErlNifCharEncoding));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_ref,(ErlNifEnv* env));
+
+ERL_NIF_API_FUNC_DECL(ErlNifMutex*,enif_mutex_create,(char *name));
+ERL_NIF_API_FUNC_DECL(void,enif_mutex_destroy,(ErlNifMutex *mtx));
+ERL_NIF_API_FUNC_DECL(int,enif_mutex_trylock,(ErlNifMutex *mtx));
+ERL_NIF_API_FUNC_DECL(void,enif_mutex_lock,(ErlNifMutex *mtx));
+ERL_NIF_API_FUNC_DECL(void,enif_mutex_unlock,(ErlNifMutex *mtx));
+ERL_NIF_API_FUNC_DECL(ErlNifCond*,enif_cond_create,(char *name));
+ERL_NIF_API_FUNC_DECL(void,enif_cond_destroy,(ErlNifCond *cnd));
+ERL_NIF_API_FUNC_DECL(void,enif_cond_signal,(ErlNifCond *cnd));
+ERL_NIF_API_FUNC_DECL(void,enif_cond_broadcast,(ErlNifCond *cnd));
+ERL_NIF_API_FUNC_DECL(void,enif_cond_wait,(ErlNifCond *cnd, ErlNifMutex *mtx));
+ERL_NIF_API_FUNC_DECL(ErlNifRWLock*,enif_rwlock_create,(char *name));
+ERL_NIF_API_FUNC_DECL(void,enif_rwlock_destroy,(ErlNifRWLock *rwlck));
+ERL_NIF_API_FUNC_DECL(int,enif_rwlock_tryrlock,(ErlNifRWLock *rwlck));
+ERL_NIF_API_FUNC_DECL(void,enif_rwlock_rlock,(ErlNifRWLock *rwlck));
+ERL_NIF_API_FUNC_DECL(void,enif_rwlock_runlock,(ErlNifRWLock *rwlck));
+ERL_NIF_API_FUNC_DECL(int,enif_rwlock_tryrwlock,(ErlNifRWLock *rwlck));
+ERL_NIF_API_FUNC_DECL(void,enif_rwlock_rwlock,(ErlNifRWLock *rwlck));
+ERL_NIF_API_FUNC_DECL(void,enif_rwlock_rwunlock,(ErlNifRWLock *rwlck));
+ERL_NIF_API_FUNC_DECL(int,enif_tsd_key_create,(char *name, ErlNifTSDKey *key));
+ERL_NIF_API_FUNC_DECL(void,enif_tsd_key_destroy,(ErlNifTSDKey key));
+ERL_NIF_API_FUNC_DECL(void,enif_tsd_set,(ErlNifTSDKey key, void *data));
+ERL_NIF_API_FUNC_DECL(void*,enif_tsd_get,(ErlNifTSDKey key));
+ERL_NIF_API_FUNC_DECL(ErlNifThreadOpts*,enif_thread_opts_create,(char *name));
+ERL_NIF_API_FUNC_DECL(void,enif_thread_opts_destroy,(ErlNifThreadOpts *opts));
+ERL_NIF_API_FUNC_DECL(int,enif_thread_create,(char *name,ErlNifTid *tid,void * (*func)(void *),void *args,ErlNifThreadOpts *opts));
+ERL_NIF_API_FUNC_DECL(ErlNifTid,enif_thread_self,(void));
+ERL_NIF_API_FUNC_DECL(int,enif_equal_tids,(ErlNifTid tid1, ErlNifTid tid2));
+ERL_NIF_API_FUNC_DECL(void,enif_thread_exit,(void *resp));
+ERL_NIF_API_FUNC_DECL(int,enif_thread_join,(ErlNifTid, void **respp));
+
+ERL_NIF_API_FUNC_DECL(void*,enif_realloc,(void* ptr, size_t size));
+ERL_NIF_API_FUNC_DECL(void,enif_system_info,(ErlNifSysInfo *sip, size_t si_size));
+ERL_NIF_API_FUNC_DECL(int,enif_fprintf,(void/* FILE* */ *filep, const char *format, ...));
+ERL_NIF_API_FUNC_DECL(int,enif_inspect_iolist_as_binary,(ErlNifEnv*, ERL_NIF_TERM term, ErlNifBinary* bin));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_sub_binary,(ErlNifEnv*, ERL_NIF_TERM bin_term, size_t pos, size_t size));
+ERL_NIF_API_FUNC_DECL(int,enif_get_string,(ErlNifEnv*, ERL_NIF_TERM list, char* buf, unsigned len, ErlNifCharEncoding));
+ERL_NIF_API_FUNC_DECL(int,enif_get_atom,(ErlNifEnv*, ERL_NIF_TERM atom, char* buf, unsigned len, ErlNifCharEncoding));
+ERL_NIF_API_FUNC_DECL(int,enif_is_fun,(ErlNifEnv*, ERL_NIF_TERM term));
+ERL_NIF_API_FUNC_DECL(int,enif_is_pid,(ErlNifEnv*, ERL_NIF_TERM term));
+ERL_NIF_API_FUNC_DECL(int,enif_is_port,(ErlNifEnv*, ERL_NIF_TERM term));
+ERL_NIF_API_FUNC_DECL(int,enif_get_uint,(ErlNifEnv*, ERL_NIF_TERM term, unsigned* ip));
+ERL_NIF_API_FUNC_DECL(int,enif_get_long,(ErlNifEnv*, ERL_NIF_TERM term, long* ip));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_uint,(ErlNifEnv*, unsigned i));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_long,(ErlNifEnv*, long i));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_tuple_from_array,(ErlNifEnv*, const ERL_NIF_TERM arr[], unsigned cnt));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_list_from_array,(ErlNifEnv*, const ERL_NIF_TERM arr[], unsigned cnt));
+ERL_NIF_API_FUNC_DECL(int,enif_is_empty_list,(ErlNifEnv*, ERL_NIF_TERM term));
+ERL_NIF_API_FUNC_DECL(ErlNifResourceType*,enif_open_resource_type,(ErlNifEnv*, const char* module_str, const char* name_str, void (*dtor)(ErlNifEnv*,void *), ErlNifResourceFlags flags, ErlNifResourceFlags* tried));
+ERL_NIF_API_FUNC_DECL(void*,enif_alloc_resource,(ErlNifResourceType* type, size_t size));
+ERL_NIF_API_FUNC_DECL(void,enif_release_resource,(void* obj));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_resource,(ErlNifEnv*, void* obj));
+ERL_NIF_API_FUNC_DECL(int,enif_get_resource,(ErlNifEnv*, ERL_NIF_TERM term, ErlNifResourceType* type, void** objp));
+ERL_NIF_API_FUNC_DECL(size_t,enif_sizeof_resource,(void* obj));
+ERL_NIF_API_FUNC_DECL(unsigned char*,enif_make_new_binary,(ErlNifEnv*,size_t size,ERL_NIF_TERM* termp));
+ERL_NIF_API_FUNC_DECL(int,enif_is_list,(ErlNifEnv*, ERL_NIF_TERM term));
+ERL_NIF_API_FUNC_DECL(int,enif_is_tuple,(ErlNifEnv*, ERL_NIF_TERM term));
+ERL_NIF_API_FUNC_DECL(int,enif_get_atom_length,(ErlNifEnv*, ERL_NIF_TERM atom, unsigned* len, ErlNifCharEncoding));
+ERL_NIF_API_FUNC_DECL(int,enif_get_list_length,(ErlNifEnv* env, ERL_NIF_TERM term, unsigned* len));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM, enif_make_atom_len,(ErlNifEnv* env, const char* name, size_t len));
+ERL_NIF_API_FUNC_DECL(int, enif_make_existing_atom_len,(ErlNifEnv* env, const char* name, size_t len, ERL_NIF_TERM* atom, ErlNifCharEncoding));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_string_len,(ErlNifEnv* env, const char* string, size_t len, ErlNifCharEncoding));
+ERL_NIF_API_FUNC_DECL(ErlNifEnv*,enif_alloc_env,(void));
+ERL_NIF_API_FUNC_DECL(void,enif_free_env,(ErlNifEnv* env));
+ERL_NIF_API_FUNC_DECL(void,enif_clear_env,(ErlNifEnv* env));
+ERL_NIF_API_FUNC_DECL(int,enif_send,(ErlNifEnv* env, const ErlNifPid* to_pid, ErlNifEnv* msg_env, ERL_NIF_TERM msg));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_copy,(ErlNifEnv* dst_env, ERL_NIF_TERM src_term));
+ERL_NIF_API_FUNC_DECL(ErlNifPid*,enif_self,(ErlNifEnv* caller_env, ErlNifPid* pid));
+ERL_NIF_API_FUNC_DECL(int,enif_get_local_pid,(ErlNifEnv* env, ERL_NIF_TERM, ErlNifPid* pid));
+ERL_NIF_API_FUNC_DECL(void,enif_keep_resource,(void* obj));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_resource_binary,(ErlNifEnv*,void* obj,const void* data, size_t size));
+
+/*
+** Add last to keep compatibility on Windows!!!
+*/
+#endif
+
+#ifdef ERL_NIF_API_FUNC_MACRO
+# define enif_priv_data ERL_NIF_API_FUNC_MACRO(enif_priv_data)
+# define enif_alloc ERL_NIF_API_FUNC_MACRO(enif_alloc)
+# define enif_free ERL_NIF_API_FUNC_MACRO(enif_free)
+# define enif_is_atom ERL_NIF_API_FUNC_MACRO(enif_is_atom)
+# define enif_is_binary ERL_NIF_API_FUNC_MACRO(enif_is_binary)
+# define enif_is_ref ERL_NIF_API_FUNC_MACRO(enif_is_ref)
+# define enif_inspect_binary ERL_NIF_API_FUNC_MACRO(enif_inspect_binary)
+# define enif_alloc_binary ERL_NIF_API_FUNC_MACRO(enif_alloc_binary)
+# define enif_realloc_binary ERL_NIF_API_FUNC_MACRO(enif_realloc_binary)
+# define enif_release_binary ERL_NIF_API_FUNC_MACRO(enif_release_binary)
+# define enif_get_int ERL_NIF_API_FUNC_MACRO(enif_get_int)
+# define enif_get_ulong ERL_NIF_API_FUNC_MACRO(enif_get_ulong)
+# define enif_get_double ERL_NIF_API_FUNC_MACRO(enif_get_double)
+# define enif_get_tuple ERL_NIF_API_FUNC_MACRO(enif_get_tuple)
+# define enif_get_list_cell ERL_NIF_API_FUNC_MACRO(enif_get_list_cell)
+# define enif_is_identical ERL_NIF_API_FUNC_MACRO(enif_is_identical)
+# define enif_compare ERL_NIF_API_FUNC_MACRO(enif_compare)
+
+# define enif_make_binary ERL_NIF_API_FUNC_MACRO(enif_make_binary)
+# define enif_make_badarg ERL_NIF_API_FUNC_MACRO(enif_make_badarg)
+# define enif_make_int ERL_NIF_API_FUNC_MACRO(enif_make_int)
+# define enif_make_ulong ERL_NIF_API_FUNC_MACRO(enif_make_ulong)
+# define enif_make_double ERL_NIF_API_FUNC_MACRO(enif_make_double)
+# define enif_make_atom ERL_NIF_API_FUNC_MACRO(enif_make_atom)
+# define enif_make_existing_atom ERL_NIF_API_FUNC_MACRO(enif_make_existing_atom)
+# define enif_make_tuple ERL_NIF_API_FUNC_MACRO(enif_make_tuple)
+# define enif_make_list ERL_NIF_API_FUNC_MACRO(enif_make_list)
+# define enif_make_list_cell ERL_NIF_API_FUNC_MACRO(enif_make_list_cell)
+# define enif_make_string ERL_NIF_API_FUNC_MACRO(enif_make_string)
+# define enif_make_ref ERL_NIF_API_FUNC_MACRO(enif_make_ref)
+
+# define enif_mutex_create ERL_NIF_API_FUNC_MACRO(enif_mutex_create)
+# define enif_mutex_destroy ERL_NIF_API_FUNC_MACRO(enif_mutex_destroy)
+# define enif_mutex_trylock ERL_NIF_API_FUNC_MACRO(enif_mutex_trylock)
+# define enif_mutex_lock ERL_NIF_API_FUNC_MACRO(enif_mutex_lock)
+# define enif_mutex_unlock ERL_NIF_API_FUNC_MACRO(enif_mutex_unlock)
+# define enif_cond_create ERL_NIF_API_FUNC_MACRO(enif_cond_create)
+# define enif_cond_destroy ERL_NIF_API_FUNC_MACRO(enif_cond_destroy)
+# define enif_cond_signal ERL_NIF_API_FUNC_MACRO(enif_cond_signal)
+# define enif_cond_broadcast ERL_NIF_API_FUNC_MACRO(enif_cond_broadcast)
+# define enif_cond_wait ERL_NIF_API_FUNC_MACRO(enif_cond_wait)
+# define enif_rwlock_create ERL_NIF_API_FUNC_MACRO(enif_rwlock_create)
+# define enif_rwlock_destroy ERL_NIF_API_FUNC_MACRO(enif_rwlock_destroy)
+# define enif_rwlock_tryrlock ERL_NIF_API_FUNC_MACRO(enif_rwlock_tryrlock)
+# define enif_rwlock_rlock ERL_NIF_API_FUNC_MACRO(enif_rwlock_rlock)
+# define enif_rwlock_runlock ERL_NIF_API_FUNC_MACRO(enif_rwlock_runlock)
+# define enif_rwlock_tryrwlock ERL_NIF_API_FUNC_MACRO(enif_rwlock_tryrwlock)
+# define enif_rwlock_rwlock ERL_NIF_API_FUNC_MACRO(enif_rwlock_rwlock)
+# define enif_rwlock_rwunlock ERL_NIF_API_FUNC_MACRO(enif_rwlock_rwunlock)
+# define enif_tsd_key_create ERL_NIF_API_FUNC_MACRO(enif_tsd_key_create)
+# define enif_tsd_key_destroy ERL_NIF_API_FUNC_MACRO(enif_tsd_key_destroy)
+# define enif_tsd_set ERL_NIF_API_FUNC_MACRO(enif_tsd_set)
+# define enif_tsd_get ERL_NIF_API_FUNC_MACRO(enif_tsd_get)
+# define enif_thread_opts_create ERL_NIF_API_FUNC_MACRO(enif_thread_opts_create)
+# define enif_thread_opts_destroy ERL_NIF_API_FUNC_MACRO(enif_thread_opts_destroy)
+# define enif_thread_create ERL_NIF_API_FUNC_MACRO(enif_thread_create)
+# define enif_thread_self ERL_NIF_API_FUNC_MACRO(enif_thread_self)
+# define enif_equal_tids ERL_NIF_API_FUNC_MACRO(enif_equal_tids)
+# define enif_thread_exit ERL_NIF_API_FUNC_MACRO(enif_thread_exit)
+# define enif_thread_join ERL_NIF_API_FUNC_MACRO(enif_thread_join)
+
+# define enif_realloc ERL_NIF_API_FUNC_MACRO(enif_realloc)
+# define enif_system_info ERL_NIF_API_FUNC_MACRO(enif_system_info)
+# define enif_fprintf ERL_NIF_API_FUNC_MACRO(enif_fprintf)
+# define enif_inspect_iolist_as_binary ERL_NIF_API_FUNC_MACRO(enif_inspect_iolist_as_binary)
+# define enif_make_sub_binary ERL_NIF_API_FUNC_MACRO(enif_make_sub_binary)
+# define enif_get_string ERL_NIF_API_FUNC_MACRO(enif_get_string)
+# define enif_get_atom ERL_NIF_API_FUNC_MACRO(enif_get_atom)
+# define enif_is_fun ERL_NIF_API_FUNC_MACRO(enif_is_fun)
+# define enif_is_pid ERL_NIF_API_FUNC_MACRO(enif_is_pid)
+# define enif_is_port ERL_NIF_API_FUNC_MACRO(enif_is_port)
+# define enif_get_uint ERL_NIF_API_FUNC_MACRO(enif_get_uint)
+# define enif_get_long ERL_NIF_API_FUNC_MACRO(enif_get_long)
+# define enif_make_uint ERL_NIF_API_FUNC_MACRO(enif_make_uint)
+# define enif_make_long ERL_NIF_API_FUNC_MACRO(enif_make_long)
+# define enif_make_tuple_from_array ERL_NIF_API_FUNC_MACRO(enif_make_tuple_from_array)
+# define enif_make_list_from_array ERL_NIF_API_FUNC_MACRO(enif_make_list_from_array)
+# define enif_is_empty_list ERL_NIF_API_FUNC_MACRO(enif_is_empty_list)
+# define enif_open_resource_type ERL_NIF_API_FUNC_MACRO(enif_open_resource_type)
+# define enif_alloc_resource ERL_NIF_API_FUNC_MACRO(enif_alloc_resource)
+# define enif_release_resource ERL_NIF_API_FUNC_MACRO(enif_release_resource)
+# define enif_make_resource ERL_NIF_API_FUNC_MACRO(enif_make_resource)
+# define enif_get_resource ERL_NIF_API_FUNC_MACRO(enif_get_resource)
+# define enif_sizeof_resource ERL_NIF_API_FUNC_MACRO(enif_sizeof_resource)
+# define enif_make_new_binary ERL_NIF_API_FUNC_MACRO(enif_make_new_binary)
+# define enif_is_list ERL_NIF_API_FUNC_MACRO(enif_is_list)
+# define enif_is_tuple ERL_NIF_API_FUNC_MACRO(enif_is_tuple)
+# define enif_get_atom_length ERL_NIF_API_FUNC_MACRO(enif_get_atom_length)
+# define enif_get_list_length ERL_NIF_API_FUNC_MACRO(enif_get_list_length)
+# define enif_make_atom_len ERL_NIF_API_FUNC_MACRO(enif_make_atom_len)
+# define enif_make_existing_atom_len ERL_NIF_API_FUNC_MACRO(enif_make_existing_atom_len)
+# define enif_make_string_len ERL_NIF_API_FUNC_MACRO(enif_make_string_len)
+# define enif_alloc_env ERL_NIF_API_FUNC_MACRO(enif_alloc_env)
+# define enif_free_env ERL_NIF_API_FUNC_MACRO(enif_free_env)
+# define enif_clear_env ERL_NIF_API_FUNC_MACRO(enif_clear_env)
+# define enif_send ERL_NIF_API_FUNC_MACRO(enif_send)
+# define enif_make_copy ERL_NIF_API_FUNC_MACRO(enif_make_copy)
+# define enif_self ERL_NIF_API_FUNC_MACRO(enif_self)
+# define enif_get_local_pid ERL_NIF_API_FUNC_MACRO(enif_get_local_pid)
+# define enif_keep_resource ERL_NIF_API_FUNC_MACRO(enif_keep_resource)
+# define enif_make_resource_binary ERL_NIF_API_FUNC_MACRO(enif_make_resource_binary)
+#endif
+
+#ifndef enif_make_list1
+# define enif_make_list1(ENV,E1) enif_make_list(ENV,1,E1)
+# define enif_make_list2(ENV,E1,E2) enif_make_list(ENV,2,E1,E2)
+# define enif_make_list3(ENV,E1,E2,E3) enif_make_list(ENV,3,E1,E2,E3)
+# define enif_make_list4(ENV,E1,E2,E3,E4) enif_make_list(ENV,4,E1,E2,E3,E4)
+# define enif_make_list5(ENV,E1,E2,E3,E4,E5) enif_make_list(ENV,5,E1,E2,E3,E4,E5)
+# define enif_make_list6(ENV,E1,E2,E3,E4,E5,E6) enif_make_list(ENV,6,E1,E2,E3,E4,E5,E6)
+# define enif_make_list7(ENV,E1,E2,E3,E4,E5,E6,E7) enif_make_list(ENV,7,E1,E2,E3,E4,E5,E6,E7)
+# define enif_make_list8(ENV,E1,E2,E3,E4,E5,E6,E7,E8) enif_make_list(ENV,8,E1,E2,E3,E4,E5,E6,E7,E8)
+# define enif_make_list9(ENV,E1,E2,E3,E4,E5,E6,E7,E8,E9) enif_make_list(ENV,9,E1,E2,E3,E4,E5,E6,E7,E8,E9)
+# define enif_make_tuple1(ENV,E1) enif_make_tuple(ENV,1,E1)
+# define enif_make_tuple2(ENV,E1,E2) enif_make_tuple(ENV,2,E1,E2)
+# define enif_make_tuple3(ENV,E1,E2,E3) enif_make_tuple(ENV,3,E1,E2,E3)
+# define enif_make_tuple4(ENV,E1,E2,E3,E4) enif_make_tuple(ENV,4,E1,E2,E3,E4)
+# define enif_make_tuple5(ENV,E1,E2,E3,E4,E5) enif_make_tuple(ENV,5,E1,E2,E3,E4,E5)
+# define enif_make_tuple6(ENV,E1,E2,E3,E4,E5,E6) enif_make_tuple(ENV,6,E1,E2,E3,E4,E5,E6)
+# define enif_make_tuple7(ENV,E1,E2,E3,E4,E5,E6,E7) enif_make_tuple(ENV,7,E1,E2,E3,E4,E5,E6,E7)
+# define enif_make_tuple8(ENV,E1,E2,E3,E4,E5,E6,E7,E8) enif_make_tuple(ENV,8,E1,E2,E3,E4,E5,E6,E7,E8)
+# define enif_make_tuple9(ENV,E1,E2,E3,E4,E5,E6,E7,E8,E9) enif_make_tuple(ENV,9,E1,E2,E3,E4,E5,E6,E7,E8,E9)
+
+# define enif_make_pid(ENV, PID) ((const ERL_NIF_TERM)((PID)->pid))
+#endif
+
diff --git a/erts/emulator/test/nif_SUITE_data/nif_api_2_4/README b/erts/emulator/test/nif_SUITE_data/nif_api_2_4/README
new file mode 100644
index 0000000000..7abd0319a6
--- /dev/null
+++ b/erts/emulator/test/nif_SUITE_data/nif_api_2_4/README
@@ -0,0 +1,6 @@
+These are old genuine header files
+checked out from tag OTP_R16B 05f11890bdfec4bfc3a78e191
+
+I choose this API version (2.4) to test, as it's before
+the addition of 'options' in ErlNifEntry and 'flags' in ErlNifFunc
+and without include of generated erl_native_features_config.h.
diff --git a/erts/emulator/hipe/hipe_perfctr.h b/erts/emulator/test/nif_SUITE_data/nif_api_2_4/erl_drv_nif.h
index 8fbf9ecf35..3e5435e353 100644
--- a/erts/emulator/hipe/hipe_perfctr.h
+++ b/erts/emulator/test/nif_SUITE_data/nif_api_2_4/erl_drv_nif.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2004-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2010-2017. 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
@@ -17,7 +17,32 @@
* %CopyrightEnd%
*/
+/*
+ * Common structures for both erl_driver.h and erl_nif.h
+ */
+
+#ifndef __ERL_DRV_NIF_H__
+#define __ERL_DRV_NIF_H__
+
+typedef struct {
+ int driver_major_version;
+ int driver_minor_version;
+ char *erts_version;
+ char *otp_release;
+ int thread_support;
+ int smp_support;
+ int async_threads;
+ int scheduler_threads;
+ int nif_major_version;
+ int nif_minor_version;
+} ErlDrvSysInfo;
+
+typedef struct {
+ int suggested_stack_size;
+} ErlDrvThreadOpts;
+
+#endif /* __ERL_DRV_NIF_H__ */
+
+
+
-extern int hipe_perfctr_hrvtime_open(void);
-extern void hipe_perfctr_hrvtime_close(void);
-extern double hipe_perfctr_hrvtime_get(void);
diff --git a/erts/emulator/test/nif_SUITE_data/nif_api_2_4/erl_nif.h b/erts/emulator/test/nif_SUITE_data/nif_api_2_4/erl_nif.h
new file mode 100644
index 0000000000..c3013b6b74
--- /dev/null
+++ b/erts/emulator/test/nif_SUITE_data/nif_api_2_4/erl_nif.h
@@ -0,0 +1,237 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2009-2017. 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%
+ */
+
+/* Include file for writers of Native Implemented Functions.
+*/
+
+#ifndef __ERL_NIF_H__
+#define __ERL_NIF_H__
+
+
+#include "erl_drv_nif.h"
+
+/* Version history:
+** 0.1: R13B03
+** 1.0: R13B04
+** 2.0: R14A
+** 2.1: R14B02 "vm_variant"
+** 2.2: R14B03 enif_is_exception
+** 2.3: R15 enif_make_reverse_list, enif_is_number
+** 2.4: R16 enif_consume_timeslice
+*/
+#define ERL_NIF_MAJOR_VERSION 2
+#define ERL_NIF_MINOR_VERSION 4
+
+#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
+
+#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
+
+struct enif_environment_t;
+typedef struct enif_environment_t ErlNifEnv;
+
+typedef struct
+{
+ const char* name;
+ unsigned arity;
+ ERL_NIF_TERM (*fptr)(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+}ErlNifFunc;
+
+typedef struct enif_entry_t
+{
+ int major;
+ int minor;
+ const char* name;
+ int num_of_funcs;
+ ErlNifFunc* funcs;
+ int (*load) (ErlNifEnv*, void** priv_data, ERL_NIF_TERM load_info);
+ int (*reload) (ErlNifEnv*, void** priv_data, ERL_NIF_TERM load_info);
+ int (*upgrade)(ErlNifEnv*, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info);
+ void (*unload) (ErlNifEnv*, void* priv_data);
+ const char* vm_variant;
+}ErlNifEntry;
+
+
+
+typedef struct
+{
+ size_t size;
+ unsigned char* data;
+
+ /* Internals (avert your eyes) */
+ ERL_NIF_TERM bin_term;
+ void* ref_bin;
+}ErlNifBinary;
+
+typedef struct enif_resource_type_t ErlNifResourceType;
+typedef void ErlNifResourceDtor(ErlNifEnv*, void*);
+typedef enum
+{
+ ERL_NIF_RT_CREATE = 1,
+ ERL_NIF_RT_TAKEOVER = 2
+}ErlNifResourceFlags;
+
+typedef enum
+{
+ ERL_NIF_LATIN1 = 1
+}ErlNifCharEncoding;
+
+typedef struct
+{
+ ERL_NIF_TERM pid; /* internal, may change */
+}ErlNifPid;
+
+typedef ErlDrvSysInfo ErlNifSysInfo;
+
+typedef struct ErlDrvTid_ *ErlNifTid;
+typedef struct ErlDrvMutex_ ErlNifMutex;
+typedef struct ErlDrvCond_ ErlNifCond;
+typedef struct ErlDrvRWLock_ ErlNifRWLock;
+typedef int ErlNifTSDKey;
+
+typedef ErlDrvThreadOpts ErlNifThreadOpts;
+
+#if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_))
+# define ERL_NIF_API_FUNC_DECL(RET_TYPE, NAME, ARGS) RET_TYPE (*NAME) ARGS
+typedef struct {
+# include "erl_nif_api_funcs.h"
+} TWinDynNifCallbacks;
+extern TWinDynNifCallbacks WinDynNifCallbacks;
+# undef ERL_NIF_API_FUNC_DECL
+#endif
+
+#if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_)) && !defined(STATIC_ERLANG_DRIVER)
+# define ERL_NIF_API_FUNC_MACRO(NAME) (WinDynNifCallbacks.NAME)
+# include "erl_nif_api_funcs.h"
+/* note that we have to keep ERL_NIF_API_FUNC_MACRO defined */
+
+#else /* non windows or included from emulator itself */
+
+# define ERL_NIF_API_FUNC_DECL(RET_TYPE, NAME, ARGS) extern RET_TYPE NAME ARGS
+# include "erl_nif_api_funcs.h"
+# undef ERL_NIF_API_FUNC_DECL
+#endif
+
+
+#if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_))
+# define ERL_NIF_INIT_GLOB TWinDynNifCallbacks WinDynNifCallbacks;
+# define ERL_NIF_INIT_DECL(MODNAME) __declspec(dllexport) ErlNifEntry* nif_init(TWinDynNifCallbacks* callbacks)
+# define ERL_NIF_INIT_BODY memcpy(&WinDynNifCallbacks,callbacks,sizeof(TWinDynNifCallbacks))
+#else
+# define ERL_NIF_INIT_GLOB
+# define ERL_NIF_INIT_BODY
+# define ERL_NIF_INIT_DECL(MODNAME) ErlNifEntry* nif_init(void)
+#endif
+
+
+#ifdef __cplusplus
+}
+# define ERL_NIF_INIT_PROLOGUE extern "C" {
+# define ERL_NIF_INIT_EPILOGUE }
+#else
+# define ERL_NIF_INIT_PROLOGUE
+# define ERL_NIF_INIT_EPILOGUE
+#endif
+
+
+#define ERL_NIF_INIT(NAME, FUNCS, LOAD, RELOAD, UPGRADE, UNLOAD) \
+ERL_NIF_INIT_PROLOGUE \
+ERL_NIF_INIT_GLOB \
+ERL_NIF_INIT_DECL(NAME); \
+ERL_NIF_INIT_DECL(NAME) \
+{ \
+ static ErlNifEntry entry = \
+ { \
+ ERL_NIF_MAJOR_VERSION, \
+ ERL_NIF_MINOR_VERSION, \
+ #NAME, \
+ sizeof(FUNCS) / sizeof(*FUNCS), \
+ FUNCS, \
+ LOAD, RELOAD, UPGRADE, UNLOAD, \
+ ERL_NIF_VM_VARIANT \
+ }; \
+ ERL_NIF_INIT_BODY; \
+ return &entry; \
+} \
+ERL_NIF_INIT_EPILOGUE
+
+#if defined(USE_DYNAMIC_TRACE) && (defined(USE_DTRACE) || defined(USE_SYSTEMTAP))
+#define HAVE_USE_DTRACE 1
+#endif
+
+#ifdef HAVE_USE_DTRACE
+ERL_NIF_TERM erl_nif_user_trace_s1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+ERL_NIF_TERM erl_nif_user_trace_i4s4(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+ERL_NIF_TERM erl_nif_user_trace_n(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+#endif
+
+#endif /* __ERL_NIF_H__ */
+
diff --git a/erts/emulator/test/nif_SUITE_data/nif_api_2_4/erl_nif_api_funcs.h b/erts/emulator/test/nif_SUITE_data/nif_api_2_4/erl_nif_api_funcs.h
new file mode 100644
index 0000000000..92954403f3
--- /dev/null
+++ b/erts/emulator/test/nif_SUITE_data/nif_api_2_4/erl_nif_api_funcs.h
@@ -0,0 +1,503 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2009-2017. 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%
+ */
+
+#if !defined(ERL_NIF_API_FUNC_DECL) && !defined(ERL_NIF_API_FUNC_MACRO)
+# error This file should not be included directly
+#endif
+
+/*
+** WARNING: add new ERL_NIF_API_FUNC_DECL entries at the bottom of the list
+** to keep compatibility on Windows!!!
+**
+** And don't forget to increase ERL_NIF_MINOR_VERSION in erl_nif.h
+** when adding functions to the API.
+*/
+#ifdef ERL_NIF_API_FUNC_DECL
+ERL_NIF_API_FUNC_DECL(void*,enif_priv_data,(ErlNifEnv*));
+ERL_NIF_API_FUNC_DECL(void*,enif_alloc,(size_t size));
+ERL_NIF_API_FUNC_DECL(void,enif_free,(void* ptr));
+ERL_NIF_API_FUNC_DECL(int,enif_is_atom,(ErlNifEnv*, ERL_NIF_TERM term));
+ERL_NIF_API_FUNC_DECL(int,enif_is_binary,(ErlNifEnv*, ERL_NIF_TERM term));
+ERL_NIF_API_FUNC_DECL(int,enif_is_ref,(ErlNifEnv*, ERL_NIF_TERM term));
+ERL_NIF_API_FUNC_DECL(int,enif_inspect_binary,(ErlNifEnv*, ERL_NIF_TERM bin_term, ErlNifBinary* bin));
+ERL_NIF_API_FUNC_DECL(int,enif_alloc_binary,(size_t size, ErlNifBinary* bin));
+ERL_NIF_API_FUNC_DECL(int,enif_realloc_binary,(ErlNifBinary* bin, size_t size));
+ERL_NIF_API_FUNC_DECL(void,enif_release_binary,(ErlNifBinary* bin));
+ERL_NIF_API_FUNC_DECL(int,enif_get_int,(ErlNifEnv*, ERL_NIF_TERM term, int* ip));
+ERL_NIF_API_FUNC_DECL(int,enif_get_ulong,(ErlNifEnv*, ERL_NIF_TERM term, unsigned long* ip));
+ERL_NIF_API_FUNC_DECL(int,enif_get_double,(ErlNifEnv*, ERL_NIF_TERM term, double* dp));
+ERL_NIF_API_FUNC_DECL(int,enif_get_list_cell,(ErlNifEnv* env, ERL_NIF_TERM term, ERL_NIF_TERM* head, ERL_NIF_TERM* tail));
+ERL_NIF_API_FUNC_DECL(int,enif_get_tuple,(ErlNifEnv* env, ERL_NIF_TERM tpl, int* arity, const ERL_NIF_TERM** array));
+ERL_NIF_API_FUNC_DECL(int,enif_is_identical,(ERL_NIF_TERM lhs, ERL_NIF_TERM rhs));
+ERL_NIF_API_FUNC_DECL(int,enif_compare,(ERL_NIF_TERM lhs, ERL_NIF_TERM rhs));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_binary,(ErlNifEnv* env, ErlNifBinary* bin));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_badarg,(ErlNifEnv* env));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_int,(ErlNifEnv* env, int i));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_ulong,(ErlNifEnv* env, unsigned long i));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_double,(ErlNifEnv* env, double d));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_atom,(ErlNifEnv* env, const char* name));
+ERL_NIF_API_FUNC_DECL(int,enif_make_existing_atom,(ErlNifEnv* env, const char* name, ERL_NIF_TERM* atom, ErlNifCharEncoding));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_tuple,(ErlNifEnv* env, unsigned cnt, ...));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_list,(ErlNifEnv* env, unsigned cnt, ...));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_list_cell,(ErlNifEnv* env, ERL_NIF_TERM car, ERL_NIF_TERM cdr));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_string,(ErlNifEnv* env, const char* string, ErlNifCharEncoding));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_ref,(ErlNifEnv* env));
+
+ERL_NIF_API_FUNC_DECL(ErlNifMutex*,enif_mutex_create,(char *name));
+ERL_NIF_API_FUNC_DECL(void,enif_mutex_destroy,(ErlNifMutex *mtx));
+ERL_NIF_API_FUNC_DECL(int,enif_mutex_trylock,(ErlNifMutex *mtx));
+ERL_NIF_API_FUNC_DECL(void,enif_mutex_lock,(ErlNifMutex *mtx));
+ERL_NIF_API_FUNC_DECL(void,enif_mutex_unlock,(ErlNifMutex *mtx));
+ERL_NIF_API_FUNC_DECL(ErlNifCond*,enif_cond_create,(char *name));
+ERL_NIF_API_FUNC_DECL(void,enif_cond_destroy,(ErlNifCond *cnd));
+ERL_NIF_API_FUNC_DECL(void,enif_cond_signal,(ErlNifCond *cnd));
+ERL_NIF_API_FUNC_DECL(void,enif_cond_broadcast,(ErlNifCond *cnd));
+ERL_NIF_API_FUNC_DECL(void,enif_cond_wait,(ErlNifCond *cnd, ErlNifMutex *mtx));
+ERL_NIF_API_FUNC_DECL(ErlNifRWLock*,enif_rwlock_create,(char *name));
+ERL_NIF_API_FUNC_DECL(void,enif_rwlock_destroy,(ErlNifRWLock *rwlck));
+ERL_NIF_API_FUNC_DECL(int,enif_rwlock_tryrlock,(ErlNifRWLock *rwlck));
+ERL_NIF_API_FUNC_DECL(void,enif_rwlock_rlock,(ErlNifRWLock *rwlck));
+ERL_NIF_API_FUNC_DECL(void,enif_rwlock_runlock,(ErlNifRWLock *rwlck));
+ERL_NIF_API_FUNC_DECL(int,enif_rwlock_tryrwlock,(ErlNifRWLock *rwlck));
+ERL_NIF_API_FUNC_DECL(void,enif_rwlock_rwlock,(ErlNifRWLock *rwlck));
+ERL_NIF_API_FUNC_DECL(void,enif_rwlock_rwunlock,(ErlNifRWLock *rwlck));
+ERL_NIF_API_FUNC_DECL(int,enif_tsd_key_create,(char *name, ErlNifTSDKey *key));
+ERL_NIF_API_FUNC_DECL(void,enif_tsd_key_destroy,(ErlNifTSDKey key));
+ERL_NIF_API_FUNC_DECL(void,enif_tsd_set,(ErlNifTSDKey key, void *data));
+ERL_NIF_API_FUNC_DECL(void*,enif_tsd_get,(ErlNifTSDKey key));
+ERL_NIF_API_FUNC_DECL(ErlNifThreadOpts*,enif_thread_opts_create,(char *name));
+ERL_NIF_API_FUNC_DECL(void,enif_thread_opts_destroy,(ErlNifThreadOpts *opts));
+ERL_NIF_API_FUNC_DECL(int,enif_thread_create,(char *name,ErlNifTid *tid,void * (*func)(void *),void *args,ErlNifThreadOpts *opts));
+ERL_NIF_API_FUNC_DECL(ErlNifTid,enif_thread_self,(void));
+ERL_NIF_API_FUNC_DECL(int,enif_equal_tids,(ErlNifTid tid1, ErlNifTid tid2));
+ERL_NIF_API_FUNC_DECL(void,enif_thread_exit,(void *resp));
+ERL_NIF_API_FUNC_DECL(int,enif_thread_join,(ErlNifTid, void **respp));
+
+ERL_NIF_API_FUNC_DECL(void*,enif_realloc,(void* ptr, size_t size));
+ERL_NIF_API_FUNC_DECL(void,enif_system_info,(ErlNifSysInfo *sip, size_t si_size));
+ERL_NIF_API_FUNC_DECL(int,enif_fprintf,(void/* FILE* */ *filep, const char *format, ...));
+ERL_NIF_API_FUNC_DECL(int,enif_inspect_iolist_as_binary,(ErlNifEnv*, ERL_NIF_TERM term, ErlNifBinary* bin));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_sub_binary,(ErlNifEnv*, ERL_NIF_TERM bin_term, size_t pos, size_t size));
+ERL_NIF_API_FUNC_DECL(int,enif_get_string,(ErlNifEnv*, ERL_NIF_TERM list, char* buf, unsigned len, ErlNifCharEncoding));
+ERL_NIF_API_FUNC_DECL(int,enif_get_atom,(ErlNifEnv*, ERL_NIF_TERM atom, char* buf, unsigned len, ErlNifCharEncoding));
+ERL_NIF_API_FUNC_DECL(int,enif_is_fun,(ErlNifEnv*, ERL_NIF_TERM term));
+ERL_NIF_API_FUNC_DECL(int,enif_is_pid,(ErlNifEnv*, ERL_NIF_TERM term));
+ERL_NIF_API_FUNC_DECL(int,enif_is_port,(ErlNifEnv*, ERL_NIF_TERM term));
+ERL_NIF_API_FUNC_DECL(int,enif_get_uint,(ErlNifEnv*, ERL_NIF_TERM term, unsigned* ip));
+ERL_NIF_API_FUNC_DECL(int,enif_get_long,(ErlNifEnv*, ERL_NIF_TERM term, long* ip));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_uint,(ErlNifEnv*, unsigned i));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_long,(ErlNifEnv*, long i));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_tuple_from_array,(ErlNifEnv*, const ERL_NIF_TERM arr[], unsigned cnt));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_list_from_array,(ErlNifEnv*, const ERL_NIF_TERM arr[], unsigned cnt));
+ERL_NIF_API_FUNC_DECL(int,enif_is_empty_list,(ErlNifEnv*, ERL_NIF_TERM term));
+ERL_NIF_API_FUNC_DECL(ErlNifResourceType*,enif_open_resource_type,(ErlNifEnv*, const char* module_str, const char* name_str, void (*dtor)(ErlNifEnv*,void *), ErlNifResourceFlags flags, ErlNifResourceFlags* tried));
+ERL_NIF_API_FUNC_DECL(void*,enif_alloc_resource,(ErlNifResourceType* type, size_t size));
+ERL_NIF_API_FUNC_DECL(void,enif_release_resource,(void* obj));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_resource,(ErlNifEnv*, void* obj));
+ERL_NIF_API_FUNC_DECL(int,enif_get_resource,(ErlNifEnv*, ERL_NIF_TERM term, ErlNifResourceType* type, void** objp));
+ERL_NIF_API_FUNC_DECL(size_t,enif_sizeof_resource,(void* obj));
+ERL_NIF_API_FUNC_DECL(unsigned char*,enif_make_new_binary,(ErlNifEnv*,size_t size,ERL_NIF_TERM* termp));
+ERL_NIF_API_FUNC_DECL(int,enif_is_list,(ErlNifEnv*, ERL_NIF_TERM term));
+ERL_NIF_API_FUNC_DECL(int,enif_is_tuple,(ErlNifEnv*, ERL_NIF_TERM term));
+ERL_NIF_API_FUNC_DECL(int,enif_get_atom_length,(ErlNifEnv*, ERL_NIF_TERM atom, unsigned* len, ErlNifCharEncoding));
+ERL_NIF_API_FUNC_DECL(int,enif_get_list_length,(ErlNifEnv* env, ERL_NIF_TERM term, unsigned* len));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM, enif_make_atom_len,(ErlNifEnv* env, const char* name, size_t len));
+ERL_NIF_API_FUNC_DECL(int, enif_make_existing_atom_len,(ErlNifEnv* env, const char* name, size_t len, ERL_NIF_TERM* atom, ErlNifCharEncoding));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_string_len,(ErlNifEnv* env, const char* string, size_t len, ErlNifCharEncoding));
+ERL_NIF_API_FUNC_DECL(ErlNifEnv*,enif_alloc_env,(void));
+ERL_NIF_API_FUNC_DECL(void,enif_free_env,(ErlNifEnv* env));
+ERL_NIF_API_FUNC_DECL(void,enif_clear_env,(ErlNifEnv* env));
+ERL_NIF_API_FUNC_DECL(int,enif_send,(ErlNifEnv* env, const ErlNifPid* to_pid, ErlNifEnv* msg_env, ERL_NIF_TERM msg));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_copy,(ErlNifEnv* dst_env, ERL_NIF_TERM src_term));
+ERL_NIF_API_FUNC_DECL(ErlNifPid*,enif_self,(ErlNifEnv* caller_env, ErlNifPid* pid));
+ERL_NIF_API_FUNC_DECL(int,enif_get_local_pid,(ErlNifEnv* env, ERL_NIF_TERM, ErlNifPid* pid));
+ERL_NIF_API_FUNC_DECL(void,enif_keep_resource,(void* obj));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_resource_binary,(ErlNifEnv*,void* obj,const void* data, size_t size));
+#if SIZEOF_LONG != 8
+ERL_NIF_API_FUNC_DECL(int,enif_get_int64,(ErlNifEnv*, ERL_NIF_TERM term, ErlNifSInt64* ip));
+ERL_NIF_API_FUNC_DECL(int,enif_get_uint64,(ErlNifEnv*, ERL_NIF_TERM term, ErlNifUInt64* ip));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_int64,(ErlNifEnv*, ErlNifSInt64));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_uint64,(ErlNifEnv*, ErlNifUInt64));
+#endif
+ERL_NIF_API_FUNC_DECL(int,enif_is_exception,(ErlNifEnv*, ERL_NIF_TERM term));
+ERL_NIF_API_FUNC_DECL(int,enif_make_reverse_list,(ErlNifEnv*, ERL_NIF_TERM term, ERL_NIF_TERM *list));
+ERL_NIF_API_FUNC_DECL(int,enif_is_number,(ErlNifEnv*, ERL_NIF_TERM term));
+ERL_NIF_API_FUNC_DECL(void*,enif_dlopen,(const char* lib, void (*err_handler)(void*,const char*), void* err_arg));
+ERL_NIF_API_FUNC_DECL(void*,enif_dlsym,(void* handle, const char* symbol, void (*err_handler)(void*,const char*), void* err_arg));
+ERL_NIF_API_FUNC_DECL(int,enif_consume_timeslice,(ErlNifEnv*, int percent));
+
+/*
+** Add new entries here to keep compatibility on Windows!!!
+*/
+#endif
+
+/*
+** Please keep the ERL_NIF_API_FUNC_MACRO list below in the same order
+** as the ERL_NIF_API_FUNC_DECL list above
+*/
+#ifdef ERL_NIF_API_FUNC_MACRO
+# define enif_priv_data ERL_NIF_API_FUNC_MACRO(enif_priv_data)
+# define enif_alloc ERL_NIF_API_FUNC_MACRO(enif_alloc)
+# define enif_free ERL_NIF_API_FUNC_MACRO(enif_free)
+# define enif_is_atom ERL_NIF_API_FUNC_MACRO(enif_is_atom)
+# define enif_is_binary ERL_NIF_API_FUNC_MACRO(enif_is_binary)
+# define enif_is_ref ERL_NIF_API_FUNC_MACRO(enif_is_ref)
+# define enif_inspect_binary ERL_NIF_API_FUNC_MACRO(enif_inspect_binary)
+# define enif_alloc_binary ERL_NIF_API_FUNC_MACRO(enif_alloc_binary)
+# define enif_realloc_binary ERL_NIF_API_FUNC_MACRO(enif_realloc_binary)
+# define enif_release_binary ERL_NIF_API_FUNC_MACRO(enif_release_binary)
+# define enif_get_int ERL_NIF_API_FUNC_MACRO(enif_get_int)
+# define enif_get_ulong ERL_NIF_API_FUNC_MACRO(enif_get_ulong)
+# define enif_get_double ERL_NIF_API_FUNC_MACRO(enif_get_double)
+# define enif_get_tuple ERL_NIF_API_FUNC_MACRO(enif_get_tuple)
+# define enif_get_list_cell ERL_NIF_API_FUNC_MACRO(enif_get_list_cell)
+# define enif_is_identical ERL_NIF_API_FUNC_MACRO(enif_is_identical)
+# define enif_compare ERL_NIF_API_FUNC_MACRO(enif_compare)
+
+# define enif_make_binary ERL_NIF_API_FUNC_MACRO(enif_make_binary)
+# define enif_make_badarg ERL_NIF_API_FUNC_MACRO(enif_make_badarg)
+# define enif_make_int ERL_NIF_API_FUNC_MACRO(enif_make_int)
+# define enif_make_ulong ERL_NIF_API_FUNC_MACRO(enif_make_ulong)
+# define enif_make_double ERL_NIF_API_FUNC_MACRO(enif_make_double)
+# define enif_make_atom ERL_NIF_API_FUNC_MACRO(enif_make_atom)
+# define enif_make_existing_atom ERL_NIF_API_FUNC_MACRO(enif_make_existing_atom)
+# define enif_make_tuple ERL_NIF_API_FUNC_MACRO(enif_make_tuple)
+# define enif_make_list ERL_NIF_API_FUNC_MACRO(enif_make_list)
+# define enif_make_list_cell ERL_NIF_API_FUNC_MACRO(enif_make_list_cell)
+# define enif_make_string ERL_NIF_API_FUNC_MACRO(enif_make_string)
+# define enif_make_ref ERL_NIF_API_FUNC_MACRO(enif_make_ref)
+
+# define enif_mutex_create ERL_NIF_API_FUNC_MACRO(enif_mutex_create)
+# define enif_mutex_destroy ERL_NIF_API_FUNC_MACRO(enif_mutex_destroy)
+# define enif_mutex_trylock ERL_NIF_API_FUNC_MACRO(enif_mutex_trylock)
+# define enif_mutex_lock ERL_NIF_API_FUNC_MACRO(enif_mutex_lock)
+# define enif_mutex_unlock ERL_NIF_API_FUNC_MACRO(enif_mutex_unlock)
+# define enif_cond_create ERL_NIF_API_FUNC_MACRO(enif_cond_create)
+# define enif_cond_destroy ERL_NIF_API_FUNC_MACRO(enif_cond_destroy)
+# define enif_cond_signal ERL_NIF_API_FUNC_MACRO(enif_cond_signal)
+# define enif_cond_broadcast ERL_NIF_API_FUNC_MACRO(enif_cond_broadcast)
+# define enif_cond_wait ERL_NIF_API_FUNC_MACRO(enif_cond_wait)
+# define enif_rwlock_create ERL_NIF_API_FUNC_MACRO(enif_rwlock_create)
+# define enif_rwlock_destroy ERL_NIF_API_FUNC_MACRO(enif_rwlock_destroy)
+# define enif_rwlock_tryrlock ERL_NIF_API_FUNC_MACRO(enif_rwlock_tryrlock)
+# define enif_rwlock_rlock ERL_NIF_API_FUNC_MACRO(enif_rwlock_rlock)
+# define enif_rwlock_runlock ERL_NIF_API_FUNC_MACRO(enif_rwlock_runlock)
+# define enif_rwlock_tryrwlock ERL_NIF_API_FUNC_MACRO(enif_rwlock_tryrwlock)
+# define enif_rwlock_rwlock ERL_NIF_API_FUNC_MACRO(enif_rwlock_rwlock)
+# define enif_rwlock_rwunlock ERL_NIF_API_FUNC_MACRO(enif_rwlock_rwunlock)
+# define enif_tsd_key_create ERL_NIF_API_FUNC_MACRO(enif_tsd_key_create)
+# define enif_tsd_key_destroy ERL_NIF_API_FUNC_MACRO(enif_tsd_key_destroy)
+# define enif_tsd_set ERL_NIF_API_FUNC_MACRO(enif_tsd_set)
+# define enif_tsd_get ERL_NIF_API_FUNC_MACRO(enif_tsd_get)
+# define enif_thread_opts_create ERL_NIF_API_FUNC_MACRO(enif_thread_opts_create)
+# define enif_thread_opts_destroy ERL_NIF_API_FUNC_MACRO(enif_thread_opts_destroy)
+# define enif_thread_create ERL_NIF_API_FUNC_MACRO(enif_thread_create)
+# define enif_thread_self ERL_NIF_API_FUNC_MACRO(enif_thread_self)
+# define enif_equal_tids ERL_NIF_API_FUNC_MACRO(enif_equal_tids)
+# define enif_thread_exit ERL_NIF_API_FUNC_MACRO(enif_thread_exit)
+# define enif_thread_join ERL_NIF_API_FUNC_MACRO(enif_thread_join)
+
+# define enif_realloc ERL_NIF_API_FUNC_MACRO(enif_realloc)
+# define enif_system_info ERL_NIF_API_FUNC_MACRO(enif_system_info)
+# define enif_fprintf ERL_NIF_API_FUNC_MACRO(enif_fprintf)
+# define enif_inspect_iolist_as_binary ERL_NIF_API_FUNC_MACRO(enif_inspect_iolist_as_binary)
+# define enif_make_sub_binary ERL_NIF_API_FUNC_MACRO(enif_make_sub_binary)
+# define enif_get_string ERL_NIF_API_FUNC_MACRO(enif_get_string)
+# define enif_get_atom ERL_NIF_API_FUNC_MACRO(enif_get_atom)
+# define enif_is_fun ERL_NIF_API_FUNC_MACRO(enif_is_fun)
+# define enif_is_pid ERL_NIF_API_FUNC_MACRO(enif_is_pid)
+# define enif_is_port ERL_NIF_API_FUNC_MACRO(enif_is_port)
+# define enif_get_uint ERL_NIF_API_FUNC_MACRO(enif_get_uint)
+# define enif_get_long ERL_NIF_API_FUNC_MACRO(enif_get_long)
+# define enif_make_uint ERL_NIF_API_FUNC_MACRO(enif_make_uint)
+# define enif_make_long ERL_NIF_API_FUNC_MACRO(enif_make_long)
+# define enif_make_tuple_from_array ERL_NIF_API_FUNC_MACRO(enif_make_tuple_from_array)
+# define enif_make_list_from_array ERL_NIF_API_FUNC_MACRO(enif_make_list_from_array)
+# define enif_is_empty_list ERL_NIF_API_FUNC_MACRO(enif_is_empty_list)
+# define enif_open_resource_type ERL_NIF_API_FUNC_MACRO(enif_open_resource_type)
+# define enif_alloc_resource ERL_NIF_API_FUNC_MACRO(enif_alloc_resource)
+# define enif_release_resource ERL_NIF_API_FUNC_MACRO(enif_release_resource)
+# define enif_make_resource ERL_NIF_API_FUNC_MACRO(enif_make_resource)
+# define enif_get_resource ERL_NIF_API_FUNC_MACRO(enif_get_resource)
+# define enif_sizeof_resource ERL_NIF_API_FUNC_MACRO(enif_sizeof_resource)
+# define enif_make_new_binary ERL_NIF_API_FUNC_MACRO(enif_make_new_binary)
+# define enif_is_list ERL_NIF_API_FUNC_MACRO(enif_is_list)
+# define enif_is_tuple ERL_NIF_API_FUNC_MACRO(enif_is_tuple)
+# define enif_get_atom_length ERL_NIF_API_FUNC_MACRO(enif_get_atom_length)
+# define enif_get_list_length ERL_NIF_API_FUNC_MACRO(enif_get_list_length)
+# define enif_make_atom_len ERL_NIF_API_FUNC_MACRO(enif_make_atom_len)
+# define enif_make_existing_atom_len ERL_NIF_API_FUNC_MACRO(enif_make_existing_atom_len)
+# define enif_make_string_len ERL_NIF_API_FUNC_MACRO(enif_make_string_len)
+# define enif_alloc_env ERL_NIF_API_FUNC_MACRO(enif_alloc_env)
+# define enif_free_env ERL_NIF_API_FUNC_MACRO(enif_free_env)
+# define enif_clear_env ERL_NIF_API_FUNC_MACRO(enif_clear_env)
+# define enif_send ERL_NIF_API_FUNC_MACRO(enif_send)
+# define enif_make_copy ERL_NIF_API_FUNC_MACRO(enif_make_copy)
+# define enif_self ERL_NIF_API_FUNC_MACRO(enif_self)
+# define enif_get_local_pid ERL_NIF_API_FUNC_MACRO(enif_get_local_pid)
+# define enif_keep_resource ERL_NIF_API_FUNC_MACRO(enif_keep_resource)
+# define enif_make_resource_binary ERL_NIF_API_FUNC_MACRO(enif_make_resource_binary)
+#if SIZEOF_LONG != 8
+# define enif_get_int64 ERL_NIF_API_FUNC_MACRO(enif_get_int64)
+# define enif_get_uint64 ERL_NIF_API_FUNC_MACRO(enif_get_uint64)
+# define enif_make_int64 ERL_NIF_API_FUNC_MACRO(enif_make_int64)
+# define enif_make_uint64 ERL_NIF_API_FUNC_MACRO(enif_make_uint64)
+#endif
+
+# define enif_is_exception ERL_NIF_API_FUNC_MACRO(enif_is_exception)
+# define enif_make_reverse_list ERL_NIF_API_FUNC_MACRO(enif_make_reverse_list)
+# define enif_is_number ERL_NIF_API_FUNC_MACRO(enif_is_number)
+# define enif_dlopen ERL_NIF_API_FUNC_MACRO(enif_dlopen)
+# define enif_dlsym ERL_NIF_API_FUNC_MACRO(enif_dlsym)
+# define enif_consume_timeslice ERL_NIF_API_FUNC_MACRO(enif_consume_timeslice)
+
+/*
+** Add new entries here
+*/
+#endif
+
+
+#if defined(__GNUC__) && !(defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_))
+
+/* Inline functions for compile time type checking of arguments to
+ variadic functions.
+*/
+
+# define ERL_NIF_INLINE __inline__
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple1(ErlNifEnv* env,
+ ERL_NIF_TERM e1)
+{
+ return enif_make_tuple(env, 1, e1);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple2(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2)
+{
+ return enif_make_tuple(env, 2, e1, e2);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple3(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3)
+{
+ return enif_make_tuple(env, 3, e1, e2, e3);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple4(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4)
+{
+ return enif_make_tuple(env, 4, e1, e2, e3, e4);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple5(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4,
+ ERL_NIF_TERM e5)
+{
+ return enif_make_tuple(env, 5, e1, e2, e3, e4, e5);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple6(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4,
+ ERL_NIF_TERM e5,
+ ERL_NIF_TERM e6)
+{
+ return enif_make_tuple(env, 6, e1, e2, e3, e4, e5, e6);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple7(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4,
+ ERL_NIF_TERM e5,
+ ERL_NIF_TERM e6,
+ ERL_NIF_TERM e7)
+{
+ return enif_make_tuple(env, 7, e1, e2, e3, e4, e5, e6, e7);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple8(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4,
+ ERL_NIF_TERM e5,
+ ERL_NIF_TERM e6,
+ ERL_NIF_TERM e7,
+ ERL_NIF_TERM e8)
+{
+ return enif_make_tuple(env, 8, e1, e2, e3, e4, e5, e6, e7, e8);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple9(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4,
+ ERL_NIF_TERM e5,
+ ERL_NIF_TERM e6,
+ ERL_NIF_TERM e7,
+ ERL_NIF_TERM e8,
+ ERL_NIF_TERM e9)
+{
+ return enif_make_tuple(env, 9, e1, e2, e3, e4, e5, e6, e7, e8, e9);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list1(ErlNifEnv* env,
+ ERL_NIF_TERM e1)
+{
+ return enif_make_list(env, 1, e1);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list2(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2)
+{
+ return enif_make_list(env, 2, e1, e2);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list3(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3)
+{
+ return enif_make_list(env, 3, e1, e2, e3);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list4(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4)
+{
+ return enif_make_list(env, 4, e1, e2, e3, e4);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list5(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4,
+ ERL_NIF_TERM e5)
+{
+ return enif_make_list(env, 5, e1, e2, e3, e4, e5);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list6(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4,
+ ERL_NIF_TERM e5,
+ ERL_NIF_TERM e6)
+{
+ return enif_make_list(env, 6, e1, e2, e3, e4, e5, e6);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list7(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4,
+ ERL_NIF_TERM e5,
+ ERL_NIF_TERM e6,
+ ERL_NIF_TERM e7)
+{
+ return enif_make_list(env, 7, e1, e2, e3, e4, e5, e6, e7);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list8(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4,
+ ERL_NIF_TERM e5,
+ ERL_NIF_TERM e6,
+ ERL_NIF_TERM e7,
+ ERL_NIF_TERM e8)
+{
+ return enif_make_list(env, 8, e1, e2, e3, e4, e5, e6, e7, e8);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list9(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4,
+ ERL_NIF_TERM e5,
+ ERL_NIF_TERM e6,
+ ERL_NIF_TERM e7,
+ ERL_NIF_TERM e8,
+ ERL_NIF_TERM e9)
+{
+ return enif_make_list(env, 9, e1, e2, e3, e4, e5, e6, e7, e8, e9);
+}
+
+# undef ERL_NIF_INLINE
+
+#else /* fallback with macros */
+
+#ifndef enif_make_list1
+# define enif_make_list1(ENV,E1) enif_make_list(ENV,1,E1)
+# define enif_make_list2(ENV,E1,E2) enif_make_list(ENV,2,E1,E2)
+# define enif_make_list3(ENV,E1,E2,E3) enif_make_list(ENV,3,E1,E2,E3)
+# define enif_make_list4(ENV,E1,E2,E3,E4) enif_make_list(ENV,4,E1,E2,E3,E4)
+# define enif_make_list5(ENV,E1,E2,E3,E4,E5) enif_make_list(ENV,5,E1,E2,E3,E4,E5)
+# define enif_make_list6(ENV,E1,E2,E3,E4,E5,E6) enif_make_list(ENV,6,E1,E2,E3,E4,E5,E6)
+# define enif_make_list7(ENV,E1,E2,E3,E4,E5,E6,E7) enif_make_list(ENV,7,E1,E2,E3,E4,E5,E6,E7)
+# define enif_make_list8(ENV,E1,E2,E3,E4,E5,E6,E7,E8) enif_make_list(ENV,8,E1,E2,E3,E4,E5,E6,E7,E8)
+# define enif_make_list9(ENV,E1,E2,E3,E4,E5,E6,E7,E8,E9) enif_make_list(ENV,9,E1,E2,E3,E4,E5,E6,E7,E8,E9)
+# define enif_make_tuple1(ENV,E1) enif_make_tuple(ENV,1,E1)
+# define enif_make_tuple2(ENV,E1,E2) enif_make_tuple(ENV,2,E1,E2)
+# define enif_make_tuple3(ENV,E1,E2,E3) enif_make_tuple(ENV,3,E1,E2,E3)
+# define enif_make_tuple4(ENV,E1,E2,E3,E4) enif_make_tuple(ENV,4,E1,E2,E3,E4)
+# define enif_make_tuple5(ENV,E1,E2,E3,E4,E5) enif_make_tuple(ENV,5,E1,E2,E3,E4,E5)
+# define enif_make_tuple6(ENV,E1,E2,E3,E4,E5,E6) enif_make_tuple(ENV,6,E1,E2,E3,E4,E5,E6)
+# define enif_make_tuple7(ENV,E1,E2,E3,E4,E5,E6,E7) enif_make_tuple(ENV,7,E1,E2,E3,E4,E5,E6,E7)
+# define enif_make_tuple8(ENV,E1,E2,E3,E4,E5,E6,E7,E8) enif_make_tuple(ENV,8,E1,E2,E3,E4,E5,E6,E7,E8)
+# define enif_make_tuple9(ENV,E1,E2,E3,E4,E5,E6,E7,E8,E9) enif_make_tuple(ENV,9,E1,E2,E3,E4,E5,E6,E7,E8,E9)
+#endif
+
+#endif /* __GNUC__ && !WIN32 */
+
+#ifndef enif_make_pid
+
+# define enif_make_pid(ENV, PID) ((const ERL_NIF_TERM)((PID)->pid))
+
+#if SIZEOF_LONG == 8
+# define enif_get_int64 enif_get_long
+# define enif_get_uint64 enif_get_ulong
+# define enif_make_int64 enif_make_long
+# define enif_make_uint64 enif_make_ulong
+#endif
+
+#endif
+
diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.1.2_0.c b/erts/emulator/test/nif_SUITE_data/nif_mod.1.2_0.c
new file mode 100644
index 0000000000..a554cc7f25
--- /dev/null
+++ b/erts/emulator/test/nif_SUITE_data/nif_mod.1.2_0.c
@@ -0,0 +1,4 @@
+#include "nif_api_2_0/erl_nif.h"
+
+#define NIF_LIB_VER 1
+#include "nif_mod.c"
diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.1.2_4.c b/erts/emulator/test/nif_SUITE_data/nif_mod.1.2_4.c
new file mode 100644
index 0000000000..6d28dbb8ba
--- /dev/null
+++ b/erts/emulator/test/nif_SUITE_data/nif_mod.1.2_4.c
@@ -0,0 +1,4 @@
+#include "nif_api_2_4/erl_nif.h"
+
+#define NIF_LIB_VER 1
+#include "nif_mod.c"
diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.2.2_0.c b/erts/emulator/test/nif_SUITE_data/nif_mod.2.2_0.c
new file mode 100644
index 0000000000..0731e6b5d0
--- /dev/null
+++ b/erts/emulator/test/nif_SUITE_data/nif_mod.2.2_0.c
@@ -0,0 +1,4 @@
+#include "nif_api_2_0/erl_nif.h"
+
+#define NIF_LIB_VER 2
+#include "nif_mod.c"
diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.2.2_4.c b/erts/emulator/test/nif_SUITE_data/nif_mod.2.2_4.c
new file mode 100644
index 0000000000..628fd42b52
--- /dev/null
+++ b/erts/emulator/test/nif_SUITE_data/nif_mod.2.2_4.c
@@ -0,0 +1,4 @@
+#include "nif_api_2_4/erl_nif.h"
+
+#define NIF_LIB_VER 2
+#include "nif_mod.c"
diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.3.2_0.c b/erts/emulator/test/nif_SUITE_data/nif_mod.3.2_0.c
new file mode 100644
index 0000000000..d7e676b668
--- /dev/null
+++ b/erts/emulator/test/nif_SUITE_data/nif_mod.3.2_0.c
@@ -0,0 +1,4 @@
+#include "nif_api_2_0/erl_nif.h"
+
+#define NIF_LIB_VER 3
+#include "nif_mod.c"
diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.3.2_4.c b/erts/emulator/test/nif_SUITE_data/nif_mod.3.2_4.c
new file mode 100644
index 0000000000..bdbe8cf381
--- /dev/null
+++ b/erts/emulator/test/nif_SUITE_data/nif_mod.3.2_4.c
@@ -0,0 +1,4 @@
+#include "nif_api_2_4/erl_nif.h"
+
+#define NIF_LIB_VER 3
+#include "nif_mod.c"
diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.c b/erts/emulator/test/nif_SUITE_data/nif_mod.c
index 11b5d0cc35..885b8ebaf8 100644
--- a/erts/emulator/test/nif_SUITE_data/nif_mod.c
+++ b/erts/emulator/test/nif_SUITE_data/nif_mod.c
@@ -1,22 +1,23 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2009-2014. All Rights Reserved.
+ * Copyright Ericsson AB 2009-2017. 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/.
+ * 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
*
- * 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.
+ * 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 "erl_nif.h"
+#include <erl_nif.h>
#include <string.h>
#include <stdio.h>
@@ -175,6 +176,7 @@ static void do_load_info(ErlNifEnv* env, ERL_NIF_TERM load_info, int* retvalp)
CHECK(enif_is_empty_list(env, head));
}
+#if NIF_LIB_VER != 3
static int load(ErlNifEnv* env, void** priv, ERL_NIF_TERM load_info)
{
NifModPrivData* data;
@@ -229,6 +231,7 @@ static void unload(ErlNifEnv* env, void* priv)
add_call(env, data, "unload");
NifModPrivData_release(data);
}
+#endif /* NIF_LIB_VER != 3 */
static ERL_NIF_TERM lib_version(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
@@ -236,10 +239,22 @@ static ERL_NIF_TERM lib_version(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg
return enif_make_int(env, NIF_LIB_VER);
}
+static ERL_NIF_TERM nif_api_version(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ /*ADD_CALL("nif_api_version");*/
+ return enif_make_tuple2(env,
+ enif_make_int(env, ERL_NIF_MAJOR_VERSION),
+ enif_make_int(env, ERL_NIF_MINOR_VERSION));
+}
+
static ERL_NIF_TERM get_priv_data_ptr(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
+ NifModPrivData** bin_data;
+ ERL_NIF_TERM res;
ADD_CALL("get_priv_data_ptr");
- return enif_make_ulong(env, (unsigned long)priv_data(env));
+ bin_data = (NifModPrivData**)enif_make_new_binary(env, sizeof(void*), &res);
+ *bin_data = priv_data(env);
+ return res;
}
static ERL_NIF_TERM make_new_resource(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
@@ -278,6 +293,7 @@ static ERL_NIF_TERM get_resource(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar
static ErlNifFunc nif_funcs[] =
{
{"lib_version", 0, lib_version},
+ {"nif_api_version", 0, nif_api_version},
{"get_priv_data_ptr", 0, get_priv_data_ptr},
{"make_new_resource", 2, make_new_resource},
{"get_resource", 2, get_resource}
diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.erl b/erts/emulator/test/nif_SUITE_data/nif_mod.erl
index 6634624698..8019cfcf82 100644
--- a/erts/emulator/test/nif_SUITE_data/nif_mod.erl
+++ b/erts/emulator/test/nif_SUITE_data/nif_mod.erl
@@ -1,44 +1,66 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2005-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2005-2016. 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.
+%% 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(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,
+-export([load_nif_lib/2, load_nif_lib/3, start/0, lib_version/0,
get_priv_data_ptr/0, make_new_resource/2, get_resource/2]).
-export([loop/0, upgrade/1]).
-define(nif_stub,nif_stub_error(?LINE)).
+-ifdef(USE_ON_LOAD).
+-on_load(on_load/0).
+
+on_load() ->
+ [{data_dir, Path}] = ets:lookup(nif_SUITE, data_dir),
+ [{lib_version, Ver}] = ets:lookup(nif_SUITE, lib_version),
+ [{nif_api_version, API}] = ets:lookup(nif_SUITE, nif_api_version),
+ R = erlang:load_nif(filename:join(Path,libname(Ver,API)), []),
+ check_api_version(R, API).
+
+-endif.
+
+check_api_version(Err, _) when Err =/= ok -> Err;
+check_api_version(ok, []) -> ok;
+check_api_version(ok, [$., MajC, $_ | MinS]) ->
+ {Maj, Min} = {list_to_integer([MajC]), list_to_integer(MinS)},
+ {Maj, Min} = nif_api_version(),
+ ok.
+
load_nif_lib(Config, Ver) ->
load_nif_lib(Config, Ver, []).
load_nif_lib(Config, Ver, LoadInfo) ->
- ?line Path = ?config(data_dir, Config),
- erlang:load_nif(filename:join(Path,libname(Ver)), LoadInfo).
-
-libname(no_init) -> libname(3);
-libname(Ver) when is_integer(Ver) ->
- "nif_mod." ++ integer_to_list(Ver).
+ Path = proplists:get_value(data_dir, Config),
+ API = proplists:get_value(nif_api_version, Config, ""),
+ R = erlang:load_nif(filename:join(Path,libname(Ver,API)), LoadInfo),
+ check_api_version(R, API).
+libname(no_init,API) -> libname(3,API);
+libname(Ver,API) when is_integer(Ver) ->
+ "nif_mod." ++ integer_to_list(Ver) ++ API.
+
start() ->
spawn_opt(?MODULE,loop,[],
[link, monitor]).
@@ -61,7 +83,9 @@ upgrade(Pid) ->
lib_version() -> % NIF
undefined.
-call_history() -> ?nif_stub.
+nif_api_version() -> %NIF
+ {undefined,undefined}.
+
get_priv_data_ptr() -> ?nif_stub.
make_new_resource(_,_) -> ?nif_stub.
get_resource(_,_) -> ?nif_stub.
diff --git a/erts/emulator/test/nif_SUITE_data/testcase_driver.h b/erts/emulator/test/nif_SUITE_data/testcase_driver.h
index 98339e4746..feb10ecaea 100644
--- a/erts/emulator/test/nif_SUITE_data/testcase_driver.h
+++ b/erts/emulator/test/nif_SUITE_data/testcase_driver.h
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
@@ -19,7 +20,7 @@
#ifndef TESTCASE_DRIVER_H__
#define TESTCASE_DRIVER_H__
-#include "erl_nif.h"
+#include <erl_nif.h>
#include <stdlib.h>
#include <stdio.h>
diff --git a/erts/emulator/test/nif_SUITE_data/tester.c b/erts/emulator/test/nif_SUITE_data/tester.c
index 257b116322..ea4afd924d 100644
--- a/erts/emulator/test/nif_SUITE_data/tester.c
+++ b/erts/emulator/test/nif_SUITE_data/tester.c
@@ -1,4 +1,4 @@
-#include "erl_nif.h"
+#include <erl_nif.h>
#include <stdio.h>
#include <stdarg.h>
@@ -53,7 +53,7 @@ void testcase_free(void *ptr)
void testcase_run(TestCaseState_t *tcs);
-static int reload(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info)
+static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info)
{
return 0;
}
@@ -70,5 +70,5 @@ static ErlNifFunc nif_funcs[] =
{"run", 0, run}
};
-ERL_NIF_INIT(tester,nif_funcs,NULL,reload,NULL,NULL)
+ERL_NIF_INIT(tester,nif_funcs,NULL,NULL,upgrade,NULL)
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 3f9b339ed2..8e9e3cb05a 100644
--- a/erts/emulator/test/node_container_SUITE.erl
+++ b/erts/emulator/test/node_container_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2002-2017. 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.
+%% 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%
%%
@@ -27,84 +28,70 @@
-module(node_container_SUITE).
-author('[email protected]').
-%-define(line_trace, 1).
+-include_lib("common_test/include/ct.hrl").
--include_lib("test_server/include/test_server.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,
+ pid_wrap/1,
+ port_wrap/1,
+ bad_nc/1,
+ unique_pid/1,
+ iter_max_procs/1,
+ magic_ref/1]).
+
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 12}}].
+
all() ->
[term_to_binary_to_term_eq, round_trip_eq, cmp, ref_eq,
node_table_gc, dist_link_refc, dist_monitor_refc,
node_controller_refc, ets_refc, match_spec_refc,
- timer_refc, otp_4715, pid_wrap, port_wrap, bad_nc,
- unique_pid, iter_max_procs].
-
-groups() ->
- [].
+ timer_refc, pid_wrap, port_wrap, bad_nc,
+ unique_pid, iter_max_procs, magic_ref].
init_per_suite(Config) ->
Config.
end_per_suite(_Config) ->
+ erts_debug:set_internal_state(available_internal_state, true),
+ 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.
%%%
@@ -116,111 +103,108 @@ 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]),
+ ttbtteq_do_remote({get_nodename(), 3}),
+ ttbtteq_do_remote({get_nodename(), 4}),
+ ttbtteq_do_remote({get_nodename(), 16#adec0ded}),
+ nc_refc_check(node()),
+ ok.
+
+ttbtteq_do_remote(RNode) ->
+ 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)),
+ 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 between 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 ---------------------------------------------------
@@ -231,103 +215,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 ----------------------------------------------------
%%
@@ -335,13 +319,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 ---------------------------------------------------
%%
@@ -353,12 +337,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):
@@ -370,96 +354,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) ->
- ?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()),
- ?line ok.
+ erts_debug:set_internal_state(available_internal_state, true),
+ erts_debug:set_internal_state(node_tab_delayed_delete, 0),
+ 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
+ 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) ->
@@ -469,289 +453,245 @@ 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) ->
- ?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),
+ erts_debug:set_internal_state(available_internal_state, true),
+ erts_debug:set_internal_state(node_tab_delayed_delete, 0),
+ 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()),
- ?line ok.
+ 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
+ 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) -> [];
-otp_4715(Config) when is_list(Config) ->
- case ?t: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)
- 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).
+ 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.
-pid_wrap(doc) -> [];
-pid_wrap(suite) -> [];
-pid_wrap(Config) when is_list(Config) -> ?line pp_wrap(pid).
+pid_wrap(Config) when is_list(Config) -> pp_wrap(pid).
-port_wrap(doc) -> [];
-port_wrap(suite) -> [];
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 os:type() of
+ {unix, _} ->
+ pp_wrap(port);
+ _ ->
+ {skip, "Only run on unix"}
+ end.
get_next_id(pid) ->
erts_debug:get_internal_state(next_pid);
@@ -764,173 +704,202 @@ 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, bad_creation},
+ {'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),
+ Cmt = io_lib:format("max processes = ~p; "
+ "process line length = ~p",
+ [element(2, Res), element(1, Res)]),
+ {comment, lists:flatten(Cmt)}.
+
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.
+magic_ref(Config) when is_list(Config) ->
+ {MRef0, Addr0} = erts_debug:set_internal_state(make, magic_ref),
+ true = is_reference(MRef0),
+ {Addr0, 1, true} = erts_debug:get_internal_state({magic_ref,MRef0}),
+ MRef1 = binary_to_term(term_to_binary(MRef0)),
+ {Addr0, 2, true} = erts_debug:get_internal_state({magic_ref,MRef1}),
+ MRef0 = MRef1,
+ Me = self(),
+ {Pid, Mon} = spawn_opt(fun () ->
+ receive
+ {Me, MRef} ->
+ Me ! {self(), erts_debug:get_internal_state({magic_ref,MRef})}
+ end
+ end,
+ [link, monitor]),
+ Pid ! {self(), MRef0},
+ receive
+ {Pid, Info} ->
+ {Addr0, 3, true} = Info
+ end,
+ receive
+ {'DOWN', Mon, process, Pid, _} ->
+ ok
+ end,
+ {Addr0, 2, true} = erts_debug:get_internal_state({magic_ref,MRef0}),
+ id(MRef0),
+ id(MRef1),
+ MRefExt = term_to_binary(erts_debug:set_internal_state(make, magic_ref)),
+ garbage_collect(),
+ {MRef2, _Addr2} = binary_to_term(MRefExt),
+ true = is_reference(MRef2),
+ true = erts_debug:get_internal_state({magic_ref,MRef2}),
+ ok.
%%
%% -- Internal utils ---------------------------------------------------------
%%
+id(X) ->
+ X.
+
-define(ND_REFS, erts_debug:get_internal_state(node_and_dist_references)).
node_container_refc_check(Node) when is_atom(Node) ->
@@ -941,116 +910,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}) ->
- FoundRefs =
- lists:foldl(
- fun ({_Referrer, ReferencesList}, A1) ->
- A1 + lists:foldl(fun ({_T,Rs},A2) ->
- A2+Rs
- end,
- 0,
- ReferencesList)
- end,
- 0,
- ReferrerList),
-
- %% Reference count equals found references ?
- case Refc =:= FoundRefs of
- true ->
- ok;
- false ->
- 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} -> 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) ->
@@ -1062,7 +1041,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);
@@ -1075,34 +1054,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())).
@@ -1113,33 +1092,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(second))
+ ++ "-"
+ ++ integer_to_list(erlang:unique_integer([positive])).
get_nodefirstname() ->
- {A, B, C} = now(),
- list_to_atom(atom_to_list(?MODULE)
- ++ "-"
- ++ integer_to_list(A)
- ++ "-"
- ++ integer_to_list(B)
- ++ "-"
- ++ integer_to_list(C)).
+ list_to_atom(get_nodefirstname_string()).
get_nodename() ->
- {A, B, C} = now(),
- list_to_atom(atom_to_list(?MODULE)
- ++ "-"
- ++ integer_to_list(A)
- ++ "-"
- ++ integer_to_list(B)
- ++ "-"
- ++ integer_to_list(C)
- ++ "@"
- ++ hostname()).
-
+ list_to_atom(get_nodefirstname_string()
+ ++ "@"
+ ++ hostname()).
+
-define(VERSION_MAGIC, 131).
@@ -1149,6 +1120,9 @@ get_nodename() ->
-define(PORT_EXT, 102).
-define(PID_EXT, 103).
-define(NEW_REFERENCE_EXT, 114).
+-define(NEW_PID_EXT, $X).
+-define(NEW_PORT_EXT, $Y).
+-define(NEWER_REFERENCE_EXT, $Z).
uint32_be(Uint) when is_integer(Uint), 0 =< Uint, Uint < 1 bsl 32 ->
[(Uint bsr 24) band 16#ff,
@@ -1171,18 +1145,25 @@ uint8(Uint) ->
exit({badarg, uint8, [Uint]}).
+pid_tag(bad_creation) -> ?PID_EXT;
+pid_tag(Creation) when Creation =< 3 -> ?PID_EXT;
+pid_tag(_Creation) -> ?NEW_PID_EXT.
+
+enc_creation(bad_creation) -> uint8(4);
+enc_creation(Creation) when Creation =< 3 -> uint8(Creation);
+enc_creation(Creation) -> uint32_be(Creation).
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_tag(Creation),
+ ?ATOM_EXT,
+ uint16_be(length(NodeName)),
+ NodeName,
+ uint32_be(Number),
+ uint32_be(Serial),
+ enc_creation(Creation)])) of
Pid when is_pid(Pid) ->
Pid;
{'EXIT', {badarg, _}} ->
@@ -1191,16 +1172,20 @@ mk_pid({NodeName, Creation}, Number, Serial) ->
exit({unexpected_binary_to_term_result, Other})
end.
+port_tag(bad_creation) -> ?PORT_EXT;
+port_tag(Creation) when Creation =< 3 -> ?PORT_EXT;
+port_tag(_Creation) -> ?NEW_PORT_EXT.
+
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,
+ port_tag(Creation),
?ATOM_EXT,
uint16_be(length(NodeName)),
NodeName,
uint32_be(Number),
- uint8(Creation)])) of
+ enc_creation(Creation)])) of
Port when is_port(Port) ->
Port;
{'EXIT', {badarg, _}} ->
@@ -1209,37 +1194,39 @@ mk_port({NodeName, Creation}, Number) ->
exit({unexpected_binary_to_term_result, Other})
end.
+ref_tag(bad_creation) -> ?NEW_REFERENCE_EXT;
+ref_tag(Creation) when Creation =< 3 -> ?NEW_REFERENCE_EXT;
+ref_tag(_Creation) -> ?NEWER_REFERENCE_EXT.
+
mk_ref({NodeName, Creation}, Numbers) when is_atom(NodeName),
- 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),
+ Creation =< 3,
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) ->
case catch binary_to_term(list_to_binary([?VERSION_MAGIC,
- ?NEW_REFERENCE_EXT,
+ ref_tag(Creation),
uint16_be(length(Numbers)),
?ATOM_EXT,
uint16_be(length(NodeName)),
NodeName,
- uint8(Creation),
+ enc_creation(Creation),
lists:map(fun (N) ->
uint32_be(N)
end,
@@ -1254,10 +1241,10 @@ mk_ref({NodeName, Creation}, Numbers) when is_list(NodeName),
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().
@@ -1273,6 +1260,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 57eec87e63..8b1519ae36 100644
--- a/erts/emulator/test/nofrag_SUITE.erl
+++ b/erts/emulator/test/nofrag_SUITE.erl
@@ -1,75 +1,52 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2016. 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.
+%% 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(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) ->
@@ -104,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, _) ->
@@ -144,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, _) ->
@@ -178,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) ->
@@ -201,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 ff8d18eef8..1c76eb8019 100644
--- a/erts/emulator/test/num_bif_SUITE.erl
+++ b/erts/emulator/test/num_bif_SUITE.erl
@@ -1,25 +1,26 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2013. 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.
-%%
+%%
+%% Copyright Ericsson AB 1997-2017. 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(num_bif_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% Tests the BIFs:
%% abs/1
@@ -31,26 +32,28 @@
%% list_to_integer/1
%% round/1
%% trunc/1
+%% floor/1
+%% ceil/1
%% integer_to_binary/1
%% 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
+ t_round/1, t_trunc_and_friends/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_and_friends, t_list_to_integer_edge_cases].
-groups() ->
+groups() ->
[{t_string_to_float, [],
[t_string_to_float_safe, t_string_to_float_risky]}].
@@ -72,7 +75,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)),
@@ -92,7 +95,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)),
@@ -105,10 +108,10 @@ t_float(Config) when is_list(Config) ->
4294967305.0 = float(id(4294967305)),
-4294967305.0 = float(id(-4294967305)),
- %% Extremly big bignums.
+ %% Extremely big bignums.
Big = id(list_to_integer(id(lists:duplicate(2000, $1)))),
{'EXIT', {badarg, _}} = (catch float(Big)),
-
+
ok.
@@ -182,7 +185,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),
@@ -254,7 +257,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,
@@ -292,32 +295,83 @@ t_round(Config) when is_list(Config) ->
4294967297 = round(id(4294967296.9)),
-4294967296 = -round(id(4294967296.1)),
-4294967297 = -round(id(4294967296.9)),
+
+ 6209607916799025 = round(id(6209607916799025.0)),
+ -6209607916799025 = round(id(-6209607916799025.0)),
ok.
-t_trunc(Config) when is_list(Config) ->
- 0 = trunc(id(0.0)),
- 5 = trunc(id(5.3333)),
- -10 = trunc(id(-10.978987)),
+%% Test trunc/1, floor/1, ceil/1, and round/1.
+t_trunc_and_friends(_Config) ->
+ MinusZero = 0.0 / (-1.0),
+ 0 = trunc_and_friends(MinusZero),
+ 0 = trunc_and_friends(0.0),
+ 5 = trunc_and_friends(5.3333),
+ -10 = trunc_and_friends(-10.978987),
- % The largest smallnum, converted to float (OTP-3722):
+ %% The largest smallnum, converted to float (OTP-3722):
X = id((1 bsl 27) - 1),
- F = id(X + 0.0),
+ F = X + 0.0,
io:format("X = ~p/~w/~w, F = ~p/~w/~w, trunc(F) = ~p/~w/~w~n",
[X, X, binary_to_list(term_to_binary(X)),
F, F, binary_to_list(term_to_binary(F)),
- trunc(F), trunc(F), binary_to_list(term_to_binary(trunc(F)))]),
- X = trunc(F),
- X = trunc(F+1)-1,
- X = trunc(F-1)+1,
- X = -trunc(-F),
- X = -trunc(-F-1)-1,
- X = -trunc(-F+1)+1,
+ trunc_and_friends(F),
+ trunc_and_friends(F),
+ binary_to_list(term_to_binary(trunc_and_friends(F)))]),
+ X = trunc_and_friends(F),
+ X = trunc_and_friends(F+1)-1,
+ X = trunc_and_friends(F-1)+1,
+ X = -trunc_and_friends(-F),
+ X = -trunc_and_friends(-F-1)-1,
+ X = -trunc_and_friends(-F+1)+1,
%% Bignums.
- 4294967305 = trunc(id(4294967305.7)),
- -4294967305 = trunc(id(-4294967305.7)),
+ 4294967305 = trunc_and_friends(4294967305.7),
+ -4294967305 = trunc_and_friends(-4294967305.7),
+ 18446744073709551616 = trunc_and_friends(float(1 bsl 64)),
+ -18446744073709551616 = trunc_and_friends(-float(1 bsl 64)),
+
+ %% Random.
+ t_trunc_and_friends_rand(100),
ok.
+t_trunc_and_friends_rand(0) ->
+ ok;
+t_trunc_and_friends_rand(N) ->
+ F0 = rand:uniform() * math:pow(10, 50*rand:normal()),
+ F = case rand:uniform() of
+ U when U < 0.5 -> -F0;
+ _ -> F0
+ end,
+ _ = trunc_and_friends(F),
+ t_trunc_and_friends_rand(N-1).
+
+trunc_and_friends(F) ->
+ Trunc = trunc(F),
+ Floor = floor(F),
+ Ceil = ceil(F),
+ Round = round(F),
+
+ Trunc = trunc(Trunc),
+ Floor = floor(Floor),
+ Ceil = ceil(Ceil),
+ Round = round(Round),
+
+ Trunc = trunc(float(Trunc)),
+ Floor = floor(float(Floor)),
+ Ceil = ceil(float(Ceil)),
+ Round = round(float(Round)),
+
+ true = Floor =< Trunc andalso Trunc =< Ceil,
+ true = Ceil - Floor =< 1,
+ true = Round =:= Floor orelse Round =:= Ceil,
+
+ if
+ F < 0 ->
+ Trunc = Ceil;
+ true ->
+ Trunc = Floor
+ end,
+ Trunc.
%% Tests integer_to_binary/1.
@@ -344,9 +398,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]]]),
@@ -394,18 +448,15 @@ t_string_to_integer(Config) when is_list(Config) ->
test_sti(268435455),
test_sti(-268435455),
- %% 1 bsl 28 - 1, just before 32 bit bignum
- test_sti(1 bsl 28 - 1),
- %% 1 bsl 28, just beyond 32 bit small
- test_sti(1 bsl 28),
- %% 1 bsl 33, just beyond 32 bit
- test_sti(1 bsl 33),
- %% 1 bsl 60 - 1, just before 64 bit bignum
- test_sti(1 bsl 60 - 1),
- %% 1 bsl 60, just beyond 64 bit small
- test_sti(1 bsl 60),
- %% 1 bsl 65, just beyond 64 bit
- test_sti(1 bsl 65),
+ % Interesting values around 2-pows, such as MIN_SMALL and MAX_SMALL.
+ lists:foreach(fun(Bits) ->
+ N = 1 bsl Bits,
+ test_sti(N - 1),
+ test_sti(N),
+ test_sti(N + 1)
+ end,
+ lists:seq(16, 130)),
+
%% Bignums.
test_sti(123456932798748738738,16),
test_sti(list_to_integer(lists:duplicate(2000, $1))),
@@ -418,46 +469,102 @@ 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",""]),
-
+ 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},
{"1z111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111",16},
{"111z11111111",16}]),
-
+
+ %% log2 calculation overflow bug in do_integer_to_list (OTP-12624)
+ %% Would crash with segv
+ 0 = list_to_integer(lists:duplicate(10000000,$0)),
+
+ 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) ->
- Num = list_to_integer(int2list(Num,Base),Base),
- Num = -1*list_to_integer(int2list(Num*-1,Base),Base),
- Num = binary_to_integer(int2bin(Num,Base),Base),
- Num = -1*binary_to_integer(int2bin(Num*-1,Base),Base).
+ Neg = -Num,
+ Num = list_to_integer(int2list(Num,Base),Base),
+ Neg = list_to_integer(int2list(Num*-1,Base),Base),
+ Num = binary_to_integer(int2bin(Num,Base),Base),
+ Neg = binary_to_integer(int2bin(Num*-1,Base),Base).
% Calling this function (which is not supposed to be inlined) prevents
% the compiler from calculating the answer, so we don't test the compiler
diff --git a/erts/emulator/test/old_mod.erl b/erts/emulator/test/old_mod.erl
deleted file mode 100644
index 124842390a..0000000000
--- a/erts/emulator/test/old_mod.erl
+++ /dev/null
@@ -1,47 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2003-2010. 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%
-%%
-
--module(old_mod).
--compile(r10).
-
--export([sort_on_old_node/1, sorter/3]).
-
--include("test_server.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.
diff --git a/erts/emulator/test/old_scheduler_SUITE.erl b/erts/emulator/test/old_scheduler_SUITE.erl
deleted file mode 100644
index 262536a068..0000000000
--- a/erts/emulator/test/old_scheduler_SUITE.erl
+++ /dev/null
@@ -1,414 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2004-2011. 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%
-%%
-
--module(old_scheduler_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,
- 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]}].
-
-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]
- 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
-%%
-%% The test case function spawns two controlling processes: Starter and Receiver.
-%% Starter spawns a number of prio A and a number of prio B test processes. Each
-%% test process loops for a number of times, sends a report to the Receiver, then
-%% loops again. For each report, the Receiver increases a counter that corresponds
-%% to the priority of the sender. After a certain amount of time, the Receiver
-%% sends the collected data to the main test process and waits for the test case
-%% to terminate. From this data, it's possible to calculate the average run time
-%% relationship between the prio A and B test processes.
-%%
-%% Note that in order to be able to run tests with high or max prio test processes,
-%% the main test process and the Receiver needs to run at max prio, or they will
-%% be starved by the test processes. The controlling processes must not wait for
-%% messages from a normal (or low) prio process while max or high prio test processes
-%% are running (which happens e.g. if an io function is called).
-%%-----------------------------------------------------------------------------------
-
-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].
-
-end_per_testcase(_Case, Config) ->
- erlang:system_flag(multi_scheduling, unblock),
- Dog=?config(watchdog, Config),
- Prio=?config(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
- end.
-
-%% Run equal number of low and normal prio processes.
-
-equal(suite) -> [];
-equal(doc) -> [];
-equal(Config) when is_list(Config) ->
- ?line Self = self(),
-
- %% specify number of test processes to run
- Normal = {normal,500},
- Low = {low,500},
-
- %% specify time of test (in seconds)
- Time = 30,
-
- %% start controllers
- ?line Receiver =
- spawn(fun() -> receiver(now(), Time, Self, Normal, Low) end),
- ?line Starter =
- spawn(fun() -> starter(Normal, Low, Receiver) end),
-
- %% receive test data from Receiver
- ?line {NRs,NAvg,LRs,LAvg,Ratio} =
- receive
- {Receiver,Res} -> Res
- end,
-
- %% stop controllers and test processes
- ?line exit(Starter, kill),
- ?line exit(Receiver, kill),
-
- io:format("Reports: ~w normal (~w/proc), ~w low (~w/proc). Ratio: ~w~n",
- [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});
- true ->
- 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(),
- Normal = {normal,1},
- Low = {low,1000},
-
- %% specify time of test (in seconds)
- Time = 30,
-
- ?line Receiver =
- spawn(fun() -> receiver(now(), 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),
- io:format("Reports: ~w normal (~w/proc), ~w low (~w/proc). Ratio: ~w~n",
- [NRs,NAvg,LRs,LAvg,Ratio]),
- if Ratio < 7.5 ; Ratio > 8.5 ->
- ?t:fail({bad_ratio,Ratio});
- true ->
- 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(),
- Normal = {normal,1000},
- Low = {low,1},
-
- %% specify time of test (in seconds)
- Time = 30,
-
- ?line Receiver =
- spawn(fun() -> receiver(now(), 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),
- io:format("Reports: ~w normal (~w/proc), ~w low (~w/proc). Ratio: ~w~n",
- [NRs,NAvg,LRs,LAvg,Ratio]),
- if Ratio < 7.0 ; Ratio > 8.5 ->
- ?t:fail({bad_ratio,Ratio});
- true ->
- 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(),
- Max = {max,2},
- High = {high,2},
- Normal = {normal,100},
- Low = {low,100},
-
- %% specify time of test (in seconds)
- Time = 30,
-
- ?line Receiver1 =
- spawn(fun() -> receiver(now(), 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),
- io:format("Reports: ~w max (~w/proc), ~w high (~w/proc). Ratio: ~w~n",
- [M1Rs,M1Avg,HRs,HAvg,Ratio1]),
- if Ratio1 < 1.0 ->
- ?t:fail({bad_ratio,Ratio1});
- true ->
- ok(Config)
- end,
-
- ?line Receiver2 =
- spawn(fun() -> receiver(now(), 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),
- io:format("Reports: ~w max (~w/proc), ~w normal (~w/proc). Ratio: ~w~n",
- [M2Rs,M2Avg,NRs,NAvg,Ratio2]),
- if Ratio2 < 1.0 ->
- ?t:fail({bad_ratio,Ratio2});
- true ->
- ok
- end,
-
- ?line Receiver3 =
- spawn(fun() -> receiver(now(), 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),
- io:format("Reports: ~w max (~w/proc), ~w low (~w/proc). Ratio: ~w~n",
- [M3Rs,M3Avg,LRs,LAvg,Ratio3]),
- if Ratio3 < 1.0 ->
- ?t:fail({bad_ratio,Ratio3});
- true ->
- 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(),
- High = {high,2},
- Normal = {normal,100},
- Low = {low,100},
-
- %% specify time of test (in seconds)
- Time = 30,
-
- ?line Receiver1 =
- spawn(fun() -> receiver(now(), 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),
- io:format("Reports: ~w high (~w/proc), ~w normal (~w/proc). Ratio: ~w~n",
- [H1Rs,H1Avg,NRs,NAvg,Ratio1]),
- if Ratio1 < 1.0 ->
- ?t:fail({bad_ratio,Ratio1});
- true ->
- ok
- end,
-
- ?line Receiver2 =
- spawn(fun() -> receiver(now(), 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),
- io:format("Reports: ~w high (~w/proc), ~w low (~w/proc). Ratio: ~w~n",
- [H2Rs,H2Avg,LRs,LAvg,Ratio2]),
- if Ratio2 < 1.0 ->
- ?t:fail({bad_ratio,Ratio2});
- true ->
- ok(Config)
- end.
-
-
-%%-----------------------------------------------------------------------------------
-%% Controller processes and help functions
-%%-----------------------------------------------------------------------------------
-
-receiver(T0, TimeSec, Main, {P1,P1N}, {P2,P2N}) ->
- %% prio should be max so that mailbox doesn't overflow
- process_flag(priority, max),
- receiver(T0, TimeSec*1000, Main, P1,P1N,0, P2,P2N,0, 100000).
-
-%% uncomment lines below to get life sign (debug)
-receiver(T0, Time, Main, P1,P1N,P1Rs, P2,P2N,P2Rs, 0) ->
-% T = elapsed_ms(T0, now()),
-% 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 - elapsed_ms(T0, now()), % test time remaining
- Remain1 = if Remain < 0 ->
- 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,
- if Remain > 0 -> % keep going
- 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()
- end.
-
-starter({P1,P1N}, {P2,P2N}, Receiver) ->
- %% start N1 processes with prio P1
- start_p(P1, P1N, Receiver),
- %% start N2 processes with prio P2
- start_p(P2, P2N, Receiver),
- erlang:display({started,P1N+P2N}),
- flush_loop().
-
-start_p(_, 0, _) ->
- ok;
-start_p(Prio, N, Receiver) ->
- spawn_link(fun() -> p(Prio, Receiver) end),
- start_p(Prio, N-1, Receiver).
-
-p(Prio, Receiver) ->
- %% set process priority
- process_flag(priority, Prio),
- p_loop(0, Prio, Receiver).
-
-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
- end,
- %% send report
- Receiver ! {self(),Prio},
- p_loop(0, Prio, Receiver);
-
-p_loop(N, Prio, Receiver) ->
- p_loop(N+1, Prio, Receiver).
-
-
-flush_loop() ->
- receive _ ->
- ok
- end,
- flush_loop().
-
-elapsed_ms({_MS0,S0,MuS0},{_MS1,S1,MuS1}) ->
- round(((S1-S0)*1000)+((MuS1-MuS0)/1000)).
diff --git a/erts/emulator/test/op_SUITE.erl b/erts/emulator/test/op_SUITE.erl
index ef4689b850..08655d32a5 100644
--- a/erts/emulator/test/op_SUITE.erl
+++ b/erts/emulator/test/op_SUITE.erl
@@ -1,86 +1,70 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2011. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2016. 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.
+%% 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(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, 5}}].
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),
- {comment,integer_to_list(length(Cases)) ++ " cases"}.
+ %% Try to use less memory by splitting the cases
+
+ Cases1 = [{Op,X,Y} || Op <- ['bsl'], X <- Vs, Y <- Vs],
+ N1 = length(Cases1),
+ run_test_module(Cases1, false),
-logical(doc) -> "Test the logical operators and internal BIFs.";
+ Cases2 = [{Op,X,Y} || Op <- ['bsr'], X <- Vs, Y <- Vs],
+ N2 = length(Cases2),
+ run_test_module(Cases2, false),
+ {comment,integer_to_list(N1 + N2) ++ " cases"}.
+
+%% 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,
@@ -89,51 +73,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),
@@ -144,8 +129,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.
@@ -153,48 +138,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};
@@ -217,81 +202,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'}]}]},
- ?line Module = make_module(op_tests, [Fun1,Fun2,Fun3,Id]),
- ?line lists:foreach(fun(F) -> io:put_chars([erl_pp:form(F),"\n"]) end, Module),
+ 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),
+ 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.
@@ -315,19 +300,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),
@@ -353,8 +338,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},
@@ -364,15 +349,18 @@ make_module(Name, Funcs) ->
make_function(Name, Body) ->
{function,1,Name,0,[{clause,1,[],[],Body}]}.
-
-eval(E) ->
- ?line case catch erl_eval:exprs(E, []) of
- {'EXIT',Reason} -> {'EXIT',Reason};
- {value,Val,_Bs} -> Val
- end.
-
-unvalue(V) -> erl_parse:abstract(V).
-
+
+eval(E0) ->
+ E = erl_parse:new_anno(E0),
+ 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/os_signal_SUITE.erl b/erts/emulator/test/os_signal_SUITE.erl
new file mode 100644
index 0000000000..6bafb0e18c
--- /dev/null
+++ b/erts/emulator/test/os_signal_SUITE.erl
@@ -0,0 +1,357 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. 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%
+%%
+
+%%
+%% File: os_signal_SUITE.erl
+%% Author: Björn-Egil Dahlberg
+%% Created: 2017-01-13
+%%
+
+-module(os_signal_SUITE).
+
+-include_lib("common_test/include/ct.hrl").
+-export([all/0, suite/0]).
+-export([init_per_testcase/2, end_per_testcase/2]).
+-export([init_per_suite/1, end_per_suite/1]).
+
+-export([set_alarm/1, fork/0, get_exit_code/1]).
+
+% Test cases
+-export([set_unset/1,
+ t_sighup/1,
+ t_sigusr1/1,
+ t_sigusr2/1,
+ t_sigterm/1,
+ t_sigalrm/1,
+ t_sigchld/1,
+ t_sigchld_fork/1]).
+
+-define(signal_server, erl_signal_server).
+
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 2}}].
+
+all() ->
+ case os:type() of
+ {win32, _} -> [];
+ _ -> [set_unset,
+ t_sighup,
+ t_sigusr1,
+ t_sigusr2,
+ t_sigterm,
+ t_sigalrm,
+ t_sigchld,
+ t_sigchld_fork]
+ end.
+
+init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
+ Pid = erlang:whereis(?signal_server),
+ true = erlang:unregister(?signal_server),
+ [{signal_server, Pid}|Config].
+
+end_per_testcase(_Func, Config) ->
+ case proplists:get_value(signal_server, Config) of
+ undefined -> ok;
+ Pid ->
+ true = erlang:register(?signal_server, Pid),
+ ok
+ end.
+
+init_per_suite(Config) ->
+ load_nif(Config),
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+%% tests
+
+set_unset(_Config) ->
+ Signals = [sighup, %sigint,
+ sigquit, %sigill,
+ sigabrt,
+ sigalrm, sigterm,
+ sigusr1, sigusr2,
+ sigchld,
+ sigstop, sigtstp],
+ F1 = fun(Sig) -> ok = os:set_signal(Sig,handle) end,
+ F2 = fun(Sig) -> ok = os:set_signal(Sig,default) end,
+ F3 = fun(Sig) -> ok = os:set_signal(Sig,ignore) end,
+ %% set handle
+ ok = lists:foreach(F1, Signals),
+ %% set ignore
+ ok = lists:foreach(F2, Signals),
+ %% set default
+ ok = lists:foreach(F3, Signals),
+ ok.
+
+t_sighup(_Config) ->
+ Pid1 = setup_service(),
+ OsPid = os:getpid(),
+ os:set_signal(sighup, handle),
+ ok = kill("HUP", OsPid),
+ ok = kill("HUP", OsPid),
+ ok = kill("HUP", OsPid),
+ Msgs1 = fetch_msgs(Pid1),
+ io:format("Msgs1: ~p~n", [Msgs1]),
+ [{notify,sighup},
+ {notify,sighup},
+ {notify,sighup}] = Msgs1,
+ %% no proc
+ ok = kill("HUP", OsPid),
+ ok = kill("HUP", OsPid),
+ ok = kill("HUP", OsPid),
+ %% ignore
+ Pid2 = setup_service(),
+ os:set_signal(sighup, ignore),
+ ok = kill("HUP", OsPid),
+ ok = kill("HUP", OsPid),
+ ok = kill("HUP", OsPid),
+ Msgs2 = fetch_msgs(Pid2),
+ io:format("Msgs2: ~p~n", [Msgs2]),
+ [] = Msgs2,
+ %% reset to handle (it's the default)
+ os:set_signal(sighup, handle),
+ ok.
+
+t_sigusr1(_Config) ->
+ Pid1 = setup_service(),
+ OsPid = os:getpid(),
+ os:set_signal(sigusr1, handle),
+ ok = kill("USR1", OsPid),
+ ok = kill("USR1", OsPid),
+ ok = kill("USR1", OsPid),
+ Msgs1 = fetch_msgs(Pid1),
+ io:format("Msgs1: ~p~n", [Msgs1]),
+ [{notify,sigusr1},
+ {notify,sigusr1},
+ {notify,sigusr1}] = Msgs1,
+ %% no proc
+ ok = kill("USR1", OsPid),
+ ok = kill("USR1", OsPid),
+ ok = kill("USR1", OsPid),
+ %% ignore
+ Pid2 = setup_service(),
+ os:set_signal(sigusr1, ignore),
+ ok = kill("USR1", OsPid),
+ ok = kill("USR1", OsPid),
+ ok = kill("USR1", OsPid),
+ Msgs2 = fetch_msgs(Pid2),
+ io:format("Msgs2: ~p~n", [Msgs2]),
+ [] = Msgs2,
+ %% reset to ignore (it's the default)
+ os:set_signal(sigusr1, handle),
+ ok.
+
+t_sigusr2(_Config) ->
+ Pid1 = setup_service(),
+ OsPid = os:getpid(),
+ os:set_signal(sigusr2, handle),
+ ok = kill("USR2", OsPid),
+ ok = kill("USR2", OsPid),
+ ok = kill("USR2", OsPid),
+ Msgs1 = fetch_msgs(Pid1),
+ io:format("Msgs1: ~p~n", [Msgs1]),
+ [{notify,sigusr2},
+ {notify,sigusr2},
+ {notify,sigusr2}] = Msgs1,
+ %% no proc
+ ok = kill("USR2", OsPid),
+ ok = kill("USR2", OsPid),
+ ok = kill("USR2", OsPid),
+ %% ignore
+ Pid2 = setup_service(),
+ os:set_signal(sigusr2, ignore),
+ ok = kill("USR2", OsPid),
+ ok = kill("USR2", OsPid),
+ ok = kill("USR2", OsPid),
+ Msgs2 = fetch_msgs(Pid2),
+ io:format("Msgs2: ~p~n", [Msgs2]),
+ [] = Msgs2,
+ %% reset to ignore (it's the default)
+ os:set_signal(sigusr2, ignore),
+ ok.
+
+t_sigterm(_Config) ->
+ Pid1 = setup_service(),
+ OsPid = os:getpid(),
+ os:set_signal(sigterm, handle),
+ ok = kill("TERM", OsPid),
+ ok = kill("TERM", OsPid),
+ ok = kill("TERM", OsPid),
+ Msgs1 = fetch_msgs(Pid1),
+ io:format("Msgs1: ~p~n", [Msgs1]),
+ [{notify,sigterm},
+ {notify,sigterm},
+ {notify,sigterm}] = Msgs1,
+ %% no proc
+ ok = kill("TERM", OsPid),
+ ok = kill("TERM", OsPid),
+ ok = kill("TERM", OsPid),
+ %% ignore
+ Pid2 = setup_service(),
+ os:set_signal(sigterm, ignore),
+ ok = kill("TERM", OsPid),
+ ok = kill("TERM", OsPid),
+ ok = kill("TERM", OsPid),
+ Msgs2 = fetch_msgs(Pid2),
+ io:format("Msgs2: ~p~n", [Msgs2]),
+ [] = Msgs2,
+ %% reset to handle (it's the default)
+ os:set_signal(sigterm, handle),
+ ok.
+
+t_sigchld(_Config) ->
+ Pid1 = setup_service(),
+ OsPid = os:getpid(),
+ os:set_signal(sigchld, handle),
+ ok = kill("CHLD", OsPid),
+ ok = kill("CHLD", OsPid),
+ ok = kill("CHLD", OsPid),
+ Msgs1 = fetch_msgs(Pid1),
+ io:format("Msgs1: ~p~n", [Msgs1]),
+ [{notify,sigchld},
+ {notify,sigchld},
+ {notify,sigchld}] = Msgs1,
+ %% no proc
+ ok = kill("CHLD", OsPid),
+ ok = kill("CHLD", OsPid),
+ ok = kill("CHLD", OsPid),
+ %% ignore
+ Pid2 = setup_service(),
+ os:set_signal(sigchld, ignore),
+ ok = kill("CHLD", OsPid),
+ ok = kill("CHLD", OsPid),
+ ok = kill("CHLD", OsPid),
+ Msgs2 = fetch_msgs(Pid2),
+ io:format("Msgs2: ~p~n", [Msgs2]),
+ [] = Msgs2,
+ %% reset to handle (it's the default)
+ os:set_signal(sigchld, ignore),
+ ok.
+
+
+t_sigalrm(_Config) ->
+ Pid1 = setup_service(),
+ ok = os:set_signal(sigalrm, handle),
+ ok = os_signal_SUITE:set_alarm(1),
+ receive after 3000 -> ok end,
+ Msgs1 = fetch_msgs(Pid1),
+ [{notify,sigalrm}] = Msgs1,
+ io:format("Msgs1: ~p~n", [Msgs1]),
+ os:set_signal(sigalrm, ignore),
+ Pid2 = setup_service(),
+ ok = os_signal_SUITE:set_alarm(1),
+ receive after 3000 -> ok end,
+ Msgs2 = fetch_msgs(Pid2),
+ [] = Msgs2,
+ io:format("Msgs2: ~p~n", [Msgs2]),
+ Pid3 = setup_service(),
+ os:set_signal(sigalrm, handle),
+ ok = os_signal_SUITE:set_alarm(1),
+ receive after 3000 -> ok end,
+ Msgs3 = fetch_msgs(Pid3),
+ [{notify,sigalrm}] = Msgs3,
+ io:format("Msgs3: ~p~n", [Msgs3]),
+ os:set_signal(sigalrm, ignore),
+ ok.
+
+t_sigchld_fork(_Config) ->
+ Pid1 = setup_service(),
+ ok = os:set_signal(sigchld, handle),
+ {ok,OsPid} = os_signal_SUITE:fork(),
+ receive after 3000 -> ok end,
+ Msgs1 = fetch_msgs(Pid1),
+ io:format("Msgs1: ~p~n", [Msgs1]),
+ [{notify,sigchld}] = Msgs1,
+ {ok,Status} = os_signal_SUITE:get_exit_code(OsPid),
+ io:format("exit status from ~w : ~w~n", [OsPid,Status]),
+ 42 = Status,
+ %% reset to ignore (it's the default)
+ os:set_signal(sigchld, ignore),
+ ok.
+
+
+%% nif stubs
+
+set_alarm(_Secs) -> no.
+fork() -> no.
+get_exit_code(_OsPid) -> no.
+
+%% aux
+
+setup_service() ->
+ Pid = spawn_link(fun msgs/0),
+ true = erlang:register(?signal_server, Pid),
+ Pid.
+
+msgs() ->
+ msgs([]).
+msgs(Ms) ->
+ receive
+ {Pid, fetch_msgs} -> Pid ! {self(), lists:reverse(Ms)};
+ Msg ->
+ msgs([Msg|Ms])
+ end.
+
+fetch_msgs(Pid) ->
+ Pid ! {self(), fetch_msgs},
+ receive {Pid, Msgs} -> Msgs end.
+
+kill(Signal, Pid) ->
+ {0,_} = run("kill", ["-s", Signal, Pid]),
+ receive after 200 -> ok end,
+ ok.
+
+load_nif(Config) ->
+ Path = proplists:get_value(data_dir, Config),
+ case erlang:load_nif(filename:join(Path,"os_signal_nif"), 0) of
+ ok -> ok;
+ {error,{reload,_}} -> ok
+ end.
+
+run(Program0, Args) -> run(".", Program0, Args).
+run(Cwd, Program0, Args) when is_list(Cwd) ->
+ Program = case os:find_executable(Program0) of
+ Path when is_list(Path) ->
+ Path;
+ false ->
+ exit(no)
+ end,
+ Options = [{args,Args},binary,exit_status,stderr_to_stdout,
+ {line,4096}, {cd, Cwd}],
+ try open_port({spawn_executable,Program}, Options) of
+ Port ->
+ run_loop(Port, [])
+ catch
+ error:_ ->
+ exit(no)
+ end.
+
+run_loop(Port, Output) ->
+ receive
+ {Port,{exit_status,Status}} ->
+ {Status,lists:reverse(Output)};
+ {Port,{data,{eol,Bin}}} ->
+ run_loop(Port, [Bin|Output]);
+ _Msg ->
+ run_loop(Port, Output)
+ end.
diff --git a/erts/emulator/test/os_signal_SUITE_data/Makefile.src b/erts/emulator/test/os_signal_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..a7f5cdbba5
--- /dev/null
+++ b/erts/emulator/test/os_signal_SUITE_data/Makefile.src
@@ -0,0 +1,6 @@
+
+NIF_LIBS = os_signal_nif@dll@
+
+all: $(NIF_LIBS)
+
+@SHLIB_RULES@
diff --git a/erts/emulator/test/os_signal_SUITE_data/os_signal_nif.c b/erts/emulator/test/os_signal_SUITE_data/os_signal_nif.c
new file mode 100644
index 0000000000..78e1348383
--- /dev/null
+++ b/erts/emulator/test/os_signal_SUITE_data/os_signal_nif.c
@@ -0,0 +1,66 @@
+#include <sys/wait.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <stdio.h>
+
+#include <erl_nif.h>
+
+static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info)
+{
+ return 0;
+}
+
+static ERL_NIF_TERM set_alarm(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ int t;
+ if (!enif_get_int(env, argv[0], &t)) {
+ return enif_make_badarg(env);
+ }
+
+ alarm(t);
+
+ return enif_make_atom(env, "ok");
+}
+
+static ERL_NIF_TERM fork_0(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ pid_t pid;
+
+ pid = fork();
+
+ if (pid == 0) {
+ /* child */
+ exit(42);
+ }
+
+ return enif_make_tuple(env, 2,
+ enif_make_atom(env, "ok"),
+ enif_make_int(env, (int)pid));
+}
+
+static ERL_NIF_TERM get_exit_code(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ int x;
+ pid_t pid;
+ if (!enif_get_int(env, argv[0], &x)) {
+ return enif_make_badarg(env);
+ }
+
+ pid = (pid_t) x;
+
+ waitpid(pid, &x, 0);
+
+ return enif_make_tuple(env, 2,
+ enif_make_atom(env, "ok"),
+ enif_make_int(env, WEXITSTATUS(x)));
+}
+
+
+static ErlNifFunc nif_funcs[] =
+{
+ {"set_alarm", 1, set_alarm},
+ {"fork", 0, fork_0},
+ {"get_exit_code", 1, get_exit_code}
+};
+
+ERL_NIF_INIT(os_signal_SUITE,nif_funcs,load,NULL,NULL,NULL)
diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl
index e01b2f253b..730a17d7e8 100644
--- a/erts/emulator/test/port_SUITE.erl
+++ b/erts/emulator/test/port_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2014. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2017. 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/.
+%% 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
%%
-%% 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.
+%% 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%
%%
@@ -73,65 +74,128 @@
%%
--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,
- unregister_name/1, parallelism_option/1]).
-
--export([do_iter_max_ports/2]).
+-export([all/0, suite/0, groups/0, init_per_testcase/2, end_per_testcase/2,
+ init_per_suite/1, end_per_suite/1]).
+-export([
+ bad_args/1,
+ bad_env/1,
+ bad_packet/1,
+ bad_port_messages/1,
+ basic_ping/1,
+ cd/1,
+ cd_relative/1,
+ close_deaf_port/1,
+ count_fds/1,
+ dropped_commands/1,
+ dying_port/1,
+ env/1,
+ eof/1,
+ exit_status/1,
+ exit_status_multi_scheduling_block/1,
+ huge_env/1,
+ pipe_limit_env/1,
+ input_only/1,
+ iter_max_ports/1,
+ line/1,
+ mix_up_ports/1,
+ mon_port_invalid_type/1,
+ mon_port_bad_named/1,
+ mon_port_bad_remote_on_local/1,
+ mon_port_local/1,
+ mon_port_name_demonitor/1,
+ mon_port_named/1,
+ mon_port_origin_dies/1,
+ mon_port_owner_dies/1,
+ mon_port_pid_demonitor/1,
+ mon_port_remote_on_remote/1,
+ mon_port_driver_die/1,
+ mon_port_driver_die_demonitor/1,
+ mul_basic/1,
+ mul_slow_writes/1,
+ name1/1,
+ open_input_file_port/1,
+ open_output_file_port/1,
+ otp_3906/1,
+ otp_4389/1,
+ otp_5112/1,
+ otp_5119/1,
+ otp_6224/1,
+ output_only/1,
+ parallelism_option/1,
+ parallell/1,
+ port_program_with_path/1,
+ port_setget_data/1,
+ ports/1,
+ slow_writes/1,
+ spawn_driver/1,
+ spawn_executable/1,
+ stderr_to_stdout/1,
+ stream_big/1,
+ stream_small/1,
+ t_binary/1,
+ t_exit/1,
+ tps_16_bytes/1,
+ tps_1K/1,
+ unregister_name/1,
+ win_massive/1,
+ win_massive_client/1
+]).
+
+-export([do_iter_max_ports/2, relative_cd/0]).
%% Internal exports.
-export([tps/3]).
-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").
+-include_lib("eunit/include/eunit.hrl").
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 1}}].
-all() ->
+all() ->
[otp_6224, {group, stream}, basic_ping, slow_writes,
bad_packet, bad_port_messages, {group, options},
- {group, multiple_packets}, parallell, dying_port,
+ {group, multiple_packets}, parallell, dying_port, dropped_commands,
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,
+ cd_relative, pipe_limit_env, bad_args,
+ 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,
spawn_executable, close_deaf_port, unregister_name,
- parallelism_option].
-
-groups() ->
+ port_setget_data,
+ parallelism_option,
+ mon_port_invalid_type,
+ mon_port_local,
+ mon_port_remote_on_remote,
+ mon_port_bad_remote_on_local,
+ mon_port_origin_dies,
+ mon_port_owner_dies,
+ mon_port_named,
+ mon_port_bad_named,
+ mon_port_pid_demonitor,
+ mon_port_name_demonitor,
+ mon_port_driver_die,
+ mon_port_driver_die_demonitor
+ ].
+
+groups() ->
[{stream, [], [stream_small, stream_big]},
{options, [], [t_binary, eof, input_only, output_only]},
{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) when Case =:= mon_port_driver_die;
+ Case =:= mon_port_driver_die_demonitor ->
+ case erlang:system_info(schedulers_online) of
+ 1 -> {skip, "Need 2 schedulers to run testcase"};
+ _ -> Config
+ end;
init_per_testcase(Case, Config) ->
[{testcase, Case} |Config].
@@ -151,69 +215,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}]),
+ {ok, Node} =
+ 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}]),
+ {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).
@@ -221,22 +279,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
@@ -244,17 +300,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),
@@ -262,16 +314,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) -> [];
@@ -284,7 +334,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),
@@ -292,16 +341,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) ->
+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
@@ -311,7 +358,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]),
@@ -322,12 +369,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}, []),
@@ -344,13 +389,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]),
@@ -362,47 +406,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.
@@ -411,11 +457,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
@@ -424,9 +469,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
@@ -434,27 +478,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([]) ->
@@ -462,18 +505,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),
@@ -494,14 +536,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) ->
@@ -509,6 +549,47 @@ make_dying_port(Config) when is_list(Config) ->
Command = lists:concat([PortTest, " -h0 -d -q"]),
open_port({spawn, Command}, [stream]).
+%% Test that dropped port_commands work correctly.
+%% This used to cause a segfault.
+%%
+%% This testcase creates a port and then lets many processes
+%% do parallel commands to it. After a while it closes the
+%% port and we are trying to catch the race when doing a
+%% command while the port is closing.
+dropped_commands(Config) ->
+ %% Test with output callback
+ dropped_commands(Config, false, {self(), {command, "1"}}),
+ %% Test with outputv callback
+ dropped_commands(Config, true, {self(), {command, "1"}}).
+
+dropped_commands(Config, Outputv, Cmd) ->
+ Path = proplists:get_value(data_dir, Config),
+ os:putenv("ECHO_DRV_USE_OUTPUTV", atom_to_list(Outputv)),
+ ok = load_driver(Path, "echo_drv"),
+ [dropped_commands_test(Cmd) || _ <- lists:seq(1, 100)],
+ timer:sleep(100),
+ erl_ddll:unload_driver("echo_drv"),
+ os:unsetenv("ECHO_DRV_USE_OUTPUTV"),
+ ok.
+
+dropped_commands_test(Cmd) ->
+ spawn_monitor(
+ fun() ->
+ Port = erlang:open_port({spawn_driver, "echo_drv"},
+ [{parallelism, true}]),
+ [spawn_link(fun() -> spin(Port, Cmd) end) || _ <- lists:seq(1,8)],
+ timer:sleep(5),
+ port_close(Port),
+ timer:sleep(5),
+ exit(nok)
+ end),
+ receive _M -> timer:sleep(5) end.
+
+spin(P, Cmd) ->
+ P ! Cmd,
+ spin(P, Cmd).
+
+
%% Tests that port program with complete path (but without any
%% .exe extension) can be started, even if there is a file with
%% the same name but without the extension in the same directory.
@@ -520,22 +601,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),
@@ -543,12 +623,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",
@@ -557,17 +637,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.
@@ -575,20 +652,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.
@@ -603,16 +678,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
@@ -621,31 +724,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 ->
@@ -669,46 +771,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) ->
@@ -717,118 +827,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",
@@ -838,36 +935,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)],
- ExistingList = [{lists:flatten(io_lib:format("V~p_existing",[X])),"a_value"}
- || X <- lists:seq(1,150)],
+ NotExistingList = [{lists:flatten(io_lib:format("V~p_not_existing",[X])),false}
+ || X <- lists:seq(1,150)],
+ ExistingList = [{lists:flatten(io_lib:format("V~p_existing",[X])),"a_value"}
+ || 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) ->
@@ -875,27 +970,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().
@@ -915,64 +1009,232 @@ bad_env(Config) when is_list(Config) ->
ok.
try_bad_env(Env) ->
- try open_port({spawn,"ls"}, [{env,Env}])
- catch
- error:badarg -> ok
+ badarg = try open_port({spawn,"ls"}, [{env,Env}])
+ catch
+ error:badarg -> badarg
+ end.
+
+
+%% Test that we can handle a very very large environment gracefully.
+huge_env(Config) when is_list(Config) ->
+ ct:timetrap({minutes, 2}),
+ {Vars, Cmd} = case os:type() of
+ {win32,_} -> {500, "cmd /q /c ls"};
+ _ ->
+ %% We create a huge environment,
+ %% 20000 variables is about 25MB
+ %% which seems to be the limit on Linux.
+ {20000, "ls"}
+ 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,Cmd},[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.
+%% Test to spawn program with command payload buffer
+%% just around pipe capacity (9f779819f6bda734c5953468f7798)
+pipe_limit_env(Config) when is_list(Config) ->
+ Cmd = case os:type() of
+ {win32,_} -> "cmd /q /c true";
+ _ -> "true"
+ end,
+ CmdSize = command_payload_size(Cmd),
+ Limits = [4096, 16384, 65536], % Try a couple of common pipe buffer sizes
+
+ lists:foreach(fun(Lim) ->
+ lists:foreach(fun(L) -> pipe_limit_env_do(L, Cmd, CmdSize)
+ end, lists:seq(Lim-5, Lim+5))
+ end, Limits),
+ ok.
+
+pipe_limit_env_do(Bytes, Cmd, CmdSize) ->
+ case env_of_bytes(Bytes-CmdSize) of
+ [] -> skip;
+ Env ->
+ try erlang:open_port({spawn,Cmd},[exit_status, {env, Env}]) of
+ P ->
+ receive
+ {P, {exit_status,N}} ->
+ %% Bug caused exit_status 150 (EINVAL+128)
+ 0 = 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
+ end.
+
+%% environ format: KEY=VALUE\0
+env_of_bytes(Bytes) when Bytes > 3 ->
+ [{"X",lists:duplicate(Bytes-3, $x)}];
+env_of_bytes(_) -> [].
+
+%% White box assumption about payload written to pipe
+%% for Cmd and current environment (see spawn_start in sys_driver.c)
+command_payload_size(Cmd) ->
+ EnvSize = lists:foldl(fun(E,Acc) -> length(E) + 1 + Acc end,
+ 0, os:getenv()),
+ {ok, PWD} = file:get_cwd(),
+ (4 % buffsz
+ + 4 % flags
+ + 5 + length(Cmd) + 1 % "exec $Cmd"
+ + length(PWD) + 1 % $PWD
+ + 1 % nullbuff
+ + 4 % env_len
+ + EnvSize).
+
+%% Test bad 'args' options.
+bad_args(Config) when is_list(Config) ->
+ try_bad_args({args, [self()]}),
+ try_bad_args({args, ["head" | "tail"]}),
+ try_bad_args({args, ["head", "body" | "tail"]}),
+ try_bad_args({args, [<<"head">>, <<"body">> | <<"tail">>]}),
+ try_bad_args({args, not_a_list}),
+ try_bad_args({args, ["string",<<"binary">>, 1472, "string"]}),
+ try_bad_args({args, ["string",<<"binary">>], "element #3"}),
+ ok.
+
+try_bad_args(Args) ->
+ badarg = try open_port({spawn_executable,"ls"}, [Args])
+ catch
+ error:badarg -> badarg
+ 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.
+ InvalidDir = filename:join(DataDir, "invaliddir"),
+ try open_port({spawn, Cmd},
+ [{cd, InvalidDir}, exit_status, {line, 256}]) of
+ _ ->
+ receive
+ {_, {exit_status, _}} ->
+ ok;
+ Other4 ->
+ ct:fail({env, Other4})
+ end
+ catch error:eacces ->
+ %% This happens on Windows
+ ok
+ end,
+
+ %% Check that there are no lingering messages
+ receive
+ Other5 ->
+ ct:fail({env, Other5})
+ after 10 ->
+ ok
+ end.
+
+%% Test that an emulator that has set it's cwd to
+%% something other then when it started, can use
+%% relative {cd,"./"} to open port and that cd will
+%% be relative the new cwd and not the original
+cd_relative(Config) ->
+
+ Program = atom_to_list(lib:progname()),
+ DataDir = proplists:get_value(data_dir, Config),
+ TestDir = filename:join(DataDir, "dir"),
+
+ Cmd = Program ++ " -pz " ++ filename:dirname(code:where_is_file("port_SUITE.beam")) ++
+ " -noshell -s port_SUITE relative_cd -s erlang halt",
+
+ _ = open_port({spawn, Cmd}, [{line, 256}, {cd, TestDir}]),
+
+ receive
+ {_, {data, {eol, String}}} ->
+ case filename_equal(String, TestDir) of
+ true ->
+ ok;
+ false ->
+ ct:fail({cd_relative, String})
+ end;
+ Other ->
+ ct:fail(Other)
+ end.
+
+relative_cd() ->
+
+ Program = atom_to_list(lib:progname()),
+ ok = file:set_cwd(".."),
+ {ok, Cwd} = file:get_cwd(),
+
+ Cmd = Program ++ " -pz " ++ Cwd ++
+ " -noshell -s port_test pwd -s erlang halt",
+
+ _ = open_port({spawn, Cmd}, [{line, 256}, {cd, "./dir"}, exit_status]),
+
+ receive
+ {_, {data, {eol, String}}} ->
+ io:format("~s~n",[String]);
+ Other ->
+ io:format("ERROR: ~p~n",[Other])
+ end.
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([], []) ->
@@ -983,10 +1245,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 ->
@@ -994,17 +1256,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).
@@ -1017,83 +1276,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) ->
@@ -1101,12 +1360,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.
@@ -1114,21 +1373,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([], _) ->
@@ -1138,17 +1397,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) ->
@@ -1167,18 +1426,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),
@@ -1187,183 +1446,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,
+ 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?"},
- []),
- receive
- {Port2, {data, "Hello port?"}} = Msg2 ->
- io:format("~p~n", [Msg2]),
- ok;
- Other2 ->
- test_server:fail({unexpected2, Other2})
- end,
+ Port2 = erlang:open_port({spawn_driver, "echo_drv -Hello port?"},
+ []),
+ 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,
{'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,[]),
@@ -1372,26 +1613,26 @@ spawn_executable(Config) when is_list(Config) ->
["echo_args"] = run_echo_args(DataDir,[binary, "echo_args"]),
["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"]),
+ [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"]),
- [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,[switch_order,ExactFile1,"hello world",
+ "dlrow olleh"]),
+ [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"]),
- [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("\""++ExactFile1++"\" "++"\"hello world\" \"dlrow olleh\""),
+ [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])),
@@ -1401,28 +1642,33 @@ spawn_executable(Config) when is_list(Config) ->
[ExactFile2] = run_echo_args(SpaceDir,[]),
["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"]),
[ExactFile2,"hello world","dlrow olleh"] =
- run_echo_args(SpaceDir,[binary, 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"]),
+
+ [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"]),
+
[ExactFile2] = run_echo_args(SpaceDir,[default]),
- [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"]),
- [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\"")),
-
- ExeExt =
- case string:to_lower(lists:last(string:tokens(ExactFile2,"."))) of
- "exe" ->
- ".exe";
- _ ->
- ""
- end,
+ 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"]),
+ [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\"")),
+
+ ExeExt =
+ 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])),
@@ -1430,39 +1676,38 @@ spawn_executable(Config) when is_list(Config) ->
[ExactFile3] = run_echo_args(SpaceDir,Executable2,[]),
["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"]),
+ [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"]),
- [ExactFile3,"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\""),
[ExactFile3,"hello world","dlrow olleh"] =
- run_echo_args_2(unicode:characters_to_binary("\""++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"]),
+ [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\"")),
{'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) ->
@@ -1473,29 +1718,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"]),
+ [DN,"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"]),
+ [DN,"hello","world"] =
+ run_echo_args(Dir,FN,
+ ["knaskurt","hello","world"]),
EF = filename:basename(DN),
ok.
@@ -1503,40 +1748,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"]),
- [Full,"hello","world of spaces"] =
- run_echo_args(Dir,FN,
- [default,"hello","world of spaces"]),
+ [Full,"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"]),
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.
+ [Full,"hello",Pattern] =
+ 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) ->
@@ -1545,7 +1790,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).
@@ -1553,9 +1798,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},
@@ -1569,14 +1814,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;
@@ -1584,54 +1829,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,
+ 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,
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),
+ receive
+ Msg2 ->
+ ct:fail({unexpected, Msg2})
+ after 1000 ->
+ ok
+ end,
ok.
loop(Stop, Stop, Fun) when is_function(Fun) ->
@@ -1640,131 +1880,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().
@@ -1773,163 +2000,160 @@ 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 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) ->
%%
%% We want to start port programs from as many schedulers as possible
%% and we want these port programs to terminate while multi-scheduling
%% is blocked.
- %%
+ %%
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 = now(),
+ Start = erlang:monotonic_time(microsecond),
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),
- StartedTime = timer:now_diff(now(), Start)/1000000,
- ?t:format("StartedTime = ~p~n", [StartedTime]),
+ receive {P, started, SIds} -> SIds end
+ end,
+ Procs),
+ StartedTime = (erlang:monotonic_time(microsecond) - Start)/1000000,
+ io:format("StartedTime = ~p~n", [StartedTime]),
true = StartedTime < SleepSecs,
- erlang:system_flag(multi_scheduling, block),
+ erlang:system_flag(multi_scheduling, block_normal),
lists:foreach(fun (P) -> receive {P, done} -> ok end end, Procs),
- DoneTime = timer:now_diff(now(), Start)/1000000,
- ?t:format("DoneTime = ~p~n", [DoneTime]),
+ DoneTime = (erlang:monotonic_time(microsecond) - Start)/1000000,
+ io:format("DoneTime = ~p~n", [DoneTime]),
true = DoneTime > SleepSecs,
ok = verify_multi_scheduling_blocked(),
- erlang:system_flag(multi_scheduling, unblock),
+ erlang:system_flag(multi_scheduling, unblock_normal),
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) ->
@@ -1938,10 +2162,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)
@@ -1949,7 +2173,7 @@ ping(Config, Sizes, HSize, CmdLine, Options) ->
%% Sizes = Size of packets to generated.
%% HSize = Header size: 1, 2, or 4
%% CmdLine = Additional command line options.
-%% Options = Addtional port options.
+%% Options = Additional port options.
expect_input(Config, Sizes, HSize, CmdLine, Options) ->
expect_input1(Config, Sizes, {HSize, CmdLine, Options}, [], []).
@@ -1963,7 +2187,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]);
@@ -1986,15 +2210,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),
@@ -2005,11 +2229,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(_, [], _) ->
@@ -2037,34 +2261,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, []) ->
@@ -2079,30 +2303,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);
@@ -2110,13 +2334,13 @@ maybe_to_list(List) ->
List.
format({Eol,List}) ->
- io_lib:format("tuple<~w,~s>",[Eol, maybe_to_list(List)]);
+ io_lib:format("tuple<~w,~w>",[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)]);
@@ -2143,17 +2367,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(), []).
@@ -2174,15 +2398,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, []).
@@ -2191,13 +2414,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
@@ -2217,14 +2438,14 @@ ports_snapshots(0, _, _) ->
ok;
ports_snapshots(Iter, TrafficPid, OtherPorts) ->
- TrafficPid ! start,
+ TrafficPid ! start,
receive after 1 -> ok end,
Snapshot = erlang:ports(),
TrafficPid ! {self(), stop},
receive {TrafficPid, EventList, TrafficPorts} -> ok end,
-
+
%%io:format("Snapshot=~p\n", [Snapshot]),
ports_verify(Snapshot, OtherPorts ++ TrafficPorts, EventList),
@@ -2236,78 +2457,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})
+ receive
+ {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) ->
+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!?!?"),
@@ -2316,28 +2536,329 @@ 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(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))},
+ 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)),
+ 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),
+ port_close(Port),
+ lists:foreach(fun({Pid,Ref}) ->
+ receive {'DOWN', Ref, process, Pid, normal} -> ok end
+ end,
+ PRs),
+ ok.
+
+port_setget_data_hammer(Port, HeapData, IsSet0, N) ->
+ 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,
+ receive {Papa, prepare_for_close} ->
+ put(prepare_for_close, true),
+ Papa ! {self(),prepare_for_close}
+ after 0 ->
+ 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.
+
+%% Attempt to monitor pid as port, and port as pid
+mon_port_invalid_type(_Config) ->
+ Port = hd(erlang:ports()),
+ ?assertError(badarg, erlang:monitor(port, self())),
+ ?assertError(badarg, erlang:monitor(process, Port)),
+ ok.
+
+%% With local port
+mon_port_local(Config) ->
+ Port1 = create_port(Config, ["-h1", "-q"]), % will close after we send 1 byte
+ Ref1 = erlang:monitor(port, Port1),
+ ?assertMatch({proc_monitors, true, port_monitored_by, true},
+ port_is_monitored(self(), Port1)),
+ Port1 ! {self(), {command, <<"1">>}}, % port test will close self immediately
+ receive ExitP1 -> ?assertMatch({'DOWN', Ref1, port, Port1, _}, ExitP1)
+ after 1000 -> ?assert(false) end,
+ ?assertMatch({proc_monitors, false, port_monitored_by, false},
+ port_is_monitored(self(), Port1)),
+
+ %% Trying to re-monitor a port which exists but is not healthy will
+ %% succeed but then will immediately send DOWN
+ Ref2 = erlang:monitor(port, Port1),
+ receive ExitP2 -> ?assertMatch({'DOWN', Ref2, port, Port1, _}, ExitP2)
+ after 1000 -> ?assert(false) end,
+ ok.
+
+%% With remote port on remote node (should fail)
+mon_port_remote_on_remote(_Config) ->
+ Port3 = binary_to_term(<<131, 102, % Ext term format: PORT_EXT
+ 100, 0, 13, "fgsfds@fgsfds", % Node :: ATOM_EXT
+ 1:32/big, % Id
+ 0>>), % Creation
+ ?assertError(badarg, erlang:monitor(port, Port3)),
+ ok.
+
+%% Remote port belongs to this node and does not exist
+%% Port4 produces #Port<0.167772160> which should not exist in a test run
+mon_port_bad_remote_on_local(_Config) ->
+ Port4 = binary_to_term(<<131, 102, % Ext term format: PORT_EXT
+ 100, 0, 13, "nonode@nohost", % Node
+ 167772160:32/big, % Id
+ 0>>), % Creation
+ ?assertError(badarg, erlang:monitor(port, Port4)),
+ ok.
+
+%% Monitor owner (origin) dies before port is closed
+mon_port_origin_dies(Config) ->
+ Port5 = create_port(Config, ["-h1", "-q"]), % will close after we send 1 byte
+ Self5 = self(),
+ Proc5 = spawn(fun() ->
+ Self5 ! test5_started,
+ erlang:monitor(port, Port5),
+ receive stop -> ok end
+ end),
+ erlang:monitor(process, Proc5), % we want to sync with its death
+ receive test5_started -> ok
+ after 1000 -> ?assert(false) end,
+ ?assertMatch({proc_monitors, true, port_monitored_by, true},
+ port_is_monitored(Proc5, Port5)),
+ Proc5 ! stop,
+ % receive from monitor (removing race condition)
+ receive ExitP5 -> ?assertMatch({'DOWN', _, process, Proc5, _}, ExitP5)
+ after 1000 -> ?assert(false) end,
+ ?assertMatch({proc_monitors, false, port_monitored_by, false},
+ port_is_monitored(Proc5, Port5)),
+ Port5 ! {self(), {command, <<"1">>}}, % make port quit
+ ok.
+
+%% Port and Monitor owner dies before port is closed
+%% This testcase checks for a regression memory leak in erts
+%% when the controlling and monitoring process is the same process
+%% and the process dies
+mon_port_owner_dies(Config) ->
+ Self = self(),
+ Proc = spawn(fun() ->
+ Port = create_port(Config, ["-h1", "-q"]),
+ Self ! {test_started, Port},
+ erlang:monitor(port, Port),
+ receive stop -> ok end
+ end),
+ erlang:monitor(process, Proc), % we want to sync with its death
+ Port = receive {test_started,P} -> P
+ after 1000 -> ?assert(false) end,
+ ?assertMatch({proc_monitors, true, port_monitored_by, true},
+ port_is_monitored(Proc, Port)),
+ Proc ! stop,
+ %% receive from monitor
+ receive ExitP5 -> ?assertMatch({'DOWN', _, process, Proc, _}, ExitP5)
+ after 1000 -> ?assert(false) end,
+ ok.
+
+%% Monitor a named port
+mon_port_named(Config) ->
+ Name6 = test_port6,
+ Port6 = create_port(Config, ["-h1", "-q"]), % will close after we send 1 byte
+ erlang:register(Name6, Port6),
+ erlang:monitor(port, Name6),
+ ?assertMatch({proc_monitors, true, port_monitored_by, true},
+ port_is_monitored(self(), Name6)),
+ Port6 ! {self(), {command, <<"1">>}}, % port test will close self immediately
+ receive ExitP6 -> ?assertMatch({'DOWN', _, port, {Name6, _}, _}, ExitP6)
+ after 1000 -> ?assert(false) end,
+ ?assertMatch({proc_monitors, false, port_monitored_by, false},
+ port_is_monitored(self(), Name6)),
+ ok.
+
+%% Named does not exist: Should succeed but immediately send 'DOWN'
+mon_port_bad_named(_Config) ->
+ Name7 = test_port7,
+ erlang:monitor(port, Name7),
+ receive {'DOWN', _, port, {Name7, _}, noproc} -> ok
+ after 1000 -> ?assert(false) end,
+ ok.
+
+%% Monitor a pid and demonitor by ref
+mon_port_pid_demonitor(Config) ->
+ Port8 = create_port(Config, ["-h1", "-q"]), % will close after we send 1 byte
+ Ref8 = erlang:monitor(port, Port8),
+ ?assertMatch({proc_monitors, true, port_monitored_by, true},
+ port_is_monitored(self(), Port8)),
+ erlang:demonitor(Ref8),
+ ?assertMatch({proc_monitors, false, port_monitored_by, false},
+ port_is_monitored(self(), Port8)),
+ Port8 ! {self(), {command, <<"1">>}}, % port test will close self immediately
+ ok.
+
+%% Monitor by name and demonitor by ref
+mon_port_name_demonitor(Config) ->
+ Name9 = test_port9,
+ Port9 = create_port(Config, ["-h1", "-q"]), % will close after we send 1 byte
+ erlang:register(Name9, Port9),
+ Ref9 = erlang:monitor(port, Name9),
+ ?assertMatch({proc_monitors, true, port_monitored_by, true},
+ port_is_monitored(self(), Name9)),
+ erlang:demonitor(Ref9),
+ ?assertMatch({proc_monitors, false, port_monitored_by, false},
+ port_is_monitored(self(), Name9)),
+ Port9 ! {self(), {command, <<"1">>}}, % port test will close self immediately
+ ok.
+
+%% 1. Spawn a port which will sleep 3 seconds
+%% 2. Port driver and dies horribly (via C driver_failure call). This should
+%% mark port as exiting or something.
+%% 3. While the command happens, a monitor is requested on the port
+mon_port_driver_die(Config) ->
+ erlang:process_flag(scheduler, 1),
+
+ Path = proplists:get_value(data_dir, Config),
+ ok = load_driver(Path, "sleep_failure_drv"),
+ Port = open_port({spawn, "sleep_failure_drv"}, []),
+
+ Self = self(),
+ erlang:spawn_opt(fun() ->
+ timer:sleep(250),
+ Ref = erlang:monitor(port, Port),
+ %% Now check that msg actually arrives
+ receive
+ {'DOWN', Ref, _Port2, _, _} = M -> Self ! M
+ after 3000 -> Self ! no_down_message
+ end
+ end,[{scheduler, 2}]),
+ Port ! {self(), {command, "Fail, please!"}},
+ receive
+ A when is_atom(A) -> ?assertEqual(A, 'A_should_be_printed');
+ {'DOWN', _R, port, Port, noproc} -> ok;
+ {'DOWN', _R, _P, _, _} = M -> ct:fail({got_wrong_down,M})
+ after 5000 -> ?assert(false)
+ end,
+ ok.
+
+
+%% 1. Spawn a port which will sleep 3 seconds
+%% 2. Monitor port
+%% 3. Port driver and dies horribly (via C driver_failure call). This should
+%% mark port as exiting or something.
+%% 4. While the command happens, a demonitor is requested on the port
+mon_port_driver_die_demonitor(Config) ->
+ erlang:process_flag(scheduler, 1),
+
+ Path = proplists:get_value(data_dir, Config),
+ ok = load_driver(Path, "sleep_failure_drv"),
+ Port = open_port({spawn, "sleep_failure_drv"}, []),
+
+ Self = self(),
+ erlang:spawn_opt(
+ fun() ->
+ Ref = erlang:monitor(port, Port),
+ Self ! Ref,
+ timer:sleep(250),
+ erlang:demonitor(Ref),
+ %% Now check that msg still arrives,
+ %% the demon should have arrived after
+ %% the port exited
+ receive
+ {'DOWN', Ref, _Port2, _, _} = M -> Self ! M
+ after 3000 -> Self ! no_down_message
+ end
+ end,[{scheduler, 2}]),
+ Ref = receive R -> R end,
+ Port ! {self(), {command, "Fail, please!"}},
+ receive
+ {'DOWN', Ref, port, Port, normal} -> ok;
+ {'DOWN', _R, _P, _, _} = M -> ct:fail({got_wrong_down,M})
+ after 5000 -> ?assert(false)
+ end,
+ ok.
+
+%% @doc Makes a controllable port for testing. Underlying mechanism of this
+%% port is not important, only important is our ability to close/kill it or
+%% have it monitored.
+create_port(Config, Args) ->
+ DataDir = ?config(data_dir, Config),
+ %% Borrow port test utility from port SUITE
+ Program = filename:join([DataDir, "port_test"]),
+ erlang:open_port({spawn_executable, Program}, [{args, Args}]).
+
+%% @doc Checks if process Pid exists, and if so, if its monitoring (or not)
+%% the Port (or if port doesn't exist, we assume answer is no).
+port_is_monitored(Pid, Port) when is_pid(Pid), is_port(Port) ->
+ %% Variant for when port is a port id (port())
+ A = case erlang:process_info(Pid, monitors) of
+ undefined -> false;
+ {monitors, ProcMTargets} -> lists:member({port, Port}, ProcMTargets)
+ end,
+ B = case erlang:port_info(Port, monitored_by) of
+ undefined -> false;
+ {monitored_by, PortMonitors} -> lists:member(Pid, PortMonitors)
+ end,
+ {proc_monitors, A, port_monitored_by, B};
+port_is_monitored(Pid, PortName) when is_pid(Pid), is_atom(PortName) ->
+ %% Variant for when port is an atom
+ A = case erlang:process_info(Pid, monitors) of
+ undefined -> false;
+ {monitors, ProcMTargets} ->
+ lists:member({port, {PortName, node()}}, ProcMTargets)
+ end,
+ B = case erlang:whereis(PortName) of
+ undefined -> false; % name is not registered or is dead
+ PortId ->
+ case erlang:port_info(PortId, monitored_by) of
+ undefined -> false; % is dead
+ {monitored_by, PortMonitors} ->
+ lists:member(Pid, PortMonitors)
+ end
+ end,
+ {proc_monitors, A, port_monitored_by, B}.
diff --git a/erts/emulator/test/port_SUITE_data/Makefile.src b/erts/emulator/test/port_SUITE_data/Makefile.src
index ff822ae720..3a343e6d17 100644
--- a/erts/emulator/test/port_SUITE_data/Makefile.src
+++ b/erts/emulator/test/port_SUITE_data/Makefile.src
@@ -4,7 +4,7 @@ CFLAGS = @CFLAGS@ -I@erl_include@ @DEFS@
CROSSLDFLAGS = @CROSSLDFLAGS@
PROGS = port_test@exe@ echo_args@exe@ dead_port@exe@
-DRIVERS = echo_drv@dll@ exit_drv@dll@ failure_drv@dll@
+DRIVERS = echo_drv@dll@ exit_drv@dll@ failure_drv@dll@ sleep_failure_drv@dll@
all: $(PROGS) $(DRIVERS) port_test.@EMULATOR@
@@ -20,6 +20,12 @@ echo_args@exe@: echo_args@obj@
echo_args@obj@: echo_args.c
$(CC) -c -o echo_args@obj@ $(CFLAGS) echo_args.c
+dead_port@exe@: dead_port@obj@
+ $(LD) $(CROSSLDFLAGS) -o dead_port dead_port@obj@ @LIBS@
+
+dead_port@obj@: dead_port.c
+ $(CC) -c -o dead_port@obj@ $(CFLAGS) dead_port.c
+
port_test.@EMULATOR@: port_test.erl
@erl_name@ -compile port_test
diff --git a/erts/emulator/test/port_SUITE_data/dead_port.c b/erts/emulator/test/port_SUITE_data/dead_port.c
index ea91546b0c..26f09f33c7 100644
--- a/erts/emulator/test/port_SUITE_data/dead_port.c
+++ b/erts/emulator/test/port_SUITE_data/dead_port.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2016. 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/.
+ * 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
*
- * 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.
+ * 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%
*/
diff --git a/erts/emulator/test/port_SUITE_data/echo_drv.c b/erts/emulator/test/port_SUITE_data/echo_drv.c
index 1d39c6a00c..b4370f6455 100644
--- a/erts/emulator/test/port_SUITE_data/echo_drv.c
+++ b/erts/emulator/test/port_SUITE_data/echo_drv.c
@@ -18,8 +18,11 @@ typedef struct _erl_drv_data EchoDrvData;
static EchoDrvData *echo_drv_start(ErlDrvPort port, char *command);
static void echo_drv_stop(EchoDrvData *data_p);
-static void echo_drv_output(ErlDrvData drv_data, char *buf,
- ErlDrvSizeT len);
+static void echo_drv_output(ErlDrvData drv_data, char *buf, ErlDrvSizeT len);
+static ErlDrvSSizeT echo_control(ErlDrvData drv_data,
+ unsigned int command, char *buf,
+ ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen);
+static void echo_outputv(ErlDrvData drv_data, ErlIOVec *ev);
static void echo_drv_finish(void);
static ErlDrvEntry echo_drv_entry = {
@@ -32,9 +35,9 @@ static ErlDrvEntry echo_drv_entry = {
"echo_drv",
echo_drv_finish,
NULL, /* handle */
- NULL, /* control */
+ echo_control, /* control */
NULL, /* timeout */
- NULL, /* outputv */
+ echo_outputv, /* outputv */
NULL, /* ready_async */
NULL,
NULL,
@@ -56,6 +59,14 @@ static ErlDrvEntry echo_drv_entry = {
DRIVER_INIT(echo_drv)
{
+ char buf[10];
+ size_t bufsz = sizeof(buf);
+ char *use_outputv;
+ use_outputv = (erl_drv_getenv("ECHO_DRV_USE_OUTPUTV", buf, &bufsz) == 0
+ ? buf
+ : "false");
+ if (strcmp(use_outputv, "true") != 0)
+ echo_drv_entry.outputv = NULL;
return &echo_drv_entry;
}
@@ -87,3 +98,15 @@ static void echo_drv_output(ErlDrvData drv_data, char *buf, ErlDrvSizeT len) {
static void echo_drv_finish() {
}
+
+static ErlDrvSSizeT echo_control(ErlDrvData drv_data,
+ unsigned int command, char *buf,
+ ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen)
+{
+ return 0;
+}
+
+static void echo_outputv(ErlDrvData drv_data, ErlIOVec *ev)
+{
+ return;
+}
diff --git a/erts/emulator/test/port_SUITE_data/port_test.c b/erts/emulator/test/port_SUITE_data/port_test.c
index 7abefab2e3..fa97b4c9d0 100644
--- a/erts/emulator/test/port_SUITE_data/port_test.c
+++ b/erts/emulator/test/port_SUITE_data/port_test.c
@@ -10,9 +10,11 @@
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
+#include <ctype.h>
#ifndef __WIN32__
#include <unistd.h>
+#include <limits.h>
#include <sys/time.h>
@@ -32,14 +34,14 @@
exit(1); \
}
-#define MAIN(argc, argv) main(argc, argv)
+#define ASSERT(e) ((void) ((e) ? 1 : abort()))
extern int errno;
typedef struct {
char* progname; /* Name of this program (from argv[0]). */
int header_size; /* Number of bytes in each packet header:
- * 1, 2, or 4, or 0 for a continous byte stream. */
+ * 1, 2, or 4, or 0 for a continuous byte stream. */
int fd_from_erl; /* File descriptor from Erlang. */
int fd_to_erl; /* File descriptor to Erlang. */
unsigned char* io_buf; /* Buffer for file i/o. */
@@ -48,6 +50,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.
@@ -103,11 +106,9 @@ int err;
#endif
-MAIN(argc, argv)
-int argc;
-char *argv[];
+int main(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 +116,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 +146,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 +194,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);
@@ -358,9 +376,11 @@ write_reply(buf, size)
int size; /* Size of buffer to send. */
{
int n; /* Temporary to hold size. */
+ int rv;
if (port_data->slow_writes <= 0) { /* Normal, "fast", write. */
- write(port_data->fd_to_erl, buf, size);
+ rv = write(port_data->fd_to_erl, buf, size);
+ ASSERT(rv == size);
} else {
/*
* Write chunks with delays in between.
@@ -368,7 +388,8 @@ write_reply(buf, size)
while (size > 0) {
n = size > port_data->slow_writes ? port_data->slow_writes : size;
- write(port_data->fd_to_erl, buf, n);
+ rv = write(port_data->fd_to_erl, buf, n);
+ ASSERT(rv == n);
size -= n;
buf += n;
if (size)
@@ -539,7 +560,7 @@ char* spec; /* Specification for reply. */
buf = (char *) malloc(total_size);
if (buf == NULL) {
fprintf(stderr, "%s: insufficent memory for reply buffer of size %d\n",
- port_data->progname, total_size);
+ port_data->progname, (int)total_size);
exit(1);
}
diff --git a/erts/emulator/test/port_SUITE_data/port_test.erl b/erts/emulator/test/port_SUITE_data/port_test.erl
index 56abfd5ded..406d376b26 100644
--- a/erts/emulator/test/port_SUITE_data/port_test.erl
+++ b/erts/emulator/test/port_SUITE_data/port_test.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1998-2016. 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.
+%% 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%
%%
diff --git a/erts/emulator/test/port_SUITE_data/sleep_failure_drv.c b/erts/emulator/test/port_SUITE_data/sleep_failure_drv.c
new file mode 100644
index 0000000000..1f52646572
--- /dev/null
+++ b/erts/emulator/test/port_SUITE_data/sleep_failure_drv.c
@@ -0,0 +1,76 @@
+#include <stdio.h>
+#include "erl_driver.h"
+#ifdef __WIN32__
+# include <windows.h>
+#else
+# include <unistd.h>
+#endif
+
+typedef struct _erl_drv_data FailureDrvData;
+
+static FailureDrvData *failure_drv_start(ErlDrvPort, char *);
+static void failure_drv_stop(FailureDrvData *);
+static void failure_drv_output(ErlDrvData, char *, ErlDrvSizeT);
+static void failure_drv_finish(void);
+
+static ErlDrvEntry failure_drv_entry = {
+ NULL, /* init */
+ failure_drv_start,
+ failure_drv_stop,
+ failure_drv_output,
+ NULL, /* ready_input */
+ NULL, /* ready_output */
+ "sleep_failure_drv",
+ NULL, /* finish */
+ NULL, /* handle */
+ NULL, /* control */
+ NULL, /* timeout */
+ NULL, /* outputv */
+ NULL, /* ready_async */
+ NULL,
+ NULL,
+ NULL,
+ ERL_DRV_EXTENDED_MARKER,
+ ERL_DRV_EXTENDED_MAJOR_VERSION,
+ ERL_DRV_EXTENDED_MINOR_VERSION,
+ 0,
+ NULL,
+ NULL,
+ NULL,
+};
+
+
+
+/* -------------------------------------------------------------------------
+** Entry functions
+**/
+
+DRIVER_INIT(failure_drv)
+{
+ return &failure_drv_entry;
+}
+
+static FailureDrvData *failure_drv_start(ErlDrvPort port, char *command) {
+ void *void_ptr;
+
+ return void_ptr = port;
+}
+
+static void failure_drv_stop(FailureDrvData *data_p) {
+}
+
+static void failure_drv_output(ErlDrvData drv_data, char *buf, ErlDrvSizeT len) {
+ FailureDrvData *data_p = (FailureDrvData *) drv_data;
+ void *void_ptr;
+ ErlDrvPort port = void_ptr = data_p;
+
+#ifdef __WIN32__
+ Sleep(3000);
+#else
+ sleep(3);
+#endif
+ driver_failure(port, 0);
+}
+
+static void failure_drv_finish() {
+}
diff --git a/erts/emulator/test/port_bif_SUITE.erl b/erts/emulator/test/port_bif_SUITE.erl
index f439867e9c..e1e1ec9fb9 100644
--- a/erts/emulator/test/port_bif_SUITE.erl
+++ b/erts/emulator/test/port_bif_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2012. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2016. 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.
+%% 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%
%%
@@ -20,20 +21,20 @@
-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_os_pid/1, port_info_race/1,
connect/1, control/1, echo_to_busy/1]).
-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,
@@ -42,28 +43,8 @@ all() ->
groups() ->
[{command_e, [],
[command_e_1, command_e_2, command_e_3, command_e_4]},
- {port_info, [], [port_info1, port_info2, port_info_os_pid]}].
-
-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).
+ {port_info, [],
+ [port_info1, port_info2, port_info_os_pid, port_info_race]}].
command(Config) when is_list(Config) ->
load_control_drv(Config),
@@ -85,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),
@@ -104,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.
@@ -117,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),
@@ -126,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.
@@ -139,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),
@@ -150,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),
@@ -167,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.
@@ -246,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),
@@ -254,15 +235,36 @@ do_port_info_os_pid() ->
true = erlang:port_close(P),
ok.
+port_info_race(Config) when is_list(Config) ->
+ DataDir = proplists:get_value(data_dir, Config),
+ Program = filename:join(DataDir, "port_test"),
+ Top = self(),
+ P1 = open_port({spawn,Program}, [{packet,1}]),
+ P2 = open_port({spawn,Program}, [{packet,1}]),
+ Info1 = erlang:port_info(P1),
+ Info2 = erlang:port_info(P2),
+ F = fun Loop(Port, _, 0) ->
+ Top ! {ok,Port};
+ Loop(Port, Info, N) ->
+ Info = erlang:port_info(Port),
+ Loop(Port, Info, N - 1)
+ end,
+ spawn_link(fun () -> F(P1, Info1, 1000) end),
+ spawn_link(fun () -> F(P2, Info2, 1000) end),
+ receive {ok,P1} -> ok end,
+ receive {ok,P2} -> ok end,
+ true = erlang:port_close(P1),
+ true = erlang:port_close(P2),
+ ok.
+
output_test(_, _, Input, Output) when Output > 16#1fffffff ->
io:format("~p bytes received\n", [Input]);
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),
@@ -272,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).
@@ -321,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.
@@ -386,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.
@@ -398,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) ->
@@ -427,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").
@@ -461,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/port_bif_SUITE_data/port_test.c b/erts/emulator/test/port_bif_SUITE_data/port_test.c
index 28324a56a6..923ab99ccc 100644
--- a/erts/emulator/test/port_bif_SUITE_data/port_test.c
+++ b/erts/emulator/test/port_bif_SUITE_data/port_test.c
@@ -39,7 +39,7 @@ extern int errno;
typedef struct {
char* progname; /* Name of this program (from argv[0]). */
int header_size; /* Number of bytes in each packet header:
- * 1, 2, or 4, or 0 for a continous byte stream. */
+ * 1, 2, or 4, or 0 for a continuous byte stream. */
int fd_from_erl; /* File descriptor from Erlang. */
int fd_to_erl; /* File descriptor to Erlang. */
unsigned char* io_buf; /* Buffer for file i/o. */
diff --git a/erts/emulator/test/port_trace_SUITE.erl b/erts/emulator/test/port_trace_SUITE.erl
new file mode 100644
index 0000000000..c78dc754a9
--- /dev/null
+++ b/erts/emulator/test/port_trace_SUITE.erl
@@ -0,0 +1,652 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1999-2017. 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(port_trace_SUITE).
+
+-export([all/0, suite/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([port_specs/1, ports/1, open_close/1,
+ command/1, control/1, connect/1, call/1,
+ output/1, output2/1, output_binary/1,
+ outputv/1, set_timer/1, failure_eof/1,
+ failure_atom/1, failure_posix/1,
+ failure/1, output_term/1,
+ driver_output_term/1,
+ send_term/1, driver_send_term/1,
+ driver_remote_send_term/1]).
+
+-define(ECHO_DRV_NOOP, 0).
+-define(ECHO_DRV_OUTPUT, 1).
+-define(ECHO_DRV_OUTPUT2, 2).
+-define(ECHO_DRV_OUTPUT_BINARY, 3).
+-define(ECHO_DRV_OUTPUTV, 4).
+-define(ECHO_DRV_SET_TIMER, 5).
+-define(ECHO_DRV_FAILURE_EOF, 6).
+-define(ECHO_DRV_FAILURE_ATOM, 7).
+-define(ECHO_DRV_FAILURE_POSIX, 8).
+-define(ECHO_DRV_FAILURE, 9).
+-define(ECHO_DRV_OUTPUT_TERM, 10).
+-define(ECHO_DRV_DRIVER_OUTPUT_TERM, 11).
+-define(ECHO_DRV_SEND_TERM, 12).
+-define(ECHO_DRV_DRIVER_SEND_TERM, 13).
+-define(ECHO_DRV_SAVE_CALLER, 14).
+-define(ECHO_DRV_REMOTE_SEND_TERM, 15).
+
+suite() -> [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 2}}].
+
+all() ->
+ [port_specs, ports, open_close,
+ command, control, connect, call,
+ output, output2, output_binary,
+ outputv, set_timer, failure_eof,
+ failure_atom, failure_posix,
+ failure, output_term,
+ driver_output_term,
+ send_term, driver_send_term,
+ driver_remote_send_term].
+
+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(driver_remote_send_term, Config) ->
+ case erlang:system_info(smp_support) of
+ false ->
+ {skip,"Only supported on smp systems"};
+ true ->
+ init_per_testcase(driver_remote_send_term_smp, Config)
+ end;
+init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
+ erlang:trace(all, false, [all]),
+ os:unsetenv("OUTPUTV"),
+ reload_drv(Config),
+ Config.
+
+end_per_testcase(_Func, _Config) ->
+ erlang:trace(all, false, [all]),
+ ok.
+
+%% Test the first argument of trace/3
+port_specs(_Config) ->
+
+ S = self(),
+
+ Tracer = fun F() ->
+ receive
+ stop ->
+ ok;
+ M ->
+ S ! M,
+ F()
+ end
+ end,
+
+ Test = fun(TraceSpec, Info1, Info2) ->
+ {TracerPid,Ref} = spawn_monitor(Tracer),
+ Prt1 = erlang:open_port({spawn, echo_drv}, [binary]),
+ erlang:trace(TraceSpec, true, ['receive', {tracer, TracerPid}]),
+ %% We disable trace messages from the testcase process
+ erlang:trace(self(), false, ['receive']),
+ Prt2 = erlang:open_port({spawn, echo_drv}, [binary]),
+
+ InfoCheck =
+ fun(Info, Prt) ->
+ if
+ Info ->
+ {tracer, TracerPid} = erlang:trace_info(Prt, tracer),
+ {flags,['receive']} = erlang:trace_info(Prt, flags);
+ not Info ->
+ {tracer,[]} = erlang:trace_info(Prt, tracer),
+ {flags,[]} = erlang:trace_info(Prt, flags)
+ end
+ end,
+ InfoCheck(Info1, Prt1),
+ InfoCheck(Info2, Prt2),
+
+ %% These may create trace messages
+ erlang:port_command(Prt1, <<?ECHO_DRV_NOOP>>),
+ erlang:port_command(Prt2, <<?ECHO_DRV_NOOP>>),
+
+ %% Test what happens when the tracer dies
+ trace_delivered(),
+ TracerPid ! stop,
+ receive {'DOWN', Ref, process, TracerPid, normal} -> ok end,
+
+ %% These should not generate any trace messages
+ erlang:port_command(Prt1, <<?ECHO_DRV_NOOP>>),
+ erlang:port_command(Prt2, <<?ECHO_DRV_NOOP>>),
+
+ InfoCheck(false, Prt1),
+ InfoCheck(false, Prt2),
+
+ erlang:port_close(Prt1),
+ erlang:port_close(Prt2),
+ erlang:trace(all, false, [all]),
+ {Prt1, Prt2}
+ end,
+
+ {_Prt11, Prt12} = Test(new, false, true),
+ [{trace, Prt12, 'receive', {S, {command,<<?ECHO_DRV_NOOP>>}}}]
+ = flush(Prt12),
+
+ {_Prt21, Prt22} = Test(new_ports, false, true),
+ [{trace, Prt22, 'receive', {S, {command,<<?ECHO_DRV_NOOP>>}}}]
+ = flush(Prt22),
+
+ {Prt31, _Prt32} = Test(existing, true, false),
+ [{trace, Prt31, 'receive', {S, {command,<<?ECHO_DRV_NOOP>>}}}]
+ = flush(Prt31),
+
+ {Prt41, _Prt42} = Test(existing_ports, true, false),
+ [{trace, Prt41, 'receive', {S, {command,<<?ECHO_DRV_NOOP>>}}}]
+ = flush(Prt41),
+
+ {Prt51, Prt52} = Test(all, true, true),
+ [{trace, Prt51, 'receive', {S, {command,<<?ECHO_DRV_NOOP>>}}}]
+ = flush(Prt51),
+ [{trace, Prt52, 'receive', {S, {command,<<?ECHO_DRV_NOOP>>}}}]
+ = flush(Prt52),
+
+ {Prt61, Prt62} = Test(ports, true, true),
+ [{trace, Prt61, 'receive', {S, {command,<<?ECHO_DRV_NOOP>>}}}]
+ = flush(Prt61),
+ [{trace, Prt62, 'receive', {S, {command,<<?ECHO_DRV_NOOP>>}}}]
+ = flush(Prt62),
+
+ ok.
+
+%% Test that the 'ports' trace flag works
+ports(_Config) ->
+
+ {Prt, S} = trace_and_open([ports],[binary]),
+
+ [{trace, Prt, open, S, echo_drv},
+ {trace, Prt, getting_linked, S}] = flush(),
+
+ register(?MODULE, Prt),
+ unregister(?MODULE),
+ register(?MODULE, Prt),
+
+ [{trace,Prt,register,port_trace_SUITE},
+ {trace,Prt,unregister,port_trace_SUITE},
+ {trace,Prt,register,port_trace_SUITE}] = flush(),
+
+ unlink(Prt),
+ link(Prt),
+
+ [{trace,Prt,getting_unlinked,S},
+ {trace,Prt,getting_linked,S}] = flush(),
+
+ erlang:port_close(Prt),
+
+ [{trace,Prt,closed,normal},
+ {trace,Prt,unregister,port_trace_SUITE},
+ {trace,Prt,unlink,S}] = flush(),
+
+ ok.
+
+%% Test that port_close and ! close generate correct trace messages
+open_close(_Config) ->
+
+ S = trace_ports([send,'receive']),
+
+ Prt = erlang:open_port({spawn, echo_drv}, [binary]),
+ erlang:port_close(Prt),
+ [{trace, Prt, 'receive', {S, close}}] = flush(),
+
+ Prt2 = erlang:open_port({spawn, echo_drv}, [binary]),
+ Prt2 ! {S, close},
+ recv({Prt2, closed}),
+ [{trace, Prt2, 'receive', {S, close}},
+ {trace, Prt2, send, closed, S}] = flush(),
+
+ catch erlang:port_close(Prt2),
+ [] = flush(),
+
+ ok.
+
+%% Test that port_command and ! command generate correct trace messages
+command(Config) ->
+
+ Flags = [send,'receive'],
+ S = trace_ports(Flags),
+ Prt = erlang:open_port({spawn, echo_drv}, [binary]),
+
+ erlang:port_command(Prt, <<?ECHO_DRV_NOOP:8>>),
+ [{trace, Prt, 'receive', {S, {command, <<?ECHO_DRV_NOOP:8>>}}}] = flush(),
+
+ erlang:port_command(Prt, [?ECHO_DRV_NOOP, <<0:8>>]),
+ [{trace, Prt, 'receive', {S, {command, <<?ECHO_DRV_NOOP:8,0:8>>}}}] = flush(),
+
+ Prt ! {S, {command, <<?ECHO_DRV_NOOP:8>>}},
+ [{trace, Prt, 'receive', {S, {command, <<?ECHO_DRV_NOOP:8>>}}}] = flush(),
+
+ OutputMsg = <<?ECHO_DRV_NOOP:8,0:(8*512)>>,
+ Prt ! {S, {command, OutputMsg}},
+ [{trace, Prt, 'receive', {S, {command, OutputMsg}}}] = flush(),
+
+ close(Prt, Flags),
+
+ os:putenv("OUTPUTV","true"),
+ reload_drv(Config),
+
+ Prt2 = erlang:open_port({spawn, echo_drv}, [binary]),
+ OutputvMsg = [<<0:8>>,<<0:(8*512)>>,<<0:(8*256)>>,<<0:8>>],
+
+ erlang:port_command(Prt2, OutputvMsg),
+ [{trace, Prt2, 'receive', {S, {command, OutputvMsg}}}] = flush(),
+
+ Prt2 ! {S, {command, OutputvMsg}},
+ [{trace, Prt2, 'receive', {S, {command, OutputvMsg}}}] = flush(),
+
+ close(Prt2, Flags),
+
+ os:unsetenv("OUTPUTV"),
+
+ ok.
+
+%% Test that port_control generate correct trace messages
+control(_Config) ->
+
+ Flags = [send,'receive'],
+ {Prt, S} = trace_and_open(Flags,[binary]),
+
+ [0] = erlang:port_control(Prt, 1, <<?ECHO_DRV_NOOP:8, 0:8>>),
+ [{trace, Prt, 'receive', {S, {control, {1, <<?ECHO_DRV_NOOP:8, 0:8>>}}}},
+ {trace, Prt, send, {Prt, {control, <<0:8>>}}, S}] = flush(),
+
+ [0] = erlang:port_control(Prt, (1 bsl 32) - 1, <<?ECHO_DRV_NOOP:8, 0:8>>),
+ [{trace, Prt, 'receive', {S, {control, {(1 bsl 32) - 1, <<?ECHO_DRV_NOOP:8, 0:8>>}}}},
+ {trace, Prt, send, {Prt, {control, <<0:8>>}}, S}] = flush(),
+
+ Msg = <<?ECHO_DRV_NOOP:8, 0:(8*512)>>,
+ Pat = lists:duplicate(512, 0),
+ Pat = erlang:port_control(Prt, 1, Msg),
+ [{trace, Prt, 'receive', {S, {control, {1, Msg}}}},
+ {trace, Prt, send, {Prt, {control, <<0:(8*512)>>}}, S}] = flush(),
+
+ close(Prt, Flags),
+
+ ok.
+
+%% Test that port_connect and ! connect generate correct trace messages
+%% This includes that the proper getting_linked messages are sent
+connect(_Config) ->
+
+
+ {Prt, S} = trace_and_open([send, 'receive', ports],[binary]),
+
+ flush(),
+
+ {Pid,Ref} = spawn_monitor(
+ fun() ->
+ receive
+ go ->
+ Prt ! {self(), {connect, S}},
+ receive {Prt, connected} -> unlink(Prt) end
+ end
+ end),
+ erlang:trace(Pid, true, [send, 'receive', procs]),
+
+ erlang:port_connect(Prt, Pid),
+ unlink(Prt),
+
+ [{trace,Prt,getting_linked,Pid},
+ {trace,Prt,'receive',{S,{connect,Pid}}},
+ {trace,Prt,send,{Prt,connected},S},
+ {trace,Prt,getting_unlinked, S}] = flush(Prt),
+
+ [{trace,Pid,getting_linked,Prt}] = flush(),
+
+ Pid ! go,
+ recv({'DOWN',Ref,process,Pid,normal}),
+
+ [{trace,Prt,'receive',{Pid,{connect,S}}},
+ {trace,Prt,send,{Prt,connected},Pid},
+ {trace,Prt,getting_unlinked,Pid}] = flush(Prt),
+
+ [{trace,Pid,'receive',go},
+ {trace,Pid,send,{Pid,{connect,S}}, Prt},
+ {trace,Pid,'receive',{Prt,connected}},
+ {trace,Pid,unlink,Prt},
+ {trace,Pid,exit,normal}] = flush(),
+
+ erlang:port_close(Prt),
+ [{trace, Prt, 'receive', {S, close}},
+ {trace, Prt, closed, normal}] = flush(),
+ ok.
+
+%% Test that port_call generate correct trace messages
+call(_Config) ->
+
+ Flags = [send,'receive'],
+ {Prt, S} = trace_and_open(Flags,[binary]),
+
+ Test = fun(Msg) ->
+ BinMsg = term_to_binary(Msg),
+
+ Msg = erlang:port_call(Prt, 0, Msg),
+ [{trace, Prt, 'receive', {S, {call, {0, BinMsg}}}},
+ {trace, Prt, send, {Prt, {call, BinMsg}}, S}] = flush()
+ end,
+
+ Test({hello, world, make_ref()}),
+ Test({hello, world, lists:seq(1,1000)}),
+
+ close(Prt, Flags),
+
+ ok.
+
+%% Test that driver_output generate correct trace messages
+output(_Config) ->
+
+ Flags = [send],
+ {Prt, S} = trace_and_open(Flags,[binary]),
+
+ erlang:port_command(Prt, <<?ECHO_DRV_OUTPUT, 123456:32>>),
+ recv({Prt,{data,<<123456:32>>}}),
+
+ [{trace, Prt, send, {Prt, {data, <<123456:32>>}}, S}] = flush(),
+
+ close(Prt, Flags),
+
+ ok.
+
+%% Test that driver_output2 generate correct trace messages
+output2(_Config) ->
+
+ Flags = [send],
+ {Prt, S} = trace_and_open(Flags,[binary]),
+
+ erlang:port_command(Prt, <<?ECHO_DRV_OUTPUT2, 123456:32>>),
+ recv({Prt,{data,[$a|<<123456:32>>]}}),
+ [{trace, Prt, send, {Prt, {data, [$a|<<123456:32>>]}}, S}] = flush(),
+
+ close(Prt, Flags),
+
+ ok.
+
+%% Test that driver_output_binary generate correct trace messages
+output_binary(_Config) ->
+
+ Flags = [send],
+ {Prt, S} = trace_and_open(Flags,[binary]),
+
+ erlang:port_command(Prt, <<?ECHO_DRV_OUTPUT_BINARY, 0, 123456:32>>),
+ recv({Prt,{data,[$a|<<123456:32>>]}}),
+ [{trace, Prt, send, {Prt, {data, [$a|<<123456:32>>]}}, S}] = flush(),
+
+ close(Prt, Flags),
+
+ ok.
+
+%% Test that driver_outputv generate correct trace messages
+outputv(_Config) ->
+
+ Flags = [send],
+ {Prt, S} = trace_and_open(Flags,[binary]),
+
+ erlang:port_command(Prt, <<?ECHO_DRV_OUTPUTV, 123456:32>>),
+ recv({Prt,{data,[$a|<<123456:32>>]}}),
+
+ [{trace, Prt, send, {Prt, {data, [$a|<<123456:32>>]}}, S}] = flush(),
+
+ erlang:port_close(Prt),
+ [] = flush(),
+
+ ok.
+
+%% Test that driver_set_timer generate correct trace messages
+set_timer(_Config) ->
+
+ Flags = [send,'receive'],
+ {Prt, S} = trace_and_open(Flags,[binary]),
+
+ erlang:port_command(Prt, <<?ECHO_DRV_SET_TIMER>>),
+ timer:sleep(100),
+ [{trace, Prt, 'receive', {S, {command, <<?ECHO_DRV_SET_TIMER>>}}},
+ {trace, Prt, 'receive', timeout}] = flush(),
+
+ close(Prt, Flags),
+
+ ok.
+
+%% Test that driver_failure* generate correct trace messages
+failure_eof(_Config) ->
+
+ Flags = [send,'receive', ports],
+ S = trace_ports(Flags),
+
+ Prt = erlang:open_port({spawn, echo_drv}, [eof, binary]),
+ [{trace, Prt, open, S, echo_drv},
+ {trace, Prt, getting_linked, S}] = flush(),
+
+ erlang:port_command(Prt, <<?ECHO_DRV_FAILURE_EOF>>),
+ recv({Prt,eof}),
+ [{trace, Prt, 'receive', {S, {command, <<?ECHO_DRV_FAILURE_EOF>>}}},
+ {trace, Prt, send, {Prt, eof}, S}] = flush(),
+
+ close(Prt, Flags),
+
+ %% Run same test without eof option
+ failure_test(<<?ECHO_DRV_FAILURE_EOF>>, normal).
+
+failure_atom(_Config) ->
+ failure_test(<<?ECHO_DRV_FAILURE_ATOM, "failure\0">>, failure).
+failure_posix(_Config) ->
+ failure_test(<<?ECHO_DRV_FAILURE_POSIX>>, eagain).
+failure(_Config) ->
+ failure_test(<<?ECHO_DRV_FAILURE, 1>>, 1).
+
+failure_test(Failure, Reason) ->
+
+ {Prt, S} = trace_and_open([send, 'receive', ports],[binary]),
+
+ [{trace, Prt, open, S, echo_drv},
+ {trace, Prt, getting_linked, S}] = flush(),
+
+ process_flag(trap_exit, true),
+ erlang:port_command(Prt, Failure),
+ try
+ recv({'EXIT',Prt,Reason})
+ after
+ process_flag(trap_exit, false)
+ end,
+ [{trace, Prt, 'receive', {S, {command, Failure}}},
+ {trace, Prt, closed, Reason},
+ {trace, Prt, unlink, S}] = flush(),
+
+ ok.
+
+%% Test that erl_drv_output_term generate correct trace messages
+output_term(_Config) ->
+
+ Flags = [send],
+ {Prt, S} = trace_and_open(Flags,[binary]),
+
+ erlang:port_command(Prt, <<?ECHO_DRV_OUTPUT_TERM, 123456:32>>),
+ recv({echo, Prt, <<123456:32>>}),
+ [{trace, Prt, send, {echo, Prt, <<123456:32>>}, S}] = flush(),
+
+ close(Prt, Flags),
+
+ ok.
+
+%% Test that driver_output_term generate correct trace messages
+driver_output_term(_Config) ->
+
+ Flags = [send],
+ {Prt, S} = trace_and_open(Flags,[binary]),
+
+ erlang:port_command(Prt, <<?ECHO_DRV_DRIVER_OUTPUT_TERM, 123456:32>>),
+ recv({echo, Prt, <<123456:32>>}),
+ [{trace, Prt, send, {echo, Prt, <<123456:32>>}, S}] = flush(),
+
+ close(Prt, Flags),
+
+ ok.
+
+%% Test that erl_drv_send_term generate correct trace messages
+send_term(_Config) ->
+
+ Flags = [send],
+ {Prt, S} = trace_and_open(Flags,[binary]),
+
+ erlang:port_command(Prt, <<?ECHO_DRV_SEND_TERM, 123456:32>>),
+ recv({echo, Prt, <<123456:32>>}),
+ [{trace, Prt, send, {echo, Prt, <<123456:32>>}, S}] = flush(),
+
+ {Pid, Ref} = spawn_monitor(fun() -> erlang:port_command(Prt, <<?ECHO_DRV_SAVE_CALLER>>) end),
+ recv({'DOWN',Ref,process,Pid,normal}),
+ erlang:port_command(Prt, <<?ECHO_DRV_SEND_TERM, 123456:32>>),
+ [{trace, Prt, send_to_non_existing_process, {echo, Prt, <<123456:32>>}, Pid}] = flush(),
+
+ close(Prt, Flags),
+
+ ok.
+
+%% Test that driver_send_term generate correct trace messages
+driver_send_term(_Config) ->
+
+ Flags = [send],
+ {Prt, S} = trace_and_open(Flags,[binary]),
+
+ erlang:port_command(Prt, <<?ECHO_DRV_DRIVER_SEND_TERM, 123456:32>>),
+ recv({echo, Prt, <<123456:32>>}),
+ [{trace, Prt, send, {echo, Prt, <<123456:32>>}, S}] = flush(),
+
+ {Pid, Ref} = spawn_monitor(fun() -> erlang:port_command(Prt, <<?ECHO_DRV_SAVE_CALLER>>) end),
+ recv({'DOWN',Ref,process,Pid,normal}),
+ erlang:port_command(Prt, <<?ECHO_DRV_SEND_TERM, 123456:32>>),
+ [{trace, Prt, send_to_non_existing_process, {echo, Prt, <<123456:32>>}, Pid}] = flush(),
+
+ close(Prt, Flags),
+
+ ok.
+
+%% Test that driver_send_term from non-scheduler thread does not
+%% generate trace messages.
+driver_remote_send_term(_Config) ->
+
+ Flags = [send],
+ {Prt, S} = trace_and_open(Flags,[binary]),
+
+ erlang:port_command(Prt, <<?ECHO_DRV_REMOTE_SEND_TERM, 123456:32>>),
+ recv({echo, Prt, <<123456:32>>}),
+ [] = flush(),
+
+ Pid = spawn_link(
+ fun() ->
+ erlang:port_command(Prt, <<?ECHO_DRV_SAVE_CALLER>>),
+ S ! ok,
+ receive M -> S ! M end
+ end),
+ recv(ok),
+ erlang:trace(Pid, true, ['receive']),
+
+ erlang:port_command(Prt, <<?ECHO_DRV_REMOTE_SEND_TERM, 123456:32>>),
+ recv({echo, Prt, <<123456:32>>}),
+ [{trace, Pid, 'receive', {echo, Prt, <<123456:32>>}}] = flush(),
+
+ close(Prt, Flags),
+
+ ok.
+
+%%%%%%%%%%%%%%%%%%%
+%% Helper functions
+%%%%%%%%%%%%%%%%%%%
+
+trace_ports(TraceFlags) ->
+ erlang:trace(new_ports, true, TraceFlags),
+ self().
+
+trace_and_open(TraceFlags, OpenFlags) ->
+ S = self(),
+ Ports = proplists:get_value(ports, TraceFlags),
+ [trace_ports(TraceFlags) || Ports],
+ Prt = erlang:open_port({spawn, echo_drv}, OpenFlags),
+ [erlang:trace(Prt, true, TraceFlags) || Ports == undefined],
+ {Prt, S}.
+
+close(Prt, Flags) ->
+ Recv = proplists:get_value('receive', Flags),
+ Ports = proplists:get_value(ports, Flags),
+ S = self(),
+
+ erlang:port_close(Prt),
+
+ if Recv, Ports ->
+ [{trace, Prt, 'receive', {S, close}},
+ {trace, Prt, closed, normal},
+ {trace, Prt, unlink, S}] = flush();
+ Recv ->
+ [{trace, Prt, 'receive', {S, close}}] = flush();
+ Ports ->
+ [{trace, Prt, closed, normal},
+ {trace, Prt, unlink, S}] = flush();
+ true ->
+ [] = flush()
+ end.
+
+trace_delivered() ->
+ Ref = erlang:trace_delivered(all),
+ receive {trace_delivered, all, Ref} -> ok end.
+
+flush() ->
+ flush(all).
+flush(From) ->
+ trace_delivered(),
+ f(From).
+
+f(From) ->
+ receive
+ M when From =:= all; element(2, M) == From ->
+ [M | f(From)]
+ after 0 ->
+ []
+ end.
+
+recv(Msg) ->
+ receive Msg -> ok after 1000 -> ct:fail({did_not_get_data,Msg,flush()}) end.
+
+load_drv(Config) ->
+ Path = proplists:get_value(data_dir, Config),
+ case erl_ddll:load_driver(Path, echo_drv) of
+ ok -> ok;
+ {error, Error} = Res ->
+ io:format("~s\n", [erl_ddll:format_error(Error)]),
+ ct:fail(Res)
+ end.
+
+reload_drv(Config) ->
+ erl_ddll:unload_driver(echo_drv),
+ load_drv(Config).
diff --git a/erts/emulator/test/port_trace_SUITE_data/Makefile.src b/erts/emulator/test/port_trace_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..c1bf142ccf
--- /dev/null
+++ b/erts/emulator/test/port_trace_SUITE_data/Makefile.src
@@ -0,0 +1,3 @@
+all: echo_drv@dll@
+
+@SHLIB_RULES@
diff --git a/erts/emulator/test/port_trace_SUITE_data/echo_drv.c b/erts/emulator/test/port_trace_SUITE_data/echo_drv.c
new file mode 100644
index 0000000000..20ec33a594
--- /dev/null
+++ b/erts/emulator/test/port_trace_SUITE_data/echo_drv.c
@@ -0,0 +1,296 @@
+#include <stdio.h>
+#include "erl_driver.h"
+#include <errno.h>
+#include <string.h>
+#include <assert.h>
+
+
+/* -------------------------------------------------------------------------
+** Data types
+**/
+
+struct my_thread {
+ struct my_thread* next;
+ ErlDrvTid tid;
+};
+
+typedef struct _erl_drv_data {
+ ErlDrvPort erlang_port;
+ ErlDrvTermData caller;
+ struct my_thread* threads;
+} EchoDrvData;
+
+struct remote_send_term {
+ struct my_thread thread;
+ ErlDrvTermData port;
+ ErlDrvTermData caller;
+ int len;
+ char buf[1]; /* buf[len] */
+};
+
+#define ECHO_DRV_NOOP 0
+#define ECHO_DRV_OUTPUT 1
+#define ECHO_DRV_OUTPUT2 2
+#define ECHO_DRV_OUTPUT_BINARY 3
+#define ECHO_DRV_OUTPUTV 4
+#define ECHO_DRV_SET_TIMER 5
+#define ECHO_DRV_FAILURE_EOF 6
+#define ECHO_DRV_FAILURE_ATOM 7
+#define ECHO_DRV_FAILURE_POSIX 8
+#define ECHO_DRV_FAILURE 9
+#define ECHO_DRV_OUTPUT_TERM 10
+#define ECHO_DRV_DRIVER_OUTPUT_TERM 11
+#define ECHO_DRV_SEND_TERM 12
+#define ECHO_DRV_DRIVER_SEND_TERM 13
+#define ECHO_DRV_SAVE_CALLER 14
+#define ECHO_DRV_REMOTE_SEND_TERM 15
+
+
+/* -------------------------------------------------------------------------
+** Entry struct
+**/
+
+static EchoDrvData *echo_drv_start(ErlDrvPort port, char *command);
+static void echo_drv_stop(ErlDrvData drv_data);
+static void echo_drv_output(ErlDrvData drv_data, char *buf,
+ ErlDrvSizeT len);
+static void echo_drv_outputv(ErlDrvData drv_data, ErlIOVec *iov);
+static void echo_drv_finish(void);
+static ErlDrvSSizeT echo_drv_control(ErlDrvData drv_data,
+ unsigned int command,
+ char *buf, ErlDrvSizeT len,
+ char **rbuf, ErlDrvSizeT rlen);
+static void echo_drv_timeout(ErlDrvData drv_data);
+static ErlDrvSSizeT echo_drv_call(ErlDrvData drv_data,
+ unsigned int command,
+ char *buf, ErlDrvSizeT len,
+ char **rbuf, ErlDrvSizeT rlen,
+ unsigned int *flags);
+
+static ErlDrvEntry echo_drv_entry = {
+ NULL, /* init */
+ echo_drv_start,
+ echo_drv_stop,
+ echo_drv_output,
+ NULL, /* ready_input */
+ NULL, /* ready_output */
+ "echo_drv",
+ echo_drv_finish,
+ NULL, /* handle */
+ echo_drv_control,
+ echo_drv_timeout, /* timeout */
+ NULL, /* outputv */
+ NULL, /* ready_async */
+ NULL, /* flush */
+ echo_drv_call, /* call */
+ NULL, /* event */
+ ERL_DRV_EXTENDED_MARKER,
+ ERL_DRV_EXTENDED_MAJOR_VERSION,
+ ERL_DRV_EXTENDED_MINOR_VERSION,
+ 0,
+ NULL,
+ NULL,
+ NULL
+};
+
+static void* send_term_thread(void *);
+
+/* -------------------------------------------------------------------------
+** Entry functions
+**/
+
+DRIVER_INIT(echo_drv)
+{
+ char buff[5];
+ size_t size = sizeof(buff);
+
+ if (erl_drv_getenv("OUTPUTV", buff, &size) == -1) {
+ echo_drv_entry.outputv = NULL;
+ } else {
+ echo_drv_entry.outputv = echo_drv_outputv;
+ }
+
+ return &echo_drv_entry;
+}
+
+static EchoDrvData *echo_drv_start(ErlDrvPort port, char *command)
+{
+ EchoDrvData *echo_drv_data_p = driver_alloc(sizeof(EchoDrvData));
+ echo_drv_data_p->erlang_port = port;
+ echo_drv_data_p->caller = driver_caller(port);
+ echo_drv_data_p->threads = NULL;
+ return echo_drv_data_p;
+}
+
+static void echo_drv_stop(EchoDrvData *data_p)
+{
+ struct my_thread* thr = data_p->threads;
+
+ while (thr) {
+ struct my_thread* next = thr->next;
+ void* exit_value;
+ int ret = erl_drv_thread_join(thr->tid, &exit_value);
+ assert(ret == 0 && exit_value == NULL);
+ driver_free(thr);
+ thr = next;
+ }
+ driver_free(data_p);
+}
+
+static void echo_drv_outputv(ErlDrvData drv_data, ErlIOVec *iov)
+{
+ return;
+}
+
+static void echo_drv_output(ErlDrvData drv_data, char *buf, ErlDrvSizeT len) {
+ EchoDrvData* data_p = (EchoDrvData *) drv_data;
+ ErlDrvPort port = data_p->erlang_port;
+
+ switch (buf[0]) {
+ case ECHO_DRV_OUTPUT:
+ {
+ driver_output(port, buf+1, len-1);
+ break;
+ }
+ case ECHO_DRV_OUTPUT2:
+ {
+ driver_output2(port, "a", 1, buf+1, len-1);
+ break;
+ }
+ case ECHO_DRV_OUTPUT_BINARY:
+ {
+ ErlDrvBinary *bin = driver_alloc_binary(len-1);
+ memcpy(&bin->orig_bytes, buf+1, len-1);
+ driver_output_binary(port, "a", 1, bin, 1, len - 2);
+ driver_free_binary(bin);
+ break;
+ }
+ case ECHO_DRV_OUTPUTV:
+ {
+ ErlIOVec iov;
+ ErlDrvSizeT sz;
+ driver_enq(port, buf + 1, len - 1);
+ sz = driver_peekqv(port, &iov);
+ driver_outputv(port, "a", 1, &iov, 0);
+ driver_deq(port, sz);
+ break;
+ }
+ case ECHO_DRV_SET_TIMER:
+ {
+ driver_set_timer(port, 10);
+ break;
+ }
+ case ECHO_DRV_FAILURE_EOF:
+ {
+ driver_failure_eof(port);
+ break;
+ }
+ case ECHO_DRV_FAILURE_ATOM:
+ {
+ driver_failure_atom(port, buf+1);
+ break;
+ }
+ case ECHO_DRV_FAILURE_POSIX:
+ {
+ driver_failure_posix(port, EAGAIN);
+ break;
+ }
+ case ECHO_DRV_FAILURE:
+ {
+ driver_failure(port, buf[1]);
+ break;
+ }
+ case ECHO_DRV_OUTPUT_TERM:
+ case ECHO_DRV_DRIVER_OUTPUT_TERM:
+ case ECHO_DRV_SEND_TERM:
+ case ECHO_DRV_DRIVER_SEND_TERM:
+ {
+ ErlDrvTermData term[] = {
+ ERL_DRV_ATOM, driver_mk_atom("echo"),
+ ERL_DRV_PORT, driver_mk_port(port),
+ ERL_DRV_BUF2BINARY, (ErlDrvTermData)(buf+1),
+ (ErlDrvTermData)(len - 1),
+ ERL_DRV_TUPLE, 3};
+ switch (buf[0]) {
+ case ECHO_DRV_OUTPUT_TERM:
+ erl_drv_output_term(driver_mk_port(port), term, sizeof(term) / sizeof(ErlDrvTermData));
+ break;
+ case ECHO_DRV_DRIVER_OUTPUT_TERM:
+ driver_output_term(port, term, sizeof(term) / sizeof(ErlDrvTermData));
+ break;
+ case ECHO_DRV_SEND_TERM:
+ driver_send_term(port, data_p->caller,
+ term, sizeof(term) / sizeof(ErlDrvTermData));
+ break;
+ case ECHO_DRV_DRIVER_SEND_TERM:
+ erl_drv_send_term(driver_mk_port(port), data_p->caller,
+ term, sizeof(term) / sizeof(ErlDrvTermData));
+ break;
+ }
+ break;
+ }
+ case ECHO_DRV_REMOTE_SEND_TERM:
+ {
+ struct remote_send_term *t = driver_alloc(sizeof(struct remote_send_term) + len);
+ t->len = len-1;
+ t->port = driver_mk_port(port);
+ t->caller = data_p->caller;
+ memcpy(t->buf, buf+1, t->len);
+ erl_drv_thread_create("tmp_thread", &t->thread.tid, send_term_thread, t, NULL);
+ t->thread.next = data_p->threads;
+ data_p->threads = &t->thread;
+ break;
+ }
+ case ECHO_DRV_SAVE_CALLER:
+ data_p->caller = driver_caller(port);
+ break;
+ default:
+ break;
+ }
+}
+
+static void echo_drv_finish() {
+
+}
+
+static ErlDrvSSizeT echo_drv_control(ErlDrvData drv_data,
+ unsigned int command,
+ char *buf, ErlDrvSizeT len,
+ char **rbuf, ErlDrvSizeT rlen)
+{
+ if ((len - 1) > rlen)
+ *rbuf = driver_alloc(len - 1);
+ memcpy(*rbuf, buf+1, len-1);
+ return len-1;
+}
+
+static void echo_drv_timeout(ErlDrvData drv_data)
+{
+
+}
+
+static ErlDrvSSizeT echo_drv_call(ErlDrvData drv_data,
+ unsigned int command,
+ char *buf, ErlDrvSizeT len,
+ char **rbuf, ErlDrvSizeT rlen,
+ unsigned int *flags)
+{
+ if ((len - command) > rlen)
+ *rbuf = driver_alloc(len - command);
+ memcpy(*rbuf, buf+command, len-command);
+ return len-command;
+}
+
+static void* send_term_thread(void *a)
+{
+ struct remote_send_term *t = (struct remote_send_term*)a;
+ ErlDrvTermData term[] = {
+ ERL_DRV_ATOM, driver_mk_atom("echo"),
+ ERL_DRV_PORT, t->port,
+ ERL_DRV_BUF2BINARY, (ErlDrvTermData)(t->buf),
+ (ErlDrvTermData)(t->len),
+ ERL_DRV_TUPLE, 3};
+ erl_drv_send_term(t->port, t->caller,
+ term, sizeof(term) / sizeof(ErlDrvTermData));
+ return NULL;
+}
diff --git a/erts/emulator/test/prim_eval_SUITE.erl b/erts/emulator/test/prim_eval_SUITE.erl
new file mode 100644
index 0000000000..3f4965f96d
--- /dev/null
+++ b/erts/emulator/test/prim_eval_SUITE.erl
@@ -0,0 +1,78 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. 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(prim_eval_SUITE).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_testcase/2, end_per_testcase/2,
+ init_per_group/2, end_per_group/2]).
+
+-export(['ERL-365'/1]).
+
+init_per_testcase(_Case, Config) ->
+ Config.
+
+end_per_testcase(_Case, _Config) ->
+ ok.
+
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap,{minutes,1}}].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+all() ->
+ ['ERL-365'].
+
+'ERL-365'(Config) when is_list(Config) ->
+ %% def_arg_reg[0] is used for storage of timeout instruction
+ %% when a 'receive after' is executed. When a process was
+ %% scheduled out inside prim_eval:'receive'/0 due to a function
+ %% call, def_arg_reg[0] was overwritten due to storage of live
+ %% registers.
+ P = spawn_link(fun () ->
+ prim_eval:'receive'(fun (_M) ->
+ erlang:bump_reductions((1 bsl 27)-1),
+ id(true),
+ nomatch
+ end,
+ 200)
+ end),
+ receive after 100 -> ok end,
+ P ! {wont, match},
+ receive after 200 -> ok end,
+ ok.
+
+
+
+id(X) ->
+ X.
diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl
index 932d0f87f1..a8bcfac84d 100644
--- a/erts/emulator/test/process_SUITE.erl
+++ b/erts/emulator/test/process_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2017. 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/.
+%% 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
%%
-%% 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.
+%% 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%
%%
@@ -25,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).
@@ -40,11 +41,12 @@
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,
process_info_messages/1, process_flag_badarg/1, process_flag_heap_size/1,
- spawn_opt_heap_size/1,
+ spawn_opt_heap_size/1, spawn_opt_max_heap_size/1,
processes_large_tab/1, processes_default_tab/1, processes_small_tab/1,
processes_this_tab/1, processes_apply_trap/1,
processes_last_call_trap/1, processes_gc_trap/1,
@@ -58,14 +60,16 @@
system_task_on_suspended/1,
gc_request_when_gc_disabled/1,
gc_request_blast_when_gc_disabled/1]).
--export([prio_server/2, prio_client/2]).
+-export([prio_server/2, prio_client/2, init/1, handle_event/2]).
-export([init_per_testcase/2, end_per_testcase/2]).
-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},
@@ -74,11 +78,14 @@ 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,
- spawn_opt_heap_size, otp_6237, {group, processes_bif},
+ spawn_opt_heap_size, spawn_opt_max_heap_size, otp_6237,
+ {group, processes_bif},
{group, otp_7738}, garb_other_running,
{group, system_task}].
@@ -112,7 +119,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.
@@ -124,12 +131,15 @@ 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).
+ %% Restore max_heap_size to default value.
+ erlang:system_flag(max_heap_size,
+ #{size => 0,
+ kill => true,
+ error_logger => true}),
+ ok.
fun_spawn(Fun) ->
spawn_link(erlang, apply, [Fun, []]).
@@ -142,7 +152,7 @@ spawn_with_binaries(Config) when is_list(Config) ->
TwoMeg = lists:duplicate(1024, L),
Fun = fun() -> spawn(?MODULE, binary_owner, [list_to_binary(TwoMeg)]),
receive after 1 -> ok end end,
- Iter = case test_server:purify_is_running() of
+ Iter = case test_server:is_valgrind() of
true -> 10;
false -> 150
end,
@@ -154,11 +164,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.
@@ -172,11 +181,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.
@@ -190,34 +198,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.
@@ -236,7 +242,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
@@ -247,7 +253,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.
@@ -256,21 +262,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.
@@ -284,7 +289,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) ->
@@ -316,10 +321,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() ->
@@ -328,7 +332,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.
@@ -341,15 +345,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.
@@ -360,7 +362,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) ->
@@ -379,29 +381,26 @@ eat_high(Low) ->
process_flag(priority, high),
receive after 1000 -> ok end,
exit(Low, {you, are, dead}),
- {_, Sec, _} = now(),
- loop(Sec, Sec).
+ loop(erlang:monotonic_time() + erlang:convert_time_unit(5,second,native)).
%% Busy loop for 5 seconds.
-loop(OrigSec, CurrentSec) when CurrentSec < OrigSec+5 ->
- {_, NewSec, _} = now(),
- loop(OrigSec, NewSec);
-loop(_, _) ->
- ok.
+loop(StopTime) ->
+ case StopTime >= erlang:monotonic_time() of
+ true -> ok;
+ false -> loop(StopTime)
+ end.
%% 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 +408,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() ->
@@ -432,6 +431,8 @@ t_process_info(Config) when is_list(Config) ->
{status, running} = process_info(self(), status),
{min_heap_size, 233} = process_info(self(), min_heap_size),
{min_bin_vheap_size,46422} = process_info(self(), min_bin_vheap_size),
+ {max_heap_size, #{ size := 0, kill := true, error_logger := true}} =
+ process_info(self(), max_heap_size),
{current_function,{?MODULE,t_process_info,1}} =
process_info(self(), current_function),
{current_function,{?MODULE,t_process_info,1}} =
@@ -445,11 +446,22 @@ t_process_info(Config) when is_list(Config) ->
verify_loc(Line2, Res2),
pi_stacktrace([{?MODULE,t_process_info,1,?LINE}]),
+ verify_stacktrace_depth(),
+
Gleader = group_leader(),
{group_leader, Gleader} = process_info(self(), group_leader),
{'EXIT',{badarg,_Info}} = (catch process_info('not_a_pid')),
ok.
+verify_stacktrace_depth() ->
+ CS = current_stacktrace,
+ OldDepth = erlang:system_flag(backtrace_depth, 0),
+ {CS,[]} = erlang:process_info(self(), CS),
+ _ = erlang:system_flag(backtrace_depth, 8),
+ {CS,[{?MODULE,verify_stacktrace_depth,0,_},_|_]} =
+ erlang:process_info(self(), CS),
+ _ = erlang:system_flag(backtrace_depth, OldDepth).
+
pi_stacktrace(Expected0) ->
{Line,Res} = {?LINE,erlang:process_info(self(), current_stacktrace)},
{current_stacktrace,Stack} = Res,
@@ -571,6 +583,8 @@ process_info_other_msg(Config) when is_list(Config) ->
{min_heap_size, 233} = process_info(Pid, min_heap_size),
{min_bin_vheap_size, 46422} = process_info(Pid, min_bin_vheap_size),
+ {max_heap_size, #{ size := 0, kill := true, error_logger := true}} =
+ process_info(self(), max_heap_size),
Pid ! stop,
ok.
@@ -666,12 +680,8 @@ 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),
+ Proc = spawn_link(fun () -> receive after infinity -> ok end end),
register(process_SUITE_process_info_2_list1, self()),
register(process_SUITE_process_info_2_list2, Proc),
erts_debug:set_internal_state(available_internal_state,true),
@@ -702,10 +712,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 +744,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 +753,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 +808,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 +838,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 +930,73 @@ start_spawner() ->
stop_spawner() ->
ok.
+%% Tests erlang:process_info(Pid, garbage_collection_info)
+process_info_garbage_collection(_Config) ->
+ Parent = self(),
+ Pid = spawn_link(
+ fun() ->
+ %% We set mqd to off_heap and send an tuple
+ %% to process in order to force mbuf_size
+ %% to be used
+ process_flag(message_queue_data, off_heap),
+ 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},{total_heap_size, THSBefore}] =
+ erlang:process_info(Pid, [garbage_collection_info, total_heap_size]),
+ Pid ! go, receive deep -> ok end,
+ [{_, Deep},{_,THSDeep}] =
+ erlang:process_info(Pid, [garbage_collection_info, total_heap_size]),
+ Pid ! {ok, make_ref()}, receive shallow -> ok end,
+ [{_, After},{_, THSAfter}] =
+ erlang:process_info(Pid, [garbage_collection_info, total_heap_size]),
+ 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]),
+ ct:log("Before THS: ~p",[THSBefore]),
+ ct:log("Deep THS: ~p",[THSDeep]),
+ ct:log("After THS: ~p",[THSAfter]),
+
+ %% Check stack_size
+ true = gv(stack_size, Before) < gv(stack_size, Deep),
+ true = gv(stack_size, After) < gv(stack_size, Deep),
+
+ %% Check used heap size
+ true = gv(heap_size, Before) + gv(old_heap_size, Before)
+ < gv(heap_size, Deep) + gv(old_heap_size, Deep),
+ true = gv(heap_size, Before) + gv(old_heap_size, Before)
+ < gv(heap_size, After) + gv(old_heap_size, After),
+
+ %% Check that total_heap_size == heap_block_size + old_heap_block_size + mbuf_size
+ THSBefore = gv(heap_block_size, Before)
+ + gv(old_heap_block_size, Before)
+ + gv(mbuf_size, Before),
+
+ THSDeep = gv(heap_block_size, Deep)
+ + gv(old_heap_block_size, Deep)
+ + gv(mbuf_size, Deep),
+
+ THSAfter = gv(heap_block_size, After)
+ + gv(old_heap_block_size, After)
+ + gv(mbuf_size, After),
+
+ ok.
+
+gv(Key,List) ->
+ proplists:get_value(Key,List).
+
%% Tests erlang:bump_reductions/1.
bump_reductions(Config) when is_list(Config) ->
erlang:garbage_collect(),
@@ -942,10 +1007,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
@@ -968,36 +1033,48 @@ bump_big(Prev, Limit) ->
%% Priority 'low' should be mixed with 'normal' using a factor of
%% about 8. (OTP-2644)
low_prio(Config) when is_list(Config) ->
- case erlang:system_info(schedulers_online) of
- 1 ->
- ok = low_prio_test(Config);
- _ ->
- erlang:system_flag(multi_scheduling, block),
- ok = low_prio_test(Config),
- erlang:system_flag(multi_scheduling, unblock),
- {comment,
- "Test not written for SMP runtime system. "
- "Multi scheduling blocked during test."}
- end.
+ erlang:system_flag(multi_scheduling, block_normal),
+ Prop = low_prio_test(Config),
+ erlang:system_flag(multi_scheduling, unblock_normal),
+ Str = lists:flatten(io_lib:format("Low/high proportion is ~.3f",
+ [Prop])),
+ {comment,Str}.
low_prio_test(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- S = spawn_link(?MODULE, prio_server, [0, 0]),
+
+ %% Spawn the server running with high priority. The server must
+ %% not run at normal priority as that would skew the results for
+ %% two reasons:
+ %%
+ %% 1. There would be one more normal-priority processes than
+ %% low-priority processes.
+ %%
+ %% 2. The receive queue would grow faster than the server process
+ %% could process it. That would in turn trigger the reduction
+ %% punishment for the clients.
+ S = spawn_opt(?MODULE, prio_server, [0, 0], [link,{priority,high}]),
+
+ %% Spawn the clients and let them run for a while.
PCs = spawn_prio_clients(S, erlang:system_info(schedulers_online)),
- timer:sleep(2000),
+ ct:sleep({seconds,2}),
lists:foreach(fun (P) -> exit(P, kill) end, PCs),
+
+ %% Stop the server and retrieve the result.
S ! exit,
- receive {'EXIT', S, {A, B}} -> check_prio(A, B) end,
- ok.
+ receive
+ {'EXIT', S, {A, B}} ->
+ check_prio(A, B)
+ end.
check_prio(A, B) ->
Prop = A/B,
ok = io:format("Low=~p, High=~p, Prop=~p\n", [A, B, Prop]),
- %% It isn't 1/8, it's more like 0.3, but let's check that
- %% the low-prio processes get some little chance to run at all.
- true = (Prop < 1.0),
- true = (Prop > 1/32).
+ %% Prop is expected to be appr. 1/8. Allow a reasonable margin.
+ true = Prop < 1/4,
+ true = Prop > 1/16,
+ Prop.
prio_server(A, B) ->
receive
@@ -1032,8 +1109,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) ->
@@ -1042,9 +1118,9 @@ yield(Config) when is_list(Config) ->
++ ") is enabled. Testcase gets messed up by modfied "
"timing."};
_ ->
- MS = erlang:system_flag(multi_scheduling, block),
+ MS = erlang:system_flag(multi_scheduling, block_normal),
yield_test(),
- erlang:system_flag(multi_scheduling, unblock),
+ erlang:system_flag(multi_scheduling, unblock_normal),
case MS of
blocked ->
{comment,
@@ -1074,7 +1150,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 +1187,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 +1237,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 +1278,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 +1316,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 +1374,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),
@@ -1316,6 +1381,28 @@ process_flag_badarg(Config) when is_list(Config) ->
chk_badarg(fun () -> process_flag(min_heap_size, gurka) end),
chk_badarg(fun () -> process_flag(min_bin_vheap_size, gurka) end),
chk_badarg(fun () -> process_flag(min_bin_vheap_size, -1) end),
+
+ chk_badarg(fun () -> process_flag(max_heap_size, gurka) end),
+ chk_badarg(fun () -> process_flag(max_heap_size, -1) end),
+ chk_badarg(fun () ->
+ {_,Min} = process_info(self(), min_heap_size),
+ process_flag(max_heap_size, Min - 1)
+ end),
+ chk_badarg(fun () ->
+ {_,Min} = process_info(self(), min_heap_size),
+ process_flag(max_heap_size, #{size => Min - 1})
+ end),
+ chk_badarg(fun () -> process_flag(max_heap_size, #{}) end),
+ chk_badarg(fun () -> process_flag(max_heap_size, #{ kill => true }) end),
+ chk_badarg(fun () -> process_flag(max_heap_size, #{ size => 233,
+ kill => gurka }) end),
+ chk_badarg(fun () -> process_flag(max_heap_size, #{ size => 233,
+ error_logger => gurka }) end),
+ chk_badarg(fun () -> process_flag(max_heap_size, #{ size => 233,
+ kill => true,
+ error_logger => gurka }) end),
+ chk_badarg(fun () -> process_flag(max_heap_size, #{ size => 1 bsl 64 }) end),
+
chk_badarg(fun () -> process_flag(priority, 4711) end),
chk_badarg(fun () -> process_flag(save_calls, hmmm) end),
P= spawn_link(fun () -> receive die -> ok end end),
@@ -1326,8 +1413,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 +1479,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 +1506,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 +1524,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 +1538,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,16 +1546,20 @@ 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) ->
- sys_mem_cond_run(1024, fun () -> chk_processes_bif_test_res(processes_bif_test()) end).
+ Mem = case {erlang:system_info(build_type),
+ erlang:system_info(allocator)} of
+ {lcnt, {_, _Vsn, [sys_alloc], _Opts}} ->
+ %% When running +Mea min + lcnt we may need more memory
+ 1024 * 4;
+ _ ->
+ 1024
+ end,
+ sys_mem_cond_run(Mem, fun () -> chk_processes_bif_test_res(processes_bif_test()) end).
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,
@@ -1493,7 +1570,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"
@@ -1534,7 +1611,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
@@ -1544,7 +1621,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
@@ -1553,7 +1630,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
@@ -1566,6 +1643,7 @@ spawn_initial_hangarounds(_Cleaner, NP, Max, Len, HAs) when NP > Max ->
{Len, HAs};
spawn_initial_hangarounds(Cleaner, NP, Max, Len, HAs) ->
Skip = 30,
+ wait_for_proc_slots(Skip+3),
HA1 = spawn_opt(?MODULE, hangaround, [Cleaner, initial_hangaround],
[{priority, low}]),
HA2 = spawn_opt(?MODULE, hangaround, [Cleaner, initial_hangaround],
@@ -1575,6 +1653,15 @@ spawn_initial_hangarounds(Cleaner, NP, Max, Len, HAs) ->
spawn_drop(Skip),
spawn_initial_hangarounds(Cleaner, NP+Skip, Max, Len+3, [HA1,HA2,HA3|HAs]).
+wait_for_proc_slots(MinFreeSlots) ->
+ case erlang:system_info(process_limit) - erlang:system_info(process_count) of
+ FreeSlots when FreeSlots < MinFreeSlots ->
+ receive after 10 -> ok end,
+ wait_for_proc_slots(MinFreeSlots);
+ _FreeSlots ->
+ ok
+ end.
+
spawn_drop(N) when N =< 0 ->
ok;
spawn_drop(N) ->
@@ -1613,7 +1700,7 @@ processes_bif_test() ->
true ->
%% Do it again with a process suspended while
%% in the processes/0 bif.
- erlang:system_flag(multi_scheduling, block),
+ erlang:system_flag(multi_scheduling, block_normal),
Suspendee = spawn_link(fun () ->
Tester ! {suspend_me, self()},
Tester ! {self(),
@@ -1626,7 +1713,7 @@ processes_bif_test() ->
end),
receive {suspend_me, Suspendee} -> ok end,
erlang:suspend_process(Suspendee),
- erlang:system_flag(multi_scheduling, unblock),
+ erlang:system_flag(multi_scheduling, unblock_normal),
[{status,suspended},{current_function,{erlang,ptab_list_continue,2}}] =
process_info(Suspendee, [status, current_function]),
@@ -1658,7 +1745,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,
@@ -1666,10 +1753,10 @@ do_processes_bif_test(WantReds, DieTest, Processes) ->
Splt = NoTestProcs div 10,
{TP1, TP23} = lists:split(Splt, TestProcs),
{TP2, TP3} = lists:split(Splt, TP23),
- erlang:system_flag(multi_scheduling, block),
+ erlang:system_flag(multi_scheduling, block_normal),
Tester ! DoIt,
receive GetGoing -> ok end,
- erlang:system_flag(multi_scheduling, unblock),
+ erlang:system_flag(multi_scheduling, unblock_normal),
SpawnProcesses(high),
lists:foreach( fun (P) ->
SpawnHangAround(),
@@ -1700,7 +1787,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 ->
@@ -1721,12 +1808,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(),
@@ -1776,8 +1863,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.
@@ -1807,7 +1894,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() ->
@@ -1815,7 +1902,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 ->
@@ -1831,10 +1918,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,
@@ -1857,10 +1940,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),
@@ -1875,10 +1954,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(),
@@ -1890,7 +1965,7 @@ processes_gc_trap(Config) when is_list(Config) ->
processes()
end,
- erlang:system_flag(multi_scheduling, block),
+ erlang:system_flag(multi_scheduling, block_normal),
Suspendee = spawn_link(fun () ->
Tester ! {suspend_me, self()},
Tester ! {self(),
@@ -1900,7 +1975,7 @@ processes_gc_trap(Config) when is_list(Config) ->
end),
receive {suspend_me, Suspendee} -> ok end,
erlang:suspend_process(Suspendee),
- erlang:system_flag(multi_scheduling, unblock),
+ erlang:system_flag(multi_scheduling, unblock_normal),
[{status,suspended}, {current_function,{erlang,ptab_list_continue,2}}]
= process_info(Suspendee, [status, current_function]),
@@ -1917,10 +1992,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
@@ -1932,10 +2003,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
@@ -1946,10 +2013,122 @@ spawn_opt_heap_size(Config) when is_list(Config) ->
Pid ! stop,
ok.
-processes_term_proc_list(doc) ->
- [];
-processes_term_proc_list(suite) ->
- [];
+spawn_opt_max_heap_size(_Config) ->
+
+ error_logger:add_report_handler(?MODULE, self()),
+
+ %% Test that numerical limit works
+ max_heap_size_test(1024, 1024, true, true),
+
+ %% Test that map limit works
+ max_heap_size_test(#{ size => 1024 }, 1024, true, true),
+
+ %% Test that no kill is sent
+ max_heap_size_test(#{ size => 1024, kill => false }, 1024, false, true),
+
+ %% Test that no error_logger report is sent
+ max_heap_size_test(#{ size => 1024, error_logger => false }, 1024, true, false),
+
+ %% Test that system_flag works
+ erlang:system_flag(max_heap_size, #{ size => 0, kill => false,
+ error_logger => true}),
+ max_heap_size_test(#{ size => 1024 }, 1024, false, true),
+ max_heap_size_test(#{ size => 1024, kill => true }, 1024, true, true),
+
+ erlang:system_flag(max_heap_size, #{ size => 0, kill => true,
+ error_logger => false}),
+ max_heap_size_test(#{ size => 1024 }, 1024, true, false),
+ max_heap_size_test(#{ size => 1024, error_logger => true }, 1024, true, true),
+
+ erlang:system_flag(max_heap_size, #{ size => 1 bsl 20, kill => true,
+ error_logger => true}),
+ max_heap_size_test(#{ }, 1 bsl 20, true, true),
+
+ erlang:system_flag(max_heap_size, #{ size => 0, kill => true,
+ error_logger => true}),
+
+ %% Test that ordinary case works as expected again
+ max_heap_size_test(1024, 1024, true, true),
+
+ ok.
+
+max_heap_size_test(Option, Size, Kill, ErrorLogger)
+ when map_size(Option) == 0 ->
+ max_heap_size_test([], Size, Kill, ErrorLogger);
+max_heap_size_test(Option, Size, Kill, ErrorLogger)
+ when is_map(Option); is_integer(Option) ->
+ max_heap_size_test([{max_heap_size, Option}], Size, Kill, ErrorLogger);
+max_heap_size_test(Option, Size, Kill, ErrorLogger) ->
+ OomFun = fun F() -> timer:sleep(5),[lists:seq(1,1000)|F()] end,
+ Pid = spawn_opt(OomFun, Option),
+ {max_heap_size, MHSz} = erlang:process_info(Pid, max_heap_size),
+ ct:log("Default: ~p~nOption: ~p~nProc: ~p~n",
+ [erlang:system_info(max_heap_size), Option, MHSz]),
+
+ #{ size := Size} = MHSz,
+
+ Ref = erlang:monitor(process, Pid),
+ if Kill ->
+ receive
+ {'DOWN', Ref, process, Pid, killed} ->
+ ok
+ end;
+ true ->
+ ok
+ end,
+ if ErrorLogger ->
+ receive
+ %% There must be at least one error message.
+ {error, _, {emulator, _, [Pid|_]}} ->
+ ok
+ end;
+ true ->
+ ok
+ end,
+ if not Kill ->
+ exit(Pid, die),
+ receive
+ {'DOWN', Ref, process, Pid, die} ->
+ ok
+ end,
+ %% If the process was not killed, the limit may have
+ %% been reached more than once and there may be
+ %% more {error, ...} messages left.
+ receive_error_messages(Pid);
+ true ->
+ ok
+ end,
+
+ %% Make sure that there are no unexpected messages.
+ receive_unexpected().
+
+receive_error_messages(Pid) ->
+ receive
+ {error, _, {emulator, _, [Pid|_]}} ->
+ receive_error_messages(Pid)
+ after 1000 ->
+ ok
+ end.
+
+receive_unexpected() ->
+ receive
+ {info_report, _, _} ->
+ %% May be an alarm message from os_mon. Ignore.
+ receive_unexpected();
+ M ->
+ ct:fail({unexpected_message, M})
+ after 10 ->
+ ok
+ end.
+
+%% error_logger report handler proxy
+init(Pid) ->
+ {ok, Pid}.
+
+handle_event(Event, Pid) ->
+ Pid ! Event,
+ {ok, Pid}.
+
processes_term_proc_list(Config) when is_list(Config) ->
Tester = self(),
as_expected = processes_term_proc_list_test(false),
@@ -2015,7 +2194,7 @@ processes_term_proc_list_test(MustChk) ->
end)
end,
SpawnSuspendProcessesProc = fun () ->
- erlang:system_flag(multi_scheduling, block),
+ erlang:system_flag(multi_scheduling, block_normal),
P = spawn_link(fun () ->
Tester ! {suspend_me, self()},
Tester ! {self(),
@@ -2025,7 +2204,7 @@ processes_term_proc_list_test(MustChk) ->
end),
receive {suspend_me, P} -> ok end,
erlang:suspend_process(P),
- erlang:system_flag(multi_scheduling, unblock),
+ erlang:system_flag(multi_scheduling, unblock_normal),
[{status,suspended},
{current_function,{erlang,ptab_list_continue,2}}]
= process_info(P, [status, current_function]),
@@ -2086,7 +2265,7 @@ processes_term_proc_list_test(MustChk) ->
S8 = SpawnSuspendProcessesProc(),
?CHK_TERM_PROC_LIST(MustChk, 7),
- erlang:system_flag(multi_scheduling, block),
+ erlang:system_flag(multi_scheduling, block_normal),
Exit(S8),
?CHK_TERM_PROC_LIST(MustChk, 7),
Exit(S5),
@@ -2095,28 +2274,16 @@ processes_term_proc_list_test(MustChk) ->
?CHK_TERM_PROC_LIST(MustChk, 6),
Exit(S6),
?CHK_TERM_PROC_LIST(MustChk, 0),
- erlang:system_flag(multi_scheduling, unblock),
+ erlang:system_flag(multi_scheduling, unblock_normal),
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).
@@ -2185,8 +2352,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.
@@ -2263,7 +2430,7 @@ no_priority_inversion2(Config) when is_list(Config) ->
[{priority, max}, monitor, link])
end,
lists:seq(1, 2*erlang:system_info(schedulers))),
- receive after 500 -> ok end,
+ receive after 2000 -> ok end,
{PL, ML} = spawn_opt(fun () ->
tok_loop()
end,
@@ -2273,7 +2440,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,
@@ -2315,7 +2482,7 @@ no_priority_inversion2(Config) when is_list(Config) ->
request_gc(Pid, Prio) ->
Ref = make_ref(),
- erts_internal:request_system_task(Pid, Prio, {garbage_collect, Ref}),
+ erts_internal:request_system_task(Pid, Prio, {garbage_collect, Ref, major}),
Ref.
system_task_blast(Config) when is_list(Config) ->
@@ -2390,7 +2557,7 @@ gc_request_when_gc_disabled_do(ReqIdType) ->
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,
@@ -2457,20 +2624,17 @@ start_node(Config) ->
start_node(Config, Args) when is_list(Config) ->
Pa = filename:dirname(code:which(?MODULE)),
- {A, B, C} = now(),
Name = list_to_atom(atom_to_list(?MODULE)
++ "-"
- ++ atom_to_list(?config(testcase, Config))
- ++ "-"
- ++ integer_to_list(A)
+ ++ atom_to_list(proplists:get_value(testcase, Config))
++ "-"
- ++ integer_to_list(B)
+ ++ integer_to_list(erlang:system_time(second))
++ "-"
- ++ integer_to_list(C)),
- ?t:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]).
+ ++ integer_to_list(erlang:unique_integer([positive]))),
+ 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
@@ -2478,7 +2642,10 @@ enable_internal_state() ->
_ -> erts_debug:set_internal_state(available_internal_state, true)
end.
-sys_mem_cond_run(ReqSizeMB, TestFun) when is_integer(ReqSizeMB) ->
+sys_mem_cond_run(OrigReqSizeMB, TestFun) when is_integer(OrigReqSizeMB) ->
+ %% Debug normally needs more memory, so double the requirement
+ Debug = erlang:system_info(debug_compiled),
+ ReqSizeMB = if Debug -> OrigReqSizeMB * 2; true -> OrigReqSizeMB end,
case total_memory() of
TotMem when is_integer(TotMem), TotMem >= ReqSizeMB ->
TestFun();
diff --git a/erts/emulator/test/pseudoknot_SUITE.erl b/erts/emulator/test/pseudoknot_SUITE.erl
index 5a7cdcecd5..ed4d40ac65 100644
--- a/erts/emulator/test/pseudoknot_SUITE.erl
+++ b/erts/emulator/test/pseudoknot_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2001-2016. 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.
+%% 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%
%%
diff --git a/erts/emulator/test/random_iolist.erl b/erts/emulator/test/random_iolist.erl
index 8f21b5a3b3..555f063e0a 100644
--- a/erts/emulator/test/random_iolist.erl
+++ b/erts/emulator/test/random_iolist.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2016. 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.
+%% 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%
%%
@@ -35,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;
@@ -44,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,
@@ -56,7 +57,7 @@ random_list(N) ->
random_list(N,[]).
front() ->
- case random:uniform(10) of
+ case rand:uniform(10) of
10 ->
false;
_ ->
@@ -64,7 +65,7 @@ front() ->
end.
any_type() ->
- case random:uniform(10) of
+ case rand:uniform(10) of
1 ->
list;
2 ->
@@ -76,7 +77,7 @@ any_type() ->
end.
tail_type() ->
- case random:uniform(5) of
+ case rand:uniform(5) of
1 ->
list;
2 ->
@@ -89,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) ->
@@ -138,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 2e7ac1f50c..a12019ec83 100644
--- a/erts/emulator/test/receive_SUITE.erl
+++ b/erts/emulator/test/receive_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2017. 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/.
+%% 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
%%
-%% 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.
+%% 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%
%%
@@ -21,65 +22,57 @@
%% 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].
-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),
-
- {Time,ok} = tc(fun() -> calls(10, Pid) end),
-
- [self() ! {msg,N} || N <- lists:seq(1, 500000)],
+ _WarmUpTime = time_calls(Pid),
+ Time = time_calls(Pid),
+ _ = [self() ! {msg,N} || N <- lists:seq(1, 500000)],
+ io:format("Time for empty message queue: ~p", [Time]),
erlang:garbage_collect(),
- {NewTime1,ok} = tc(fun() -> calls(10, Pid) end),
- {NewTime2,ok} = tc(fun() -> calls(10, Pid) end),
+ call_with_huge_message_queue_1(Pid, Time, 5).
+
+call_with_huge_message_queue_1(_Pid, _Time, 0) ->
+ ct:fail(bad_ratio);
+call_with_huge_message_queue_1(Pid, Time, NumTries) ->
+ HugeTime = time_calls(Pid),
+ io:format("Time for huge message queue: ~p", [HugeTime]),
+
+ case (HugeTime+1) / (Time+1) of
+ Q when Q < 10 ->
+ ok;
+ Q ->
+ io:format("Too high ratio: ~p\n", [Q]),
+ call_with_huge_message_queue_1(Pid, Time, NumTries-1)
+ end.
- io:format("Time for empty message queue: ~p", [Time]),
- io:format("Time1 for huge message queue: ~p", [NewTime1]),
- io:format("Time2 for huge message queue: ~p", [NewTime2]),
-
- case hd(lists:sort([(NewTime1+1) / (Time+1), (NewTime2+1) / (Time+1)])) of
- Q when Q < 10 ->
- ok;
- Q ->
- io:format("Best Q = ~p", [Q]),
- ?t:fail()
- end,
- ok.
+%% Time a number calls. Try to avoid returning a zero time.
+time_calls(Pid) ->
+ time_calls(Pid, 10).
+
+time_calls(_Pid, 0) ->
+ 0;
+time_calls(Pid, NumTries) ->
+ case timer:tc(fun() -> calls(Pid) end) of
+ {0,ok} ->
+ time_calls(Pid, NumTries-1);
+ {Time,ok} ->
+ Time
+ end.
+
+calls(Pid) ->
+ calls(100, Pid).
calls(0, _) -> ok;
calls(N, Pid) ->
@@ -130,6 +123,3 @@ echo_loop() ->
Pid ! {Ref,Msg},
echo_loop()
end.
-
-tc(Fun) ->
- timer:tc(erlang, apply, [Fun,[]]).
diff --git a/erts/emulator/test/ref_SUITE.erl b/erts/emulator/test/ref_SUITE.erl
index e13dfa1575..5f519d522e 100644
--- a/erts/emulator/test/ref_SUITE.erl
+++ b/erts/emulator/test/ref_SUITE.erl
@@ -1,72 +1,48 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2011. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2016. 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.
+%% 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(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 9953df3458..49da94a775 100644
--- a/erts/emulator/test/register_SUITE.erl
+++ b/erts/emulator/test/register_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2016. 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.
+%% 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%
%%
@@ -22,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
%%
@@ -70,37 +44,25 @@ end_per_testcase(_Case, Config) when is_list(Config) ->
-define(OTP_8099_NAME, otp_8099_reg_proc).
otp_8099(Config) when is_list(Config) ->
- case catch erlang:system_info(lock_counting) of
- true -> {skipped,
- "Lock counting enabled. Current lock counting "
- "implementation cannot handle this many "
- "processes."};
- _ ->
- otp_8099_test(1000000)
- end.
+ otp_8099_test(1000000).
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 ddf8b2d919..aae7651f6d 100644
--- a/erts/emulator/test/save_calls_SUITE.erl
+++ b/erts/emulator/test/save_calls_SUITE.erl
@@ -1,30 +1,28 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2016. 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.
+%% 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(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]).
@@ -35,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.
@@ -72,91 +55,99 @@ 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.2 * 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),
+ true = (L3 /= false),
+ L31 = lists:filter(fun is_local_function/1, L3),
+ [] = L31,
+ erlang:process_flag(self(), save_calls, 0),
+
+ %% Also check that it works on another process ...
+ Pid = spawn(fun () -> receive after infinity -> ok end end),
+ erlang:process_flag(Pid, save_calls, 10),
+ {last_calls, L4} = process_info(Pid, last_calls),
+ true = (L4 /= false),
+ L41 = lists:filter(fun is_local_function/1, L4),
+ [] = L41,
+ exit(Pid,kill),
ok.
do_bipp() ->
@@ -171,7 +162,7 @@ do_bapp() ->
do_bopp(T) ->
receive
- X -> X
+ X -> X
after T -> ok
end.
@@ -188,25 +179,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 ->
@@ -218,7 +209,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),
@@ -230,30 +221,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.
@@ -268,12 +259,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).
@@ -282,17 +273,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 3906471f87..af33de237c 100644
--- a/erts/emulator/test/scheduler_SUITE.erl
+++ b/erts/emulator/test/scheduler_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2017. 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/.
+%% 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
%%
-%% 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.
+%% 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%
%%
@@ -30,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,
@@ -53,22 +54,23 @@
sct_cmd/1,
sbt_cmd/1,
scheduler_threads/1,
+ scheduler_suspend_basic/1,
scheduler_suspend/1,
dirty_scheduler_threads/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,
+ equal_with_high_max,
+ bound_process,
+ {group, scheduler_bind}, scheduler_threads,
+ scheduler_suspend_basic, scheduler_suspend,
dirty_scheduler_threads,
reader_groups].
@@ -84,12 +86,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 ->
@@ -101,15 +97,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)).
@@ -129,130 +122,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, _) ->
@@ -486,59 +479,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,
@@ -567,288 +560,334 @@ 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
- {Avail, _} when Avail == unknown; OldAff == unknown ->
+ case {erlang:system_info(logical_processors_available), OldAff} of
+ {Avail, _} when Avail == unknown; OldAff == unknown; OldAff == 1 ->
%% 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;
- _ ->
+ {_Avail, _} ->
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
- {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",
- [Aff, Onln1, erlang:system_info(scheduler_bindings)]),
- ?line unchanged = adjust_schedulers_online(),
- ?line ok;
- Fail ->
- ?line ?t:fail(Fail)
- end
+ Cpus = bits_in_mask(OldAff),
+ RmCpus = case Cpus > Onln0 of
+ true -> Cpus - Onln0 + 1;
+ false -> Onln0 - Cpus + 1
+ end,
+ Onln1 = Cpus - RmCpus,
+ case Onln1 > 0 of
+ false ->
+ %% Nothing much to test; just a smoke test
+ ok;
+ true ->
+ Aff = restrict_affinity_mask(OldAff, RmCpus),
+ set_affinity_mask(Aff),
+ case adjust_schedulers_online() of
+ {Onln0, Onln1} ->
+ 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)]),
+ unchanged = adjust_schedulers_online(),
+ ok;
+ Fail ->
+ ct:fail(Fail)
+ end
+ end
end
after
set_affinity_mask(OldAff),
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)])
end
end.
+bits_in_mask(Mask) ->
+ bits_in_mask(Mask, 0, 0).
+
+bits_in_mask(0, _Shift, N) ->
+ N;
+bits_in_mask(Mask, Shift, N) ->
+ case Mask band (1 bsl Shift) of
+ 0 -> bits_in_mask(Mask, Shift+1, N);
+ _ -> bits_in_mask(Mask band (bnot (1 bsl Shift)),
+ Shift+1, N+1)
+ end.
+
+restrict_affinity_mask(Mask, N) ->
+ try
+ restrict_affinity_mask(Mask, 0, N)
+ catch
+ throw : Reason ->
+ exit({Reason, Mask, N})
+ end.
+
+restrict_affinity_mask(Mask, _Shift, 0) ->
+ Mask;
+restrict_affinity_mask(0, _Shift, _N) ->
+ throw(overresticted_affinity_mask);
+restrict_affinity_mask(Mask, Shift, N) ->
+ case Mask band (1 bsl Shift) of
+ 0 -> restrict_affinity_mask(Mask, Shift+1, N);
+ _ -> restrict_affinity_mask(Mask band (bnot (1 bsl Shift)),
+ Shift+1, N-1)
+ end.
+
adjust_schedulers_online() ->
case erlang:system_info(update_cpu_info) of
unchanged ->
unchanged;
changed ->
Avail = erlang:system_info(logical_processors_available),
- {erlang:system_flag(schedulers_online, Avail), Avail}
+ Scheds = erlang:system_info(schedulers),
+ SOnln = case Avail > Scheds of
+ true -> Scheds;
+ false -> Avail
+ end,
+ {erlang:system_flag(schedulers_online, SOnln), SOnln}
end.
read_affinity(Data) ->
@@ -882,7 +921,7 @@ get_affinity_mask(_Port, _Status, Affinity) ->
Affinity.
get_affinity_mask() ->
- case ?t:os_type() of
+ case os:type() of
{unix, linux} ->
case catch open_port({spawn, "taskset -p " ++ os:getpid()},
[exit_status]) of
@@ -926,21 +965,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},
@@ -964,7 +1003,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 ->
@@ -987,14 +1026,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,
@@ -1004,56 +1043,52 @@ 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),
{Sched, SchedOnln, _} = get_sstate(Config, ""),
%% Configure half the number of both the scheduler threads and
%% the scheduler threads online.
- {HalfSched, HalfSchedOnln} = case SmpSupport of
- false -> {1,1};
- true ->
- {Sched div 2,
- SchedOnln div 2}
- end,
+ {HalfSched, HalfSchedOnln} = {lists:max([1,Sched div 2]),
+ lists:max([1,SchedOnln div 2])},
{HalfSched, HalfSchedOnln, _} = get_sstate(Config, "+SP 50:50"),
%% Use +S to configure 4x the number of scheduler threads and
%% 4x the number of scheduler threads online, but alter that
@@ -1079,39 +1114,38 @@ scheduler_threads(Config) when is_list(Config) ->
{Sched, HalfSchedOnln, _} = get_sstate(Config, "+SP:50"),
%% Configure 2x scheduler threads only
{TwiceSched, SchedOnln, _} = get_sstate(Config, "+SP 200"),
- %% Test resetting the scheduler counts
- ResetCmd = "+S "++FourSched++":"++FourSchedOnln++" +S 0:0",
- {Sched, SchedOnln, _} = get_sstate(Config, ResetCmd),
- %% Test negative +S settings, but only for SMP-enabled emulators
- case SmpSupport of
- false -> ok;
- true ->
- SchedMinus1 = Sched-1,
- SchedOnlnMinus1 = SchedOnln-1,
- {SchedMinus1, SchedOnlnMinus1, _} = get_sstate(Config, "+S -1"),
- {Sched, SchedOnlnMinus1, _} = get_sstate(Config, "+S :-1"),
- {SchedMinus1, SchedOnlnMinus1, _} = get_sstate(Config, "+S -1:-1")
- end,
- ok.
+ case {erlang:system_info(logical_processors),
+ erlang:system_info(logical_processors_available)} of
+ {LProc, LProcAvail} when is_integer(LProc), is_integer(LProcAvail) ->
+ %% Test resetting the scheduler counts
+ ResetCmd = "+S "++FourSched++":"++FourSchedOnln++" +S 0:0",
+ {LProc, LProcAvail, _} = get_sstate(Config, ResetCmd),
+ %% Test negative +S settings, but only for SMP-enabled emulators
+ case {SmpSupport, LProc > 1, LProcAvail > 1} of
+ {true, true, true} ->
+ SchedMinus1 = LProc-1,
+ SchedOnlnMinus1 = LProcAvail-1,
+ {SchedMinus1, SchedOnlnMinus1, _} = get_sstate(Config, "+S -1"),
+ {LProc, SchedOnlnMinus1, _} = get_sstate(Config, "+S :-1"),
+ {SchedMinus1, SchedOnlnMinus1, _} = get_sstate(Config, "+S -1:-1"),
+ ok;
+ _ ->
+ {comment, "Skipped reduced amount of schedulers test due to too few logical processors"}
+ end;
+ _ -> %% Skipped when missing info about logical processors...
+ {comment, "Skipped reset amount of schedulers test, and reduced amount of schedulers test due to too unknown amount of logical processors"}
+ end.
dirty_scheduler_threads(Config) when is_list(Config) ->
- SmpSupport = erlang:system_info(smp_support),
- try
- erlang:system_info(dirty_cpu_schedulers),
- dirty_scheduler_threads_test(Config, SmpSupport)
- catch
- error:badarg ->
- {skipped, "No dirty scheduler support"}
+ case erlang:system_info(dirty_cpu_schedulers) of
+ 0 -> {skipped, "No dirty scheduler support"};
+ _ -> dirty_scheduler_threads_test(Config)
end.
-dirty_scheduler_threads_test(Config, SmpSupport) ->
+dirty_scheduler_threads_test(Config) ->
{Sched, SchedOnln, _} = get_dsstate(Config, ""),
- {HalfSched, HalfSchedOnln} = case SmpSupport of
- false -> {1,1};
- true ->
- {Sched div 2,
- SchedOnln div 2}
- end,
+ {HalfSched, HalfSchedOnln} = {lists:max([1,Sched div 2]),
+ lists:max([1,SchedOnln div 2])},
Cmd1 = "+SDcpu "++integer_to_list(HalfSched)++":"++
integer_to_list(HalfSchedOnln),
{HalfSched, HalfSchedOnln, _} = get_dsstate(Config, Cmd1),
@@ -1129,6 +1163,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,
@@ -1137,9 +1172,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.
@@ -1165,50 +1202,184 @@ get_dsstate(Config, Cmd) ->
stop_node(Node),
{DSCPU, DSCPUOnln, DSIO}.
+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,
+ until(fun () ->
+ {_A, B, C} = erlang:system_info(
+ schedulers_state),
+ B == C
+ end,
+ erlang:monotonic_time()
+ + erlang:convert_time_unit(1,
+ seconds,
+ native)),
+ erlang:system_info(schedulers_state)
+ end]),
+ stop_node(Node),
+ ok.
+
+until(Pred, MaxTime) ->
+ case Pred() of
+ true ->
+ true;
+ false ->
+ case erlang:monotonic_time() > MaxTime of
+ true ->
+ false;
+ false ->
+ receive after 100 -> ok end,
+ until(Pred, MaxTime)
+ end
+ end.
sst0_loop(0) ->
ok;
@@ -1237,12 +1408,9 @@ sst2_loop(N) ->
sst2_loop(N-1).
sst3_loop(S, N) ->
- try erlang:system_info(dirty_cpu_schedulers) of
- DS ->
- sst3_loop_with_dirty_schedulers(S, DS, N)
- catch
- error:badarg ->
- sst3_loop_normal_schedulers_only(S, N)
+ case erlang:system_info(dirty_cpu_schedulers) of
+ 0 -> sst3_loop_normal_schedulers_only(S, N);
+ DS -> sst3_loop_with_dirty_schedulers(S, DS, N)
end.
sst3_loop_normal_schedulers_only(_S, 0) ->
@@ -1271,270 +1439,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) ->
@@ -1549,6 +1730,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
+ _ : _ ->
+ ct: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}.
@@ -1567,21 +1776,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".
@@ -1605,101 +1814,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, []) ->
[];
@@ -1710,7 +1919,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
@@ -1829,14 +2038,14 @@ do_it(Tracer, Low, Normal, High, Max) ->
do_it(Tracer, Low, Normal, High, Max, RedsPerSchedLimit) ->
OldPrio = process_flag(priority, max),
go_work(Low, Normal, High, Max),
- StartWait = now(),
+ StartWait = erlang:monotonic_time(millisecond),
%% Give the emulator a chance to balance the load...
wait_balance(5),
- EndWait = now(),
- BalanceWait = timer:now_diff(EndWait,StartWait) div 1000,
+ EndWait = erlang:monotonic_time(millisecond),
+ 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;
@@ -1906,55 +2115,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() ->
@@ -2027,21 +2236,18 @@ start_node(Config) ->
start_node(Config, "").
start_node(Config, Args) when is_list(Config) ->
- ?line Pa = filename:dirname(code:which(?MODULE)),
- ?line {A, B, C} = now(),
- ?line Name = list_to_atom(atom_to_list(?MODULE)
- ++ "-"
- ++ atom_to_list(?config(testcase, Config))
- ++ "-"
- ++ integer_to_list(A)
- ++ "-"
- ++ integer_to_list(B)
- ++ "-"
- ++ integer_to_list(C)),
- ?line ?t:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]).
+ 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(second))
+ ++ "-"
+ ++ integer_to_list(erlang:unique_integer([positive]))),
+ 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() ->
@@ -2053,7 +2259,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).
@@ -2065,7 +2271,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/send_term_SUITE.erl b/erts/emulator/test/send_term_SUITE.erl
index 8e1f8df43a..8afe4e4ac1 100644
--- a/erts/emulator/test/send_term_SUITE.erl
+++ b/erts/emulator/test/send_term_SUITE.erl
@@ -1,67 +1,44 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2005-2014. All Rights Reserved.
+%% Copyright Ericsson AB 2005-2016. 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.
+%% 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(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").
-
-init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- Dog=?t:timetrap(?t:minutes(3)),
- [{watchdog, Dog}|Config].
+-include_lib("common_test/include/ct.hrl").
-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},
@@ -75,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
@@ -139,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) ->
@@ -183,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}, []).
@@ -218,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"]),
@@ -260,34 +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()}],
+ 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).
@@ -297,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]),
@@ -354,16 +332,17 @@ write_bytes(IoDev, Prefix, [B|Bs], N) ->
write_bytes(IoDev, ",", Bs, N+1).
write_license(IoDev) ->
- S = "/* ``The contents of this file are subject to the Erlang Public License,~n"
- " * Version 1.1, (the \"License\"); you may not use this file except in~n"
- " * compliance with the License. You should have received a copy of the~n"
- " * Erlang Public License along with this software. If not, it can be~n"
- " * retrieved via the world wide web at http://www.erlang.org/.~n"
- " * ~n"
- " * Software distributed under the License is distributed on an \"AS IS\"~n"
- " * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See~n"
- " * the License for the specific language governing rights and limitations~n"
- " * under the License.~n"
+ S = "/* ``Licensed under the Apache License, Version 2.0 (the \"License\");~n"
+ " * you may not use this file except in compliance with the License.~n"
+ " * You may obtain a copy of the License at~n"
+ " * ~n"
+ " * http://www.apache.org/licenses/LICENSE-2.0~n"
+ " * ~n"
+ " * Unless required by applicable law or agreed to in writing, software~n"
+ " * distributed under the License is distributed on an \"AS IS\" BASIS,~n"
+ " * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.~n"
+ " * See the License for the specific language governing permissions and~n"
+ " * limitations under the License.~n"
" * ~n"
" * The Initial Developer of the Original Code is Ericsson AB.~n"
" * Portions created by Ericsson are Copyright 2007, Ericsson AB.~n"
diff --git a/erts/emulator/test/send_term_SUITE_data/ext_terms.bin b/erts/emulator/test/send_term_SUITE_data/ext_terms.bin
index b239284323..5ff0b2ccf1 100644
--- a/erts/emulator/test/send_term_SUITE_data/ext_terms.bin
+++ b/erts/emulator/test/send_term_SUITE_data/ext_terms.bin
Binary files differ
diff --git a/erts/emulator/test/send_term_SUITE_data/ext_terms.h b/erts/emulator/test/send_term_SUITE_data/ext_terms.h
index 08134f3b05..83277078c6 100644
--- a/erts/emulator/test/send_term_SUITE_data/ext_terms.h
+++ b/erts/emulator/test/send_term_SUITE_data/ext_terms.h
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson AB.
* Portions created by Ericsson are Copyright 2007, Ericsson AB.
@@ -24,9 +25,9 @@
#ifndef EXT_TERMS_H__
#define EXT_TERMS_H__
static struct {
- unsigned char ext[162];
+ unsigned char ext[637];
int ext_size;
- unsigned char cext[162];
+ unsigned char cext[637];
int cext_size;
} ext_terms[] = {
{{131,104,3,98,0,0,18,103,98,255,255,237,153,108,0,0,0,2,100,0,7,97,110,95,97,116,111,109,107,0,6,97,32,108,105,115,116,106},
@@ -37,26 +38,26 @@ static struct {
46,
{131,108,0,0,0,4,110,9,0,0,0,160,222,197,173,201,53,54,110,7,1,199,113,21,183,140,242,3,107,0,6,98,108,117,112,112,33,100,0,5,98,108,105,112,112,106},
46},
- {{131,104,5,103,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,0,0,0,38,0,0,0,0,3,104,2,114,0,3,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,40,0,0,0,0,0,0,0,0,102,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,0,0,0,1,3,103,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,0,0,0,37,0,0,0,0,3,102,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,0,0,0,1,3,114,0,3,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,59,0,0,0,0,0,0,0,0},
- 162,
- {131,80,0,0,0,161,120,156,203,96,77,79,97,224,77,140,207,203,79,73,117,72,207,47,74,74,76,103,96,96,80,3,98,6,230,12,166,34,6,102,116,89,102,160,140,6,3,20,164,97,209,203,200,12,52,145,39,17,85,80,21,108,96,26,166,4,35,51,216,14,20,97,144,21,214,48,43,0,1,209,36,52},
- 82},
- {{131,104,5,104,0,106,106,112,0,0,0,79,0,21,87,190,182,1,38,106,214,65,228,1,52,27,227,2,212,0,0,0,1,0,0,0,0,100,0,15,115,101,110,100,95,116,101,114,109,95,83,85,73,84,69,97,1,98,0,184,11,180,103,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,0,0,0,37,0,0,0,0,3,109,0,0,0,31,104,101,106,32,104,111,112,112,32,116,114,97,108,108,97,108,97,97,97,97,97,97,97,97,97,97,97,97,97,97,97},
- 123,
- {131,80,0,0,0,122,120,156,203,96,205,96,200,202,42,96,96,96,240,103,16,13,223,183,141,81,45,235,154,227,19,70,19,233,199,76,87,128,130,140,64,204,144,194,192,95,156,154,151,18,95,146,90,148,27,31,28,234,25,226,154,200,152,196,176,131,123,75,122,10,3,79,98,94,126,74,170,67,122,126,81,82,98,58,80,173,42,72,3,115,46,144,144,207,72,205,82,200,200,47,40,80,40,41,74,204,201,73,204,73,68,5,0,18,237,35,68},
- 117},
+ {{131,104,5,103,100,0,20,97,95,110,111,100,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,0,0,0,41,0,0,0,0,2,104,2,114,0,3,100,0,20,97,95,110,111,100,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,2,0,0,0,42,0,0,0,3,0,0,0,0,102,100,0,20,97,95,110,111,100,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,0,0,0,0,2,103,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,0,0,0,40,0,0,0,0,3,102,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,0,0,0,0,3,114,0,3,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,3,0,0,0,56,0,0,0,3,0,0,0,0},
+ 204,
+ {131,80,0,0,0,203,120,156,203,96,77,79,97,16,73,140,207,203,79,73,117,72,205,169,48,54,201,200,171,52,50,210,53,76,98,96,96,208,4,98,6,166,12,166,34,6,102,28,138,152,128,10,180,128,152,25,164,50,13,183,73,12,76,64,107,132,179,19,115,114,48,229,52,64,242,204,105,56,229,25,152,193,246,99,147,5,89,107,1,179,30,0,103,37,46,144},
+ 96},
+ {{131,104,5,104,0,106,106,112,0,0,0,86,0,123,56,104,225,98,55,108,63,185,201,160,64,191,31,210,203,0,0,0,2,0,0,0,0,100,0,15,115,101,110,100,95,116,101,114,109,95,83,85,73,84,69,97,2,98,3,217,195,71,103,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,0,0,0,40,0,0,0,0,3,109,0,0,0,31,104,101,106,32,104,111,112,112,32,116,114,97,108,108,97,108,97,97,97,97,97,97,97,97,97,97,97,97,97,97,97},
+ 130,
+ {131,80,0,0,0,129,120,156,203,96,205,96,200,202,42,96,96,96,8,99,168,182,200,120,152,100,158,99,191,243,228,2,135,253,242,151,78,3,5,153,128,152,33,133,129,191,56,53,47,37,190,36,181,40,55,62,56,212,51,196,53,145,41,137,249,230,97,247,244,20,6,225,236,196,156,156,84,135,212,156,10,99,147,140,188,74,35,35,93,195,36,160,22,13,144,62,230,92,32,33,159,145,154,165,144,145,95,80,160,80,82,4,84,154,152,147,136,10,0,219,221,39,33},
+ 123},
{{131,108,0,0,0,4,110,10,0,28,199,113,166,118,185,145,86,105,9,110,5,1,28,103,24,89,10,107,0,2,98,33,100,0,10,98,108,105,112,112,112,112,112,112,112,106},
46,
{131,108,0,0,0,4,110,10,0,28,199,113,166,118,185,145,86,105,9,110,5,1,28,103,24,89,10,107,0,2,98,33,100,0,10,98,108,105,112,112,112,112,112,112,112,106},
46},
- {{131,104,5,98,0,0,18,103,103,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,0,0,0,38,0,0,0,0,3,104,2,114,0,3,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,40,0,0,0,0,0,0,0,0,102,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,0,0,0,1,3,98,255,255,237,153,108,0,0,0,2,100,0,7,97,110,95,97,116,111,109,107,0,6,97,32,108,105,115,116,106},
- 120,
- {131,80,0,0,0,119,120,156,203,96,77,98,96,16,74,79,79,97,224,77,140,207,203,79,73,117,72,207,47,74,74,76,103,96,96,80,3,98,6,230,12,166,34,6,102,116,89,102,160,140,6,3,20,164,97,209,203,200,156,244,255,255,219,153,57,64,38,83,10,3,123,98,94,124,98,73,126,110,54,3,91,162,66,78,102,113,73,22,0,167,192,30,158},
- 93},
- {{131,104,4,103,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,0,0,0,38,0,0,0,0,3,104,2,114,0,3,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,40,0,0,0,0,0,0,0,0,102,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,0,0,0,1,3,103,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,0,0,0,0,0,0,0,0,3,102,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,0,0,0,1,3},
- 131,
- {131,80,0,0,0,130,120,156,203,96,73,79,97,224,77,140,207,203,79,73,117,72,207,47,74,74,76,103,96,96,80,3,98,6,230,12,166,34,6,102,116,89,102,160,140,6,3,20,164,97,209,203,200,12,52,145,39,17,85,16,12,152,211,48,37,24,153,1,215,214,30,50},
- 72},
+ {{131,104,5,98,0,0,18,103,103,100,0,20,97,95,110,111,100,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,0,0,0,41,0,0,0,0,2,104,2,114,0,3,100,0,20,97,95,110,111,100,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,2,0,0,0,42,0,0,0,3,0,0,0,0,102,100,0,20,97,95,110,111,100,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,0,0,0,0,2,98,255,255,237,153,108,0,0,0,2,100,0,7,97,110,95,97,116,111,109,107,0,6,97,32,108,105,115,116,106},
+ 141,
+ {131,80,0,0,0,140,120,156,203,96,77,98,96,16,74,79,79,97,16,73,140,207,203,79,73,117,72,205,169,48,54,201,200,171,52,50,210,53,4,202,49,104,2,49,3,83,6,83,17,3,51,14,69,76,64,5,90,64,204,12,82,153,134,219,36,6,166,164,255,255,223,206,204,1,177,82,24,216,19,243,226,19,75,242,115,179,25,216,18,21,114,50,139,75,178,0,77,99,35,202},
+ 100},
+ {{131,104,4,103,100,0,20,97,95,110,111,100,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,0,0,0,41,0,0,0,0,2,104,2,114,0,3,100,0,20,97,95,110,111,100,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,2,0,0,0,42,0,0,0,3,0,0,0,0,102,100,0,20,97,95,110,111,100,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,0,0,0,0,2,103,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,0,0,0,0,0,0,0,0,3,102,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,0,0,0,0,3},
+ 166,
+ {131,80,0,0,0,165,120,156,203,96,73,79,97,16,73,140,207,203,79,73,117,72,205,169,48,54,201,200,171,52,50,210,53,76,98,96,96,208,4,98,6,166,12,166,34,6,102,28,138,152,128,10,180,128,152,25,164,50,13,183,73,12,76,64,107,132,179,19,115,114,176,200,129,0,115,26,110,121,102,0,219,33,38,209},
+ 84},
{{131,104,3,98,0,0,18,103,98,255,255,237,153,108,0,0,0,2,100,0,7,97,110,95,97,116,111,109,107,0,6,97,32,108,105,115,116,106},
38,
{131,104,3,98,0,0,18,103,98,255,255,237,153,108,0,0,0,2,100,0,7,97,110,95,97,116,111,109,107,0,6,97,32,108,105,115,116,106},
@@ -65,46 +66,58 @@ static struct {
33,
{131,104,3,98,0,0,18,103,98,255,255,237,153,108,0,0,0,2,100,0,4,97,116,111,109,107,0,4,108,105,115,116,106},
33},
- {{131,104,4,103,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,0,0,0,38,0,0,0,0,3,104,2,114,0,3,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,40,0,0,0,0,0,0,0,0,102,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,0,0,0,1,3,103,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,0,0,0,0,0,0,0,0,3,102,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,0,0,0,1,3},
- 131,
- {131,80,0,0,0,130,120,156,203,96,73,79,97,224,77,140,207,203,79,73,117,72,207,47,74,74,76,103,96,96,80,3,98,6,230,12,166,34,6,102,116,89,102,160,140,6,3,20,164,97,209,203,200,12,52,145,39,17,85,16,12,152,211,48,37,24,153,1,215,214,30,50},
+ {{131,104,4,103,100,0,20,97,95,110,111,100,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,0,0,0,41,0,0,0,0,2,104,2,114,0,3,100,0,20,97,95,110,111,100,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,2,0,0,0,42,0,0,0,3,0,0,0,0,102,100,0,20,97,95,110,111,100,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,0,0,0,0,2,103,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,0,0,0,0,0,0,0,0,3,102,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,0,0,0,0,3},
+ 166,
+ {131,80,0,0,0,165,120,156,203,96,73,79,97,16,73,140,207,203,79,73,117,72,205,169,48,54,201,200,171,52,50,210,53,76,98,96,96,208,4,98,6,166,12,166,34,6,102,28,138,152,128,10,180,128,152,25,164,50,13,183,73,12,76,64,107,132,179,19,115,114,176,200,129,0,115,26,110,121,102,0,219,33,38,209},
+ 84},
+ {{131,104,4,110,8,0,28,199,17,175,172,214,173,61,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,0,114,0,3,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,3,0,0,0,57,0,0,0,3,0,0,0,0},
+ 81,
+ {131,80,0,0,0,80,120,156,203,96,201,227,96,144,57,46,184,126,205,181,181,182,73,255,255,7,165,100,48,98,133,12,69,12,204,41,12,194,217,137,57,57,169,14,169,57,21,198,38,25,121,149,70,70,186,134,73,204,12,12,12,150,64,12,162,25,0,231,161,20,138},
+ 71},
+ {{131,104,4,110,9,0,28,199,241,98,116,219,231,23,24,98,255,255,82,100,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,107,0,1,1,106,106,106,106,106,106,106,106,106,106,114,0,3,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,3,0,0,0,58,0,0,0,3,0,0,0,0},
+ 122,
+ {131,80,0,0,0,121,120,156,203,96,201,227,100,144,57,254,49,169,228,246,115,113,137,164,255,255,131,82,114,24,24,24,24,73,34,178,25,24,25,179,224,160,136,129,57,133,65,56,59,49,39,39,213,33,53,167,194,216,36,35,175,210,200,72,215,48,137,25,168,214,10,136,65,52,3,0,142,142,25,0},
+ 80},
+ {{131,104,4,110,8,0,28,199,129,17,222,251,42,6,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,97,2,114,0,3,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,3,0,0,0,59,0,0,0,3,0,0,0,0},
+ 83,
+ {131,80,0,0,0,82,120,156,203,96,201,227,96,144,57,222,40,120,239,183,22,91,210,255,255,65,41,25,140,216,97,34,83,17,3,115,10,131,112,118,98,78,78,170,67,106,78,133,177,73,70,94,165,145,145,174,97,18,51,3,3,131,53,16,131,104,6,0,233,167,20,95},
72},
- {{131,104,4,110,8,0,28,199,17,175,172,214,173,61,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,0,114,0,3,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,60,0,0,0,0,0,0,0,0},
- 74,
- {131,80,0,0,0,73,120,156,203,96,201,227,96,144,57,46,184,126,205,181,181,182,73,255,255,7,165,100,48,98,133,12,69,12,204,41,12,60,137,121,249,41,169,14,233,249,69,73,137,233,204,12,12,12,54,12,80,0,0,73,17,18,208},
- 63},
- {{131,104,4,110,9,0,28,199,241,98,116,219,231,23,24,98,255,255,82,100,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,107,0,1,1,106,106,106,106,106,106,106,106,106,106,114,0,3,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,61,0,0,0,0,0,0,0,0},
- 115,
- {131,80,0,0,0,114,120,156,203,96,201,227,100,144,57,254,49,169,228,246,115,113,137,164,255,255,131,82,114,24,24,24,24,73,34,178,25,24,25,179,224,160,136,129,57,133,129,39,49,47,63,37,213,33,61,191,40,41,49,157,25,168,200,150,1,10,0,208,188,23,70},
+ {{131,104,4,110,9,0,28,199,113,221,139,146,14,239,240,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,97,3,114,0,3,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,3,0,0,0,60,0,0,0,3,0,0,0,0},
+ 84,
+ {131,80,0,0,0,83,120,156,203,96,201,227,100,144,57,94,120,183,123,18,223,251,15,73,255,255,7,165,100,48,98,135,137,204,69,12,204,41,12,194,217,137,57,57,169,14,169,57,21,198,38,25,121,149,70,70,186,134,73,204,12,12,12,54,64,12,162,25,0,106,11,22,31},
+ 73},
+ {{131,104,4,110,9,0,28,199,177,214,190,98,202,104,2,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,97,4,114,0,3,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,3,0,0,0,61,0,0,0,3,0,0,0,0},
+ 84,
+ {131,80,0,0,0,83,120,156,203,96,201,227,100,144,57,190,241,218,190,164,83,25,76,73,255,255,7,165,100,48,98,135,137,44,69,12,204,41,12,194,217,137,57,57,169,14,169,57,21,198,38,25,121,149,70,70,186,134,73,204,12,12,12,182,64,12,162,25,0,74,151,21,164},
+ 73},
+ {{131,104,4,110,7,0,28,199,85,220,50,202,15,98,255,255,82,100,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,107,0,1,5,106,106,106,106,106,106,106,106,106,106,114,0,3,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,3,0,0,0,62,0,0,0,3,0,0,0,0},
+ 120,
+ {131,80,0,0,0,119,120,156,203,96,201,99,103,144,57,30,122,199,232,20,127,210,255,255,65,41,57,12,12,12,140,36,17,217,12,140,172,89,112,80,196,192,156,194,32,156,157,152,147,147,234,144,154,83,97,108,146,145,87,105,100,164,107,152,196,12,84,107,7,196,32,154,1,0,225,225,23,138},
+ 78},
+ {{131,104,4,110,9,0,28,199,241,98,116,219,231,23,24,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,97,6,114,0,3,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,3,0,0,0,63,0,0,0,3,0,0,0,0},
+ 84,
+ {131,80,0,0,0,83,120,156,203,96,201,227,100,144,57,254,49,169,228,246,115,113,137,164,255,255,131,82,50,24,177,195,68,182,34,6,230,20,6,225,236,196,156,156,84,135,212,156,10,99,147,140,188,74,35,35,93,195,36,102,6,6,6,123,32,6,209,12,0,64,205,21,133},
+ 73},
+ {{131,104,4,110,7,0,28,199,59,73,56,148,1,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,97,7,114,0,3,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,3,0,0,0,64,0,0,0,3,0,0,0,0},
+ 82,
+ {131,80,0,0,0,81,120,156,203,96,201,99,103,144,57,110,237,105,49,133,49,233,255,255,160,148,12,70,236,48,145,189,136,129,57,133,65,56,59,49,39,39,213,33,53,167,194,216,36,35,175,210,200,72,215,48,137,153,129,129,193,1,136,65,52,3,0,137,143,19,30},
71},
- {{131,104,4,110,8,0,28,199,129,17,222,251,42,6,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,97,2,114,0,3,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,62,0,0,0,0,0,0,0,0},
- 76,
- {131,80,0,0,0,75,120,156,203,96,201,227,96,144,57,222,40,120,239,183,22,91,210,255,255,65,41,25,140,216,97,34,83,17,3,115,10,3,79,98,94,126,74,170,67,122,126,81,82,98,58,51,3,3,131,29,3,20,0,0,76,82,18,165},
- 64},
- {{131,104,4,110,9,0,28,199,113,221,139,146,14,239,240,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,97,3,114,0,3,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,63,0,0,0,0,0,0,0,0},
- 77,
- {131,80,0,0,0,76,120,156,203,96,201,227,100,144,57,94,120,183,123,18,223,251,15,73,255,255,7,165,100,48,98,135,137,204,69,12,204,41,12,60,137,121,249,41,169,14,233,249,69,73,137,233,204,12,12,12,246,12,80,0,0,192,110,20,101},
- 65},
- {{131,104,4,110,9,0,28,199,177,214,190,98,202,104,2,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,97,4,114,0,3,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,64,0,0,0,0,0,0,0,0},
- 77,
- {131,80,0,0,0,76,120,156,203,96,201,227,100,144,57,190,241,218,190,164,83,25,76,73,255,255,7,165,100,48,98,135,137,44,69,12,204,41,12,60,137,121,249,41,169,14,233,249,69,73,137,233,204,12,12,12,14,12,80,0,0,164,94,19,234},
- 65},
- {{131,104,4,110,7,0,28,199,85,220,50,202,15,98,255,255,82,100,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,107,0,1,5,106,106,106,106,106,106,106,106,106,106,114,0,3,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,65,0,0,0,0,0,0,0,0},
- 113,
- {131,80,0,0,0,112,120,156,203,96,201,99,103,144,57,30,122,199,232,20,127,210,255,255,65,41,57,12,12,12,140,36,17,217,12,140,172,89,112,80,196,192,156,194,192,147,152,151,159,146,234,144,158,95,148,148,152,206,12,84,228,200,0,5,0,46,116,21,208},
- 69},
- {{131,104,4,110,9,0,28,199,241,98,116,219,231,23,24,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,97,6,114,0,3,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,66,0,0,0,0,0,0,0,0},
- 77,
- {131,80,0,0,0,76,120,156,203,96,201,227,100,144,57,254,49,169,228,246,115,113,137,164,255,255,131,82,50,24,177,195,68,182,34,6,230,20,6,158,196,188,252,148,84,135,244,252,162,164,196,116,102,6,6,6,39,6,40,0,0,155,123,19,203},
- 65},
- {{131,104,4,110,7,0,28,199,59,73,56,148,1,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,97,7,114,0,3,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,67,0,0,0,0,0,0,0,0},
- 75,
- {131,80,0,0,0,74,120,156,203,96,201,99,103,144,57,110,237,105,49,133,49,233,255,255,160,148,12,70,236,48,145,189,136,129,57,133,129,39,49,47,63,37,213,33,61,191,40,41,49,157,153,129,129,193,153,1,10,0,245,21,17,100},
- 62},
- {{131,104,4,110,8,0,28,199,17,175,172,214,173,61,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,97,8,114,0,3,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,68,0,0,0,0,0,0,0,0},
- 76,
- {131,80,0,0,0,75,120,156,203,96,201,227,96,144,57,46,184,126,205,181,181,182,73,255,255,7,165,100,48,98,135,137,28,69,12,204,41,12,60,137,121,249,41,169,14,233,249,69,73,137,233,204,12,12,12,46,12,80,0,0,112,226,19,66},
- 64}
+ {{131,104,4,110,8,0,28,199,17,175,172,214,173,61,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,97,8,114,0,3,100,0,19,107,97,108,108,101,64,101,108,120,51,52,104,110,121,50,50,45,49,98,3,0,0,0,65,0,0,0,3,0,0,0,0},
+ 83,
+ {131,80,0,0,0,82,120,156,203,96,201,227,96,144,57,46,184,126,205,181,181,182,73,255,255,7,165,100,48,98,135,137,28,69,12,204,41,12,194,217,137,57,57,169,14,169,57,21,198,38,25,121,149,70,70,186,134,73,204,12,12,12,142,64,12,162,25,0,18,103,20,252},
+ 72},
+ {{131,116,0,0,0,0},
+ 6,
+ {131,116,0,0,0,0},
+ 6},
+ {{131,116,0,0,0,3,97,1,97,11,97,2,97,22,97,3,97,33},
+ 18,
+ {131,116,0,0,0,3,97,1,97,11,97,2,97,22,97,3,97,33},
+ 18},
+ {{131,116,0,0,0,100,97,48,98,0,0,2,16,97,62,98,0,0,2,170,97,11,97,121,97,39,98,0,0,1,173,97,83,98,0,0,3,145,97,63,98,0,0,2,181,97,34,98,0,0,1,118,97,68,98,0,0,2,236,97,26,98,0,0,1,30,97,78,98,0,0,3,90,97,52,98,0,0,2,60,97,15,97,165,97,64,98,0,0,2,192,97,75,98,0,0,3,57,97,81,98,0,0,3,123,97,71,98,0,0,3,13,97,20,97,220,97,50,98,0,0,2,38,97,17,97,187,97,25,98,0,0,1,19,97,65,98,0,0,2,203,97,98,98,0,0,4,54,97,79,98,0,0,3,101,97,13,97,143,97,44,98,0,0,1,228,97,8,97,88,97,99,98,0,0,4,65,97,36,98,0,0,1,140,97,67,98,0,0,2,225,97,7,97,77,97,66,98,0,0,2,214,97,85,98,0,0,3,167,97,76,98,0,0,3,68,97,1,97,11,97,32,98,0,0,1,96,97,69,98,0,0,2,247,97,37,98,0,0,1,151,97,35,98,0,0,1,129,97,84,98,0,0,3,156,97,3,97,33,97,82,98,0,0,3,134,97,45,98,0,0,1,239,97,55,98,0,0,2,93,97,6,97,66,97,2,97,22,97,94,98,0,0,4,10,97,49,98,0,0,2,27,97,41,98,0,0,1,195,97,91,98,0,0,3,233,97,87,98,0,0,3,189,97,33,98,0,0,1,107,97,42,98,0,0,1,206,97,74,98,0,0,3,46,97,60,98,0,0,2,148,97,43,98,0,0,1,217,97,10,97,110,97,70,98,0,0,3,2,97,9,97,99,97,72,98,0,0,3,24,97,86,98,0,0,3,178,97,19,97,209,97,56,98,0,0,2,104,97,95,98,0,0,4,21,97,57,98,0,0,2,115,97,51,98,0,0,2,49,97,14,97,154,97,5,97,55,97,54,98,0,0,2,82,97,18,97,198,97,61,98,0,0,2,159,97,31,98,0,0,1,85,97,22,97,242,97,29,98,0,0,1,63,97,97,98,0,0,4,43,97,21,97,231,97,89,98,0,0,3,211,97,27,98,0,0,1,41,97,24,98,0,0,1,8,97,47,98,0,0,2,5,97,100,98,0,0,4,76,97,40,98,0,0,1,184,97,96,98,0,0,4,32,97,73,98,0,0,3,35,97,90,98,0,0,3,222,97,30,98,0,0,1,74,97,58,98,0,0,2,126,97,80,98,0,0,3,112,97,88,98,0,0,3,200,97,59,98,0,0,2,137,97,77,98,0,0,3,79,97,23,97,253,97,28,98,0,0,1,52,97,46,98,0,0,1,250,97,92,98,0,0,3,244,97,53,98,0,0,2,71,97,93,98,0,0,3,255,97,16,97,176,97,38,98,0,0,1,162,97,4,97,44,97,12,97,132},
+ 637,
+ {131,80,0,0,2,124,120,156,21,143,123,100,87,113,24,135,207,126,219,218,165,86,171,109,181,182,118,107,181,181,123,171,181,181,218,90,91,91,171,93,90,91,173,221,219,158,93,24,145,40,145,49,70,98,140,68,68,70,196,196,136,137,24,137,136,68,68,70,140,68,68,34,34,35,34,117,158,191,158,247,115,121,223,239,57,55,130,32,152,228,224,120,16,68,146,57,33,150,217,204,45,10,195,49,234,41,23,66,68,223,163,193,224,57,123,53,111,210,172,250,65,134,42,155,115,86,6,169,210,172,99,27,75,156,116,124,69,187,65,45,221,98,134,86,145,68,42,159,56,100,94,192,118,94,176,219,27,41,52,234,188,99,60,68,76,53,93,86,167,72,226,46,165,230,95,137,167,159,9,195,70,246,233,44,112,202,141,47,196,209,73,147,227,71,122,221,122,66,135,104,38,42,252,139,92,171,99,180,152,255,102,191,234,1,249,98,142,139,214,22,137,38,143,30,199,59,148,25,252,164,198,246,8,155,104,34,194,78,46,251,106,34,149,186,153,20,217,121,205,144,27,223,233,19,47,201,211,188,66,177,120,79,155,102,57,117,46,220,167,68,115,157,68,174,114,218,32,66,2,19,156,113,76,231,146,120,70,10,31,56,106,125,154,81,95,75,163,86,117,157,195,162,146,173,60,36,150,26,170,149,61,236,224,13,245,142,143,200,241,122,111,248,149,191,200,114,108,0,15,148,144,198,55,6,188,190,70,166,65,17,233,34,158,10,23,99,153,180,214,193,1,205,85,198,84,185,156,117,33,159,65,241,153,108,179,54,142,185,48,203,121,205,107,244,139,183,28,215,156,167,83,213,197,46,254,178,199,118,21,229,226,15,195,6,27,28,177,214,202,136,234,31,201,172,80,96,254,152,24,74,217,194,237,255,248,120,145,79},
+ 418}
};
-#define NO_OF_EXT_TERMS 19
+#define NO_OF_EXT_TERMS 22
#endif
diff --git a/erts/emulator/test/send_term_SUITE_data/send_term_drv.c b/erts/emulator/test/send_term_SUITE_data/send_term_drv.c
index 381a4f20d5..abb13d4603 100644
--- a/erts/emulator/test/send_term_SUITE_data/send_term_drv.c
+++ b/erts/emulator/test/send_term_SUITE_data/send_term_drv.c
@@ -1,13 +1,14 @@
-/* ``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 via the world wide web 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.
+/* ``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.
*
* The Initial Developer of the Original Code is Ericsson Utvecklings AB.
* Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
diff --git a/erts/emulator/test/sensitive_SUITE.erl b/erts/emulator/test/sensitive_SUITE.erl
index e073eab596..c3e303bbd1 100644
--- a/erts/emulator/test/sensitive_SUITE.erl
+++ b/erts/emulator/test/sensitive_SUITE.erl
@@ -1,46 +1,39 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2016. 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.
+%% 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(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,
@@ -48,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},
@@ -216,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) ->
@@ -300,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_major_start,_},{trace,Self,gc_major_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),
@@ -369,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),
- ?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],
+ {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 [{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),
+ [{seq_trace,42,{print,{0,1},Sender,[],"trace started"}},
+ {seq_trace,42,{send,{0,2},Sender,Self,blurf}}] =
+ [M || {seq_trace,42,_}=M <- Messages],
+
+ 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) ->
@@ -422,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).
@@ -430,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.
@@ -455,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 736dfe5b56..f1d11d1814 100644
--- a/erts/emulator/test/signal_SUITE.erl
+++ b/erts/emulator/test/signal_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2017. 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.
+%% 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%
%%
@@ -27,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,
@@ -50,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).
+end_per_testcase(_Func, _Config) ->
+ ok.
init_per_suite(Config) ->
Config.
@@ -69,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,
@@ -82,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() ->
@@ -127,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,
@@ -303,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 --------------------------------------------------------
@@ -515,17 +482,15 @@ repeat(Fun, N) when is_integer(N) ->
repeat(Fun, N-1).
start_node(Config) ->
- {A, B, C} = now(),
Name = list_to_atom(atom_to_list(?MODULE)
- ++ "-" ++ atom_to_list(?config(testcase, Config))
- ++ "-" ++ integer_to_list(A)
- ++ "-" ++ integer_to_list(B)
- ++ "-" ++ integer_to_list(C)),
+ ++ "-" ++ atom_to_list(proplists:get_value(testcase, Config))
+ ++ "-" ++ integer_to_list(erlang:system_time(second))
+ ++ "-" ++ 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()).
@@ -541,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 10b7e16a74..41bb07b84c 100644
--- a/erts/emulator/test/smoke_test_SUITE.erl
+++ b/erts/emulator/test/smoke_test_SUITE.erl
@@ -1,56 +1,40 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2011-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2011-2017. 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/.
+%% 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
%%
-%% 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.
+%% 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(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 ->
@@ -62,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.
%%%
@@ -85,17 +66,10 @@ boot_combo(Config) when is_list(Config) ->
ok
end
end,
- SMPDisable = fun () -> false = erlang:system_info(smp_support) end,
try
chk_boot(Config, "+Ktrue", NOOP),
chk_boot(Config, "+A42", A42),
- chk_boot(Config, "-smp disable", SMPDisable),
chk_boot(Config, "+Ktrue +A42", A42),
- chk_boot(Config, "-smp disable +A42",
- fun () -> SMPDisable(), A42() end),
- chk_boot(Config, "-smp disable +Ktrue", SMPDisable),
- chk_boot(Config, "-smp disable +Ktrue +A42",
- fun () -> SMPDisable(), A42() end),
%% A lot more combos could be implemented...
ok
after
@@ -110,13 +84,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"};
_ ->
@@ -133,7 +107,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
@@ -148,7 +122,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(),
@@ -158,7 +132,7 @@ chk_boot(Config, Args, Fun) ->
{Pid, Success} ->
Node = node(Pid),
stop_node(Node),
- ?t:format("--- Success!~n", []),
+ io:format("--- Success!~n", []),
ok
end.
@@ -167,19 +141,16 @@ start_node(Config) ->
start_node(Config, Args) when is_list(Config) ->
Pa = filename:dirname(code:which(?MODULE)),
- {A, B, C} = now(),
Name = list_to_atom(atom_to_list(?MODULE)
++ "-"
- ++ atom_to_list(?config(testcase, Config))
- ++ "-"
- ++ integer_to_list(A)
+ ++ atom_to_list(proplists:get_value(testcase, Config))
++ "-"
- ++ integer_to_list(B)
+ ++ integer_to_list(erlang:system_time(second))
++ "-"
- ++ integer_to_list(C)),
+ ++ 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 c428be6c5a..40cc940a94 100644
--- a/erts/emulator/test/statistics_SUITE.erl
+++ b/erts/emulator/test/statistics_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2012. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2017. 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/.
+%% 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
%%
-%% 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.
+%% 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%
%%
@@ -21,102 +22,93 @@
%% 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_sanity/1,
wall_clock_zero_diff/1, wall_clock_update/1,
- runtime_zero_diff/1,
+ runtime_sanity/1,
+ runtime_zero_diff/1,
runtime_update/1, runtime_diff/1,
run_queue_one/1,
scheduler_wall_time/1,
+ scheduler_wall_time_all/1,
+ msb_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").
-
-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.
+-include_lib("common_test/include/ct.hrl").
-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].
+ reductions_big, {group, run_queue},
+ scheduler_wall_time, scheduler_wall_time_all,
+ msb_scheduler_wall_time,
+ garbage_collection, io, badarg,
+ run_queues_lengths_active_tasks,
+ msacc].
groups() ->
[{wall_clock, [],
- [wall_clock_zero_diff, wall_clock_update]},
+ [wall_clock_sanity, wall_clock_zero_diff, wall_clock_update]},
{runtime, [],
- [runtime_zero_diff, runtime_update, runtime_diff]},
+ [runtime_sanity, runtime_zero_diff, runtime_update, runtime_diff]},
{run_queue, [], [run_queue_one]}].
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
+wall_clock_sanity(Config) when is_list(Config) ->
+ erlang:yield(),
+ {WallClock, _} = statistics(wall_clock),
+ MT = erlang:monotonic_time(),
+ Time = erlang:convert_time_unit(MT - erlang:system_info(start_time),
+ native, millisecond),
+ io:format("Time=~p WallClock=~p~n",
+ [Time, WallClock]),
+ true = WallClock =< Time,
+ true = Time - 100 =< WallClock,
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.
@@ -124,65 +116,79 @@ wall_clock_update1(0) ->
%%% Test statistics(runtime).
+runtime_sanity(Config) when is_list(Config) ->
+ case erlang:system_info(logical_processors_available) of
+ unknown ->
+ {skipped, "Don't know available logical processors"};
+ LP when is_integer(LP) ->
+ erlang:yield(),
+ {RunTime, _} = statistics(runtime),
+ MT = erlang:monotonic_time(),
+ Time = erlang:convert_time_unit(MT - erlang:system_info(start_time),
+ native, millisecond),
+ io:format("Time=~p RunTime=~p~n",
+ [Time, RunTime]),
+ true = RunTime =< Time*LP
+ end.
-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),
+ {CPUHog, CPUHogMon} = spawn_opt(fun cpu_heavy/0,[link,monitor]),
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),
+ unlink(CPUHog),
+ exit(CPUHog, kill),
+ true = is_integer(T1+T2+Diff0+Diff),
+ io:format("T1 = ~p, T2 = ~p, Diff = ~p, T2-T1 = ~p", [T1,T2,Diff,T2-T1]),
+ receive {'DOWN',CPUHogMon,process,CPUHog,_} -> ok end,
+ 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.
@@ -200,10 +206,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),
@@ -216,13 +221,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.
@@ -231,180 +236,471 @@ 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) ->
+ scheduler_wall_time_test(scheduler_wall_time).
+
+%% Tests that statistics(scheduler_wall_time_all) works as intended
+scheduler_wall_time_all(Config) when is_list(Config) ->
+ scheduler_wall_time_test(scheduler_wall_time_all).
+
+scheduler_wall_time_test(Type) ->
%% Should return undefined if system_flag is not turned on yet
- undefined = statistics(scheduler_wall_time),
+ undefined = statistics(Type),
%% 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(500),
- %% 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 > 5 end, AfterLoad),AfterLoad},
- true = erlang:system_flag(scheduler_wall_time, false)
+ Schedulers = erlang:system_info(schedulers_online),
+ DirtyCPUSchedulers = erlang:system_info(dirty_cpu_schedulers_online),
+ DirtyIOSchedulers = erlang:system_info(dirty_io_schedulers),
+ TotLoadSchedulers = case Type of
+ scheduler_wall_time_all ->
+ Schedulers + DirtyCPUSchedulers + DirtyIOSchedulers;
+ scheduler_wall_time ->
+ Schedulers + DirtyCPUSchedulers
+ end,
+
+ %% Let testserver and everyone else finish their work
+ timer:sleep(1500),
+ %% Empty load
+ EmptyLoad = get_load(Type),
+ {false, _} = {lists:any(fun(Load) -> Load > 50 end, EmptyLoad),EmptyLoad},
+ MeMySelfAndI = self(),
+ StartHog = fun() ->
+ Pid = spawn_link(?MODULE, hog, [self()]),
+ receive hog_started -> MeMySelfAndI ! go end,
+ Pid
+ end,
+ StartDirtyHog = fun(Func) ->
+ F = fun () ->
+ erts_debug:Func(alive_waitexiting,
+ MeMySelfAndI)
+ end,
+ Pid = spawn_link(F),
+ receive {alive, Pid} -> ok 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(Type),
+ {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)],
+ HalfDirtyCPUHogs = [StartDirtyHog(dirty_cpu)
+ || _ <- lists:seq(1, lists:max([1,DirtyCPUSchedulers div 2]))],
+ HalfDirtyIOHogs = [StartDirtyHog(dirty_io)
+ || _ <- lists:seq(1, lists:max([1,DirtyIOSchedulers div 2]))],
+ HalfLoad = lists:sum(get_load(Type)) div TotLoadSchedulers,
+ 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)],
+ LastDirtyCPUHogs = [StartDirtyHog(dirty_cpu)
+ || _ <- lists:seq(1, DirtyCPUSchedulers div 2)],
+ LastDirtyIOHogs = [StartDirtyHog(dirty_io)
+ || _ <- lists:seq(1, DirtyIOSchedulers div 2)],
+ FullScheds = get_load(Type),
+ {false,_} = {lists:any(fun(Load) -> Load < 80 end, FullScheds),FullScheds},
+ FullLoad = lists:sum(FullScheds) div TotLoadSchedulers,
+ if FullLoad > 90 -> ok;
+ true -> exit({fullload, FullLoad})
+ end,
+
+ KillHog = fun (HP) ->
+ HPM = erlang:monitor(process, HP),
+ unlink(HP),
+ exit(HP, kill),
+ receive
+ {'DOWN', HPM, process, HP, killed} ->
+ ok
+ end
+ end,
+ [KillHog(Pid) || Pid <- [P1|HalfHogs++HalfDirtyCPUHogs++HalfDirtyIOHogs
+ ++LastHogs++LastDirtyCPUHogs++LastDirtyIOHogs]],
+ receive after 2000 -> ok end, %% Give dirty schedulers time to complete...
+ AfterLoad = get_load(Type),
+ io:format("AfterLoad=~p~n", [AfterLoad]),
+ {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() ->
- Start = erlang:statistics(scheduler_wall_time),
- timer:sleep(500),
- End = erlang:statistics(scheduler_wall_time),
+get_load(Type) ->
+ Start = erlang:statistics(Type),
+ timer:sleep(1500),
+ End = erlang:statistics(Type),
lists:reverse(lists:sort(load_percentage(lists:sort(Start),lists:sort(End)))).
load_percentage([{Id, WN, TN}|Ss], [{Id, WP, TP}|Ps]) ->
[100*(WN-WP) div (TN-TP)|load_percentage(Ss, Ps)];
load_percentage([], []) -> [].
+count(0) ->
+ ok;
+count(N) ->
+ count(N-1).
+
+msb_swt_hog(true) ->
+ count(1000000),
+ erts_debug:dirty_cpu(wait, 10),
+ erts_debug:dirty_io(wait, 10),
+ msb_swt_hog(true);
+msb_swt_hog(false) ->
+ count(1000000),
+ msb_swt_hog(false).
+
+msb_scheduler_wall_time(_Config) ->
+ erlang:system_flag(scheduler_wall_time, true),
+ Dirty = erlang:system_info(dirty_cpu_schedulers) /= 0,
+ Hogs = lists:map(fun (_) ->
+ spawn_opt(fun () ->
+ msb_swt_hog(Dirty)
+ end, [{priority,low}, link, monitor])
+ end, lists:seq(1,10)),
+ erlang:system_flag(multi_scheduling, block),
+ try
+ SWT1 = lists:sort(statistics(scheduler_wall_time_all)),
+ %% io:format("SWT1 = ~p~n", [SWT1]),
+ receive after 4000 -> ok end,
+ SWT2 = lists:sort(statistics(scheduler_wall_time_all)),
+ %% io:format("SWT2 = ~p~n", [SWT2]),
+ SWT = lists:zip(SWT1, SWT2),
+ io:format("SU = ~p~n", [lists:map(fun({{I, A0, T0}, {I, A1, T1}}) ->
+ {I, (A1 - A0)/(T1 - T0)} end,
+ SWT)]),
+ {A, T} = lists:foldl(fun({{_, A0, T0}, {_, A1, T1}}, {Ai,Ti}) ->
+ {Ai + (A1 - A0), Ti + (T1 - T0)}
+ end,
+ {0, 0},
+ SWT),
+ TSU = A/T,
+ WSU = ((TSU * (erlang:system_info(schedulers)
+ + erlang:system_info(dirty_cpu_schedulers)
+ + erlang:system_info(dirty_io_schedulers)))
+ / 1),
+ %% Weighted scheduler utilization should be
+ %% very close to 1.0, i.e., we execute the
+ %% same time as one thread executing all
+ %% the time...
+ io:format("WSU = ~p~n", [WSU]),
+ true = 0.9 < WSU andalso WSU < 1.1,
+ ok
+ after
+ erlang:system_flag(multi_scheduling, unblock),
+ erlang:system_flag(scheduler_wall_time, false),
+ lists:foreach(fun ({HP, _HM}) ->
+ unlink(HP),
+ exit(HP, kill)
+ end, Hogs),
+ lists:foreach(fun ({HP, HM}) ->
+ receive
+ {'DOWN', HM, process, HP, _} ->
+ ok
+ end
+ end, Hogs),
+ ok
+ end.
-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),
+ TRQLAs0 = statistics(total_run_queue_lengths_all),
+ TATs0 = statistics(total_active_tasks),
+ TATAs0 = statistics(total_active_tasks_all),
+ true = is_integer(TRQLs0),
+ true = is_integer(TATs0),
+ true = TRQLs0 >= 0,
+ true = TRQLAs0 >= 0,
+ true = TATs0 >= 11,
+ true = TATAs0 >= 11,
+
+ NoScheds = erlang:system_info(schedulers),
+ {DefRqs,
+ AllRqs} = case erlang:system_info(dirty_cpu_schedulers) of
+ 0 -> {NoScheds, NoScheds};
+ _ -> {NoScheds+1, NoScheds+2}
+ end,
+ RQLs0 = statistics(run_queue_lengths),
+ RQLAs0 = statistics(run_queue_lengths_all),
+ ATs0 = statistics(active_tasks),
+ ATAs0 = statistics(active_tasks_all),
+ DefRqs = length(RQLs0),
+ AllRqs = length(RQLAs0),
+ DefRqs = length(ATs0),
+ AllRqs = length(ATAs0),
+ true = lists:sum(RQLs0) >= 0,
+ true = lists:sum(RQLAs0) >= 0,
+ true = lists:sum(ATs0) >= 11,
+ true = lists:sum(ATAs0) >= 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),
+ DefRqs = length(RQLs1),
+ DefRqs = 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 ceb4afb5cf..56522039da 100644
--- a/erts/emulator/test/system_info_SUITE.erl
+++ b/erts/emulator/test/system_info_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2005-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2005-2017. 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/.
+%% 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
%%
-%% 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.
+%% 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%
%%
@@ -30,55 +31,26 @@
%-define(line_trace, 1).
--include_lib("test_server/include/test_server.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]).
+-include_lib("common_test/include/ct.hrl").
--export([process_count/1, system_version/1, misc_smoke_tests/1, heap_size/1, wordsize/1, memory/1,
- ets_limit/1]).
+-export([all/0, suite/0]).
--define(DEFAULT_TIMEOUT, ?t:minutes(2)).
+-export([process_count/1, system_version/1, misc_smoke_tests/1,
+ heap_size/1, wordsize/1, memory/1, ets_limit/1, atom_limit/1,
+ atom_count/1]).
-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.
+ heap_size, wordsize, memory, ets_limit, atom_limit, atom_count].
%%%
%%% 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) ->
@@ -91,37 +63,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 (_) ->
@@ -142,54 +114,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,
- ?line ok.
+ 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]),
+ 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
@@ -212,7 +174,7 @@ memory(Config) when is_list(Config) ->
%%
erts_debug:set_internal_state(available_internal_state, true),
- %% Use a large heap size on the controling process in
+ %% Use a large heap size on the controlling process in
%% order to avoid changes in its heap size during
%% comparisons.
MinHeapSize = process_flag(min_heap_size, 1024*1024),
@@ -244,8 +206,7 @@ memory_test(_Config) ->
end)
end,
1000 div erlang:system_info(schedulers_online))
- end,
- []),
+ end, []),
cmp_memory(MWs, "spawn procs"),
Ps = lists:flatten(DPs),
@@ -253,23 +214,49 @@ 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,
+ fun () ->
+ lists:foreach(
+ fun (P) ->
+ Tmr = erlang:start_timer(1 bsl 34,
+ P,
+ hello),
+ Tmrs = case get('BIF_TMRS') of
+ undefined -> [];
+ Rs -> Rs
+ end,
+ true = is_reference(Tmr),
+ put('BIF_TMRS', [Tmr|Tmrs])
+ end, Ps)
+ end, []),
+ cmp_memory(MWs, "start BIF timer procs"),
+
+ mem_workers_call(MWs,
+ fun () ->
+ lists:foreach(fun (Tmr) ->
+ true = is_reference(Tmr),
+ true = is_integer(erlang:cancel_timer(Tmr))
+ end, get('BIF_TMRS')),
+ put('BIF_TMRS', undefined),
+ garbage_collect()
+ end, []),
+ erts_debug:set_internal_state(wait, deallocations),
+ cmp_memory(MWs, "cancel BIF timer procs"),
+
DMs = mem_workers_call(MWs,
fun () ->
lists:map(fun (P) ->
monitor(process, P)
end, Ps)
- end,
- []),
+ end, []),
cmp_memory(MWs, "monitor procs"),
Ms = lists:flatten(DMs),
mem_workers_call(MWs,
@@ -277,8 +264,7 @@ memory_test(_Config) ->
lists:foreach(fun (M) ->
demonitor(M)
end, Ms)
- end,
- []),
+ end, []),
cmp_memory(MWs, "demonitor procs"),
mem_workers_call(MWs,
@@ -286,8 +272,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,
@@ -310,8 +295,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"),
@@ -319,8 +303,7 @@ memory_test(_Config) ->
fun () ->
put(binary_data, false),
garbage_collect()
- end,
- []),
+ end, []),
cmp_memory(MWs, "release binary data"),
mem_workers_call(MWs,
@@ -328,8 +311,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"),
@@ -340,16 +322,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) ->
@@ -359,8 +339,7 @@ memory_test(_Config) ->
receive
{'DOWN', Mon, _, _, _} -> ok
end
- end,
- MWs),
+ end, MWs),
ok.
mem_worker() ->
@@ -375,22 +354,14 @@ 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).
-
-mem_workers_cast(MWs, Fun, Args) ->
- lists:foreach(fun (MW) ->
- MW ! {cast, self(), Fun, Args}
- end,
- MWs).
+ receive
+ {reply, MW, Res} ->
+ Res
+ end
+ end, MWs).
spawn_mem_workers() ->
spawn_mem_workers(erlang:system_info(schedulers_online)).
@@ -403,7 +374,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;
@@ -471,25 +441,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.
@@ -498,9 +468,18 @@ 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) -> [];
+
+get_node_name(Config) ->
+ list_to_atom(atom_to_list(?MODULE)
+ ++ "-"
+ ++ atom_to_list(proplists:get_value(testcase, Config))
+ ++ "-"
+ ++ integer_to_list(erlang:system_time(second))
+ ++ "-"
+ ++ integer_to_list(erlang:unique_integer([positive]))).
+
+
+%% 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)),
@@ -514,7 +493,7 @@ get_ets_limit(Config, EtsMax) ->
0 -> [];
_ -> [{"ERL_MAX_ETS_TABLES", integer_to_list(EtsMax)}]
end,
- {ok, Node} = start_node(Config, Envs),
+ {ok, Node} = start_node_ets(Config, Envs),
Me = self(),
Ref = make_ref(),
spawn_link(Node,
@@ -530,19 +509,50 @@ get_ets_limit(Config, EtsMax) ->
stop_node(Node),
Res.
-start_node(Config, Envs) when is_list(Config) ->
+start_node_ets(Config, Envs) when is_list(Config) ->
Pa = filename:dirname(code:which(?MODULE)),
- {A, B, C} = now(),
- Name = list_to_atom(atom_to_list(?MODULE)
- ++ "-"
- ++ atom_to_list(?config(testcase, Config))
- ++ "-"
- ++ integer_to_list(A)
- ++ "-"
- ++ integer_to_list(B)
- ++ "-"
- ++ integer_to_list(C)),
- ?t:start_node(Name, peer, [{args, "-pa "++Pa}, {env, Envs}]).
+ test_server:start_node(get_node_name(Config), peer,
+ [{args, "-pa "++Pa}, {env, Envs}]).
+
+start_node_atm(Config, AtomsMax) when is_list(Config) ->
+ Pa = filename:dirname(code:which(?MODULE)),
+ test_server:start_node(get_node_name(Config), peer,
+ [{args, "-pa "++ Pa ++ AtomsMax}]).
stop_node(Node) ->
- ?t:stop_node(Node).
+ test_server:stop_node(Node).
+
+
+%% Verify system_info(atom_limit) reflects max atoms settings
+%% (using " +t").
+atom_limit(Config0) when is_list(Config0) ->
+ Config = [{testcase,atom_limit}|Config0],
+ 2186042 = get_atom_limit(Config, " +t 2186042 "),
+ ok.
+
+get_atom_limit(Config, AtomsMax) ->
+ {ok, Node} = start_node_atm(Config, AtomsMax),
+ Me = self(),
+ Ref = make_ref(),
+ spawn_link(Node,
+ fun() ->
+ Res = erlang:system_info(atom_limit),
+ unlink(Me),
+ Me ! {Ref, Res}
+ end),
+ receive
+ {Ref, Res} ->
+ Res
+ end,
+ stop_node(Node),
+ Res.
+
+%% Verify that system_info(atom_count) works.
+atom_count(Config) when is_list(Config) ->
+ Limit = erlang:system_info(atom_limit),
+ Count1 = erlang:system_info(atom_count),
+ list_to_atom(integer_to_list(erlang:unique_integer())),
+ Count2 = erlang:system_info(atom_count),
+ true = Limit >= Count2,
+ true = Count2 > Count1,
+ ok.
diff --git a/erts/emulator/test/system_profile_SUITE.erl b/erts/emulator/test/system_profile_SUITE.erl
index a387c08ef9..9b678fcff9 100644
--- a/erts/emulator/test/system_profile_SUITE.erl
+++ b/erts/emulator/test/system_profile_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2017. 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.
+%% 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%
%%
@@ -22,61 +23,29 @@
-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, sane_location/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").
+-include_lib("common_test/include/ct.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.
-
-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.
-
+ runnable_ports, scheduler, dont_profile_profiler,
+ sane_location].
%% 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(),
@@ -105,20 +74,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(),
@@ -126,20 +104,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,
@@ -148,32 +137,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(),
@@ -191,12 +184,39 @@ dont_profile_profiler(Config) when is_list(Config) ->
exit(Pid,kill),
ok.
+%% Check sane location (of exits)
+sane_location(Config) when is_list(Config) ->
+ Check = spawn_link(fun() -> flush_sane_location() end),
+ erlang:system_profile(Check, [runnable_procs]),
+ Me = self(),
+ Pids = [spawn_link(fun() -> wat(Me) end) || _ <- lists:seq(1,100)],
+ [receive {Pid,ok} -> ok end || Pid <- Pids],
+ Check ! {Me, done},
+ receive {Check,ok} -> ok end,
+ ok.
+
+wat(Pid) ->
+ Pid ! {self(), ok}.
+
+flush_sane_location() ->
+ receive
+ {profile,_,_,{M,F,A},_} when is_atom(M), is_atom(F),
+ is_integer(A) ->
+ flush_sane_location();
+ {profile,_,_,0,_} ->
+ flush_sane_location();
+ {Pid,done} when is_pid(Pid) ->
+ Pid ! {self(), ok};
+ M ->
+ ct:fail({badness,M})
+ end.
+
%%% 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),
@@ -204,23 +224,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),
@@ -229,40 +249,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)
@@ -372,7 +401,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},
@@ -427,6 +456,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}.
@@ -447,33 +514,38 @@ 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).
-has_profiler_pid_event([], _) -> false;
-has_profiler_pid_event([{profile, Pid, _Activity, _MFA, _TS}|Events], Pid) -> true;
+has_profiler_pid_event([], _) ->
+ false;
+has_profiler_pid_event([{profile, Pid, _Activity, _MFA, _TS}|_Events], Pid) ->
+ true;
has_profiler_pid_event([_|Events], Pid) ->
has_profiler_pid_event(Events, Pid).
diff --git a/erts/emulator/test/time_SUITE.erl b/erts/emulator/test/time_SUITE.erl
index a0a8a9c42c..e01efac86b 100644
--- a/erts/emulator/test/time_SUITE.erl
+++ b/erts/emulator/test/time_SUITE.erl
@@ -1,23 +1,25 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2017. 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.
+%% 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(time_SUITE).
+-compile({nowarn_deprecated_function, {erlang,now,0}}).
%% "Time is on my side." -- The Rolling Stones
@@ -34,11 +36,19 @@
bad_univ_to_local/1, bad_local_to_univ/1,
univ_to_seconds/1, seconds_to_univ/1,
consistency/1,
- now_unique/1, now_update/1, timestamp/1]).
+ now_unique/1, now_update/1, timestamp/1,
+ time_warp_modes/1,
+ monotonic_time_monotonicity/1,
+ monotonic_time_monotonicity_parallel/1,
+ time_unit_conversion/1,
+ signed_time_unit_conversion/1,
+ erlang_timestamp/1]).
+
+-export([init_per_testcase/2, end_per_testcase/2]).
-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]).
@@ -56,6 +66,12 @@
-define(dst_timezone, 2).
+init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
+ [{testcase, Func}|Config].
+
+end_per_testcase(_Func, _Config) ->
+ ok.
+
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
@@ -63,7 +79,13 @@ all() ->
bad_univ_to_local, bad_local_to_univ,
univ_to_seconds, seconds_to_univ,
consistency,
- {group, now}, timestamp].
+ {group, now}, timestamp,
+ time_warp_modes,
+ monotonic_time_monotonicity,
+ monotonic_time_monotonicity_parallel,
+ time_unit_conversion,
+ signed_time_unit_conversion,
+ erlang_timestamp].
groups() ->
[{now, [], [now_unique, now_update]}].
@@ -81,59 +103,56 @@ 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"}
end.
-%% Tests conversion from univeral to local time.
+%% Tests conversion from universal 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.
@@ -141,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([]) ->
@@ -155,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([]) ->
@@ -190,28 +209,22 @@ test_seconds_to_univ([]) ->
%% Test that the the different time functions return
-%% consistent results. (See the test case for assumptions
-%% and limitations.)
-consistency(Config) when is_list(Config) ->
- %% Test the following equations:
- %% date() & time() == erlang:localtime()
- %% erlang:universaltime() + timezone == erlang:localtime()
+%% consistent results.
+consistency(_Config) ->
+ %% Test that:
+ %% * date() & time() gives the same time as erlang:localtime()
%%
- %% Assumptions:
- %% Middle-European time zone, EU rules for daylight-saving time.
- %%
- %% Limitations:
- %% Localtime and universaltime must be in the same month.
- %% Daylight-saving calculations are incorrect from the last
- %% Sunday of March and October to the end of the month.
+ %% * the difference between erlang:universaltime() and
+ %% erlang:localtime() is reasonable (with assuming any
+ %% particular timezone)
- ?line ok = compare_date_time_and_localtime(16),
- ?line ok = compare_local_and_universal(16).
+ ok = compare_date_time_and_localtime(16),
+ 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;
@@ -219,22 +232,18 @@ compare_date_time_and_localtime(0) ->
error.
compare_local_and_universal(Times) when Times > 0 ->
- case compare(erlang:universaltime(), erlang:localtime()) of
- true -> ok;
- false -> compare_local_and_universal(Times-1)
- end;
-compare_local_and_universal(0) ->
- error.
+ Utc = erlang:universaltime(),
+ Local = erlang:localtime(),
+ io:format("local = ~p, utc = ~p", [Local,Utc]),
-compare(Utc0, Local) ->
- io:format("local = ~p, utc = ~p", [Local, Utc0]),
- Utc = linear_time(Utc0)+effective_timezone(Utc0)*3600,
- case linear_time(Local) of
- Utc -> true;
- Other ->
- io:format("Failed: local = ~p, utc = ~p~n",
- [Other, Utc]),
- false
+ AcceptableDiff = 14*3600,
+ case linear_time(Utc) - linear_time(Local) of
+ Diff when abs(Diff) < AcceptableDiff ->
+ ok;
+ Diff ->
+ io:format("More than ~p seconds difference betwen "
+ "local and universal time", [Diff]),
+ ct:fail(huge_diff)
end.
%% This function converts a date and time to a linear time.
@@ -261,44 +270,46 @@ days_in_february(Year) ->
_ -> 28
end.
-%% This functions returns either the normal timezone or the
-%% the DST timezone, depending on the given UTC time.
-%%
-%% XXX This function uses an approximation of the EU rule for
-%% daylight saving time. This function will fail in the
-%% following intervals: After the last Sunday in March upto
-%% the end of March, and after the last Sunday in October
-%% upto the end of October.
-
-effective_timezone(Time) ->
- case os:type() of
- {unix,_} ->
- case os:cmd("date '+%Z'") of
- "SAST"++_ ->
- 2;
- _ ->
- effective_timezone1(Time)
- end;
- _ ->
- effective_timezone1(Time)
- end.
-
-effective_timezone1({{_Year,Mon,_Day}, _}) when Mon < 4 ->
- ?timezone;
-effective_timezone1({{_Year,Mon,_Day}, _}) when Mon > 10 ->
- ?timezone;
-effective_timezone1(_) ->
- ?dst_timezone.
-
%% 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, microsecond).
+
+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;
@@ -312,9 +323,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
@@ -324,15 +333,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,
@@ -347,22 +356,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))}.
@@ -370,15 +379,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;
@@ -394,31 +403,460 @@ 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
+ %% combination with no time correction...
+ check_time_warp_mode(Config, false, no_time_warp),
+ check_time_warp_mode(Config, false, single_time_warp),
+ check_time_warp_mode(Config, false, multi_time_warp),
+
+ erts_debug:set_internal_state(available_internal_state, true),
+ try
+ case erts_debug:get_internal_state({check_time_config,
+ true, no_time_warp}) of
+ false -> ok;
+ true -> check_time_warp_mode(Config, true, no_time_warp)
+ end,
+ case erts_debug:get_internal_state({check_time_config,
+ true, single_time_warp}) of
+ false -> ok;
+ true -> check_time_warp_mode(Config, true, single_time_warp)
+ end,
+ case erts_debug:get_internal_state({check_time_config,
+ true, multi_time_warp}) of
+ false -> ok;
+ true -> check_time_warp_mode(Config, true, multi_time_warp)
+ end
+ after
+ erts_debug:set_internal_state(available_internal_state, false)
+ end.
+
+check_time_warp_mode(Config, TimeCorrection, TimeWarpMode) ->
+ io:format("~n~n~n***** Testing TimeCorrection=~p TimeWarpMode=~p *****~n",
+ [TimeCorrection, TimeWarpMode]),
+ Mon = erlang:monitor(time_offset, clock_service),
+ _ = erlang:time_offset(),
+ Start = erlang:monotonic_time(1000),
+ MonotonicityTimeout = 2000,
+ {ok, Node} = start_node(Config,
+ "+c " ++ atom_to_list(TimeCorrection)
+ ++ " +C " ++ atom_to_list(TimeWarpMode)),
+ StartTime = rpc:call(Node, erlang, system_info, [start_time]),
+ Me = self(),
+ MonotincityTestStarted = make_ref(),
+ MonotincityTestDone = make_ref(),
+ spawn_link(Node,
+ fun () ->
+ Me ! MonotincityTestStarted,
+ cmp_times(erlang:start_timer(MonotonicityTimeout,
+ self(),
+ timeout),
+ erlang:monotonic_time()),
+ Me ! MonotincityTestDone
+ end),
+ receive MonotincityTestStarted -> ok end,
+ check_time_offset(Node, TimeWarpMode),
+ TimeWarpMode = rpc:call(Node, erlang, system_info, [time_warp_mode]),
+ TimeCorrection = rpc:call(Node, erlang, system_info, [time_correction]),
+ receive MonotincityTestDone -> ok end,
+ MonotonicTime = rpc:call(Node, erlang, monotonic_time, []),
+ MonotonicTimeUnit = rpc:call(Node,
+ erlang,
+ convert_time_unit,
+ [1, second, native]),
+ UpMilliSeconds = erlang:convert_time_unit(MonotonicTime - StartTime,
+ MonotonicTimeUnit,
+ millisecond),
+ io:format("UpMilliSeconds=~p~n", [UpMilliSeconds]),
+ End = erlang:monotonic_time(millisecond),
+ stop_node(Node),
+ try
+ true = (UpMilliSeconds > (98*MonotonicityTimeout) div 100),
+ true = (UpMilliSeconds < (102*(End-Start)) div 100)
+ catch
+ error:_ ->
+ io:format("Uptime inconsistency", []),
+ case {TimeCorrection, erlang:system_info(time_correction)} of
+ {true, true} ->
+ ct:fail(uptime_inconsistency);
+ {true, false} ->
+ _ = erlang:time_offset(),
+ receive
+ {'CHANGE', Mon, time_offset, clock_service, _} ->
+ ignore
+ after 1000 ->
+ ct:fail(uptime_inconsistency)
+ end;
+ _ ->
+ ignore
+ end
+ end,
+ erlang:demonitor(Mon, [flush]),
+ ok.
+
+check_time_offset(Node, no_time_warp) ->
+ final = rpc:call(Node, erlang, system_info, [time_offset]),
+ final = rpc:call(Node, erlang, system_flag, [time_offset, finalize]),
+ final = rpc:call(Node, erlang, system_info, [time_offset]);
+check_time_offset(Node, single_time_warp) ->
+ preliminary = rpc:call(Node, erlang, system_info, [time_offset]),
+ preliminary = rpc:call(Node, erlang, system_flag, [time_offset, finalize]),
+ final = rpc:call(Node, erlang, system_info, [time_offset]),
+ final = rpc:call(Node, erlang, system_flag, [time_offset, finalize]);
+check_time_offset(Node, multi_time_warp) ->
+ volatile = rpc:call(Node, erlang, system_info, [time_offset]),
+ volatile = rpc:call(Node, erlang, system_flag, [time_offset, finalize]),
+ volatile = rpc:call(Node, erlang, system_info, [time_offset]).
+
+monotonic_time_monotonicity(Config) when is_list(Config) ->
+ Done = erlang:start_timer(10000,self(),timeout),
+ cmp_times(Done, erlang:monotonic_time()).
+
+cmp_times(Done, X0) ->
+ X1 = erlang:monotonic_time(),
+ X2 = erlang:monotonic_time(),
+ X3 = erlang:monotonic_time(),
+ X4 = erlang:monotonic_time(),
+ X5 = erlang:monotonic_time(),
+ true = (X0 =< X1),
+ true = (X1 =< X2),
+ true = (X2 =< X3),
+ true = (X3 =< X4),
+ true = (X4 =< X5),
+ receive
+ {timeout, Done, timeout} ->
+ ok
+ after 0 ->
+ cmp_times(Done, X5)
+ end.
+
+-define(NR_OF_MONOTONIC_CALLS, 100000).
+
+monotonic_time_monotonicity_parallel(Config) when is_list(Config) ->
+ Me = self(),
+ Result = make_ref(),
+ Go = make_ref(),
+ UpAndRunning = make_ref(),
+ NoOnlnScheds = erlang:system_info(schedulers_online),
+ OffsetUI = erlang:unique_integer([monotonic]),
+ OffsetMT = erlang:monotonic_time(),
+ MinHSz = ?NR_OF_MONOTONIC_CALLS*(2
+ + 3
+ + erts_debug:flat_size(OffsetUI)
+ + erts_debug:flat_size(OffsetMT)),
+ Ps = lists:map(
+ fun (Sched) ->
+ spawn_opt(
+ fun () ->
+ Me ! {self(), UpAndRunning},
+ receive Go -> ok end,
+ Res = fetch_monotonic(?NR_OF_MONOTONIC_CALLS, []),
+ Me ! {self(), Result, Sched, Res}
+ end,
+ [{scheduler, Sched},
+ {priority, max},
+ {min_heap_size, MinHSz}])
+ end,
+ lists:seq(1, NoOnlnScheds)),
+ lists:foreach(fun (P) -> receive {P, UpAndRunning} -> ok end end, Ps),
+ lists:foreach(fun (P) -> P ! Go end, Ps),
+ TMs = recv_monotonics(Result, OffsetMT, OffsetUI, NoOnlnScheds, []),
+ true = check_monotonic_result(TMs, OffsetMT, OffsetUI, true).
+
+check_monotonic_result([{_Sched, _PrevUI, _MT, _PostUI}],
+ _OffsetMT, _OffsetUI, Res) ->
+ Res;
+check_monotonic_result([{_ASched, _APrevUI, AMT, APostUI} = A,
+ {_BSched, BPrevUI, BMT, _BPostUI} = B | _] = L,
+ OffsetMT, OffsetUI, Res) ->
+ NewRes = case (AMT =< BMT) orelse (BPrevUI < APostUI) of
+ true ->
+ Res;
+ false ->
+ io:format("INCONSISTENCY: ~p ~p~n", [A, B]),
+ false
+ end,
+ check_monotonic_result(tl(L), OffsetMT, OffsetUI, NewRes).
+
+recv_monotonics(_Result, _OffsetMT, _OffsetUI, 0, Acc) ->
+ lists:keysort(2, Acc);
+recv_monotonics(Result, OffsetMT, OffsetUI, N, Acc) ->
+ receive
+ {_, Result, Sched, Res} ->
+ CRes = convert_monotonic(Sched, OffsetMT, OffsetUI, Res, []),
+ recv_monotonics(Result, OffsetMT, OffsetUI, N-1, CRes ++ Acc)
+ end.
+
+convert_monotonic(_Sched, _OffsetMT, _OffsetUI, [{_MT, _UI}], Acc) ->
+ Acc;
+convert_monotonic(Sched, OffsetMT, OffsetUI,
+ [{MT, UI}, {_PrevMT, PrevUI} | _] = L, Acc) ->
+ convert_monotonic(Sched, OffsetMT, OffsetUI, tl(L),
+ [{Sched, PrevUI-OffsetUI, MT-OffsetMT, UI-OffsetUI}
+ | Acc]).
+
+fetch_monotonic(0, Acc) ->
+ Acc;
+fetch_monotonic(N, Acc) ->
+ MT = erlang:monotonic_time(),
+ UI = erlang:unique_integer([monotonic]),
+ fetch_monotonic(N-1, [{MT, UI} | Acc]).
+
+-define(CHK_RES_CONVS_TIMEOUT, 400).
+
+time_unit_conversion(Config) when is_list(Config) ->
+ Mon = erlang:monitor(time_offset, clock_service),
+ start_check_res_convs(Mon, 1000000000000),
+ start_check_res_convs(Mon, 2333333333333),
+ start_check_res_convs(Mon, 5732678356789),
+ erlang:demonitor(Mon, [flush]).
+
+start_check_res_convs(Mon, Res) ->
+ io:format("Checking ~p time_unit~n", [Res]),
+ check_res_convs(Mon,
+ erlang:start_timer(?CHK_RES_CONVS_TIMEOUT,
+ self(),
+ timeout),
+ Res).
+
+
+check_res_convs(Mon, Done, Res) ->
+ receive
+ {timeout, Done, timeout} ->
+ case Res div 10 of
+ 0 ->
+ ok;
+ NewRes ->
+ start_check_res_convs(Mon, NewRes)
+ end
+ after 0 ->
+ do_check_res_convs(Mon, Done, Res)
+ end.
+
+do_check_res_convs(Mon, Done, Res) ->
+ TStart = erlang:monotonic_time(),
+ T = erlang:monotonic_time(Res),
+ TEnd = erlang:monotonic_time(),
+ TMin = erlang:convert_time_unit(TStart, native, Res),
+ TMax = erlang:convert_time_unit(TEnd, native, Res),
+ %io:format("~p =< ~p =< ~p~n", [TMin, T, TEnd]),
+ true = (TMin =< T),
+ true = (TMax >= T),
+ check_time_offset_res_conv(Mon, Res),
+ check_res_convs(Mon, Done, Res).
+
+
+check_time_offset_res_conv(Mon, Res) ->
+ TORes = erlang:time_offset(Res),
+ TO = erlang:time_offset(),
+ case erlang:convert_time_unit(TO, native, Res) of
+ TORes ->
+ ok;
+ TORes2 ->
+ case check_time_offset_change(Mon, TO, 1000) of
+ {TO, false} ->
+ ct:fail({time_unit_conversion_inconsistency,
+ TO, TORes, TORes2});
+ {_NewTO, true} ->
+ io:format("time_offset changed", []),
+ check_time_offset_res_conv(Mon, Res)
+ end
+ end.
+
+signed_time_unit_conversion(Config) when is_list(Config) ->
+ chk_strc(1000000000, 1000000),
+ chk_strc(1000000000, 1000),
+ chk_strc(1000000000, 1),
+ chk_strc(1000000, 1000),
+ chk_strc(1000000, 1),
+ chk_strc(1000, 1),
+ chk_strc(4711, 17),
+ chk_strc(1 bsl 10, 1),
+ chk_strc(1 bsl 16, 10),
+ chk_strc(1 bsl 17, 1 bsl 8),
+ chk_strc((1 bsl 17) + 1, (1 bsl 8) - 1),
+ chk_strc(1 bsl 17, 11),
+ ok.
+
+chk_strc(Res0, Res1) ->
+ case (Res0 /= Res1) andalso (Res0 =< 1000000) andalso (Res1 =< 1000000) of
+ true ->
+ {FromRes, ToRes} = case Res0 > Res1 of
+ true -> {Res0, Res1};
+ false -> {Res1, Res0}
+ end,
+ MinFromValuesPerToValue = FromRes div ToRes,
+ MaxFromValuesPerToValue = ((FromRes-1) div ToRes)+1,
+ io:format("~p -> ~p [~p, ~p]~n",
+ [FromRes, ToRes,
+ MinFromValuesPerToValue, MaxFromValuesPerToValue]),
+ chk_values_per_value(FromRes, ToRes,
+ -10*FromRes, 10*FromRes,
+ MinFromValuesPerToValue,
+ MaxFromValuesPerToValue,
+ undefined, MinFromValuesPerToValue);
+ _ ->
+ ok
+ end,
+ chk_random_values(Res0, Res1),
+ chk_random_values(Res1, Res0),
+ ok.
+
+chk_random_values(FR, TR) ->
+ 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,
+ EndValue, EndValue,
+ MinFromValuesPerToValue, MaxFromValuesPerToValue,
+ _ToValue, FromValueCount) ->
+% io:format("~p [~p]~n", [EndValue, FromValueCount]),
+ case ((MinFromValuesPerToValue =< FromValueCount)
+ andalso (FromValueCount =< MaxFromValuesPerToValue)) of
+ false ->
+ ct:fail({MinFromValuesPerToValue,
+ FromValueCount,
+ MaxFromValuesPerToValue});
+ true ->
+ ok
+ end;
+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 ->
+ 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) ->
+ Mon = erlang:monitor(time_offset, clock_service),
+ {TO, _} = check_time_offset_change(Mon,
+ erlang:time_offset(),
+ 0),
+ Done = erlang:start_timer(10000,self(),timeout),
+ ok = check_erlang_timestamp(Done, Mon, TO).
+
+check_erlang_timestamp(Done, Mon, TO) ->
+ receive
+ {timeout, Done, timeout} ->
+ erlang:demonitor(Mon, [flush]),
+ ok
+ after 0 ->
+ do_check_erlang_timestamp(Done, Mon, TO)
+ end.
+
+do_check_erlang_timestamp(Done, Mon, TO) ->
+ MinMon = erlang:monotonic_time(),
+ {MegaSec, Sec, MicroSec} = erlang:timestamp(),
+ MaxMon = erlang:monotonic_time(),
+ TsMin = erlang:convert_time_unit(MinMon+TO,
+ native,
+ microsecond),
+ TsMax = erlang:convert_time_unit(MaxMon+TO,
+ native,
+ microsecond),
+ TsTime = (MegaSec*1000000+Sec)*1000000+MicroSec,
+ case (TsMin =< TsTime) andalso (TsTime =< TsMax) of
+ true ->
+ NewTO = case erlang:time_offset() of
+ TO ->
+ TO;
+ _ ->
+ check_time_offset_change(Mon, TO, 0)
+ end,
+ check_erlang_timestamp(Done, Mon, NewTO);
+ false ->
+ io:format("TsMin=~p TsTime=~p TsMax=~p~n", [TsMin, TsTime, TsMax]),
+ io:format("Detected inconsistency; "
+ "checking for time_offset change...", []),
+ case check_time_offset_change(Mon, TO, 1000) of
+ {TO, false} ->
+ ct:fail(timestamp_inconsistency);
+ {NewTO, true} ->
+ io:format("time_offset changed", []),
+ check_erlang_timestamp(Done, Mon, NewTO)
+ end
+ end.
+
+check_time_offset_change(Mon, TO, Wait) ->
+ process_changed_time_offset(Mon, TO, false, Wait).
+
+process_changed_time_offset(Mon, TO, Changed, Wait) ->
+ receive
+ {'CHANGE', Mon, time_offset, clock_service, NewTO} ->
+ process_changed_time_offset(Mon, NewTO, true, Wait)
+ after Wait ->
+ case erlang:time_offset() of
+ TO ->
+ {TO, Changed};
+ _OtherTO ->
+ receive
+ {'CHANGE', Mon, time_offset, clock_service, NewTO} ->
+ process_changed_time_offset(Mon, NewTO, true, Wait)
+ end
+ end
+ end.
+
+
%% Returns the test data: a list of {Utc, Local} tuples.
@@ -435,13 +873,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).
@@ -449,16 +887,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([], _) ->
[].
@@ -466,9 +904,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([], _) ->
[].
@@ -554,4 +992,22 @@ bad_dates() ->
{{1996, 4, 30}, {12, 0, -1}}, % Sec
{{1996, 4, 30}, {12, 0, 60}}].
-
+
+start_node(Config, Args) ->
+ 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)),
+ test_server:start_node(Name,
+ slave,
+ [{args, "-pa " ++ PA ++ " " ++ Args}]).
+
+stop_node(Node) ->
+ test_server:stop_node(Node).
diff --git a/erts/emulator/test/timer_bif_SUITE.erl b/erts/emulator/test/timer_bif_SUITE.erl
index c28224729d..fc11a04a31 100644
--- a/erts/emulator/test/timer_bif_SUITE.erl
+++ b/erts/emulator/test/timer_bif_SUITE.erl
@@ -1,78 +1,80 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1998-2017. 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.
+%% 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(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,
start_timer_big/1, send_after_big/1,
start_timer_e/1, send_after_e/1, cancel_timer_e/1,
- read_timer_trivial/1, read_timer/1,
- cleanup/1, evil_timers/1, registered_process/1]).
+ read_timer_trivial/1, read_timer/1, read_timer_async/1,
+ cleanup/1, evil_timers/1, registered_process/1, same_time_yielding/1,
+ same_time_yielding_with_cancel/1, same_time_yielding_with_cancel_other/1,
+% same_time_yielding_with_cancel_other_accessor/1,
+ auto_cancel_yielding/1]).
+
+-include_lib("common_test/include/ct.hrl").
--include_lib("test_server/include/test_server.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) ->
+ erts_debug:set_internal_state(available_internal_state, true),
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,
cancel_timer_1, start_timer_e, send_after_e,
cancel_timer_e, start_timer_big, send_after_big,
- read_timer_trivial, read_timer, cleanup, evil_timers,
- registered_process].
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
+ read_timer_trivial, read_timer, read_timer_async,
+ cleanup, evil_timers, registered_process,
+ same_time_yielding, same_time_yielding_with_cancel,
+ same_time_yielding_with_cancel_other,
+% same_time_yielding_with_cancel_other_accessor,
+ auto_cancel_yielding].
-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}),
+ ok = get(1400, {timeout, Ref1, plopp}),
false = erlang:read_timer(Ref1),
false = erlang:cancel_timer(Ref1),
@@ -81,62 +83,62 @@ start_timer_1(Config) when is_list(Config) ->
Ref2 = erlang:start_timer(1000, self(), plapp),
Left2 = erlang:cancel_timer(Ref2),
UpperLimit = 1000,
- true = (Left2 > 900) and (Left2 =< UpperLimit),
+ true = (Left2 > 600) and (Left2 =< UpperLimit),
empty = get_msg(),
false = erlang:cancel_timer(Ref2),
Ref3 = erlang:start_timer(1000, self(), plopp),
- no_message = get(900, {timeout, Ref3, plopp}),
+ no_message = get(600, {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),
@@ -144,141 +146,173 @@ 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(4728472847827482,
- 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(4728472847827482,
- 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) ->
- ?line Big = 1 bsl 31,
- ?line R = erlang:send_after(Big, self(), hej_hopp),
-
- ?line receive after 200 -> ok end, % Delay and clear reductions.
- ?line Left = erlang:read_timer(R),
- ?line Left = erlang:cancel_timer(R),
- ?line false = erlang:read_timer(R),
-
- ?line case Big - Left of
- Diff when Diff >= 200, Diff < 10000 ->
- ok;
- _Diff ->
- test_server:fail({big, Big, Left})
- end,
+ process_flag(scheduler, 1),
+ Big = 1 bsl 31,
+ R = erlang:send_after(Big, self(), hej_hopp),
+
+ receive after 200 -> ok end, % Delay and clear reductions.
+ Left = erlang:read_timer(R),
+ Left2 = erlang:cancel_timer(R),
+ case Left == Left2 of
+ true -> ok;
+ false -> Left = Left2 + 1
+ end,
+ false = erlang:read_timer(R),
+
+ case Big - Left of
+ Diff when Diff >= 200, Diff < 10000 ->
+ ok;
+ _Diff ->
+ ct:fail({big, Big, Left})
+ end,
+ process_flag(scheduler, 0),
+ ok.
+
+%% 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,
+ R = erlang:send_after(Big, self(), hej_hopp),
+
+ %% Access from another scheduler
+ process_flag(scheduler, erlang:system_info(schedulers_online)),
+
+ receive after 200 -> ok end, % Delay and clear reductions.
+ ok = erlang:read_timer(R, [{async, true}]),
+ ok = erlang:cancel_timer(R, [{async, true}, {info, true}]),
+ ok = erlang:read_timer(R, [{async, true}]),
+
+ {read_timer, R, Left} = receive_one(),
+ {cancel_timer, R, Left2} = receive_one(),
+ case Left == Left2 of
+ 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 ->
+ 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(10000, P1, "hej"),
- ?line T2 = erlang:send_after(10000, P1, "hej"),
- ?line Mem = mem(),
- ?line false = erlang:read_timer(T1),
- ?line false = erlang:read_timer(T2),
- ?line Mem = mem(),
+ 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,
+ Mem = mem(),
+ false = erlang:read_timer(T1),
+ false = erlang:read_timer(T2),
+ Mem = mem(),
%% Process dies before timeout
- ?line P2 = spawn(fun () -> receive after 500 -> ok end end),
- ?line T3 = erlang:start_timer(10000, P2, "hej"),
- ?line T4 = erlang:send_after(10000, P2, "hej"),
- ?line true = Mem < 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),
- ?line false = erlang:read_timer(T3),
- ?line false = erlang:read_timer(T4),
- ?line Mem = mem(),
+ 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,
+ false = erlang:read_timer(T3),
+ false = erlang:read_timer(T4),
+ Mem = mem(),
%% Cancel timer
- ?line P3 = spawn(fun () -> receive after 20000 -> ok end end),
- ?line T5 = erlang:start_timer(10000, P3, "hej"),
- ?line T6 = erlang:send_after(10000, P3, "hej"),
- ?line true = Mem < 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 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(500, self(), Ref),
- ?line T8 = erlang:send_after(500, self(), Ref),
- ?line true = Mem < 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)
@@ -290,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:
%%
@@ -334,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
@@ -343,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
@@ -353,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
@@ -367,129 +401,280 @@ 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(500, ?MODULE, "hej"),
- ?line T2 = erlang:send_after(500, ?MODULE, "hej"),
- ?line undefined = whereis(?MODULE),
- ?line true = Mem < 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(500, ?MODULE, Ref1),
- ?line T4 = erlang:send_after(500, ?MODULE, Ref1),
- ?line undefined = whereis(?MODULE),
- ?line true = Mem < 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(500, ?MODULE, Ref2),
- ?line T6 = erlang:send_after(500, ?MODULE, Ref2),
- ?line true = Mem < 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.
-mem() ->
- AA = erlang:system_info(allocated_areas),
- {value,{bif_timer,Mem}} = lists:keysearch(bif_timer, 1, AA),
- Mem.
+same_time_yielding(Config) when is_list(Config) ->
+ Mem = mem(),
+ Ref = make_ref(),
+ SchdlrsOnln = erlang:system_info(schedulers_online),
+ Tmo = erlang:monotonic_time(millisecond) + 3000,
+ Tmrs = lists:map(fun (I) ->
+ process_flag(scheduler, (I rem SchdlrsOnln) + 1),
+ erlang:start_timer(Tmo, self(), Ref, [{abs, true}])
+ end,
+ lists:seq(1, (?TIMEOUT_YIELD_LIMIT*3+1)*SchdlrsOnln)),
+ true = mem_larger_than(Mem),
+ receive_all_timeouts(length(Tmrs), Ref),
+ Done = erlang:monotonic_time(millisecond),
+ true = Done >= Tmo,
+ MsAfterTmo = Done - Tmo,
+ io:format("Done ~p ms after Tmo\n", [MsAfterTmo]),
+ case erlang:system_info(build_type) of
+ opt ->
+ true = MsAfterTmo < 200;
+ _ ->
+ true = MsAfterTmo < 1000
+ end,
+ Mem = mem(),
+ ok.
+
+%% Read out all timeouts in receive queue order. This is efficient
+%% even if there are very many messages.
+
+receive_all_timeouts(0, _Ref) ->
+ ok;
+receive_all_timeouts(N, Ref) ->
+ receive
+ {timeout, _Tmr, Ref} ->
+ receive_all_timeouts(N-1, Ref)
+ end.
+
+same_time_yielding_with_cancel(Config) when is_list(Config) ->
+ same_time_yielding_with_cancel_test(false, false).
+
+same_time_yielding_with_cancel_other(Config) when is_list(Config) ->
+ same_time_yielding_with_cancel_test(true, false).
+
+%same_time_yielding_with_cancel_other_accessor(Config) when is_list(Config) ->
+% same_time_yielding_with_cancel_test(true, true).
+
+do_cancel_tmrs(Tmo, Tmrs, Tester) ->
+ BeginCancel = erlang:convert_time_unit(Tmo,
+ millisecond,
+ microsecond) - 100,
+ busy_wait_until(fun () ->
+ erlang:monotonic_time(microsecond) >= BeginCancel
+ end),
+ lists:foreach(fun (Tmr) ->
+ erlang:cancel_timer(Tmr,
+ [{async, true},
+ {info, true}])
+ end, Tmrs),
+ case Tester == self() of
+ true -> ok;
+ false -> forward_msgs(Tester)
+ end.
+
+same_time_yielding_with_cancel_test(Other, Accessor) ->
+ Mem = mem(),
+ SchdlrsOnln = erlang:system_info(schedulers_online),
+ Tmo = erlang:monotonic_time(millisecond) + 3000,
+ Tester = self(),
+ Cancelor = case Other of
+ 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,
+ 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)),
+ true = mem_larger_than(Mem),
+ case Other of
+ 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),
+ io:format("Timeouts: ~p Cancels: ~p~n", [Tmos, Cncls]),
+ Mem = mem(),
+ case Other of
+ true -> exit(Cancelor, bang);
+ false -> ok
+ end,
+ {comment,
+ "Timeouts: " ++ integer_to_list(Tmos) ++ " Cancels: "
+ ++ integer_to_list(Cncls)}.
+
+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),
+ true = mem_larger_than(Mem),
+ exit(P, bang),
+ wait_until(fun () -> process_is_cleaned_up(P) end),
+ Mem = mem(),
+ ok.
process_is_cleaned_up(P) when is_pid(P) ->
undefined == erts_debug:get_internal_state({process_status, 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)
end.
+forward_msgs(To) ->
+ receive
+ 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 {A, B, C} = now(),
- ?line Pa = filename:dirname(code:which(?MODULE)),
- ?line Name = atom_to_list(?MODULE) ++ "-" ++ integer_to_list(A+B+C),
- {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(second))
+ ++ "-" ++ integer_to_list(erlang:unique_integer([positive])),
+ {ok, Node} = test_server:start_node(Name, slave, [{args, "-pa " ++ Pa}]),
Node.
stop_slave(Node) ->
@@ -500,18 +685,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) ->
@@ -549,5 +734,58 @@ type(X) when is_port(X) -> {port, node(X)};
type(X) when is_binary(X) -> binary;
type(X) when is_atom(X) -> atom;
type(_) -> unknown.
-
+
+mem_larger_than(no_fix_alloc) ->
+ true;
+mem_larger_than(Mem) ->
+ mem() > Mem.
+
+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
+ end.
+
+mem_get() ->
+ % Bif timer memory
+ Ref = make_ref(),
+ erlang:system_info({memory_internal, Ref, [fix_alloc]}),
+ mem_recv(erlang:system_info(schedulers), Ref, {0, 0}).
+
+mem_recv(0, _Ref, AU) ->
+ AU;
+mem_recv(N, Ref, AU) ->
+ receive
+ {Ref, _, IL} ->
+ mem_recv(N-1, Ref, mem_parse_ilists(IL, AU))
+ end.
+
+
+mem_parse_ilists([], AU) ->
+ AU;
+mem_parse_ilists([I|Is], AU) ->
+ mem_parse_ilists(Is, mem_parse_ilist(I, AU)).
+
+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}
+ 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 ->
+ 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 2251575e5a..a81aa64057 100644
--- a/erts/emulator/test/trace_SUITE.erl
+++ b/erts/emulator/test/trace_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2017. 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/.
+%% 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
%%
-%% 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.
+%% 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%
%%
@@ -23,476 +24,838 @@
%%% 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, init_per_testcase/2, end_per_testcase/2,
+ link_receive_call_correlation/0,
+ receive_trace/1, link_receive_call_correlation/1, self_send/1,
timeout_trace/1, send_trace/1,
- procs_trace/1, dist_procs_trace/1,
+ procs_trace/1, dist_procs_trace/1, procs_new_trace/1,
suspend/1, mutual_suspend/1, suspend_exit/1, suspender_exit/1,
suspend_system_limit/1, suspend_opts/1, suspend_waiting/1,
- new_clear/1, existing_clear/1,
+ new_clear/1, existing_clear/1, tracer_die/1,
set_on_spawn/1, set_on_first_spawn/1, cpu_timestamp/1,
+ set_on_link/1, set_on_first_link/1,
system_monitor_args/1, more_system_monitor_args/1,
system_monitor_long_gc_1/1, system_monitor_long_gc_2/1,
system_monitor_large_heap_1/1, system_monitor_large_heap_2/1,
system_monitor_long_schedule/1,
- bad_flag/1, trace_delivered/1]).
+ bad_flag/1, trace_delivered/1, trap_exit_self_receive/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, {minutes, 1}}].
all() ->
- [cpu_timestamp, receive_trace, self_send, timeout_trace,
+ [cpu_timestamp, receive_trace, link_receive_call_correlation,
+ self_send, timeout_trace,
send_trace, procs_trace, dist_procs_trace, suspend,
mutual_suspend, suspend_exit, suspender_exit,
suspend_system_limit, suspend_opts, suspend_waiting,
- new_clear, existing_clear, set_on_spawn,
- set_on_first_spawn, system_monitor_args,
+ new_clear, existing_clear, tracer_die, set_on_spawn,
+ set_on_first_spawn, set_on_link, set_on_first_link,
+ 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_large_heap_2, bad_flag, trace_delivered].
-
-groups() ->
- [].
+ system_monitor_long_schedule,
+ system_monitor_large_heap_2, bad_flag, trace_delivered,
+ trap_exit_self_receive].
-init_per_suite(Config) ->
- Config.
+init_per_testcase(_Case, Config) ->
+ [{receiver,spawn(fun receiver/0)}|Config].
-end_per_suite(_Config) ->
+end_per_testcase(_Case, Config) ->
+ Receiver = proplists:get_value(receiver, Config),
+ unlink(Receiver),
+ exit(Receiver, die),
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 = proplists:get_value(receiver, Config),
%% 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_trace(),
+ Hello2 = {hello, again, world},
+ Receiver ! Hello2,
+ {trace, Receiver, 'receive', Hello2} = receive_first_trace(),
+ receive_nothing(),
+
+ %% Test 'receive' with matchspec
+ F1 = fun ({Pat, IsMatching}) ->
+ set_trace_pattern('receive', Pat, []),
+ Receiver ! Hello,
+ case IsMatching of
+ true ->
+ {trace, Receiver, 'receive', Hello} = receive_first_trace();
+ false ->
+ ok
+ end,
+ receive_nothing()
+ end,
+ From = self(),
+ Node = node(),
+ lists:foreach(F1, [{no, true},
+ {[{[Node, undefined,"Unexpected"],[],[]}], false},
+ {[{[Node, From,'_'],[],[]}], true},
+ {[{[Node, '$1','_'],[{'=/=','$1',From}],[]}], false},
+ {[{['$1', '_','_'],[{'=:=','$1',Node}],[]}], true},
+ {false, false},
+ {true, true}]),
+
+ %% Remote messages
+ OtherName = atom_to_list(?MODULE)++"_receive_trace",
+ {ok, OtherNode} = start_node(OtherName),
+ RemoteProc = spawn_link(OtherNode, ?MODULE, process, [self()]),
+ io:format("RemoteProc = ~p ~n", [RemoteProc]),
+
+ RemoteProc ! {send_please, Receiver, Hello},
+ {trace, Receiver, 'receive', Hello} = receive_first_trace(),
+ RemoteProc ! {send_please, Receiver, 99},
+ {trace, Receiver, 'receive', 99} = receive_first_trace(),
+
+ %% Remote with matchspec
+ F2 = fun (To, {Pat, IsMatching}) ->
+ set_trace_pattern('receive', Pat, []),
+ RemoteProc ! {send_please, To, Hello},
+ case IsMatching of
+ true ->
+ {trace, Receiver, 'receive', Hello} = receive_first_trace();
+ false ->
+ ok
+ end,
+ receive_nothing()
+ end,
+ F2(Receiver, {no, true}),
+ F2(Receiver, {[{[OtherNode, undefined,"Unexpected"],[],[]}], false}),
+ F2(Receiver, {[{[OtherNode, RemoteProc,'_'],[],[]},
+ {[OtherNode, undefined,'_'],[],[]}], true}),
+ F2(Receiver, {[{[OtherNode, '$1','_'],
+ [{'orelse',{'=:=','$1',undefined},{'=/=',{node,'$1'},{node}}}],
+ []}], true}),
+ F2(Receiver, {[{['$1', '_','_'], [{'=:=','$1',OtherNode}], []}], true}),
+ F2(Receiver, {false, false}),
+ F2(Receiver, {true, true}),
+
+ %% Remote to named with matchspec
+ Name = trace_SUITE_receiver,
+ register(Name, Receiver),
+ NN = {Name, node()},
+ F2(NN, {no, true}),
+ F2(NN, {[{[OtherNode, undefined,"Unexpected"],[],[]}], false}),
+ F2(NN, {[{[OtherNode, RemoteProc,'_'],[],[]},
+ {[OtherNode, undefined,'_'],[],[]}], true}),
+ F2(NN, {[{[OtherNode, '$1','_'],
+ [{'orelse',{'=:=','$1',undefined},{'=/=',{node,'$1'},{node}}}],
+ []}], true}),
+ F2(NN, {[{['$1', '_','_'], [{'==','$1',OtherNode}], []}], true}),
+ F2(NN, {false, false}),
+ F2(NN, {true, true}),
+
+ unlink(RemoteProc),
+ true = stop_node(OtherNode),
+
+ %% Timeout
+ Receiver ! {set_timeout, 10},
+ {trace, Receiver, 'receive', {set_timeout, 10}} = receive_first_trace(),
+ {trace, Receiver, 'receive', timeout} = receive_first_trace(),
+ erlang:trace_pattern('receive', [{[clock_service,undefined,timeout], [], []}], []),
+ Receiver ! {set_timeout, 7},
+ {trace, Receiver, 'receive', timeout} = receive_first_trace(),
+ erlang:trace_pattern('receive', true, []),
%% 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(),
+ process_flag(trap_exit, true),
+ 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(),
+ 1 = erlang:trace(Receiver, false, ['receive']),
+ Receiver ! {hello, there},
+ Receiver ! any_garbage,
+ receive_nothing(),
+
+ %% Verify restrictions in matchspec for 'receive'
+ F3 = fun (Pat) -> {'EXIT', {badarg,_}} = (catch erlang:trace_pattern('receive', Pat, [])) end,
+ WC = ['_','_','_'],
+ F3([{WC,[],[{message, {process_dump}}]}]),
+ F3([{WC,[{is_seq_trace}],[]}]),
+ F3([{WC,[],[{set_seq_token,label,4711}]}]),
+ F3([{WC,[],[{get_seq_token}]}]),
+ F3([{WC,[],[{enable_trace,call}]}]),
+ F3([{WC,[],[{enable_trace,self(),call}]}]),
+ F3([{WC,[],[{disable_trace,call}]}]),
+ F3([{WC,[],[{disable_trace,self(),call}]}]),
+ F3([{WC,[],[{trace,[call],[]}]}]),
+ F3([{WC,[],[{trace,self(),[],[call]}]}]),
+ F3([{WC,[],[{caller}]}]),
+ F3([{WC,[],[{silent,true}]}]),
- %% Done.
- ?line test_server:timetrap_cancel(Dog),
ok.
-self_send(doc) -> ["Test that traces are generated for messages sent ",
- "and received to/from self()."];
+%% Tests that receive of a message always happens before a call with
+%% that message and that links/unlinks are ordered together with the
+%% 'receive'.
+link_receive_call_correlation() ->
+ [{timetrap, {minutes, 5}}].
+link_receive_call_correlation(Config) when is_list(Config) ->
+ Receiver = fun_spawn(fun F() ->
+ receive
+ stop -> ok;
+ M -> receive_msg(M), F()
+ end
+ end),
+ process_flag(trap_exit, true),
+
+ %% Trace the process; make sure that we receive the trace messages.
+ 1 = erlang:trace(Receiver, true, ['receive', procs, call, timestamp, scheduler_id]),
+ 1 = erlang:trace_pattern({?MODULE, receive_msg, '_'}, [], [local]),
+
+ Num = 100000,
+
+ (fun F(0) -> [];
+ F(N) ->
+ if N rem 2 == 0 ->
+ link(Receiver);
+ true ->
+ unlink(Receiver)
+ end,
+ [Receiver ! N | F(N-1)]
+ end)(Num),
+
+ Receiver ! stop,
+ MonRef = erlang:monitor(process, Receiver),
+ receive {'DOWN', MonRef, _, _, _} -> ok end,
+ Ref = erlang:trace_delivered(Receiver),
+ receive {trace_delivered, _, Ref} -> ok end,
+
+ Msgs = (fun F() -> receive M -> [M | F()] after 1 -> [] end end)(),
+
+ case check_consistent(Receiver, Num, Num, Num, Msgs) of
+ ok ->
+ ok;
+ {error, Reason} ->
+ ct:log("~p", [Msgs]),
+ ct:fail({error, Reason})
+ end.
+
+-define(schedid, , _).
+
+check_consistent(_Pid, Recv, Call, _LU, [Msg | _]) when Recv > Call ->
+ {error, Msg};
+check_consistent(Pid, Recv, Call, LU, [Msg | Msgs]) ->
+
+ case Msg of
+ {trace, Pid, 'receive', Recv ?schedid} ->
+ check_consistent(Pid,Recv - 1, Call, LU, Msgs);
+ {trace_ts, Pid, 'receive', Recv ?schedid, _} ->
+ check_consistent(Pid,Recv - 1, Call, LU, Msgs);
+
+ {trace, Pid, call, {?MODULE, receive_msg, [Call]} ?schedid} ->
+ check_consistent(Pid,Recv, Call - 1, LU, Msgs);
+ {trace_ts, Pid, call, {?MODULE, receive_msg, [Call]} ?schedid, _} ->
+ check_consistent(Pid,Recv, Call - 1, LU, Msgs);
+
+ %% We check that for each receive we have gotten a
+ %% getting_linked or getting_unlinked message. Also
+ %% if we receive a getting_linked, then the next
+ %% message we expect to receive is an even number
+ %% and odd number for getting_unlinked.
+ {trace, Pid, getting_linked, _Self ?schedid}
+ when Recv rem 2 == 0, Recv == LU ->
+ check_consistent(Pid, Recv, Call, LU - 1, Msgs);
+ {trace_ts, Pid, getting_linked, _Self ?schedid, _}
+ when Recv rem 2 == 0, Recv == LU ->
+ check_consistent(Pid, Recv, Call, LU - 1, Msgs);
+
+ {trace, Pid, getting_unlinked, _Self ?schedid}
+ when Recv rem 2 == 1, Recv == LU ->
+ check_consistent(Pid, Recv, Call, LU - 1, Msgs);
+ {trace_ts, Pid, getting_unlinked, _Self ?schedid, _}
+ when Recv rem 2 == 1, Recv == LU ->
+ check_consistent(Pid, Recv, Call, LU - 1, Msgs);
+
+ {trace,Pid,'receive',Ignore ?schedid}
+ when Ignore == stop; Ignore == timeout ->
+ check_consistent(Pid, Recv, Call, LU, Msgs);
+ {trace_ts,Pid,'receive',Ignore ?schedid,_}
+ when Ignore == stop; Ignore == timeout ->
+ check_consistent(Pid, Recv, Call, LU, Msgs);
+
+ {trace, Pid, exit, normal ?schedid} ->
+ check_consistent(Pid, Recv, Call, LU, Msgs);
+ {trace_ts, Pid, exit, normal ?schedid, _} ->
+ check_consistent(Pid, Recv, Call, LU, Msgs);
+ {'EXIT', Pid, normal} ->
+ check_consistent(Pid, Recv, Call, LU, Msgs);
+ Msg ->
+ {error, Msg}
+ end;
+check_consistent(_, 0, 0, 0, []) ->
+ ok;
+check_consistent(_, Recv, Call, LU, []) ->
+ {error,{Recv, Call, LU}}.
+
+receive_msg(M) ->
+ M.
+
+%% 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(),
+ {trace, Process, 'receive', timeout} = receive_first_trace(),
+ 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 = proplists:get_value(receiver, Config),
%% 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]),
+ F1 = fun (Pat) ->
+ set_trace_pattern(send, Pat, []),
+ Sender ! {send_please, Receiver, to_receiver},
+ {trace, Sender, send, to_receiver, Receiver} = receive_first_trace(),
+ receive_nothing()
+ end,
+ lists:foreach(F1, [no,
+ [{[Receiver,to_receiver],[],[]}],
+ [{['_','_'],[],[]}],
+ [{['$1','_'],[{is_pid,'$1'}],[]}],
+ [{['_','$1'],[{is_atom,'$1'}],[]}],
+ true]),
+
+ %% Test {message, Msg}
+ F1m = fun ({Pat, Msg}) ->
+ set_trace_pattern(send, Pat, []),
+ Sender ! {send_please, Receiver, to_receiver},
+ {trace, Sender, send, to_receiver, Receiver, Msg} = receive_first_trace(),
+ receive_nothing()
+ end,
+ lists:foreach(F1m, [{[{['_','_'],[],[{message, 4711}]}], 4711},
+ {[{['_','_'],[],[{message, "4711"}]}], "4711"}
+ ]),
+
+ %% Test {message, {process_dump}}
+ set_trace_pattern(send, [{['_','_'],[],[{message, {process_dump}}]}], []),
+ Sender ! {send_please, Receiver, to_receiver},
+ {trace, Sender, send, to_receiver, Receiver, ProcDump} = receive_first_trace(),
+ true = is_binary(ProcDump),
+ receive_nothing(),
+
+ %% Same test with false match spec
+ F2 = fun (Pat) ->
+ set_trace_pattern(send, Pat, []),
+ Sender ! {send_please, Receiver, to_receiver},
+ receive_nothing()
+ end,
+ lists:foreach(F2, [[{[Sender,to_receiver],[],[]}],
+ [{[Receiver,nomatch],[],[]}],
+ [{['$1','_'],[{is_atom,'$1'}],[]}],
+ [{['_','$1'],[{is_pid,'$1'}],[]}],
+ false,
+ [{['_','_'],[],[{message,false}]}],
+ [{['_','_'],[],[{silent,true}]}]]),
+ erlang:trace_pattern(send, true, []),
+ erlang:trace(Sender, false, [silent]),
+
+ %% Check that a message sent to another registered process is traced.
+ register(?MODULE,Receiver),
+ F3 = fun (Pat) ->
+ set_trace_pattern(send, Pat, []),
+ Sender ! {send_please, ?MODULE, to_receiver},
+ {trace, Sender, send, to_receiver, ?MODULE} = receive_first_trace(),
+ receive_nothing()
+ end,
+ lists:foreach(F3, [no,
+ [{[?MODULE,to_receiver],[],[]}],
+ [{['_','_'],[],[]}],
+ [{['$1','_'],[{is_atom,'$1'}],[]}],
+ [{['_','$1'],[{is_atom,'$1'}],[]}],
+ true]),
+ %% Again with false match spec
+ F4 = fun (Pat) ->
+ set_trace_pattern(send, Pat, []),
+ Sender ! {send_please, ?MODULE, to_receiver},
+ receive_nothing()
+ end,
+ lists:foreach(F4, [[{[nomatch,to_receiver],[],[]}],
+ [{[?MODULE,nomatch],[],[]}],
+ [{['$1','_'],[{is_pid,'$1'}],[]}],
+ [{['_','$1'],[{is_pid,'$1'}],[]}],
+ [{['_','_'],[],[{message,false}]}],
+ [{['_','_'],[],[{silent,true}]}]
+ ]),
+ unregister(?MODULE),
+ erlang:trace_pattern(send, true, []),
+ erlang:trace(Sender, false, [silent]),
%% 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(),
+ F5 = fun (Pat) ->
+ set_trace_pattern(send, Pat, []),
+ Sender ! {send_please, self(), to_myself},
+ receive to_myself -> ok end,
+ Self = self(),
+ {trace, Sender, send, to_myself, Self} = receive_first_trace(),
+ receive_nothing()
+ end,
+ lists:foreach(F5, [no,
+ [{[self(),to_myself],[],[]}],
+ [{['_','_'],[],[]}],
+ true]),
+
+ %% Check that a message sent to dead process is traced.
+ {Pid,Ref} = spawn_monitor(fun() -> ok end),
+ receive {'DOWN',Ref,_,_,_} -> ok end,
+ F6 = fun (Pat) ->
+ set_trace_pattern(send, Pat, []),
+ Sender ! {send_please, Pid, to_dead},
+ {trace, Sender, send_to_non_existing_process, to_dead, Pid} = receive_first_trace(),
+ receive_nothing()
+ end,
+ lists:foreach(F6, [no,
+ [{[Pid,to_dead],[],[]}],
+ [{['_','_'],[],[]}],
+ true]),
+
+ %% Check that a message sent to unknown registrated process is traced.
+ BadargSender = fun_spawn(fun sender/0),
+ 1 = erlang:trace(BadargSender, true, [send]),
+ unlink(BadargSender),
+ BadargSender ! {send_please, not_registered, to_unknown},
+ {trace, BadargSender, send, to_unknown, not_registered} = receive_first_trace(),
+ 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(),
+ 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(),
+ {'EXIT',{badarg,_}} = (catch erlang:trace_pattern(send, true, [global])),
+ {'EXIT',{badarg,_}} = (catch erlang:trace_pattern(send, true, [local])),
+ {'EXIT',{badarg,_}} = (catch erlang:trace_pattern(send, true, [meta])),
+ {'EXIT',{badarg,_}} = (catch erlang:trace_pattern(send, true, [{meta,self()}])),
+ {'EXIT',{badarg,_}} = (catch erlang:trace_pattern(send, true, [call_count])),
+ {'EXIT',{badarg,_}} = (catch erlang:trace_pattern(send, true, [call_time])),
+ {'EXIT',{badarg,_}} = (catch erlang:trace_pattern(send, restart, [])),
+ {'EXIT',{badarg,_}} = (catch erlang:trace_pattern(send, pause, [])),
+ {'EXIT',{badarg,_}} = (catch erlang:trace_pattern(send, [{['_','_'],[],[{caller}]}], [])),
+
%% Done.
- ?line test_server:timetrap_cancel(Dog),
ok.
+set_trace_pattern(_, no, _) -> 0;
+set_trace_pattern(MFA, Pat, Flg) ->
+ R = erlang:trace_pattern(MFA, Pat, Flg),
+ {match_spec, Pat} = erlang:trace_info(MFA, match_spec),
+ R.
+
%% 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, set_on_first_spawn]),
+ 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,
+ receive {trace, Proc3, spawned, Proc1, MFA} -> ok end,
+ receive {trace, Proc3, getting_linked, Proc1} -> ok end,
+ {trace, Proc1, spawn, Proc3, MFA} = receive_first_trace(),
+ io:format("Proc3 = ~p ~n", [Proc3]),
+ {trace, Proc1, link, Proc3} = receive_first_trace(),
+ 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,
+ receive {trace, Proc3, exit, Reason3} -> ok end,
+ {trace, Proc1, getting_unlinked, Proc3} = receive_first_trace(),
+ 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_trace(),
+ 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_trace(),
+ 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_trace(),
+ 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_trace(),
+ 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_trace(),
+ 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_trace(),
+ 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_trace(),
+ io:format("Proc4 = ~p ~n", [Proc4]),
+ {trace, Proc1, link, Proc4} = receive_first_trace(),
+ Proc1 ! {register_please, Name, Proc1},
+ {trace, Proc1, register, Name} = receive_first_trace(),
+ Proc4 ! {exit_please, Reason4},
+ receive {'EXIT', Proc1, Reason4} -> ok end,
+ {trace, Proc1, exit, Reason4} = receive_first_trace(),
+ {trace, Proc1, unregister, Name} = receive_first_trace(),
+ 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_trace(),
+ 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_trace(),
+ Reason3 = make_ref(),
+ Proc1 ! {send_please, Proc3, {exit_please, Reason3}},
+ receive {Proc1, {'EXIT', Proc3, Reason3}} -> ok end,
+ {trace, Proc1, getting_unlinked, Proc3} = receive_first_trace(),
+ 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_trace(),
+ 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_trace(),
+ 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_trace(),
+ 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_trace(),
+ 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_trace(),
+ Proc1 ! {register_please, Name, Proc1},
+ {trace, Proc1, register, Name} = receive_first_trace(),
+ Proc2 ! {exit_please, Reason2},
+ receive {'EXIT', Proc1, Reason2} -> ok end,
+ {trace, Proc1, exit, Reason2} = receive_first_trace(),
+ {trace, Proc1, unregister, Name} = receive_first_trace(),
+ receive_nothing(),
%%
%% Done.
- ?line true = stop_node(OtherNode),
- ?line test_server:timetrap_cancel(Dog),
+ true = stop_node(OtherNode),
ok.
+%% Test trace(new, How, [procs]).
+procs_new_trace(Config) when is_list(Config) ->
+ Self = self(),
+ process_flag(trap_exit, true),
+ %%
+ Proc1 = spawn_link(?MODULE, process, [Self]),
+ io:format("Proc1 = ~p ~n", [Proc1]),
+ %%
+ 0 = erlang:trace(new, true, [procs]),
+
+ MFA = {?MODULE, process, [Self]},
+ %%
+ %% spawn, link
+ Proc1 ! {spawn_link_please, Self, MFA},
+ Proc3 = receive {spawned, Proc1, P3} -> P3 end,
+ receive {trace, Proc3, spawned, Proc1, MFA} -> ok end,
+ receive {trace, Proc3, getting_linked, Proc1} -> ok end,
+ io:format("Proc3 = ~p ~n", [Proc3]),
+ receive_nothing(),
+ %%
+ %%
+ %% exit (not linked to tracing process)
+ Reason1 = make_ref(),
+ Proc1 ! {exit_please, Reason1},
+ receive {'EXIT', Proc1, Reason1} -> ok end,
+ {trace, Proc3, exit, Reason1} = receive_first_trace(),
+ receive_nothing(),
+ ok.
%% 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(),
+ [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.
- %% Done.
- ?line test_server:timetrap_cancel(Dog),
+%% Tests trace(Pid, How, [set_on_link]).
+
+set_on_link(_Config) ->
+ Listener = fun_spawn(fun process/0),
+
+ %% Create and trace a process with the set_on_link flag.
+ %% Make sure it is traced.
+ Father_SOL = fun_spawn(fun process/0),
+ 1 = erlang:trace(Father_SOL, true, [send, set_on_link]),
+ true = is_send_traced(Father_SOL, Listener, sol_father),
+
+ %% Have the process spawn of two children and test that they
+ %% are traced.
+ [Child1, Child2] = spawn_children(Father_SOL, 2),
+ true = is_send_traced(Child1, Listener, child1),
+ true = is_send_traced(Child2, Listener, child2),
+
+ %% Second generation.
+ [Child11, Child12] = spawn_children(Child1, 2),
+ 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_link(_Config) ->
+ 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.
+ Parent = fun_spawn(fun process/0),
+ 1 = erlang:trace(Parent, true, [send, set_on_first_link]),
+ is_send_traced(Parent, Listener, sol_father),
+
+ %% Have the process spawn off three children and test that the
+ %% first is traced.
+ [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) ->
@@ -500,29 +863,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() ->
@@ -532,18 +895,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(),
@@ -551,18 +911,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),
@@ -571,214 +931,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)),
- %%
- ?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,
+ ct:timetrap({seconds, 20}),
%%
- ?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) ->
@@ -793,11 +1139,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.
@@ -811,146 +1157,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) ->
@@ -962,320 +1293,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).
@@ -1283,121 +1599,158 @@ 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 = proplists:get_value(receiver, Config),
+
+ 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(),
+
+ Tracer = proplists:get_value(receiver, Config),
+ 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, % Used to be N + 1, but from 19.0 the tracer is also traced
- %% Done.
- ?line test_server:timetrap_cancel(Dog),
ok.
-bad_flag(doc) -> "Test that an invalid flag cause badarg";
-bad_flag(suite) -> [];
+%% Test that erlang:trace/3 can be called on processes where the
+%% tracer has died. OTP-13928
+tracer_die(Config) when is_list(Config) ->
+ Proc = spawn_link(fun receiver/0),
+
+ Tracer = spawn_link(fun receiver/0),
+ timer:sleep(1),
+ N = erlang:trace(existing, true, [send, {tracer, Tracer}]),
+ {flags, [send]} = erlang:trace_info(Proc, flags),
+ {tracer, Tracer} = erlang:trace_info(Proc, tracer),
+ unlink(Tracer),
+ exit(Tracer, die),
+
+ Tracer2 = spawn_link(fun receiver/0),
+ timer:sleep(1),
+ N = erlang:trace(existing, true, [send, {tracer, Tracer2}]),
+ {flags, [send]} = erlang:trace_info(Proc, flags),
+ {tracer, Tracer2} = erlang:trace_info(Proc, tracer),
+ unlink(Tracer2),
+ exit(Tracer2, die),
+
+ Tracer3 = spawn_link(fun receiver/0),
+ timer:sleep(1),
+ 1 = erlang:trace(Proc, true, [send, {tracer, Tracer3}]),
+ {flags, [send]} = erlang:trace_info(Proc, flags),
+ {tracer, Tracer3} = erlang:trace_info(Proc, tracer),
+ unlink(Tracer3),
+ exit(Tracer3, die),
+
+ ok.
+
+%% 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.
+
+%% This testcase checks that receive trace works on exit signal messages
+%% when the sender of the exit signal is the process itself.
+trap_exit_self_receive(Config) ->
+ Parent = self(),
+ Proc = spawn_link(fun() -> process(Parent) end),
+
+ 1 = erlang:trace(Proc, true, ['receive']),
+ Proc ! {trap_exit_please, true},
+ {trace, Proc, 'receive', {trap_exit_please, true}} = receive_first_trace(),
+
+ %% Make the process call exit(self(), signal)
+ Reason1 = make_ref(),
+ Proc ! {exit_signal_please, Reason1},
+ {trace, Proc, 'receive', {exit_signal_please, Reason1}} = receive_first_trace(),
+ {trace, Proc, 'receive', {'EXIT', Proc, Reason1}} = receive_first_trace(),
+ receive {Proc, {'EXIT', Proc, Reason1}} -> ok end,
+ receive_nothing(),
+
+ unlink(Proc),
+ Reason2 = make_ref(),
+ Proc ! {exit_please, Reason2},
+ {trace, Proc, 'receive', {exit_please, Reason2}} = receive_first_trace(),
+ receive_nothing(),
+ ok.
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) ->
@@ -1414,16 +1767,23 @@ tok_trace_loop(Parent, N, M) ->
receive_first() ->
receive
- Any -> Any
+ Any -> Any
+ end.
+
+%% Waits for and returns the first message in the message queue.
+
+receive_first_trace() ->
+ receive
+ Any when element(1,Any) =:= trace; element(1,Any) =:= trace_ts -> Any
end.
%% Ensures that there is no message in the message queue.
receive_nothing() ->
receive
- Any ->
- test_server:fail({unexpected_message, Any})
- after 200 ->
+ Any ->
+ ct:fail({unexpected_message, Any})
+ after 100 ->
ok
end.
@@ -1432,39 +1792,42 @@ 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);
+ {exit_signal_please, Reason} ->
+ exit(self(), Reason),
+ process(Dest);
+ {trap_exit_please, State} ->
+ process_flag(trap_exit, State),
+ process(Dest);
+ Other ->
+ Dest ! {self(), Other},
+ process(Dest)
after 3000 ->
- exit(timeout)
+ exit(timeout)
end.
@@ -1472,17 +1835,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.
@@ -1490,18 +1853,23 @@ process() ->
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()
- end.
+ receiver(infinity).
+
+receiver(Timeout) ->
+ receiver(receive
+ {set_timeout, NewTimeout} -> NewTimeout;
+ _Any -> Timeout
+ after Timeout -> infinity %% reset
+ end).
%% Works as long as it receives CPU time. Will always be RUNNABLE.
@@ -1521,8 +1889,8 @@ fun_spawn(Fun, Args) ->
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}]).
+ test_server:start_node(Name, slave,
+ [{args, "-setcookie " ++ Cookie ++" -pa " ++ Pa}]).
stop_node(Node) ->
test_server:stop_node(Node).
@@ -1530,11 +1898,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 ->
@@ -1545,48 +1913,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 2c78aa394f..f12c359874 100644
--- a/erts/emulator/test/trace_bif_SUITE.erl
+++ b/erts/emulator/test/trace_bif_SUITE.erl
@@ -1,28 +1,28 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2011. All Rights Reserved.
+%% Copyright Ericsson AB 1998-2017. 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.
+%% 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(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,
@@ -41,248 +41,315 @@ 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_link(?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),
+ unlink(Pid),
+ 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_link(?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),
+ unlink(Pid),
+ 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_link(?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),
+ unlink(Pid),
+ 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_link(?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)),
+ erlang:trace_pattern({erlang,'_','_'}, false, [local]),
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} = M ->
+ io:format("~p (PrevTs: ~p)~n",[M, PrevTs]),
+ 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} = M ->
+ io:format("~p (PrevTs: ~p)~n",[M, PrevTs]),
+ 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} = Msg ->
+ io:format("~p (PrevTs: ~p)~n",[Msg, PrevTs]),
+ 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(nanosecond);
+make_ts(strict_monotonic_timestamp) ->
+ MT = erlang:monotonic_time(nanosecond),
+ 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} ->
- _ = time(), %Assignment tells compiler to keep call.
- 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,1,module,M}, % -module(M).
- {attribute,2,export,[{F,0}]}, % -export([F/0]).
- {function,3,F,0, % F() ->
- [{clause,4,[],[],[{atom,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) ->
+ erl_anno:new(L).
diff --git a/erts/emulator/test/trace_call_count_SUITE.erl b/erts/emulator/test/trace_call_count_SUITE.erl
index 2ac58493ff..5f871835bc 100644
--- a/erts/emulator/test/trace_call_count_SUITE.erl
+++ b/erts/emulator/test/trace_call_count_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2002-2016. 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.
+%% 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%
%%
@@ -42,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).
@@ -69,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
@@ -108,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().
@@ -160,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.
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -351,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.
@@ -366,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 3036d2957b..26f96a1766 100644
--- a/erts/emulator/test/trace_call_time_SUITE.erl
+++ b/erts/emulator/test/trace_call_time_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2011. All Rights Reserved.
+%% Copyright Ericsson AB 2011-2016. 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/.
+%% 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
%%
-%% 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.
+%% 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%
%%
@@ -57,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
@@ -92,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 = now(),
- ?line with_bif(Nbc),
- ?line T1 = now(),
- ?line TimeB = timer:now_diff(T1,T0),
+ [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, microsecond),
%%
- ?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 = 5000000,
%%
- ?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 = 5000000,
%%
- ?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.
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -481,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(),
@@ -512,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]),
@@ -541,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([]) -> [].
@@ -565,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
@@ -613,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]),
@@ -658,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.
@@ -673,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() ->
@@ -695,28 +651,28 @@ setup(Opts) ->
Pid.
execute(Pids, Mfa) when is_list(Pids) ->
- T0 = now(),
+ T0 = erlang:monotonic_time(),
[P ! {self(), execute, Mfa} || P <- Pids],
As = [receive {P, answer, Answer} -> Answer end || P <- Pids],
- T1 = now(),
- {As, timer:now_diff(T1,T0)};
+ T1 = erlang:monotonic_time(),
+ {As, erlang:convert_time_unit(T1-T0, native, microsecond)};
execute(P, Mfa) ->
- T0 = now(),
+ T0 = erlang:monotonic_time(),
P ! {self(), execute, Mfa},
A = receive {P, answer, Answer} -> Answer end,
- T1 = now(),
- {A, timer:now_diff(T1,T0)}.
+ T1 = erlang:monotonic_time(),
+ {A, erlang:convert_time_unit(T1-T0, native, microsecond)}.
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_call_time_SUITE_data/trace_nif.c b/erts/emulator/test/trace_call_time_SUITE_data/trace_nif.c
index 33b346aab7..786be35c9c 100644
--- a/erts/emulator/test/trace_call_time_SUITE_data/trace_nif.c
+++ b/erts/emulator/test/trace_call_time_SUITE_data/trace_nif.c
@@ -1,4 +1,4 @@
-#include "erl_nif.h"
+#include <erl_nif.h>
static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info)
@@ -6,11 +6,6 @@ static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info)
return 0;
}
-static int reload(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info)
-{
- return 0;
-}
-
static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info)
{
return 0;
@@ -34,4 +29,4 @@ static ErlNifFunc nif_funcs[] =
{"nif_dec", 1, nif_dec_1}
};
-ERL_NIF_INIT(trace_call_time_SUITE,nif_funcs,load,reload,upgrade,unload)
+ERL_NIF_INIT(trace_call_time_SUITE,nif_funcs,load,NULL,upgrade,unload)
diff --git a/erts/emulator/test/trace_local_SUITE.erl b/erts/emulator/test/trace_local_SUITE.erl
index 1bed49aad2..253d5fed23 100644
--- a/erts/emulator/test/trace_local_SUITE.erl
+++ b/erts/emulator/test/trace_local_SUITE.erl
@@ -1,24 +1,24 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2017. 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.
+%% 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(trace_local_SUITE).
--compile({nowarn_deprecated_function, {erlang,hash,2}}).
-export([basic_test/0, bit_syntax_test/0, return_test/0,
on_and_off_test/0, stack_grow_test/0,
@@ -28,69 +28,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) ->
+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
@@ -98,168 +73,127 @@ end_per_testcase(_Case, Config) ->
c:l(?MODULE).
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 2}}].
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
+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) ->
+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 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -308,28 +242,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};
@@ -342,18 +276,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.
@@ -361,73 +295,74 @@ 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,
+ false = code:is_module_native(?MODULE), % got fooled by local trace
+ erlang:trace_pattern({?MODULE,slave,'_'},false,[local]),
+ [1,1,1,997] = 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,997] = apply_slave(?MODULE,exported_wrap,[1]),
+ ?CT(?MODULE,exported_wrap,[1]),
+ [1,1,1,997] = lambda_slave(fun() ->
+ exported_wrap(1)
+ end),
+ ?NM,
+ erlang:trace_pattern({?MODULE,'_','_'},[],[local]),
+ erlang:trace_pattern({?MODULE,slave,'_'},false,[local]),
+ [1,1,1,997] = 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.
@@ -441,149 +376,156 @@ 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,phash2,'_'},[{'_',[],[{return_trace}]}],
+ [local]),
+ erlang:trace_pattern({?MODULE,slave,'_'},false,[local]),
+ [1,1,1,997] = 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,phash2,[1,1023]),
+ ?RF(erlang,phash2,2,997),
+ ?RF(?MODULE,local_tail,1,[1,997]),
+ ?RF(?MODULE,local2,1,[1,997]),
+ ?RF(?MODULE,local,1,[1,1,997]),
+ ?RF(?MODULE,exported,1,[1,1,1,997]),
+ ?RF(?MODULE,exported_wrap,1,[1,1,1,997]),
+ shutdown(),
+ setup([call,return_to]),
+ erlang:trace_pattern({?MODULE,'_','_'},[],
+ [local]),
+ erlang:trace_pattern({erlang,phash2,'_'},[],
+ [local]),
+ erlang:trace_pattern({?MODULE,slave,'_'},false,[local]),
+ [1,1,1,997] = 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,phash2,[1,1023]),
+ ?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,phash2,'_'},[{'_',[],[{return_trace}]}],
+ [local]),
+ erlang:trace_pattern({?MODULE,slave,'_'},false,[local]),
+ [1,1,1,997] = 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,phash2,[1,1023]),
+ ?RF(erlang,phash2,2,997),
+ ?RT(?MODULE,local_tail,1),
+ ?RF(?MODULE,local_tail,1,[1,997]),
+ ?RF(?MODULE,local2,1,[1,997]),
+ ?RT(?MODULE,local,1),
+ ?RF(?MODULE,local,1,[1,1,997]),
+ ?RT(?MODULE,exported,1),
+ ?RF(?MODULE,exported,1,[1,1,1,997]),
+ ?RF(?MODULE,exported_wrap,1,[1,1,1,997]),
+ ?RT(?MODULE,slave,2),
+ shutdown(),
+ ?NM,
+
+ %% Test a regression where turning off return_to tracing
+ %% on yourself would cause a segfault.
+ Pid = setup([call,return_to]),
+ erlang:trace_pattern({'_','_','_'},[],[local]),
+ apply_slave(erlang,trace,[Pid, false, [all]]),
+ shutdown(),
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,997] = lambda_slave(LocalTail),
+ ?CT(?MODULE,local_tail,[1]),
+ erlang:trace(Pid,true,[return_to]),
+ [1,997] = lambda_slave(LocalTail),
+ ?CT(?MODULE,local_tail,[1]),
+ ?RT(?MODULE,_,_),
+ 0 = erlang:trace_pattern({?MODULE,local_tail,1},[],[global]),
+ [1,997] = lambda_slave(LocalTail),
+ ?NM,
+ 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[global]),
+ [1,1,1,997] = apply_slave(?MODULE,exported_wrap,[1]),
+ ?CT(?MODULE,exported_wrap,[1]),
+ 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[local]),
+ [1,1,1,997] = apply_slave(?MODULE,exported_wrap,[1]),
+ ?CT(?MODULE,exported_wrap,[1]),
+ ?RT(?MODULE,slave,2),
+ 1 = erlang:trace_pattern({erlang,phash2,2},[],[local]),
+ [1,1,1,997] = apply_slave(?MODULE,exported_wrap,[1]),
+ ?CT(?MODULE,exported_wrap,[1]),
+ ?CT(erlang,phash2,[1,1023]),
+ ?RT(?MODULE,local_tail,1),
+ ?RT(?MODULE,slave,2),
+ erlang:trace(Pid,true,[timestamp]),
+ [1,1,1,997] = apply_slave(?MODULE,exported_wrap,[1]),
+ ?CTT(?MODULE,exported_wrap,[1]),
+ ?CTT(erlang,phash2,[1,1023]),
+ ?RTT(?MODULE,local_tail,1),
+ ?RTT(?MODULE,slave,2),
+ erlang:trace(Pid,false,[return_to,timestamp]),
+ [1,1,1,997] = apply_slave(?MODULE,exported_wrap,[1]),
+ ?CT(?MODULE,exported_wrap,[1]),
+ ?CT(erlang,phash2,[1,1023]),
+ erlang:trace(Pid,true,[return_to]),
+ 1 = erlang:trace_pattern({erlang,phash2,2},[],[]),
+ [1,1,1,997] = apply_slave(?MODULE,exported_wrap,[1]),
+ ?CT(?MODULE,exported_wrap,[1]),
+ ?CT(erlang,phash2,[1,1023]),
+ ?RT(?MODULE,slave,2),
+ 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[]),
+ [1,1,1,997] = apply_slave(?MODULE,exported_wrap,[1]),
+ ?CT(?MODULE,exported_wrap,[1]),
+ ?CT(erlang,phash2,[1,1023]),
+ 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) ->
@@ -633,12 +575,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),
@@ -650,12 +592,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);
@@ -667,10 +607,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) ->
@@ -679,16 +619,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.
@@ -697,99 +637,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.
@@ -797,34 +737,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(),
@@ -847,65 +787,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),
@@ -914,16 +854,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}}) ->
@@ -941,20 +881,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.
@@ -989,7 +929,7 @@ local2(Val) ->
local_tail(Val). %% Tail recursive call
local_tail(Val) ->
- [Val , erlang:hash(1,1)].
+ [Val , erlang:phash2(1,1023)].
@@ -998,16 +938,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.
@@ -1016,42 +956,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);
@@ -1059,25 +999,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));
@@ -1107,114 +1047,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()).
@@ -1251,24 +1191,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) ->
@@ -1279,30 +1219,34 @@ 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
- catch _:_ ->
- undefined
+ case get(slave) of
+ {Pid,Mref} ->
+ try erlang:is_process_alive(Pid) of
+ true ->
+ Pid ! die,
+ receive
+ {'DOWN',Mref,process,Pid,Reason} ->
+ Reason
+ end;
+ _ ->
+ not_alive
+ catch _:_ ->
+ undefined
+ end;
+ _ ->
+ undefined
end.
trace_off() ->
@@ -1310,7 +1254,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),
@@ -1331,8 +1275,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) ->
@@ -1343,13 +1287,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.
@@ -1362,25 +1306,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.
@@ -1415,19 +1359,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_local_SUITE_data/trace_local_dummy.erl b/erts/emulator/test/trace_local_SUITE_data/trace_local_dummy.erl
index be9bea209a..a886323302 100644
--- a/erts/emulator/test/trace_local_SUITE_data/trace_local_dummy.erl
+++ b/erts/emulator/test/trace_local_SUITE_data/trace_local_dummy.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2016. 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.
+%% 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%
%%
diff --git a/erts/emulator/test/trace_meta_SUITE.erl b/erts/emulator/test/trace_meta_SUITE.erl
index 45987cc319..f157a6c9eb 100644
--- a/erts/emulator/test/trace_meta_SUITE.erl
+++ b/erts/emulator/test/trace_meta_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2002-2017. 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.
+%% 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%
%%
@@ -45,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).
@@ -65,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) ->
- ?line Dog=test_server:timetrap(test_server:minutes(5)),
- [{watchdog, Dog}|Config].
+ Config.
-end_per_testcase(_Case, 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
@@ -90,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().
@@ -179,107 +144,112 @@ nosilent(Config) when is_list(Config) ->
%%%
basic_test() ->
- ?line Pid = setup(),
- ?line erlang:trace_pattern({?MODULE,'_','_'},[],[meta]),
- ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]),
- ?line ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(),
- ?line ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(),
- ?line ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(),
- ?line ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(),
- ?line ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(),
- ?line erlang:trace_pattern({?MODULE,'_','_'},false,[meta]),
- ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]),
- ?line ?NM,
- ?line [1,1,1,0] = lambda_slave(fun() ->
- exported_wrap(1)
- end),
- ?line ?NM,
- ?line erlang:trace_pattern({?MODULE,'_','_'},[],[meta]),
- ?line [1,1,1,0] = lambda_slave(fun() ->
- exported_wrap(1)
- end),
- ?line ?CTT(Pid,{?MODULE,_,_}) = receive_next(), %% The fun
- ?line ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(),
- ?line ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(),
- ?line ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(),
- ?line ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(),
- ?line ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(),
- ?line erlang:trace_pattern({?MODULE,'_','_'},false,[meta]),
- ?line shutdown(),
- ?line ?NM,
+ Pid = setup(),
+ erlang:trace_pattern({?MODULE,'_','_'},[],[meta]),
+ [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]),
+ ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(),
+ ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(),
+ ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(),
+ ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(),
+ ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(),
+ erlang:trace_pattern({?MODULE,'_','_'},false,[meta]),
+ [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]),
+ ?NM,
+ [1,1,1,0] = lambda_slave(fun() ->
+ exported_wrap(1)
+ end),
+ ?NM,
+ erlang:trace_pattern({?MODULE,'_','_'},[],[meta]),
+ [1,1,1,0] = lambda_slave(fun() ->
+ exported_wrap(1)
+ end),
+ ?CTT(Pid,{?MODULE,_,_}) = receive_next(), %% The fun
+ ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(),
+ ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(),
+ ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(),
+ ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(),
+ ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(),
+ erlang:trace_pattern({?MODULE,'_','_'},false,[meta]),
+ shutdown(),
+ ?NM,
ok.
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
return_test() ->
- ?line Pid = setup(),
- ?line erlang:trace_pattern({?MODULE,'_','_'},[{'_',[],[{return_trace}]}],
+ Pid = setup(),
+ erlang:trace_pattern({?MODULE,'_','_'},[{'_',[],[{return_trace}]}],
[meta]),
- ?line erlang:trace_pattern({erlang,phash2,'_'},[{'_',[],[{return_trace}]}],
+ erlang:trace_pattern({erlang,phash2,'_'},[{'_',[],[{return_trace}]}],
[meta]),
- ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]),
- ?line ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(),
- ?line ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(),
- ?line ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(),
- ?line ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(),
- ?line ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(),
- ?line ?CTT(Pid,{erlang,phash2,[1,1]}) = receive_next(),
- ?line ?RFT(Pid,{erlang,phash2,2},0) = receive_next(),
- ?line ?RFT(Pid,{?MODULE,local_tail,1},[1,0]) = receive_next(),
- ?line ?RFT(Pid,{?MODULE,local2,1},[1,0]) = receive_next(),
- ?line ?RFT(Pid,{?MODULE,local,1},[1,1,0]) = receive_next(),
- ?line ?RFT(Pid,{?MODULE,exported,1},[1,1,1,0]) = receive_next(),
- ?line ?RFT(Pid,{?MODULE,exported_wrap,1},[1,1,1,0]) = receive_next(),
- ?line shutdown(),
- ?line ?NM,
+ [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]),
+ ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(),
+ ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(),
+ ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(),
+ ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(),
+ ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(),
+ ?CTT(Pid,{erlang,phash2,[1,1]}) = receive_next(),
+ ?RFT(Pid,{erlang,phash2,2},0) = receive_next(),
+ ?RFT(Pid,{?MODULE,local_tail,1},[1,0]) = receive_next(),
+ ?RFT(Pid,{?MODULE,local2,1},[1,0]) = receive_next(),
+ ?RFT(Pid,{?MODULE,local,1},[1,1,0]) = receive_next(),
+ ?RFT(Pid,{?MODULE,exported,1},[1,1,1,0]) = receive_next(),
+ ?RFT(Pid,{?MODULE,exported_wrap,1},[1,1,1,0]) = receive_next(),
+ shutdown(),
+ ?NM,
ok.
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
on_and_off_test() ->
- ?line Pid = setup(),
- ?line 1 = erlang:trace_pattern({?MODULE,local_tail,1},[],[meta]),
- ?line LocalTail = fun() ->
- local_tail(1)
- end,
- ?line [1,0] = lambda_slave(LocalTail),
- ?line ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(),
- ?line 0 = erlang:trace_pattern({?MODULE,local_tail,1},[],[global]),
- ?line [1,0] = lambda_slave(LocalTail),
- ?line ?NM,
- ?line 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[meta]),
- ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]),
- ?line ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(),
- ?line 1 = erlang:trace_pattern({erlang,phash2,2},[],[meta]),
- ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]),
- ?line ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(),
- ?line ?CTT(Pid,{erlang,phash2,[1,1]}) = receive_next(),
- ?line shutdown(),
- ?line erlang:trace_pattern({'_','_','_'},false,[meta]),
- ?line N = erlang:trace_pattern({erlang,'_','_'},true,[meta]),
- ?line case erlang:trace_pattern({erlang,'_','_'},false,[meta]) of
- N ->
- ok;
- Else ->
- exit({number_mismatch, {expected, N}, {got, Else}})
- end,
- ?line case erlang:trace_pattern({erlang,'_','_'},false,[meta]) of
- N ->
- ok;
- Else2 ->
- exit({number_mismatch, {expected, N}, {got, Else2}})
- end,
- ?line ?NM,
+ Pid = setup(),
+ 1 = erlang:trace_pattern({?MODULE,local_tail,1},[],[meta]),
+ LocalTail = fun() ->
+ local_tail(1)
+ end,
+ [1,0] = lambda_slave(LocalTail),
+ ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(),
+ 0 = erlang:trace_pattern({?MODULE,local_tail,1},[],[global]),
+ [1,0] = lambda_slave(LocalTail),
+ ?NM,
+ 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[meta]),
+ [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]),
+ ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(),
+ 1 = erlang:trace_pattern({erlang,phash2,2},[],[meta]),
+ [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]),
+ ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(),
+ ?CTT(Pid,{erlang,phash2,[1,1]}) = receive_next(),
+ shutdown(),
+ erlang:trace_pattern({'_','_','_'},false,[meta]),
+ N = erlang:trace_pattern({erlang,'_','_'},true,[meta]),
+ case erlang:trace_pattern({erlang,'_','_'},false,[meta]) of
+ N -> ok;
+ Else ->
+ exit({number_mismatch, {expected, N}, {got, Else}})
+ end,
+ case erlang:trace_pattern({erlang,'_','_'},false,[meta]) of
+ N -> ok;
+ Else2 ->
+ exit({number_mismatch, {expected, N}, {got, Else2}})
+ end,
+ %% ?NM,
+ %% Can't check for erlang:*/* stuff since common_test or test_server
+ %% will likely call list_to_binary in the logger. just drain any potential
+ %% message
+ ok = flush(),
ok.
-
+
+flush() ->
+ receive _ -> flush() after 0 -> ok end.
+
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
stack_grow_test() ->
- ?line Pid = setup(),
- ?line 1 = erlang:trace_pattern({?MODULE,loop,4},
+ Pid = setup(),
+ 1 = erlang:trace_pattern({?MODULE,loop,4},
[{'_',[],[{return_trace}]}],[meta]),
- ?line Num = 1 bsl 15,
- ?line Surface =
+ Num = 1 bsl 15,
+ Surface =
fun (This, ?RFT(P,{?MODULE,loop,4},N), N) when P == Pid->
if N == Num ->
?NM,
@@ -288,7 +258,7 @@ stack_grow_test() ->
This(This, receive_next(), N+1)
end
end,
- ?line Dive =
+ Dive =
fun (This, ?CTT(P,{?MODULE,loop,[{hej,hopp},[a,b,c],4.5,N]}), N)
when P == Pid->
if N == 0 ->
@@ -297,272 +267,263 @@ stack_grow_test() ->
This(This, receive_next(), N-1)
end
end,
- ?line apply_slave(?MODULE,loop,[{hej,hopp},[a,b,c],4.5,Num]),
-% ?line apply_slave_async(?MODULE,loop,[{hej,hopp},[a,b,c],4.5,Num]),
-% ?line List = collect(test_server:seconds(5)),
- ?line ok = Dive(Dive, receive_next(), Num),
- ?line ?NM,
+ apply_slave(?MODULE,loop,[{hej,hopp},[a,b,c],4.5,Num]),
+% apply_slave_async(?MODULE,loop,[{hej,hopp},[a,b,c],4.5,Num]),
+% List = collect(test_server:seconds(5)),
+ ok = Dive(Dive, receive_next(), Num),
+ ?NM,
ok.
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
info_test() ->
- ?line setup(),
- ?line Prog = [{['$1'],[{is_integer,'$1'}],[{message, false}]},
- {'_',[],[]}],
- ?line Self = self(),
- ?line GoOn = make_ref(),
-
- ?line Pid =
+ setup(),
+ Prog = [{['$1'],[{is_integer,'$1'}],[{message, false}]}, {'_',[],[]}],
+ Self = self(),
+ GoOn = make_ref(),
+ Pid =
spawn_link(
fun () ->
erlang:trace_pattern({?MODULE,exported_wrap,1},
- Prog, [{meta, Self}]),
+ Prog, [{meta, Self}]),
Self ! {self(), GoOn}
end),
- ?line receive {Pid, GoOn} -> ok end,
- ?line {traced,false} = erlang:trace_info({?MODULE,exported_wrap,1}, traced),
- ?line {match_spec, false} =
+ receive {Pid, GoOn} -> ok end,
+ {traced,false} = erlang:trace_info({?MODULE,exported_wrap,1}, traced),
+ {match_spec, false} =
erlang:trace_info({?MODULE,exported_wrap,1}, match_spec),
- ?line {meta, Self} = erlang:trace_info({?MODULE,exported_wrap,1}, meta),
- ?line {meta_match_spec, MMS} =
+ {meta, Self} = erlang:trace_info({?MODULE,exported_wrap,1}, meta),
+ {meta_match_spec, MMS} =
erlang:trace_info({?MODULE,exported_wrap,1}, meta_match_spec),
- ?line case MMS of
- Prog ->
- ok;
- Wrong ->
- exit({bad_result, {erlang,trace_info,
- [{?MODULE,exported_wrap,1},
- meta_match_spec]},
- {expected, Prog}, {got, Wrong}})
- end,
- ?line erlang:garbage_collect(self()),
- ?line receive
- after 1 ->
- ok
- end,
- ?line io:format("~p~n",[MMS]),
- ?line {meta_match_spec,MMS2} =
+ case MMS of
+ Prog ->
+ ok;
+ Wrong ->
+ exit({bad_result, {erlang,trace_info,
+ [{?MODULE,exported_wrap,1},
+ meta_match_spec]},
+ {expected, Prog}, {got, Wrong}})
+ end,
+ erlang:garbage_collect(self()),
+ receive
+ after 1 ->
+ ok
+ end,
+ io:format("~p~n",[MMS]),
+ {meta_match_spec,MMS2} =
erlang:trace_info({?MODULE,exported_wrap,1}, meta_match_spec),
- ?line io:format("~p~n",[MMS2]),
- ?line case MMS2 of
- Prog ->
- ok;
- Wrong2 ->
- exit({bad_result, {erlang,trace_info,
- [{?MODULE,exported_wrap,1},
- meta_match_spec]},
- {expected, Prog}, {got, Wrong2}})
- end,
- ?line {all, [_|_]=L} = erlang:trace_info({?MODULE,exported_wrap,1}, all),
- ?line {value, {meta, Self}} =
- lists:keysearch(meta, 1, L),
- ?line {value, {meta_match_spec, MMS}} =
- lists:keysearch(meta_match_spec, 1, L),
-
- ?line erlang:trace_pattern({?MODULE,exported_wrap,1}, true, [meta]),
- ?line {meta_match_spec, []} =
+ io:format("~p~n",[MMS2]),
+ case MMS2 of
+ Prog ->
+ ok;
+ Wrong2 ->
+ exit({bad_result, {erlang,trace_info,
+ [{?MODULE,exported_wrap,1},
+ meta_match_spec]},
+ {expected, Prog}, {got, Wrong2}})
+ end,
+ {all, [_|_]=L} = erlang:trace_info({?MODULE,exported_wrap,1}, all),
+ {value, {meta, Self}} = lists:keysearch(meta, 1, L),
+ {value, {meta_match_spec, MMS}} = lists:keysearch(meta_match_spec, 1, L),
+
+ erlang:trace_pattern({?MODULE,exported_wrap,1}, true, [meta]),
+ {meta_match_spec, []} =
erlang:trace_info({?MODULE,exported_wrap,1}, meta_match_spec),
-
- ?line erlang:trace_pattern({?MODULE,exported_wrap,1}, false, [meta]),
- ?line {meta, false} = erlang:trace_info({?MODULE,exported_wrap,1}, meta),
- ?line {meta_match_spec, false} =
+
+ erlang:trace_pattern({?MODULE,exported_wrap,1}, false, [meta]),
+ {meta, false} = erlang:trace_info({?MODULE,exported_wrap,1}, meta),
+ {meta_match_spec, false} =
erlang:trace_info({?MODULE,exported_wrap,1}, meta_match_spec),
- ?line {all, false} = erlang:trace_info({?MODULE,exported_wrap,1}, all),
-
- ?line shutdown(),
- ?line ?NM,
+ {all, false} = erlang:trace_info({?MODULE,exported_wrap,1}, all),
+ shutdown(),
+ ?NM,
ok.
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
tracer_test() ->
- ?line Slave = setup(),
- ?line Self = self(),
-
- ?line MatchSpec = [{'_',[],[{return_trace}]}],
- ?line Tracer1 = spawn_link(fun () -> relay_n(3, Self) end),
- ?line Setter =
- spawn_link(
- fun () ->
- erlang:trace_pattern({?MODULE,receiver,1},
- MatchSpec,
- [{meta,Tracer1}]),
- erlang:trace_pattern({erlang,phash2,2},
- MatchSpec,
- [{meta,Tracer1}]),
- Self ! {self(), done}
- end),
- ?line receive {Setter, done} -> ok end,
- ?line Ref = make_ref(),
- ?line apply_slave_async(?MODULE, receiver, [Ref]),
- ?line {Tracer1,?CTT(Slave,{?MODULE,receiver,[Ref]})} = receive_next(100),
- ?line {Tracer1,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(100),
- ?line {Tracer1,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(100),
+ Slave = setup(),
+ Self = self(),
+
+ MatchSpec = [{'_',[],[{return_trace}]}],
+ Tracer1 = spawn_link(fun () -> relay_n(3, Self) end),
+ Setter = spawn_link(
+ fun () ->
+ erlang:trace_pattern({?MODULE,receiver,1},
+ MatchSpec,
+ [{meta,Tracer1}]),
+ erlang:trace_pattern({erlang,phash2,2},
+ MatchSpec,
+ [{meta,Tracer1}]),
+ Self ! {self(), done}
+ end),
+ receive {Setter, done} -> ok end,
+ Ref = make_ref(),
+ apply_slave_async(?MODULE, receiver, [Ref]),
+ {Tracer1,?CTT(Slave,{?MODULE,receiver,[Ref]})} = receive_next(100),
+ {Tracer1,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(100),
+ {Tracer1,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(100),
%% Initiate a return_trace that will fail since the tracer just stopped
- ?line Slave ! Ref,
- ?line receive_no_next(100),
+ Slave ! Ref,
+ receive_no_next(100),
%% The breakpoint has not been hit since the tracer stopped
- ?line {meta,Tracer1} =
+ {meta,Tracer1} =
erlang:trace_info({?MODULE,receiver,1}, meta),
- ?line {meta_match_spec, MatchSpec} =
+ {meta_match_spec, MatchSpec} =
erlang:trace_info({?MODULE,receiver,1}, meta_match_spec),
- ?line {meta,Tracer1} =
+ {meta,Tracer1} =
erlang:trace_info({erlang,phash2,2}, meta),
- ?line {meta_match_spec, MatchSpec} =
+ {meta_match_spec, MatchSpec} =
erlang:trace_info({erlang,phash2,2}, meta_match_spec),
%% Initiate trace messages that will fail
- ?line Ref2 = make_ref(),
- ?line apply_slave_async(?MODULE, receiver, [Ref2]),
- ?line Slave ! Ref2,
- ?line receive_no_next(100),
- ?line {meta,[]} =
+ Ref2 = make_ref(),
+ apply_slave_async(?MODULE, receiver, [Ref2]),
+ Slave ! Ref2,
+ receive_no_next(100),
+ {meta,[]} =
erlang:trace_info({?MODULE,receiver,1}, meta),
- ?line {meta_match_spec, MatchSpec} =
+ {meta_match_spec, MatchSpec} =
erlang:trace_info({?MODULE,receiver,1}, meta_match_spec),
- ?line {meta,[]} =
+ {meta,[]} =
erlang:trace_info({erlang,phash2,2}, meta),
- ?line {meta_match_spec, MatchSpec} =
+ {meta_match_spec, MatchSpec} =
erlang:trace_info({erlang,phash2,2}, meta_match_spec),
%% Change tracer
- ?line Tracer2 = spawn_link(fun () -> relay_n(4, Self) end),
- ?line erlang:trace_pattern({?MODULE,receiver,1},
- MatchSpec,
- [{meta,Tracer2}]),
- ?line erlang:trace_pattern({erlang,phash2,2},
- MatchSpec,
- [{meta,Tracer2}]),
- ?line Ref3 = make_ref(),
- ?line apply_slave_async(?MODULE, receiver, [Ref3]),
- ?line {Tracer2,?CTT(Slave,{?MODULE,receiver,[Ref3]})} = receive_next(),
- ?line {Tracer2,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(),
- ?line {Tracer2,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(),
+ Tracer2 = spawn_link(fun () -> relay_n(4, Self) end),
+ erlang:trace_pattern({?MODULE,receiver,1},
+ MatchSpec,
+ [{meta,Tracer2}]),
+ erlang:trace_pattern({erlang,phash2,2},
+ MatchSpec,
+ [{meta,Tracer2}]),
+ Ref3 = make_ref(),
+ apply_slave_async(?MODULE, receiver, [Ref3]),
+ {Tracer2,?CTT(Slave,{?MODULE,receiver,[Ref3]})} = receive_next(),
+ {Tracer2,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(),
+ {Tracer2,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(),
%% Change tracer between call trace and return trace
- ?line Tracer3 = spawn_link(fun () -> relay_n(4, Self) end),
- ?line erlang:trace_pattern({?MODULE,receiver,1},
- MatchSpec,
- [{meta,Tracer3}]),
- ?line erlang:trace_pattern({erlang,phash2,2},
- MatchSpec,
- [{meta,Tracer3}]),
- ?line Slave ! Ref3,
+ Tracer3 = spawn_link(fun () -> relay_n(4, Self) end),
+ erlang:trace_pattern({?MODULE,receiver,1},
+ MatchSpec,
+ [{meta,Tracer3}]),
+ erlang:trace_pattern({erlang,phash2,2},
+ MatchSpec,
+ [{meta,Tracer3}]),
+ Slave ! Ref3,
%% The return trace should still come from Tracer2
- ?line {Tracer2,?RFT(Slave,{?MODULE,receiver,1},Ref3)} = receive_next(),
- ?line Ref4 = make_ref(),
+ {Tracer2,?RFT(Slave,{?MODULE,receiver,1},Ref3)} = receive_next(),
+ Ref4 = make_ref(),
%% Now should Tracer3 be used
- ?line apply_slave_async(?MODULE, receiver, [Ref4]),
- ?line Slave ! Ref4,
- ?line {Tracer3,?CTT(Slave,{?MODULE,receiver,[Ref4]})} = receive_next(),
- ?line {Tracer3,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(),
- ?line {Tracer3,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(),
- ?line {Tracer3,?RFT(Slave,{?MODULE,receiver,1},Ref4)} = receive_next(),
+ apply_slave_async(?MODULE, receiver, [Ref4]),
+ Slave ! Ref4,
+ {Tracer3,?CTT(Slave,{?MODULE,receiver,[Ref4]})} = receive_next(),
+ {Tracer3,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(),
+ {Tracer3,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(),
+ {Tracer3,?RFT(Slave,{?MODULE,receiver,1},Ref4)} = receive_next(),
%% The breakpoint has not been hit since the tracer stopped
- ?line {meta,Tracer3} =
- erlang:trace_info({?MODULE,receiver,1}, meta),
- ?line {meta_match_spec, MatchSpec} =
+ {meta,Tracer3} = erlang:trace_info({?MODULE,receiver,1}, meta),
+ {meta_match_spec, MatchSpec} =
erlang:trace_info({?MODULE,receiver,1}, meta_match_spec),
- ?line {meta,Tracer3} =
+ {meta,Tracer3} =
erlang:trace_info({erlang,phash2,2}, meta),
- ?line {meta_match_spec, MatchSpec} =
+ {meta_match_spec, MatchSpec} =
erlang:trace_info({erlang,phash2,2}, meta_match_spec),
-
- ?line shutdown(),
- ?line ?NM,
+ shutdown(),
+ ?NM,
ok.
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
combo_test() ->
- ?line Slave = setup(),
- ?line Self = self(),
-
- ?line MatchSpec = [{'_',[],[{return_trace}]}],
- ?line Flags = lists:sort([call, return_to]),
- ?line LocalTracer = spawn_link(fun () -> relay_n(6, Self) end),
- ?line MetaTracer = spawn_link(fun () -> relay_n(4, Self) end),
- ?line 1 = erlang:trace_pattern({?MODULE,receiver,1},
- MatchSpec,
- [local,{meta,MetaTracer}]),
- ?line 1 = erlang:trace_pattern({erlang,phash2,2},
- MatchSpec,
- [local,{meta,MetaTracer}]),
- ?line 1 = erlang:trace(Slave, true,
- [{tracer,LocalTracer} | Flags]),
+ Slave = setup(),
+ Self = self(),
+
+ MatchSpec = [{'_',[],[{return_trace}]}],
+ Flags = lists:sort([call, return_to]),
+ LocalTracer = spawn_link(fun () -> relay_n(6, Self) end),
+ MetaTracer = spawn_link(fun () -> relay_n(4, Self) end),
+ 1 = erlang:trace_pattern({?MODULE,receiver,1},
+ MatchSpec,
+ [local,{meta,MetaTracer}]),
+ 1 = erlang:trace_pattern({erlang,phash2,2},
+ MatchSpec,
+ [local,{meta,MetaTracer}]),
+ 1 = erlang:trace(Slave, true,
+ [{tracer,LocalTracer} | Flags]),
%%
- ?line {all, TraceInfo1} =
+ {all, TraceInfo1} =
erlang:trace_info({?MODULE,receiver,1}, all),
- ?line {meta,MetaTracer} =
+ {meta,MetaTracer} =
erlang:trace_info({?MODULE,receiver,1}, meta),
- ?line {value,{meta,MetaTracer}} =
+ {value,{meta,MetaTracer}} =
lists:keysearch(meta, 1, TraceInfo1),
- ?line {meta_match_spec,MatchSpec} =
+ {meta_match_spec,MatchSpec} =
erlang:trace_info({?MODULE,receiver,1}, meta_match_spec),
- ?line {value,{meta_match_spec,MatchSpec}} =
+ {value,{meta_match_spec,MatchSpec}} =
lists:keysearch(meta_match_spec, 1, TraceInfo1),
- ?line {traced,local} =
+ {traced,local} =
erlang:trace_info({?MODULE,receiver,1}, traced),
- ?line {value,{traced,local}} =
+ {value,{traced,local}} =
lists:keysearch(traced, 1, TraceInfo1),
- ?line {match_spec,MatchSpec} =
+ {match_spec,MatchSpec} =
erlang:trace_info({?MODULE,receiver,1}, match_spec),
- ?line {value,{match_spec,MatchSpec}} =
+ {value,{match_spec,MatchSpec}} =
lists:keysearch(match_spec, 1, TraceInfo1),
%%
- ?line {all, TraceInfo2} =
+ {all, TraceInfo2} =
erlang:trace_info({erlang,phash2,2}, all),
- ?line {meta,MetaTracer} =
+ {meta,MetaTracer} =
erlang:trace_info({erlang,phash2,2}, meta),
- ?line {value,{meta,MetaTracer}} =
+ {value,{meta,MetaTracer}} =
lists:keysearch(meta, 1, TraceInfo2),
- ?line {meta_match_spec,MatchSpec} =
+ {meta_match_spec,MatchSpec} =
erlang:trace_info({erlang,phash2,2}, meta_match_spec),
- ?line {value,{meta_match_spec,MatchSpec}} =
+ {value,{meta_match_spec,MatchSpec}} =
lists:keysearch(meta_match_spec, 1, TraceInfo2),
- ?line {traced,local} =
+ {traced,local} =
erlang:trace_info({erlang,phash2,2}, traced),
- ?line {value,{traced,local}} =
+ {value,{traced,local}} =
lists:keysearch(traced, 1, TraceInfo2),
- ?line {match_spec,MatchSpec} =
+ {match_spec,MatchSpec} =
erlang:trace_info({erlang,phash2,2}, match_spec),
- ?line {value,{match_spec,MatchSpec}} =
+ {value,{match_spec,MatchSpec}} =
lists:keysearch(match_spec, 1, TraceInfo2),
%%
- ?line {flags,Flags1} = erlang:trace_info(Slave, flags),
- ?line Flags = lists:sort(Flags1),
- ?line {tracer,LocalTracer} = erlang:trace_info(Slave, tracer),
+ {flags,Flags1} = erlang:trace_info(Slave, flags),
+ Flags = lists:sort(Flags1),
+ {tracer,LocalTracer} = erlang:trace_info(Slave, tracer),
%%
- ?line Ref = make_ref(),
- ?line apply_slave_async(?MODULE, receiver, [Ref]),
- ?line Slave ! Ref,
- ?line ?CTT(Slave,{?MODULE,receiver,[Ref]}) = receive_next_bytag(MetaTracer),
- ?line ?CTT(Slave,{erlang,phash2,[1,1]}) = receive_next_bytag(MetaTracer),
- ?line ?RFT(Slave,{erlang,phash2,2},0) = receive_next_bytag(MetaTracer),
- ?line ?RFT(Slave,{?MODULE,receiver,1},Ref) = receive_next_bytag(MetaTracer),
- ?line ?CT(Slave,{?MODULE,receiver,[Ref]}) = receive_next_bytag(LocalTracer),
- ?line ?CT(Slave,{erlang,phash2,[1,1]}) = receive_next_bytag(LocalTracer),
- ?line case {receive_next_bytag(LocalTracer),
+ Ref = make_ref(),
+ apply_slave_async(?MODULE, receiver, [Ref]),
+ Slave ! Ref,
+ ?CTT(Slave,{?MODULE,receiver,[Ref]}) = receive_next_bytag(MetaTracer),
+ ?CTT(Slave,{erlang,phash2,[1,1]}) = receive_next_bytag(MetaTracer),
+ ?RFT(Slave,{erlang,phash2,2},0) = receive_next_bytag(MetaTracer),
+ ?RFT(Slave,{?MODULE,receiver,1},Ref) = receive_next_bytag(MetaTracer),
+ ?CT(Slave,{?MODULE,receiver,[Ref]}) = receive_next_bytag(LocalTracer),
+ ?CT(Slave,{erlang,phash2,[1,1]}) = receive_next_bytag(LocalTracer),
+ case {receive_next_bytag(LocalTracer),
receive_next_bytag(LocalTracer)} of
{?RF(Slave,{erlang,phash2,2},0),
?RT(Slave,{?MODULE,receiver,1})} ->
- ?line ok;
+ ok;
{?RT(Slave,{?MODULE,receiver,1}),
?RF(Slave,{erlang,phash2,2},0)} ->
- ?line ok;
- Error1 -> ?t:fail({unexpected_message, Error1})
+ ok;
+ Error1 -> ct:fail({unexpected_message, Error1})
end,
- ?line case {receive_next_bytag(LocalTracer),
+ case {receive_next_bytag(LocalTracer),
receive_next_bytag(LocalTracer)} of
{?RF(Slave,{?MODULE,receiver,1},Ref),
?RT(Slave,{?MODULE,slave,1})} ->
- ?line ok;
+ ok;
{?RT(Slave,{?MODULE,slave,1}),
?RF(Slave,{?MODULE,receiver,1},Ref)} ->
- ?line ok;
- Error2 -> ?t:fail({unexpected_message, Error2})
+ ok;
+ Error2 -> ct:fail({unexpected_message, Error2})
end,
-
- ?line shutdown(),
- ?line ?NM,
+ shutdown(),
+ ?NM,
ok.
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -570,38 +531,38 @@ combo_test() ->
%% Setup silent local call tracing, and start it using meta trace.
nosilent_test() ->
- ?line Pid = setup(),
- ?line Trigger = {?MODULE,id,1},
- ?line TriggerMS = [{[start],[],[{silent,false}]},
- {[stop],[],[{silent,true},{return_trace}]}],
- ?line 1 = erlang:trace(Pid, true, [call,silent,return_to]),
- ?line erlang:trace_pattern({?MODULE,'_','_'},[],[local]),
- ?line 1 = erlang:trace_pattern({?MODULE,local2,1},
- [{'_',[],[{return_trace}]}],
- [local]),
- ?line 1 = erlang:trace_pattern({?MODULE,slave,1},false,[local]),
- ?line 1 = erlang:trace_pattern(Trigger,false,[local]),
- ?line 1 = erlang:trace_pattern(Trigger,TriggerMS,[meta]),
- ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]),
- ?line receive_no_next(17),
- ?line start = apply_slave(?MODULE, id, [start]),
- ?line ?CTT(Pid,{?MODULE,id,[start]}) = receive_next(),
- ?line [2,2,2,0] = apply_slave(?MODULE,exported_wrap,[2]),
- ?line ?CT(Pid,{?MODULE,exported_wrap,[2]}) = receive_next(),
- ?line ?CT(Pid,{?MODULE,exported,[2]}) = receive_next(),
- ?line ?CT(Pid,{?MODULE,local,[2]}) = receive_next(),
- ?line ?CT(Pid,{?MODULE,local2,[2]}) = receive_next(),
- ?line ?CT(Pid,{?MODULE,local_tail,[2]}) = receive_next(),
- ?line ?RF(Pid,{?MODULE,local2,1}, [2,0]) = receive_next(),
- ?line ?RT(Pid,{?MODULE,local,1}) = receive_next(),
- ?line ?RT(Pid,{?MODULE,exported,1}) = receive_next(),
- ?line ?RT(Pid,{?MODULE,slave,1}) = receive_next(),
- ?line stop = apply_slave(?MODULE, id, [stop]),
- ?line ?CTT(Pid,{?MODULE,id,[stop]}) = receive_next(),
- ?line ?RFT(Pid,{?MODULE,id,1}, stop) = receive_next(),
- ?line [3,3,3,0] = apply_slave(?MODULE,exported_wrap,[3]),
- ?line receive_no_next(17),
- ?line shutdown(),
+ Pid = setup(),
+ Trigger = {?MODULE,id,1},
+ TriggerMS = [{[start],[],[{silent,false}]},
+ {[stop],[],[{silent,true},{return_trace}]}],
+ 1 = erlang:trace(Pid, true, [call,silent,return_to]),
+ erlang:trace_pattern({?MODULE,'_','_'},[],[local]),
+ 1 = erlang:trace_pattern({?MODULE,local2,1},
+ [{'_',[],[{return_trace}]}],
+ [local]),
+ 1 = erlang:trace_pattern({?MODULE,slave,1},false,[local]),
+ 1 = erlang:trace_pattern(Trigger,false,[local]),
+ 1 = erlang:trace_pattern(Trigger,TriggerMS,[meta]),
+ [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]),
+ receive_no_next(17),
+ start = apply_slave(?MODULE, id, [start]),
+ ?CTT(Pid,{?MODULE,id,[start]}) = receive_next(),
+ [2,2,2,0] = apply_slave(?MODULE,exported_wrap,[2]),
+ ?CT(Pid,{?MODULE,exported_wrap,[2]}) = receive_next(),
+ ?CT(Pid,{?MODULE,exported,[2]}) = receive_next(),
+ ?CT(Pid,{?MODULE,local,[2]}) = receive_next(),
+ ?CT(Pid,{?MODULE,local2,[2]}) = receive_next(),
+ ?CT(Pid,{?MODULE,local_tail,[2]}) = receive_next(),
+ ?RF(Pid,{?MODULE,local2,1}, [2,0]) = receive_next(),
+ ?RT(Pid,{?MODULE,local,1}) = receive_next(),
+ ?RT(Pid,{?MODULE,exported,1}) = receive_next(),
+ ?RT(Pid,{?MODULE,slave,1}) = receive_next(),
+ stop = apply_slave(?MODULE, id, [stop]),
+ ?CTT(Pid,{?MODULE,id,[stop]}) = receive_next(),
+ ?RFT(Pid,{?MODULE,id,1}, stop) = receive_next(),
+ [3,3,3,0] = apply_slave(?MODULE,exported_wrap,[3]),
+ receive_no_next(17),
+ shutdown(),
ok.
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -645,9 +606,9 @@ slave(Sync) ->
Sync ! sync,
receive
{From,apply, M, F, A} ->
- ?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]),
+ ?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 ! {apply, Res},
erlang:trace_pattern({?MODULE,slave,1},false,[meta]),
slave(From);
@@ -748,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 a7484a22fd..f796b9d667 100644
--- a/erts/emulator/test/trace_nif_SUITE.erl
+++ b/erts/emulator/test/trace_nif_SUITE.erl
@@ -1,28 +1,28 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2017. 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.
+%% 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(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,
@@ -44,264 +44,243 @@ 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_link(?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),
+
+ unlink(Pid),
+ 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_link(?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),
+
+ unlink(Pid),
+ 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_link(?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).
+ case is_nif_loaded() of
+ true ->
+ ok;
+ false ->
+ Path = proplists:get_value(data_dir, Config),
+ ok = erlang:load_nif(filename:join(Path,"trace_nif"), 0)
+ end.
+is_nif_loaded() ->
+ false.
nif() ->
{"Stub0",[]}. %exit("nif/0 stub called").
nif(A1) ->
{"Stub1",[A1]}. %exit(["nif/1 stub called",A1]).
-
diff --git a/erts/emulator/test/trace_nif_SUITE_data/trace_nif.c b/erts/emulator/test/trace_nif_SUITE_data/trace_nif.c
index 26f2420b8b..1afb5ee919 100644
--- a/erts/emulator/test/trace_nif_SUITE_data/trace_nif.c
+++ b/erts/emulator/test/trace_nif_SUITE_data/trace_nif.c
@@ -1,4 +1,4 @@
-#include "erl_nif.h"
+#include <erl_nif.h>
static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info)
@@ -6,18 +6,18 @@ static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info)
return 0;
}
-static int reload(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info)
+static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info)
{
return 0;
}
-static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info)
+static void unload(ErlNifEnv* env, void* priv_data)
{
- return 0;
}
-static void unload(ErlNifEnv* env, void* priv_data)
+static ERL_NIF_TERM is_nif_loaded(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
+ return enif_make_atom(env,"true");
}
static ERL_NIF_TERM nif_0(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
@@ -38,9 +38,10 @@ static ERL_NIF_TERM nif_1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
static ErlNifFunc nif_funcs[] =
{
+ {"is_nif_loaded", 0, is_nif_loaded},
{"nif", 0, nif_0},
{"nif", 1, nif_1}
};
-ERL_NIF_INIT(trace_nif_SUITE,nif_funcs,load,reload,upgrade,unload)
+ERL_NIF_INIT(trace_nif_SUITE,nif_funcs,load,NULL,upgrade,unload)
diff --git a/erts/emulator/test/trace_port_SUITE.erl b/erts/emulator/test/trace_port_SUITE.erl
index 99df8da107..c85a77536e 100644
--- a/erts/emulator/test/trace_port_SUITE.erl
+++ b/erts/emulator/test/trace_port_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2012. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2017. 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.
+%% 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%
%%
@@ -20,238 +21,227 @@
-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,
receive_trace/1,
+ receive_trace_non_scheduler/1,
process_events/1,
schedule/1,
- fake_schedule/1,
- fake_schedule_after_register/1,
- fake_schedule_after_getting_linked/1,
- fake_schedule_after_getting_unlinked/1,
gc/1,
- default_tracer/1]).
-
--include_lib("test_server/include/test_server.hrl").
-
-test_cases() ->
- [call_trace, return_trace, send, receive_trace,
- process_events, schedule, fake_schedule,
- fake_schedule_after_register,
- fake_schedule_after_getting_linked,
- fake_schedule_after_getting_unlinked, gc,
- default_tracer].
-
-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.
+ default_tracer/1,
+ tracer_port_crash/1]).
+-include_lib("common_test/include/ct.hrl").
-init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- Dog = ?t:timetrap(?t:seconds(30)),
- [{watchdog, Dog}|Config].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 2}}].
-end_per_testcase(_Func, Config) ->
- Dog = ?config(watchdog, Config),
- ?t:timetrap_cancel(Dog).
+all() ->
+ [call_trace, return_trace, send, receive_trace,
+ receive_trace_non_scheduler,
+ process_events, schedule, gc,
+ default_tracer, tracer_port_crash].
-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.
+
+%% Test sending receive traces to a port.
+receive_trace_non_scheduler(Config) when is_list(Config) ->
+ start_tracer(Config),
+ S = self(),
+ Receiver = spawn_link(
+ fun() ->
+ receive
+ go ->
+ Ref = S ! erlang:trace_delivered(all),
+ receive {trace_delivered, Ref, all} -> ok end
+ end
+ end),
+ trac(Receiver, true, ['receive']),
+ Receiver ! go,
+ Ref = receive R -> R end,
+ expect({trace,Receiver,'receive',go}),
+ expect({trace,Receiver,'receive',{trace_delivered, all, Ref}}),
+
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}),
@@ -259,219 +249,95 @@ 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.";
-fake_schedule(Config) when is_list(Config) ->
- ?line 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),
- %%
- ?line 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(),
- %%
- ?line trac(General, false, [running]),
- ?line 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(),
- %%
- ?line 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(),
- %%
- %% 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(),
- %%
- ok.
-
-fake_schedule_after_register(doc) ->
- "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).
-
-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),
- %%
- ?line trac(G1, true, [running, timestamp, procs]),
- ?line 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(),
- %%
- ok.
-
-fake_schedule_after_getting_linked(doc) ->
- "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).
-
-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),
- %%
- ?line trac(G1, true, [running, timestamp, procs]),
- ?line 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(),
- %%
- ok.
-
-fake_schedule_after_getting_unlinked(doc) ->
- "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).
-
-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),
- %%
- ?line trac(G1, true, [running, procs]),
- ?line 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(),
- %%
- 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}),
+ expect({trace,Garber,gc_major_start,info}),
+ expect({trace,Garber,gc_major_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}),
+ expect({trace_ts,Garber,gc_major_start,info,ts}),
+ expect({trace_ts,Garber,gc_major_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 - 1, % G1 has been started, but Tracer and Port have died
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})
+ ct:fail({trace_port_linker, Id})
+ end,
+ undefined = process_info(Tracee),
+ ok
+ end.
+
%%% Help functions.
huge_data() -> huge_data(16384).
@@ -483,108 +349,99 @@ huge_data(N) ->
P = huge_data(N div 2),
[16#1234566,P|P].
-expect() ->
- receive
- Other ->
- ok = io:format("Unexpected; got ~p", [Other]),
- test_server:fail({unexpected, Other})
- after 200 ->
- 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.
@@ -592,29 +449,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) ->
@@ -624,14 +481,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);
- 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) ->
@@ -655,43 +516,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/trace_port_SUITE_data/echo_drv.c b/erts/emulator/test/trace_port_SUITE_data/echo_drv.c
index a8d4ede4fe..e40b9193ea 100644
--- a/erts/emulator/test/trace_port_SUITE_data/echo_drv.c
+++ b/erts/emulator/test/trace_port_SUITE_data/echo_drv.c
@@ -1,5 +1,6 @@
#include <stdio.h>
#include "erl_driver.h"
+#include <errno.h>
@@ -14,6 +15,7 @@ enum e_heavy {
typedef struct _erl_drv_data {
ErlDrvPort erlang_port;
enum e_heavy heavy;
+ int crash;
} EchoDrvData;
static EchoDrvData echo_drv_data, *echo_drv_data_p;
@@ -78,6 +80,7 @@ static EchoDrvData *echo_drv_start(ErlDrvPort port, char *command)
echo_drv_data_p = &echo_drv_data;
echo_drv_data_p->erlang_port = port;
echo_drv_data_p->heavy = heavy_off;
+ echo_drv_data_p->crash = 0;
return echo_drv_data_p;
}
@@ -87,6 +90,12 @@ static void echo_drv_stop(EchoDrvData *data_p) {
static void echo_drv_output(ErlDrvData drv_data, char *buf, ErlDrvSizeT len) {
EchoDrvData* data_p = (EchoDrvData *) drv_data;
+
+ if (data_p->crash) {
+ driver_failure_posix(data_p->erlang_port, EINTR);
+ return;
+ }
+
driver_output(data_p->erlang_port, buf, len);
switch (data_p->heavy) {
case heavy_off:
@@ -100,6 +109,7 @@ static void echo_drv_output(ErlDrvData drv_data, char *buf, ErlDrvSizeT len) {
data_p->heavy = heavy_off;
break;
}
+
}
static void echo_drv_finish() {
@@ -115,6 +125,8 @@ static ErlDrvSSizeT echo_drv_control(ErlDrvData drv_data,
case 'h':
data_p->heavy = heavy_set;
break;
+ case 'c':
+ data_p->crash = 1;
}
return 0;
}
diff --git a/erts/emulator/test/tracer_SUITE.erl b/erts/emulator/test/tracer_SUITE.erl
new file mode 100644
index 0000000000..ab7d047bc3
--- /dev/null
+++ b/erts/emulator/test/tracer_SUITE.erl
@@ -0,0 +1,696 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2017. 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(tracer_SUITE).
+
+%%%
+%%% Tests the tracer module interface
+%%%
+
+-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([load/1, unload/1, reload/1, invalid_tracers/1]).
+-export([send/1, recv/1, call/1, call_return/1, spawn/1, exit/1,
+ link/1, unlink/1, getting_linked/1, getting_unlinked/1,
+ register/1, unregister/1, in/1, out/1, gc_start/1, gc_end/1]).
+
+suite() -> [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 1}}].
+
+all() ->
+ [load, unload, reload, invalid_tracers, {group, basic}].
+
+groups() ->
+ [{ basic, [], [send, recv, call, call_return, spawn, exit,
+ link, unlink, getting_linked, getting_unlinked,
+ register, unregister, in, out, gc_start, gc_end]}].
+
+init_per_suite(Config) ->
+ erlang:trace_pattern({'_','_','_'}, false, [local]),
+ erlang:trace_pattern({'_','_','_'}, false, []),
+ purge(),
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+init_per_testcase(TC, Config) when TC =:= load; TC =:= reload ->
+
+ DataDir = proplists:get_value(data_dir, Config),
+
+ Pid = erlang:spawn(fun F() ->
+ receive
+ {get, Pid} ->
+ Pid ! DataDir,
+ F()
+ end
+ end),
+ register(tracer_test_config, Pid),
+ common_init_per_testcase(Config);
+init_per_testcase(_, Config) ->
+ DataDir = proplists:get_value(data_dir, Config),
+ case catch tracer_test:enabled(trace_status, self(), self()) of
+ discard ->
+ ok;
+ _ ->
+ tracer_test:load(DataDir)
+ end,
+ common_init_per_testcase(Config).
+
+common_init_per_testcase(Config) ->
+ Killer = erlang:spawn(fun() -> killer_loop([]) end),
+ register(killer_process, Killer),
+ Config.
+
+end_per_testcase(TC, _Config) when TC =:= load; TC =:= reload ->
+ purge(),
+ exit(whereis(tracer_test_config), kill),
+ kill_processes();
+end_per_testcase(_, _Config) ->
+ purge(),
+ kill_processes().
+
+kill_processes() ->
+ killer_process ! {get_pids,self()},
+ receive
+ {pids_to_kill,Pids} -> ok
+ end,
+ _ = [begin
+ case erlang:is_process_alive(P) of
+ true ->
+ io:format("Killing ~p\n", [P]);
+ false ->
+ ok
+ end,
+ erlang:unlink(P),
+ exit(P, kill)
+ end || P <- Pids],
+ ok.
+
+killer_loop(Pids) ->
+ receive
+ {add_pid,Pid} ->
+ killer_loop([Pid|Pids]);
+ {get_pids,To} ->
+ To ! {pids_to_kill,Pids}
+ end.
+
+kill_me(Pid) ->
+ killer_process ! {add_pid,Pid},
+ Pid.
+
+%%% Test cases follow.
+
+load(_Config) ->
+ purge(),
+ 1 = erlang:trace(self(), true, [{tracer, tracer_test, []}, call]),
+ purge(),
+ 1 = erlang:trace_pattern({?MODULE, all, 0}, [],
+ [{meta, tracer_test, []}]),
+ ok.
+
+unload(_Config) ->
+
+ ServerFun = fun F(0, undefined) ->
+ receive
+ {N, Pid} -> F(N, Pid)
+ end;
+ F(0, Pid) ->
+ Pid ! done,
+ F(0, undefined);
+ F(N, Pid) ->
+ ?MODULE:all(),
+ F(N-1, Pid)
+ end,
+
+ Pid = erlang:spawn_link(fun() -> ServerFun(0, undefined) end),
+
+ Tc = fun(N) ->
+ Pid ! {N, self()},
+ receive done -> ok after 1000 -> ct:fail(timeout) end,
+ trace_delivered(Pid)
+ end,
+
+ 1 = erlang:trace(Pid, true, [{tracer, tracer_test,
+ {#{ call => trace }, self(), []}},
+ call]),
+ 1 = erlang:trace_pattern({?MODULE, all, 0}, [], []),
+
+ Tc(1),
+ receive _M -> ok after 0 -> ct:fail(timeout) end,
+ receive M0 -> ct:fail({unexpected_message0, M0}) after 0 -> ok end,
+
+ code:purge(tracer_test),
+ code:delete(tracer_test),
+
+ Tc(1),
+ receive M1 -> ct:fail({unexpected_message1, M1}) after 0 -> ok end,
+
+ code:purge(tracer_test),
+
+ Tc(1),
+ receive M2 -> ct:fail({unexpected_message2, M2}) after 0 -> ok end,
+
+ ok.
+
+%% This testcase is here to make sure there are not
+%% segfaults when reloading the current nifs.
+reload(_Config) ->
+
+ Tracer = spawn_opt(fun F() -> receive _M -> F() end end,
+ [{message_queue_data, off_heap}]),
+ erlang:link(Tracer),
+ Tracee = spawn_link(fun reload_loop/0),
+
+ [begin
+ Ref = make_ref(),
+ State = {#{ call => trace }, Tracer, [Ref]},
+ erlang:trace(Tracee, true, [{tracer, tracer_test,State}, call]),
+ erlang:trace_pattern({?MODULE, all, 0}, []),
+
+ false = code:purge(tracer_test),
+ {module, _} = code:load_file(tracer_test),
+
+ %% There is a race involved in between when the internal nif cache
+ %% is purged and when the reload_loop needs the tracer module
+ %% so the tracer may be removed or still there.
+ case erlang:trace_info(Tracee, tracer) of
+ {tracer, []} -> ok;
+ {tracer, {tracer_test, State}} -> ok
+ end,
+
+ false = code:purge(tracer_test),
+ true = code:delete(tracer_test),
+ false = code:purge(tracer_test),
+ timer:sleep(10)
+ end || _ <- lists:seq(1,15)],
+
+ ok.
+
+reload_loop() ->
+ ?MODULE:all(),
+ ?MODULE:all(),
+ ?MODULE:all(),
+ ?MODULE:all(),
+ ?MODULE:all(),
+ timer:sleep(1),
+ reload_loop().
+
+invalid_tracers(_Config) ->
+ FailTrace = fun(A) ->
+ try erlang:trace(self(), true, A) of
+ _ -> ct:fail(A)
+ catch _:_ -> ok end
+ end,
+
+ FailTrace([{tracer, foobar}, call]),
+ FailTrace([{tracer, foobar, []}, call]),
+ FailTrace([{tracer, make_ref(), []}, call]),
+ FailTrace([{tracer, lists, []}, call]),
+
+ FailTP = fun(MS,FL) ->
+ try erlang:trace_pattern({?MODULE,all,0}, MS, FL) of
+ _ -> ct:fail({MS, FL})
+ catch _:_ -> ok end
+ end,
+
+ FailTP([],[{meta, foobar}]),
+ FailTP([],[{meta, foobar, []}]),
+ FailTP([],[{meta, make_ref(), []}]),
+ FailTP([],[{meta, lists, []}]),
+
+ ok.
+
+
+
+send(_Config) ->
+
+ Self = self(),
+ Tc = fun(Pid) ->
+ Pid ! fun() -> Self ! ok end,
+ receive ok -> ok after 100 -> ct:fail(timeout) end
+ end,
+
+ Expect = fun(Pid, State, EOpts) ->
+ receive
+ Msg ->
+ {send, State, Pid, ok, Opts} = Msg,
+ check_opts(EOpts, Opts, Self)
+ end
+ end,
+ test(send, Tc, Expect).
+
+
+recv(_Config) ->
+
+ Tc = fun(Pid) ->
+ Pid ! ok
+ end,
+
+ Expect = fun(Pid, State, EOpts) ->
+ receive
+ Msg ->
+ {'receive', State, Pid, ok, Opts} = Msg,
+ check_opts(EOpts, Opts)
+ end
+ end,
+
+ test('receive', Tc, Expect, false).
+
+call(_Config) ->
+
+ Self = self(),
+ Tc = fun(Pid) ->
+ Pid ! fun() -> call_test(Self), Self ! ok end,
+ receive ok -> ok after 100 -> ct:fail(timeout) end
+ end,
+
+ erlang:trace_pattern({?MODULE, call_test, 1}, [], [local]),
+
+ Expect = fun(Pid, State, EOpts) ->
+ receive
+ Msg ->
+ {call, State, Pid, {?MODULE, call_test, [Self]}, Opts} = Msg,
+ check_opts(EOpts, Opts)
+ end
+ end,
+ test(call, Tc, Expect).
+
+call_return(_Config) ->
+
+ Self = self(),
+ Tc = fun(Pid) ->
+ Pid ! fun() -> call_test(undefined), Self ! ok end,
+ receive ok -> ok after 100 -> ct:fail(timeout) end
+ end,
+
+ 1 = erlang:trace_pattern({?MODULE, call_test, 1}, [{'_',[],[{return_trace}]}], [local]),
+
+ Expect = fun(Pid, State, EOpts) ->
+ receive
+ CallMsg ->
+ {call, State, Pid, {?MODULE, call_test, [undefined]}, COpts} = CallMsg,
+ check_opts(EOpts, COpts)
+ end,
+ receive
+ RetMsg ->
+ {return_from, State, Pid, {?MODULE, call_test, 1}, ROpts} = RetMsg,
+ check_opts(EOpts, ROpts, undefined)
+ end
+ end,
+ test(call, Tc, Expect).
+
+call_test(Arg) ->
+ Arg.
+
+spawn(_Config) ->
+
+ Tc = fun(Pid) ->
+ Pid ! fun() -> kill_me(erlang:spawn(lists,seq,[1,10])), ok end
+ end,
+
+ Expect =
+ fun(Pid, State, EOpts) ->
+ receive
+ Msg ->
+ {spawn, State, Pid, NewPid, Opts} = Msg,
+ check_opts(EOpts, Opts, {lists,seq,[1,10]}),
+ true = is_pid(NewPid) andalso NewPid /= Pid
+ end
+ end,
+
+ test(spawn, procs, Tc, Expect, false).
+
+exit(_Config) ->
+ Tc = fun(Pid) ->
+ Pid ! fun() -> exit end
+ end,
+
+ Expect =
+ fun(Pid, State, EOpts) ->
+ receive
+ Msg ->
+ {exit, State, Pid, normal, Opts} = Msg,
+ check_opts(EOpts, Opts)
+ end
+ end,
+
+ test(exit, procs, Tc, Expect, true, true).
+
+link(_Config) ->
+
+ Tc = fun(Pid) ->
+ Pid ! fun() ->
+ SPid = erlang:spawn(fun() -> receive _ -> ok end end),
+ erlang:link(SPid),
+ ok
+ end
+ end,
+
+ Expect =
+ fun(Pid, State, EOpts) ->
+ receive
+ Msg ->
+ {link, State, Pid, NewPid, Opts} = Msg,
+ check_opts(EOpts, Opts),
+ true = is_pid(NewPid) andalso NewPid /= Pid
+ end
+ end,
+
+ test(link, procs, Tc, Expect, false).
+
+unlink(_Config) ->
+
+ Tc = fun(Pid) ->
+ Pid ! fun() ->
+ SPid = erlang:spawn(fun() -> receive _ -> ok end end),
+ erlang:link(SPid),
+ erlang:unlink(SPid),
+ kill_me(SPid),
+ ok
+ end
+ end,
+
+ Expect =
+ fun(Pid, State, EOpts) ->
+ receive
+ Msg ->
+ {unlink, State, Pid, NewPid, Opts} = Msg,
+ check_opts(EOpts, Opts),
+ true = is_pid(NewPid) andalso NewPid /= Pid
+ end
+ end,
+
+ test(unlink, procs, Tc, Expect, false).
+
+getting_linked(_Config) ->
+
+ Tc = fun(Pid) ->
+ Pid ! fun() ->
+ Self = self(),
+ erlang:spawn(fun() -> erlang:link(Self) end),
+ ok
+ end
+ end,
+
+ Expect =
+ fun(Pid, State, EOpts) ->
+ receive
+ Msg ->
+ {getting_linked, State, Pid, NewPid, Opts} = Msg,
+ check_opts(EOpts, Opts),
+ true = is_pid(NewPid) andalso NewPid /= Pid
+ end
+ end,
+
+ test(getting_linked, procs, Tc, Expect, false).
+
+getting_unlinked(_Config) ->
+ Tc = fun(Pid) ->
+ Pid ! fun() ->
+ Self = self(),
+ erlang:spawn(fun() ->
+ erlang:link(Self),
+ erlang:unlink(Self)
+ end),
+ ok
+ end
+ end,
+
+ Expect =
+ fun(Pid, State, EOpts) ->
+ receive
+ Msg ->
+ {getting_unlinked, State, Pid, NewPid, Opts} = Msg,
+ check_opts(EOpts, Opts),
+ true = is_pid(NewPid) andalso NewPid /= Pid
+ end
+ end,
+
+ test(getting_unlinked, procs, Tc, Expect, false).
+
+register(_Config) ->
+
+ Tc = fun(Pid) ->
+ Pid ! fun() ->
+ erlang:register(?MODULE, self()),
+ erlang:unregister(?MODULE),
+ ok
+ end
+ end,
+
+ Expect =
+ fun(Pid, State, EOpts) ->
+ receive
+ Msg ->
+ {register, State, Pid, ?MODULE, Opts} = Msg,
+ check_opts(EOpts, Opts)
+ end
+ end,
+
+ test(register, procs, Tc, Expect, false).
+
+unregister(_Config) ->
+
+ Tc = fun(Pid) ->
+ Pid ! fun() ->
+ erlang:register(?MODULE, self()),
+ erlang:unregister(?MODULE),
+ ok
+ end
+ end,
+
+ Expect =
+ fun(Pid, State, EOpts) ->
+ receive
+ Msg ->
+ {unregister, State, Pid, ?MODULE, Opts} = Msg,
+ check_opts(EOpts, Opts)
+ end
+ end,
+
+ test(unregister, procs, Tc, Expect, false).
+
+in(_Config) ->
+
+ Tc = fun(Pid) ->
+ Self = self(),
+ Pid ! fun() -> receive after 10 -> Self ! ok end end,
+ receive ok -> ok end
+ end,
+
+ Expect =
+ fun(Pid, State, EOpts) ->
+ N = (fun F(N) ->
+ receive
+ Msg ->
+ {in, State, Pid, _, Opts} = Msg,
+ check_opts(EOpts, Opts),
+ F(N+1)
+ after 0 -> N
+ end
+ end)(0),
+ true = N > 0
+ end,
+
+ test(in, running, Tc, Expect, false).
+
+out(_Config) ->
+ Tc = fun(Pid) ->
+ Pid ! fun() -> receive after 10 -> exit end end,
+ Ref = erlang:monitor(process, Pid),
+ receive {'DOWN', Ref, _, _, _} -> ok end
+ end,
+
+ Expect =
+ fun(Pid, State, EOpts) ->
+ %% We cannot predict how many out schedules there will be
+ N = (fun F(N) ->
+ receive
+ Msg ->
+ {out, State, Pid, _, Opts} = Msg,
+ check_opts(EOpts, Opts),
+ F(N+1)
+ after 0 -> N
+ end
+ end)(0),
+ true = N > 0
+ end,
+
+ test(out, running, Tc, Expect, false, true).
+
+gc_start(_Config) ->
+
+ Tc = fun(Pid) ->
+ Pid ! fun() ->
+ erlang:garbage_collect(),
+ ok
+ end
+ end,
+
+ Expect =
+ fun(Pid, State, EOpts) ->
+ receive
+ Msg ->
+ {gc_major_start, State, Pid, _, Opts} = Msg,
+ check_opts(EOpts, Opts)
+ end
+ end,
+
+ test(gc_major_start, garbage_collection, Tc, Expect, false).
+
+gc_end(_Config) ->
+
+ Tc = fun(Pid) ->
+ Pid ! fun() ->
+ erlang:garbage_collect(),
+ ok
+ end
+ end,
+
+ Expect =
+ fun(Pid, State, EOpts) ->
+ receive
+ Msg ->
+ {gc_major_end, State, Pid, _, Opts} = Msg,
+ check_opts(EOpts, Opts)
+ end
+ end,
+
+ test(gc_major_end, garbage_collection, Tc, Expect, false).
+
+test(Event, Tc, Expect) ->
+ test(Event, Tc, Expect, false).
+test(Event, Tc, Expect, Removes) ->
+ test(Event, Event, Tc, Expect, Removes).
+test(Event, TraceFlag, Tc, Expect, Removes) ->
+ test(Event, TraceFlag, Tc, Expect, Removes, false).
+test(Event, TraceFlag, Tc, Expect, _Removes, Dies) ->
+
+ ComplexState = {fun() -> ok end, <<0:(128*8)>>},
+ Opts = #{ },
+
+ %% Test that trace works
+ State1 = {#{ Event => trace }, self(), ComplexState},
+ Pid1 = start_tracee(),
+ 1 = erlang:trace(Pid1, true, [TraceFlag, {tracer, tracer_test, State1}]),
+ Tc(Pid1),
+ ok = trace_delivered(Pid1),
+
+ Expect(Pid1, State1, Opts),
+ receive M11 -> ct:fail({unexpected, M11}) after 0 -> ok end,
+ if not Dies ->
+ {flags, [TraceFlag]} = erlang:trace_info(Pid1, flags),
+ {tracer, {tracer_test, State1}} = erlang:trace_info(Pid1, tracer),
+ erlang:trace(Pid1, false, [TraceFlag]);
+ true -> ok
+ end,
+
+ %% Test that trace works with scheduler id and timestamp
+ Pid1T = start_tracee(),
+ 1 = erlang:trace(Pid1T, true, [TraceFlag, {tracer, tracer_test, State1},
+ timestamp, scheduler_id]),
+ Tc(Pid1T),
+ ok = trace_delivered(Pid1T),
+
+ Expect(Pid1T, State1, Opts#{ scheduler_id => number,
+ timestamp => timestamp}),
+ receive M11T -> ct:fail({unexpected, M11T}) after 0 -> ok end,
+ if not Dies ->
+ {flags, [scheduler_id, TraceFlag, timestamp]}
+ = erlang:trace_info(Pid1T, flags),
+ {tracer, {tracer_test, State1}} = erlang:trace_info(Pid1T, tracer),
+ erlang:trace(Pid1T, false, [TraceFlag]);
+ true -> ok
+ end,
+
+ %% Test that discard works
+ Pid2 = start_tracee(),
+ State2 = {#{ Event => discard }, self(), ComplexState},
+ 1 = erlang:trace(Pid2, true, [TraceFlag, {tracer, tracer_test, State2}]),
+ Tc(Pid2),
+ ok = trace_delivered(Pid2),
+ receive M2 -> ct:fail({unexpected, M2}) after 0 -> ok end,
+ if not Dies ->
+ {flags, [TraceFlag]} = erlang:trace_info(Pid2, flags),
+ {tracer, {tracer_test, State2}} = erlang:trace_info(Pid2, tracer),
+ erlang:trace(Pid2, false, [TraceFlag]);
+ true ->
+ ok
+ end,
+
+ ok.
+
+check_opts(E, O, Extra) ->
+ check_opts(E#{ extra => Extra }, O).
+check_opts(#{ scheduler_id := number } = E, #{ scheduler_id := N } = O)
+ when is_integer(N) ->
+ E1 = maps:remove(scheduler_id, E),
+ O1 = maps:remove(scheduler_id, O),
+ if E1 == O1 -> ok;
+ true -> ct:fail({invalid_opts, E, O})
+ end;
+check_opts(Opts, Opts) ->
+ ok;
+check_opts(E,O) ->
+ ct:fail({invalid_opts, E, O}).
+
+start_tracee() ->
+ spawn_link(
+ fun F() ->
+ receive
+ Action when is_function(Action) ->
+ case Action() of
+ ok ->
+ F();
+ Err ->
+ Err
+ end;
+ _ ->
+ F()
+ end
+ end).
+
+trace_delivered(Pid) ->
+ Ref = erlang:trace_delivered(Pid),
+ receive
+ {trace_delivered, Pid, Ref} ->
+ ok
+ after 1000 ->
+ timeout
+ end.
+
+purge() ->
+ %% Make sure module is not loaded
+ case erlang:module_loaded(tracer_test) of
+ true ->
+ code:purge(tracer_test),
+ true = code:delete(tracer_test),
+ code:purge(tracer_test);
+ _ ->
+ ok
+ end.
diff --git a/erts/emulator/test/tracer_SUITE_data/Makefile.src b/erts/emulator/test/tracer_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..154bd70ccc
--- /dev/null
+++ b/erts/emulator/test/tracer_SUITE_data/Makefile.src
@@ -0,0 +1,8 @@
+
+NIF_LIBS = tracer_test@dll@
+
+all: $(NIF_LIBS)
+
+@SHLIB_RULES@
+
+$(NIF_LIBS): tracer_test.c
diff --git a/erts/emulator/test/tracer_SUITE_data/tracer_test.c b/erts/emulator/test/tracer_SUITE_data/tracer_test.c
new file mode 100644
index 0000000000..1555a95d9a
--- /dev/null
+++ b/erts/emulator/test/tracer_SUITE_data/tracer_test.c
@@ -0,0 +1,116 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2009-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%
+ */
+
+#include <erl_nif.h>
+
+#include <stdio.h>
+#include <string.h>
+#include <assert.h>
+#include <limits.h>
+
+/* NIF interface declarations */
+static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info);
+static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info);
+static void unload(ErlNifEnv* env, void* priv_data);
+
+/* The NIFs: */
+static ERL_NIF_TERM enabled(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM trace(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+
+static ErlNifFunc nif_funcs[] = {
+ {"enabled", 3, enabled},
+ {"trace", 5, trace}
+};
+
+ERL_NIF_INIT(tracer_test, nif_funcs, load, NULL, upgrade, unload)
+
+static ERL_NIF_TERM atom_discard;
+static ERL_NIF_TERM atom_ok;
+
+#define ASSERT(expr) assert(expr)
+
+static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info)
+{
+
+ atom_discard = enif_make_atom(env, "discard");
+ atom_ok = enif_make_atom(env, "ok");
+
+ *priv_data = NULL;
+
+ return 0;
+}
+
+static void unload(ErlNifEnv* env, void* priv_data)
+{
+
+}
+
+static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data,
+ ERL_NIF_TERM load_info)
+{
+ if (*old_priv_data != NULL) {
+ return -1; /* Don't know how to do that */
+ }
+ if (*priv_data != NULL) {
+ return -1; /* Don't know how to do that */
+ }
+ if (load(env, priv_data, load_info)) {
+ return -1;
+ }
+ return 0;
+}
+
+static ERL_NIF_TERM enabled(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ int state_arity;
+ const ERL_NIF_TERM *state_tuple;
+ ERL_NIF_TERM value;
+ ASSERT(argc == 3);
+
+ if (!enif_get_tuple(env, argv[1], &state_arity, &state_tuple))
+ return atom_discard;
+
+ if (enif_get_map_value(env, state_tuple[0], argv[0], &value)) {
+ return value;
+ } else {
+ return atom_discard;
+ }
+}
+
+static ERL_NIF_TERM trace(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ int state_arity;
+ ErlNifPid self, to;
+ ERL_NIF_TERM *tuple, msg;
+ const ERL_NIF_TERM *state_tuple;
+ ASSERT(argc == 5);
+
+ enif_get_tuple(env, argv[1], &state_arity, &state_tuple);
+
+ tuple = enif_alloc(sizeof(ERL_NIF_TERM)*(argc));
+ memcpy(tuple,argv,sizeof(ERL_NIF_TERM)*argc);
+
+ msg = enif_make_tuple_from_array(env, tuple, argc);
+ enif_get_local_pid(env, state_tuple[1], &to);
+ enif_send(env, &to, NULL, msg);
+ enif_free(tuple);
+
+ return atom_ok;
+}
diff --git a/erts/emulator/test/tracer_test.erl b/erts/emulator/test/tracer_test.erl
new file mode 100644
index 0000000000..a82fd04d2e
--- /dev/null
+++ b/erts/emulator/test/tracer_test.erl
@@ -0,0 +1,55 @@
+%%
+%% %CopyrightBegin%
+%%
+%% 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.
+%% 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(tracer_test).
+
+%%%
+%%% Test tracer
+%%%
+
+-export([enabled/3, trace/5]).
+-export([load/1, load/2]).
+-on_load(load/0).
+
+enabled(_, _, _) ->
+ erlang:nif_error(nif_not_loaded).
+
+trace(_, _, _, _, _) ->
+ erlang:nif_error(nif_not_loaded).
+
+load() ->
+ case whereis(tracer_test_config) of
+ undefined ->
+ ok;
+ Pid ->
+ Pid ! {get, self()},
+ receive
+ {Conf, Postfix} ->
+ load(Conf, Postfix);
+ Conf ->
+ load(Conf)
+ end
+ end.
+
+load(DataDir) ->
+ load(DataDir, "").
+load(DataDir, Postfix) ->
+ SoFile = atom_to_list(?MODULE) ++ Postfix,
+ erlang:load_nif(filename:join(DataDir, SoFile) , 0).
diff --git a/erts/emulator/test/tuple_SUITE.erl b/erts/emulator/test/tuple_SUITE.erl
index 46ece41096..79b681b4d1 100644
--- a/erts/emulator/test/tuple_SUITE.erl
+++ b/erts/emulator/test/tuple_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2016. 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.
+%% 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%
%%
@@ -21,10 +22,11 @@
init_per_group/2,end_per_group/2,
t_size/1, t_tuple_size/1, t_element/1, t_setelement/1,
t_insert_element/1, t_delete_element/1,
- t_list_to_tuple/1, t_tuple_to_list/1,
- t_make_tuple_2/1, t_make_tuple_3/1, t_append_element/1,
+ t_list_to_tuple/1, t_list_to_upper_boundry_tuple/1, t_tuple_to_list/1,
+ 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:
%%
@@ -40,8 +42,10 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
[build_and_match, t_size, t_tuple_size, t_list_to_tuple,
+ t_list_to_upper_boundry_tuple,
t_tuple_to_list, t_element, t_setelement,
- t_make_tuple_2, t_make_tuple_3, t_append_element,
+ t_make_tuple_2, t_make_upper_boundry_tuple_2, t_make_tuple_3,
+ t_append_element, t_append_element_upper_boundry,
t_insert_element, t_delete_element,
tuple_with_case, tuple_in_guard].
@@ -49,11 +53,21 @@ groups() ->
[].
init_per_suite(Config) ->
+ A0 = case application:start(sasl) of
+ ok -> [sasl];
+ _ -> []
+ end,
+ A = case application:start(os_mon) of
+ ok -> [os_mon|A0];
+ _ -> A0
+ end,
+ [{started_apps, A}|Config].
+
+end_per_suite(Config) ->
+ As = proplists:get_value(started_apps, Config),
+ lists:foreach(fun (A) -> application:stop(A) end, As),
Config.
-end_per_suite(_Config) ->
- ok.
-
init_per_group(_GroupName, Config) ->
Config.
@@ -176,14 +190,19 @@ t_list_to_tuple(Config) when is_list(Config) ->
{'EXIT', {badarg, _}} = (catch list_to_tuple(id([a|b]))),
{'EXIT', {badarg, _}} = (catch list_to_tuple(id([a|b]))),
- % test upper boundry, 16777215 elements
- MaxSize = 1 bsl 24 - 1,
- MaxTuple = list_to_tuple(lists:seq(1, MaxSize)),
- MaxSize = size(MaxTuple),
-
{'EXIT', {badarg,_}} = (catch list_to_tuple(lists:seq(1, 1 bsl 24))),
ok.
+t_list_to_upper_boundry_tuple(Config) when is_list(Config) ->
+ sys_mem_cond_run(2048,
+ fun () ->
+ %% test upper boundry, 16777215 elements
+ MaxSize = 1 bsl 24 - 1,
+ MaxTuple = list_to_tuple(lists:seq(1, MaxSize)),
+ MaxSize = size(MaxTuple),
+ ok
+ end).
+
%% Tests tuple_to_list/1.
t_tuple_to_list(Config) when is_list(Config) ->
@@ -214,8 +233,6 @@ t_make_tuple_2(Config) when is_list(Config) ->
t_make_tuple1({a}),
t_make_tuple1(erlang:make_tuple(400, [])),
- % test upper boundry, 16777215 elements
- t_make_tuple(1 bsl 24 - 1, a),
{'EXIT', {badarg,_}} = (catch erlang:make_tuple(1 bsl 24, a)),
{'EXIT', {badarg,_}} = (catch erlang:make_tuple(-1, a)),
@@ -225,6 +242,13 @@ t_make_tuple_2(Config) when is_list(Config) ->
{'EXIT', {badarg,_}} = (catch erlang:make_tuple(1 bsl 65 + 3, a)),
ok.
+t_make_upper_boundry_tuple_2(Config) when is_list(Config) ->
+ sys_mem_cond_run(2048,
+ fun () ->
+ %% test upper boundry, 16777215 elements
+ t_make_tuple(1 bsl 24 - 1, a)
+ end).
+
t_make_tuple1(Element) ->
lists:foreach(fun(Size) -> t_make_tuple(Size, Element) end,
[0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 255, 256, 511, 512, 999,
@@ -235,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.
@@ -309,13 +333,17 @@ t_delete_element(Config) when is_list(Config) ->
%% Tests the append_element/2 BIF.
t_append_element(Config) when is_list(Config) ->
- ok = t_append_element({}, 2048, 2048),
-
- % test upper boundry, 16777215 elements
- MaxSize = 1 bsl 24 - 1,
- MaxTuple = list_to_tuple(lists:seq(1, MaxSize)),
- {'EXIT',{badarg,_}} = (catch erlang:append_element(MaxTuple, a)),
- ok.
+ ok = t_append_element({}, 2048, 2048).
+
+t_append_element_upper_boundry(Config) when is_list(Config) ->
+ sys_mem_cond_run(2048,
+ fun () ->
+ %% test upper boundry, 16777215 elements
+ MaxSize = 1 bsl 24 - 1,
+ MaxTuple = list_to_tuple(lists:seq(1, MaxSize)),
+ {'EXIT',{badarg,_}} = (catch erlang:append_element(MaxTuple, a)),
+ ok
+ end).
t_append_element(_Tuple, 0, _High) -> ok;
t_append_element(Tuple, N, High) ->
@@ -357,17 +385,45 @@ 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.
%% Use this function to avoid compile-time evaluation of an expression.
id(I) -> I.
+
+sys_mem_cond_run(ReqSizeMB, TestFun) when is_integer(ReqSizeMB) ->
+ case total_memory() of
+ TotMem when is_integer(TotMem), TotMem >= ReqSizeMB ->
+ TestFun();
+ TotMem when is_integer(TotMem) ->
+ {skipped, "Not enough memory ("++integer_to_list(TotMem)++" MB)"};
+ undefined ->
+ {skipped, "Could not retrieve memory information"}
+ end.
+
+
+total_memory() ->
+ %% Totat memory in MB.
+ try
+ MemoryData = memsup:get_system_memory_data(),
+ case lists:keysearch(total_memory, 1, MemoryData) of
+ {value, {total_memory, TM}} ->
+ TM div (1024*1024);
+ false ->
+ {value, {system_total_memory, STM}} =
+ lists:keysearch(system_total_memory, 1, MemoryData),
+ STM div (1024*1024)
+ end
+ catch
+ _ : _ ->
+ undefined
+ end.
diff --git a/erts/emulator/test/unique_SUITE.erl b/erts/emulator/test/unique_SUITE.erl
new file mode 100644
index 0000000000..cfc37bd44f
--- /dev/null
+++ b/erts/emulator/test/unique_SUITE.erl
@@ -0,0 +1,375 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2014-2017. 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(unique_SUITE).
+
+-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("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)).
+
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 4}}].
+
+all() ->
+ [unique_monotonic_integer_white_box,
+ unique_integer_white_box].
+
+init_per_suite(Config) ->
+ erts_debug:set_internal_state(available_internal_state, true),
+ Config.
+
+end_per_suite(_Config) ->
+ erts_debug:set_internal_state(available_internal_state, false),
+ ok.
+
+%%
+%%
+%% Unique counter white box test case
+%%
+%%
+
+unique_monotonic_integer_white_box(Config) when is_list(Config) ->
+ {ok, Node} = start_node(Config),
+ TestServer = self(),
+ Success = make_ref(),
+ %% Run this in a separate node, so we don't mess up
+ %% 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),
+ Mon = erlang:monitor(process, Test),
+ receive
+ {'DOWN', Mon, process, Test, Error} ->
+ ct:fail(Error);
+ Success ->
+ ok
+ end,
+ erlang:demonitor(Mon, [flush]),
+ stop_node(Node),
+ ok.
+
+set_unique_monotonic_integer_state(MinCounter, NextValue) ->
+ true = erts_debug:set_internal_state(unique_monotonic_integer_state,
+ NextValue-MinCounter-1).
+
+
+
+unique_monotonic_integer_white_box_test(TestServer, Success) ->
+ erts_debug:set_internal_state(available_internal_state, true),
+
+ WordSize = erlang:system_info({wordsize, internal}),
+ SmallBits = WordSize*8 - 4,
+
+ MinSmall = -1*(1 bsl (SmallBits-1)),
+ MaxSmall = (1 bsl (SmallBits-1))-1,
+ %% Make sure we got small sizes correct...
+ 0 = erts_debug:size(MinSmall),
+ false = 0 =:= erts_debug:size(MinSmall-1),
+ 0 = erts_debug:size(MaxSmall),
+ false = 0 =:= erts_debug:size(MaxSmall+1),
+
+ ?PRINT({min_small, MinSmall}),
+ ?PRINT({max_small, MaxSmall}),
+
+ MinSint64 = -1*(1 bsl 63),
+ MaxSint64 = (1 bsl 63)-1,
+
+ ?PRINT({min_Sint64, MinSint64}),
+ ?PRINT({max_Sint64, MaxSint64}),
+
+ MinCounter = erts_debug:get_internal_state(min_unique_monotonic_integer),
+ MaxCounter = MinCounter + (1 bsl 64) - 1,
+
+ ?PRINT({min_counter, MinCounter}),
+ ?PRINT({max_counter, MaxCounter}),
+
+ case WordSize of
+ 4 ->
+ MinCounter = MinSint64;
+ 8 ->
+ MinCounter = MinSmall
+ end,
+
+ StartState = erts_debug:get_internal_state(unique_monotonic_integer_state),
+
+ %% 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
+ end,
+
+ ?PRINT(over_zero), %% Not really an interesting limit, but...
+ set_unique_monotonic_integer_state(MinCounter, -2),
+ true = (?P(erlang:unique_integer([monotonic])) == -2),
+ true = (?P(erlang:unique_integer([monotonic])) == -1),
+ true = (?P(erlang:unique_integer([monotonic])) == 0),
+ true = (?P(erlang:unique_integer([monotonic])) == 1),
+ true = (?P(erlang:unique_integer([monotonic])) == 2),
+ garbage_collect(),
+
+ ?PRINT(over_max_small),
+ set_unique_monotonic_integer_state(MinCounter, MaxSmall-2),
+ true = (?P(erlang:unique_integer([monotonic])) == MaxSmall - 2),
+ true = (?P(erlang:unique_integer([monotonic])) == MaxSmall - 1),
+ true = (?P(erlang:unique_integer([monotonic])) == MaxSmall),
+ true = (?P(erlang:unique_integer([monotonic])) == MaxSmall + 1),
+ true = (?P(erlang:unique_integer([monotonic])) == MaxSmall + 2),
+ 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()
+ end,
+
+ ?PRINT(over_max_min_counter),
+ set_unique_monotonic_integer_state(MinCounter, if MaxCounter == MaxSint64 ->
+ 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),
+ true = (?P(erlang:unique_integer([monotonic])) == MinCounter),
+ true = (?P(erlang:unique_integer([monotonic])) == MinCounter + 1),
+ true = (?P(erlang:unique_integer([monotonic])) == MinCounter + 2),
+ garbage_collect(),
+
+ %% 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),
+
+ TestServer ! Success.
+
+%%
+%%
+%% Unique integer white box test case
+%%
+%%
+
+-record(uniqint_info, {min_int,
+ 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,
+ io:format("****************************************************~n", []),
+ io:format("*** Around MIN_UNIQ_INT ~p ***~n", [MinInt]),
+ io:format("****************************************************~n", []),
+ check_unique_integer_around(MinInt, UinqintInfo),
+ io:format("****************************************************~n", []),
+ io:format("*** Around 0 ***~n", []),
+ io:format("****************************************************~n", []),
+ check_unique_integer_around(0, UinqintInfo),
+ io:format("****************************************************~n", []),
+ io:format("*** Around MAX_SMALL ~p ***~n", [MaxSmall]),
+ io:format("****************************************************~n", []),
+ check_unique_integer_around(MaxSmall, UinqintInfo),
+ io:format("****************************************************~n", []),
+ io:format("*** Around 2^64+MIN_UNIQ_INT ~p ***~n", [(1 bsl 64)+MinInt]),
+ io:format("****************************************************~n", []),
+ check_unique_integer_around((1 bsl 64)+MinInt, UinqintInfo),
+ io:format("****************************************************~n", []),
+ io:format("*** Around 2^64 ~p~n", [(1 bsl 64)]),
+ io:format("****************************************************~n", []),
+ check_unique_integer_around((1 bsl 64), UinqintInfo),
+ io:format("****************************************************~n", []),
+ io:format("*** Around 2^64-MIN_UNIQ_INT ~p ***~n", [(1 bsl 64)-MinInt]),
+ io:format("****************************************************~n", []),
+ check_unique_integer_around((1 bsl 64)-MinInt, UinqintInfo),
+ io:format("****************************************************~n", []),
+ io:format("*** Around MAX_UNIQ_INT ~p ***~n", [MaxInt]),
+ io:format("****************************************************~n", []),
+ check_unique_integer_around(MaxInt, UinqintInfo),
+ ok.
+
+
+%%% Internal unique_integer_white_box/1 test case
+
+calc_sched_bits(NoScheds, Shift) when NoScheds < 1 bsl Shift ->
+ 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 = schedulers(),
+ io:format("Schedulers=~p~n", [Schedulers]),
+ MinSmall = -1*(1 bsl (SmallBits-1)),
+ io:format("MinSmall=~p~n", [MinSmall]),
+ MaxSmall = (1 bsl (SmallBits-1))-1,
+ io:format("MaxSmall=~p~n", [MaxSmall]),
+ SchedBits = calc_sched_bits(Schedulers, 0),
+ io:format("SchedBits=~p~n", [SchedBits]),
+ 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}.
+
+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}) ->
+ Int1 = Int - MinInt,
+ {Inc, ThreadNo} = case Int1 band ((1 bsl SchedBits) - 1) of
+ 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)
+ end.
+
+mk_uniqint(Int, #uniqint_info {min_int = MinInt,
+ sched_bits = SchedBits} = _UinqintInfo) ->
+ Int1 = Int - MinInt,
+ ThrId = Int1 band ((1 bsl SchedBits) - 1),
+ Value = (Int1 bsr SchedBits) band ((1 bsl 64) - 1),
+ 0 = Int1 bsr (SchedBits + 64),
+ Make = {make_unique_integer, ThrId, Value},
+ %% erlang:display(Make),
+ Res = erts_debug:get_internal_state(Make),
+ %% erlang:display({uniq_int, Res}),
+ Res.
+
+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 Int=~p FAILED~n", [Int]),
+ exit(badres)
+ end.
+
+check_unique_integer_around(Int, #uniqint_info{min_int = MinInt,
+ 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,
+ 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)).
+
+
+%% helpers
+
+print_ret_val(File, Line, Value) ->
+ io:format("~s:~p: ~p~n", [File, Line, Value]),
+ Value.
+
+start_node(Config) ->
+ start_node(Config, []).
+start_node(Config, Opts) when is_list(Config), is_list(Opts) ->
+ 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) ->
+ test_server:stop_node(Node).
diff --git a/erts/emulator/test/z_SUITE.erl b/erts/emulator/test/z_SUITE.erl
index 4b3075a164..feea7432a9 100644
--- a/erts/emulator/test/z_SUITE.erl
+++ b/erts/emulator/test/z_SUITE.erl
@@ -1,18 +1,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2017. 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.
+%% 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%
%%
@@ -29,148 +30,121 @@
%-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]).
+ check_io_debug/1, get_check_io_info/0,
+ leaked_processes/1]).
--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.
+ long_timers, pollset_size, check_io_debug,
+ %% Make sure that the leaked_processes/1 is always
+ %% run last.
+ leaked_processes].
%%%
%%% 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_normal = erlang:system_flag(multi_scheduling,
+ block_normal),
+ 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(normal_multi_scheduling_blockers),
+ unlink(Blocker),
+ exit(Blocker, kill),
+ receive {'DOWN', Mon, _, _, _} -> ok end,
+ enabled = erlang:system_info(multi_scheduling),
+ [] = erlang:system_info(normal_multi_scheduling_blockers),
+ ok
+ end,
+ io:format("Testing blocked~n"),
+ erlang:system_flag(multi_scheduling, block_normal),
+ case erlang:system_info(multi_scheduling) of
+ enabled ->
+ ct:fail(multi_scheduling_enabled);
+ blocked_normal ->
+ [Master] = erlang:system_info(normal_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_normal) of
+ blocked_normal -> 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) ->
@@ -197,105 +171,149 @@ 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().
+ case long_timers_test:check_result() of
+ ok -> ok;
+ high_cpu -> {comment, "Ignored failures due to high CPU utilization"};
+ missing_cpu_info -> {comment, "Ignored failures due to missing CPU utilization information"};
+ Fail -> ct:fail(Fail)
+ end.
+
-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 ->
- %% Somtimes we have fewer descriptors in the
+ %% Sometimes we have fewer descriptors in the
%% pollset at the end than when we started, but
%% 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 erts_debug:set_internal_state(available_internal_state, true),
- ?line erlang:display(erlang:system_info(check_io)),
- ?line NoOfErrorFds = erts_debug:get_internal_state(check_io_debug),
- ?line erts_debug:set_internal_state(available_internal_state, false),
- ?line 0 = NoOfErrorFds,
- ?line ok.
-
+ 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),
+ 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.
+
+leaked_processes(Config) when is_list(Config) ->
+ %% Replace the defualt timetrap with a timetrap with
+ %% known pid.
+ test_server:timetrap_cancel(),
+ Dog = test_server:timetrap(test_server:minutes(5)),
+
+ Name = leaked_processes__process_holder,
+ Name ! {get_initial_processes, self()},
+ receive
+ {initial_processes, Initial0} -> ok
+ end,
+ Initial = ordsets:from_list(Initial0),
+
+ KnownPids = ordsets:from_list([self(),Dog]),
+ Now0 = ordsets:from_list(processes()),
+ Now = ordsets:subtract(Now0, KnownPids),
+ Leaked = ordsets:subtract(Now, Initial),
+
+ _ = [begin
+ Info = process_info(P) ++ process_info(P, [current_stacktrace]),
+ io:format("~p: ~p\n", [P,Info])
+ end || P <- Leaked],
+ Comment = lists:flatten(io_lib:format("~p process(es)",
+ [length(Leaked)])),
+ {comment, Comment}.
%%
%% Internal functions...
@@ -305,7 +323,7 @@ display_check_io(ChkIo) ->
catch erlang:display('--- CHECK IO INFO ---'),
catch erlang:display(ChkIo),
catch erts_debug:set_internal_state(available_internal_state, true),
- NoOfErrorFds = (catch erts_debug:get_internal_state(check_io_debug)),
+ NoOfErrorFds = (catch element(1, erts_debug:get_internal_state(check_io_debug))),
catch erlang:display({'NoOfErrorFds', NoOfErrorFds}),
catch erts_debug:set_internal_state(available_internal_state, false),
catch erlang:display('--- CHECK IO INFO ---'),
@@ -313,16 +331,18 @@ display_check_io(ChkIo) ->
get_check_io_info() ->
ChkIo = erlang:system_info(check_io),
- case lists:keysearch(pending_updates, 1, ChkIo) of
- {value, {pending_updates, 0}} ->
+ PendUpdNo = case lists:keysearch(pending_updates, 1, ChkIo) of
+ {value, {pending_updates, PendNo}} ->
+ PendNo;
+ false ->
+ 0
+ end,
+ {value, {active_fds, ActFds}} = lists:keysearch(active_fds, 1, ChkIo),
+ case {PendUpdNo, ActFds} of
+ {0, 0} ->
display_check_io(ChkIo),
ChkIo;
- false ->
- ChkIo;
_ ->
- receive after 10 -> ok end,
+ 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 0b7c16f606..0a30553f71 100755
--- a/erts/emulator/utils/beam_makeops
+++ b/erts/emulator/utils/beam_makeops
@@ -2,18 +2,19 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1998-2012. All Rights Reserved.
+# Copyright Ericsson AB 1998-2017. 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/.
+# 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
#
-# 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.
+# 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%
#
@@ -53,6 +54,11 @@ $pack_mask[4] = ['BEAM_LOOSE_MASK', # Only for 64 bit wordsize
'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
@@ -107,7 +113,6 @@ my @if_line;
#
my $te_max_vars = 0; # Max number of variables ever needed.
my %gen_transform;
-my %min_window;
my %match_engine_ops; # All opcodes for the match engine.
my %gen_transform_offset;
my @transformations;
@@ -175,11 +180,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).
@@ -235,6 +241,21 @@ 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) {
+ $pack_mask[3] = ['BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK', $WHOLE_WORD];
+ $args_per_word[4] = 4;
+}
+
+#
# Parse the input files.
#
@@ -311,9 +332,9 @@ while (<>) {
if (/^\%macro:(.*)/) {
my($op, $macro, @flags) = split(' ', $1);
defined($macro) and $macro =~ /^-/ and
- &error("A macro must not start with a hyphen");
+ error("A macro must not start with a hyphen");
foreach (@flags) {
- /^-/ or &error("Flags for macros should start with a hyphen");
+ /^-/ or error("Flags for macros should start with a hyphen");
}
error("Macro for '$op' is already defined")
if defined $macro{$op};
@@ -326,7 +347,7 @@ while (<>) {
# Handle transformations.
#
if (/=>/) {
- &parse_transformation($_);
+ parse_transformation($_);
next;
}
@@ -336,8 +357,8 @@ while (<>) {
$op_num = undef;
if (s/^(\d+):\s*//) {
$op_num = $1;
- $op_num != 0 or &error("Opcode 0 invalid");
- &error("Opcode $op_num already defined")
+ $op_num != 0 or error("Opcode 0 invalid");
+ error("Opcode $op_num already defined")
if defined $gen_opname[$op_num];
}
@@ -348,11 +369,11 @@ while (<>) {
my($obsolete) = $1;
my($name) = $2;
my($arity) = $3;
- $name =~ /^[a-z]/ or &error("Opname must start with a lowercase letter");
+ $name =~ /^[a-z]/ or error("Opname must start with a lowercase letter");
defined $gen_arity{$name} and $gen_arity{$name} != $arity and
- &error("Opname $name already defined with arity $gen_arity{$name}");
+ error("Opname $name already defined with arity $gen_arity{$name}");
defined $unnumbered{$name,$arity} and
- &error("Opname $name already defined with arity $gen_arity{$name}");
+ error("Opname $name already defined with arity $gen_arity{$name}");
if (defined $op_num) { # Numbered generic operation
$gen_opname[$op_num] = $name;
@@ -361,7 +382,6 @@ while (<>) {
$gen_arity{$name} = $arity;
$gen_to_spec{"$name/$arity"} = undef;
$num_specific{"$name/$arity"} = 0;
- $min_window{"$name/$arity"} = 255;
$obsolete[$op_num] = defined $obsolete;
} else { # Unnumbered generic operation.
push(@unnumbered_generic, [$name, $arity]);
@@ -375,16 +395,16 @@ while (<>) {
# Name Arg1 Arg2...
#
my($name, @args) = split;
- &error("too many operands")
+ error("too many operands")
if @args > $max_spec_operands;
- &syntax_check($name, @args);
+ syntax_check($name, @args);
my $arity = @args;
if (defined $gen_opnum{$name,$arity} and $obsolete[$gen_opnum{$name,$arity}]) {
error("specific instructions may not be specified for obsolete instructions");
}
- push(@{$specific_op{"$name/$arity"}}, [$name, $hot, @args]);
+ save_specific_ops($name, $arity, $hot, @args);
if (defined $op_num) {
- &error("specific instructions must not be numbered");
+ error("specific instructions must not be numbered");
} elsif (!defined($gen_arity{$name}) && !defined($unnumbered{$name,$arity})) {
#
# Create an unumbered generic instruction too.
@@ -419,7 +439,6 @@ $num_file_opcodes = @gen_opname;
$gen_arity{$name} = $arity;
$gen_to_spec{"$name/$arity"} = undef;
$num_specific{"$name/$arity"} = 0;
- $min_window{"$name/$arity"} = 255;
}
}
@@ -427,7 +446,7 @@ $num_file_opcodes = @gen_opname;
# Produce output for the chosen target.
#
-&$target;
+&$target();
#
# Produce output needed by the emulator/loader.
@@ -443,7 +462,7 @@ sub emulator_output {
#
$name = "$outdir/beam_opcodes.c";
open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n";
- &comment('C');
+ comment('C');
print "#ifdef HAVE_CONFIG_H\n";
print "# include \"config.h\"\n";
print "#endif\n\n";
@@ -456,7 +475,7 @@ sub emulator_output {
print '#include "beam_load.h"', "\n";
print "\n";
- print "char tag_to_letter[] = {\n ";
+ print "const char tag_to_letter[] = {\n ";
for ($i = 0; $i < length($genop_types); $i++) {
print "'$tag_type[$i]', ";
}
@@ -470,7 +489,7 @@ sub emulator_output {
# Generate code for specific ops.
#
my($spec_opnum) = 0;
- print "OpEntry opc[] = {\n";
+ print "const OpEntry opc[] = {\n";
foreach $key (sort keys %specific_op) {
$gen_to_spec{$key} = $spec_opnum;
$num_specific{$key} = @{$specific_op{$key}};
@@ -506,7 +525,7 @@ sub emulator_output {
# Call a generator to calculate size and generate macros
# for the emulator.
#
- my($size, $code, $pack) = &basic_generator($name, $hot, @args);
+ my($size, $code, $pack) = basic_generator($name, $hot, @args);
#
# Save the generated $code for later.
@@ -526,12 +545,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;
@@ -543,25 +566,34 @@ sub emulator_output {
$sep = ",";
}
$init .= "}";
- &init_item($print_name, $init, $size, $pack, $sign, 0);
+ init_item($print_name, $init, $involves_r, $size, $pack, $sign);
$op_to_name[$spec_opnum] = $instr;
$spec_opnum++;
}
}
print "};\n\n";
- print "int num_instructions = $spec_opnum;\n\n";
+ print "const int num_instructions = $spec_opnum;\n\n";
+
+ #
+ # Print the array for instruction counts.
+ #
+
+ print "#ifdef ERTS_OPCODE_COUNTER_SUPPORT\n";
+ print "Uint erts_instr_count[$spec_opnum];\n";
+ print "#endif\n";
+ print "\n";
#
# Generate transformations.
#
- &tr_gen(@transformations);
+ tr_gen(@transformations);
#
# Print the generic instruction table.
#
- print "GenOpEntry gen_opc[] = {\n";
+ print "const GenOpEntry gen_opc[] = {\n";
for ($i = 0; $i < @gen_opname; $i++) {
if ($i == $num_file_opcodes) {
print "\n/*\n * Internal generic instructions.\n */\n\n";
@@ -570,7 +602,7 @@ sub emulator_output {
my($arity) = $gen_arity[$i];
printf "/* %3d */ ", $i;
if (!defined $name) {
- &init_item("", 0, 0, 0, -1);
+ init_item("", 0, 0, 0, -1);
} else {
my($key) = "$name/$arity";
my($tr) = defined $gen_transform_offset{$key} ?
@@ -582,7 +614,7 @@ sub emulator_output {
$is_transformed{$name,$arity} or
error("instruction $key has no specific instruction");
$spec_op = -1 unless defined $spec_op;
- &init_item($name, $arity, $spec_op, $num_specific, $tr, $min_window{$key});
+ init_item($name, $arity, $spec_op, $num_specific, $tr);
}
}
print "};\n";
@@ -592,7 +624,7 @@ sub emulator_output {
#
$name = "$outdir/beam_opcodes.h";
open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n";
- &comment('C');
+ comment('C');
print "#ifndef __OPCODES_H__\n";
print "#define __OPCODES_H__\n\n";
@@ -600,24 +632,27 @@ 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_WIDE_SHIFT 32\n";
- print "# define BEAM_LOOSE_SHIFT 16\n";
- print "# define BEAM_TIGHT_SHIFT 16\n";
- print "#else\n";
- print "# define BEAM_LOOSE_MASK 0xFFF\n";
- print "# define BEAM_TIGHT_MASK 0xFFC\n";
- print "# define BEAM_LOOSE_SHIFT 16\n";
- print "# define BEAM_TIGHT_SHIFT 10\n";
- print "#endif\n";
+ if ($wordsize == 32) {
+ print "#if defined(ARCH_64)\n";
+ print qq[ #error "32-bit architecture assumed, but ARCH_64 is defined"\n];
+ print "#endif\n";
+ print "#define BEAM_LOOSE_MASK 0xFFF\n";
+ print "#define BEAM_TIGHT_MASK 0xFFC\n";
+ print "#define BEAM_LOOSE_SHIFT 16\n";
+ print "#define BEAM_TIGHT_SHIFT 10\n";
+ } elsif ($wordsize == 64) {
+ print "#if !defined(ARCH_64)\n";
+ print qq[ #error "64-bit architecture assumed, but ARCH_64 not defined"\n];
+ print "#endif\n";
+ print "#define BEAM_WIDE_MASK 0xFFFFUL\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";
+ }
print "\n";
#
@@ -627,14 +662,14 @@ sub emulator_output {
my $letter;
my $tag_num = 0;
- &comment('C', "The following operand types for generic instructions",
+ comment('C', "The following operand types for generic instructions",
"occur in beam files.");
foreach $letter (split('', $compiler_types)) {
print "#define TAG_$letter $tag_num\n";
$tag_num++;
}
print "\n";
- &comment('C', "The following operand types are only used in the loader.");
+ comment('C', "The following operand types are only used in the loader.");
foreach $letter (split('', $loader_types)) {
print "#define TAG_$letter $tag_num\n";
$tag_num++;
@@ -652,8 +687,8 @@ sub emulator_output {
print "#define TE_MAX_VARS $te_max_vars\n";
print "\n";
- print "extern char tag_to_letter[];\n";
- print "extern Uint op_transform[];\n";
+ print "extern const char tag_to_letter[];\n";
+ print "extern const Uint op_transform[];\n";
print "\n";
for ($i = 0; $i < @op_to_name; $i++) {
@@ -682,7 +717,7 @@ sub emulator_output {
print "#define DEFINE_COUNTING_LABELS";
for ($i = 0; $i < @op_to_name; $i++) {
my($name) = $op_to_name[$i];
- print " \\\nCountCase($name): opc[$i].count++; goto lb_$name;";
+ print " \\\nCountCase($name): erts_instr_count[$i]++; goto lb_$name;";
}
print "\n\n";
@@ -701,26 +736,26 @@ sub emulator_output {
$name = "$outdir/beam_tr_funcs.h";
open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n";
- &comment('C');
- &tr_gen_call(@call_table);
+ comment('C');
+ tr_gen_call(@call_table);
$name = "$outdir/beam_pred_funcs.h";
open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n";
- &comment('C');
- &tr_gen_call(@pred_table);
+ comment('C');
+ tr_gen_call(@pred_table);
#
# Implementation of operations for emulator.
#
$name = "$outdir/beam_hot.h";
open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n";
- &comment('C');
- &print_code(\%hot_code);
+ comment('C');
+ print_code(\%hot_code);
$name = "$outdir/beam_cold.h";
open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n";
- &comment('C');
- &print_code(\%cold_code);
+ comment('C');
+ print_code(\%cold_code);
}
@@ -733,7 +768,7 @@ sub init_item {
print "${sep}NULL";
} elsif (/^\{/) {
print "$sep$_";
- } elsif (/^-?\d/) {
+ } elsif (/^-?\d+$/) {
print "$sep$_";
} else {
print "$sep\"$_\"";
@@ -783,7 +818,7 @@ sub compiler_output {
open(STDOUT, ">$outdir/$name") || die "Failed to open $name for writing: $!\n";
print "-module($module).\n";
- &comment('erlang');
+ comment('erlang');
print "-export([format_number/0]).\n";
print "-export([opcode/2,opname/1]).\n";
@@ -795,7 +830,7 @@ sub compiler_output {
for ($i = 0; $i < @gen_opname; $i++) {
next unless defined $gen_opname[$i];
print "%%" if $obsolete[$i];
- print "opcode(", &quote($gen_opname[$i]), ", $gen_arity[$i]) -> $i;\n";
+ print "opcode(", quote($gen_opname[$i]), ", $gen_arity[$i]) -> $i;\n";
}
print "opcode(Name, Arity) -> erlang:error(badarg, [Name,Arity]).\n\n";
@@ -803,7 +838,7 @@ sub compiler_output {
for ($i = 0; $i < @gen_opname; $i++) {
next unless defined $gen_opname[$i];
print "opname($i) -> {",
- &quote($gen_opname[$i]), ",$gen_arity[$i]};\n";
+ quote($gen_opname[$i]), ",$gen_arity[$i]};\n";
}
print "opname(Number) -> erlang:error(badarg, [Number]).\n";
@@ -812,7 +847,7 @@ sub compiler_output {
#
my($hrl_name) = "$outdir/${module}.hrl";
open(STDOUT, ">$hrl_name") || die "Failed to open $hrl_name for writing: $!\n";
- &comment('erlang');
+ comment('erlang');
for ($i = 0; $i < @tag_type && $i < 8; $i++) {
print "-define(tag_$tag_type[$i], $i).\n";
@@ -828,11 +863,33 @@ sub syntax_check {
my($name, @args) = @_;
my($i);
- &error("Bad opcode name '$name'")
+ error("Bad opcode name '$name'")
unless $name =~ /^[a-z][\w\d_]*$/;
for ($i = 0; $i < @args; $i++) {
- &error("Argument " . ($i+1) . ": invalid type '$args[$i]'")
- unless defined $arg_size{$args[$i]};
+ foreach my $type (split(//, $args[$i])) {
+ error("Argument " . ($i+1) . ": invalid type '$type'")
+ unless defined $arg_size{$type};
+ }
+ }
+}
+
+sub save_specific_ops {
+ my($name,$arity,$hot,@args) = @_;
+ my(@res) = ("");
+
+ foreach my $arg (@args) {
+ my @new_res = ();
+ foreach my $type (split(//, $arg)) {
+ foreach my $args (@res) {
+ push @new_res, "$args$type";
+ }
+ }
+ @res = @new_res;
+ }
+ my $key = "$name/$arity";
+ foreach my $args (@res) {
+ @args = split //, $args;
+ push @{$specific_op{$key}}, [$name,$hot,@args];
}
}
@@ -893,8 +950,8 @@ sub basic_generator {
my($tmp_arg_num) = 1;
my($pack_spec) = '';
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,
@@ -928,7 +985,7 @@ sub basic_generator {
#
if ($flags =~ /-pack/ && $hot) {
- ($prefix, $pack_spec, @args) = &do_pack(@args);
+ ($prefix, $pack_spec, @args) = do_pack(@args);
}
#
@@ -958,11 +1015,11 @@ sub basic_generator {
push(@f_types, $_);
$prefix .= "GetR($size, $tmp);\n";
last SWITCH; };
- /d/ and do { $var_decls .= "Eterm dst; ";
- push(@f, "dst");
+ /d/ and do { $var_decls .= "Eterm dst; Eterm* dst_ptr; ";
+ push(@f, "*dst_ptr");
push(@f_types, $_);
$prefix .= "dst = Arg($size);\n";
- $gen_dest_arg = 'StoreResult';
+ $prefix .= "dst_ptr = REG_TARGET_PTR(dst);\n";
last SWITCH;
};
defined($incl_arg{$_})
@@ -981,18 +1038,11 @@ sub basic_generator {
}
#
- # If requested, pass a pointer to the destination register.
- # The destination must be the last operand.
- #
- if ($flags =~ /-gen_dest/) {
- push(@f, $gen_dest_arg);
- }
-
- #
# Add a fail action macro if requested.
#
$flags =~ /-fail_action/ and do {
+ $no_prefetch = 1;
if (!defined $fail_type) {
my($i);
for ($i = 0; $i < @f_types; $i++) {
@@ -1039,6 +1089,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",
@@ -1060,6 +1116,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'
@@ -1080,6 +1137,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;
}
@@ -1089,7 +1158,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) = '';
@@ -1097,14 +1165,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;
@@ -1146,7 +1208,7 @@ sub do_pack {
}
$down = "$instr[$ap]$down";
- my($unpack) = &make_unpack($tmpnum, $shift[$ap], $mask[$ap]);
+ my($unpack) = make_unpack($tmpnum, $shift[$ap], $mask[$ap]);
$args[$i] = "pack:$this_size:$reg" . "b($unpack)";
if (++$ap == $args_per_word) {
@@ -1210,7 +1272,7 @@ sub parse_transformation {
foreach (@from) {
if (/^(\w+)\((.*?)\)/) {
my($name, $arglist) = ($1, $2);
- $_ = (&compile_transform_function($name, split(/\s*,\s*/, $arglist)));
+ $_ = (compile_transform_function($name, split(/\s*,\s*/, $arglist)));
} else {
(@op) = split;
($rest_var,$_) = compile_transform(1, $rest_var, @op);
@@ -1226,7 +1288,7 @@ sub parse_transformation {
my @to;
if ($to =~ /^(\w+)\((.*?)\)/) {
my($name, $arglist) = ($1, $2);
- @to = (&compile_transform_function($name, split(/\s*,\s*/, $arglist)));
+ @to = (compile_transform_function($name, split(/\s*,\s*/, $arglist)));
} else {
@to = split(/\s*\|\s*/, $to);
foreach (@to) {
@@ -1248,7 +1310,7 @@ sub compile_transform {
my $arity = 0;
foreach (@ops) {
- my(@list) = &tr_parse_op($src, $_);
+ my(@list) = tr_parse_op($src, $_);
if ($list[1] eq '*') {
$rest_var = $list[0];
} elsif (defined $rest_var and $list[0] eq $rest_var) {
@@ -1285,7 +1347,7 @@ sub tr_parse_op {
if (/^([A-Z]\w*)(.*)/) {
$var = $1;
$_ = $2;
- &error("garbage after variable")
+ error("garbage after variable")
unless /^=(.*)/ or /^(\s*)$/;
$_ = $1;
}
@@ -1296,8 +1358,10 @@ sub tr_parse_op {
$type = $1;
$_ = $2;
foreach (split('', $type)) {
- &error("bad type in $op")
+ error("bad type in $op")
unless defined $type_bit{$_} or $type eq '*';
+ $_ eq 'r' and
+ error("$op: 'r' is not allowed in transformations")
}
}
@@ -1331,14 +1395,17 @@ 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;
$_ = '';
}
# Nothing more is allowed after the command.
- &error("garbage '$_' after operand: $op")
+ error("garbage '$_' after operand: $op")
unless /^\s*$/;
# Test that destination has no conditions.
@@ -1350,11 +1417,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);
}
@@ -1369,8 +1431,7 @@ sub tr_gen {
foreach $ref (@g) {
my($line, $orig_transform, $from_ref, $to_ref) = @$ref;
- my $used_ref = used_vars($from_ref, $to_ref);
- my $so_far = tr_gen_from($line, $used_ref, @$from_ref);
+ my $so_far = tr_gen_from($line, @$from_ref);
tr_gen_to($line, $orig_transform, $so_far, @$to_ref);
}
@@ -1378,7 +1439,7 @@ sub tr_gen {
# Print the generated transformation engine.
#
my($offset) = 0;
- print "Uint op_transform[] = {\n";
+ print "const Uint op_transform[] = {\n";
foreach $key (sort keys %gen_transform) {
$gen_transform_offset{$key} = $offset;
my @instr = @{$gen_transform{$key}};
@@ -1421,58 +1482,14 @@ sub tr_gen {
print "};\n\n";
}
-sub used_vars {
- my($from_ref,$to_ref) = @_;
- my %used;
- my %seen;
-
- foreach my $ref (@$from_ref) {
- my($name,$arity,@ops) = @$ref;
- if ($name =~ /^[.]/) {
- foreach my $var (@ops) {
- $used{$var} = 1;
- }
- } else {
- # Any variable that is used at least twice on the
- # left-hand side is used. (E.g. "move R R".)
- foreach my $op (@ops) {
- my($var, $type, $type_val) = @$op;
- next if $var eq '';
- $used{$var} = 1 if $seen{$var};
- $seen{$var} = 1;
- }
- }
- }
-
- foreach my $ref (@$to_ref) {
- my($name, $arity, @ops) = @$ref;
- if ($name =~ /^[.]/) {
- foreach my $var (@ops) {
- $used{$var} = 1;
- }
- } else {
- foreach my $op (@ops) {
- my($var, $type, $type_val) = @$op;
- next if $var eq '';
- $used{$var} = 1;
- }
- }
- }
- \%used;
-}
-
sub tr_gen_from {
- my($line,$used_ref,@tr) = @_;
+ my($line,@tr) = @_;
my(%var) = ();
my(%var_type);
my($var_num) = 0;
my(@code);
- my($min_window) = 0;
- my(@fix_rest_args);
- my(@fix_pred_funcs);
my($op, $ref); # Loop variables.
my $where = "left side of transformation in line $line: ";
- my %var_used = %$used_ref;
my $may_fail = 0;
my $is_first = 1;
@@ -1494,8 +1511,20 @@ sub tr_gen_from {
my $var;
my(@args);
- push(@fix_pred_funcs, scalar(@code));
- push(@code, [$name, @ops]);
+ foreach $var (@ops) {
+ error($where, "variable '$var' unbound")
+ unless defined $var{$var};
+ if ($var_type{$var} eq 'scalar') {
+ push(@args, "var[$var{$var}]");
+ } else {
+ push(@args, "rest_args");
+ }
+ }
+ my $pi = tr_next_index(\@pred_table, \%pred_table, $name, @args);
+ my $op = make_op("$name()", 'pred', $pi);
+ my @slots = grep(/^\d+/, map { $var{$_} } @ops);
+ op_slot_usage($op, @slots);
+ push(@code, $op);
next;
}
@@ -1503,12 +1532,11 @@ sub tr_gen_from {
# Check that $name/$arity refers to a valid generic instruction.
#
- &error($where, "invalid generic op $name/$arity")
+ error($where, "invalid generic op $name/$arity")
unless defined $gen_opnum{$name,$arity};
$opnum = $gen_opnum{$name,$arity};
push(@code, make_op("$name/$arity", 'next_instr', $opnum));
- $min_window++;
foreach $op (@ops) {
my($var, $type, $type_val, $cond, $val) = @$op;
my $ignored_var = "$var (ignored)";
@@ -1532,11 +1560,11 @@ sub tr_gen_from {
$type_mask |= $type_bit{$_};
}
if ($cond ne 'is_eq') {
- push(@code, &make_op($types, 'is_type', $type_mask));
+ push(@code, make_op($types, 'is_type', $type_mask));
} else {
$cond = '';
- push(@code, &make_op("$types== $val", 'is_type_eq',
- $type_mask, $val));
+ push(@code, make_op("$types== $val", 'is_type_eq',
+ $type_mask, $val));
}
}
}
@@ -1545,32 +1573,38 @@ sub tr_gen_from {
my($m, $f, $a) = split(/:/, $val);
$ignored_var = '';
$may_fail = 1;
- push(@code, &make_op('', "$cond", "am_$m",
+ push(@code, make_op('', "$cond", "am_$m",
"am_$f", $a));
} elsif ($cond ne '') {
$ignored_var = '';
$may_fail = 1;
- push(@code, &make_op('', "$cond", $val));
+ push(@code, make_op('', "$cond", $val));
}
if ($var ne '') {
if (defined $var{$var}) {
$ignored_var = '';
$may_fail = 1;
- push(@code, &make_op($var, 'is_same_var', $var{$var}));
+ my $op = make_op($var, 'is_same_var', $var{$var});
+ op_slot_usage($op, $var{$var});
+ push(@code, $op);
} elsif ($type eq '*') {
- #
- # Reserve a hole for a 'rest_args' instruction.
- #
+ foreach my $type (values %var_type) {
+ error("only one use of a '*' variable is " .
+ "allowed on the left hand side of " .
+ "a transformation")
+ if $type eq 'array';
+ }
$ignored_var = '';
- push(@fix_rest_args, scalar(@code));
- push(@code, $var);
- } elsif ($var_used{$var}) {
+ $var{$var} = 'unnumbered';
+ $var_type{$var} = 'array';
+ push(@code, make_op($var, 'rest_args'));
+ } else {
$ignored_var = '';
$var_type{$var} = 'scalar';
$var{$var} = $var_num;
$var_num++;
- push(@code, &make_op($var, 'set_var', $var{$var}));
+ push(@code, make_op($var, 'set_var', $var{$var}));
}
}
if (is_instr($code[$#code], 'set_var')) {
@@ -1579,7 +1613,7 @@ sub tr_gen_from {
my $var = $ref->[1][1];
push(@code, make_op($comment, 'set_var_next_arg', $var));
} else {
- push(@code, &make_op($ignored_var, 'next_arg'));
+ push(@code, make_op($ignored_var, 'next_arg'));
}
}
@@ -1593,46 +1627,14 @@ sub tr_gen_from {
#
push(@code, make_op($may_fail ? '' : 'always reached', 'commit'));
- #
- # If there is an rest_args instruction, we must insert its correct
- # variable number (higher than any other).
- #
- my $index;
- &error("only one use of a '*' variable is allowed on the left hand side of a transformation")
- if @fix_rest_args > 1;
- foreach $index (@fix_rest_args) {
- my $var = $code[$index];
- $var{$var} = $var_num++;
- $var_type{$var} = 'array';
- splice(@code, $index, 1, &make_op($var, 'rest_args', $var{$var}));
- }
-
- foreach $index (@fix_pred_funcs) {
- my($name, @ops) = @{$code[$index]};
- my(@args);
- my $var;
-
- foreach $var (@ops) {
- &error($where, "variable '$var' unbound")
- unless defined $var{$var};
- if ($var_type{$var} eq 'scalar') {
- push(@args, "var[$var{$var}]");
- } else {
- push(@args, "var+$var{$var}");
- }
- }
- my $pi = tr_next_index(\@pred_table, \%pred_table, $name, @args);
- splice(@code, $index, 1, make_op("$name()", 'pred', $pi));
- }
-
$te_max_vars = $var_num
if $te_max_vars < $var_num;
- [$min_window, \%var, \%var_type, \@code];
+ [\%var, \%var_type, \@code];
}
sub tr_gen_to {
my($line, $orig_transform, $so_far, @tr) = @_;
- my($min_window, $var_ref, $var_type_ref, $code_ref) = @$so_far;
+ my($var_ref, $var_type_ref, $code_ref) = @$so_far;
my(%var) = %$var_ref;
my(%var_type) = %$var_type_ref;
my(@code) = @$code_ref;
@@ -1656,18 +1658,21 @@ sub tr_gen_to {
my(@args);
foreach $var (@ops) {
- &error($where, "variable '$var' unbound")
+ error($where, "variable '$var' unbound")
unless defined $var{$var};
if ($var_type{$var} eq 'scalar') {
push(@args, "var[$var{$var}]");
} else {
- push(@args, "var+$var{$var}");
+ push(@args, "rest_args");
}
}
pop(@code); # Get rid of 'commit' instruction
my $index = tr_next_index(\@call_table, \%call_table,
$name, @args);
- push(@code, make_op("$name()", 'call_end', $index));
+ my $op = make_op("$name()", 'call_end', $index);
+ my @slots = grep(/^\d+/, map { $var{$_} } @ops);
+ op_slot_usage($op, @slots);
+ push(@code, $op);
last;
}
@@ -1676,7 +1681,7 @@ sub tr_gen_to {
#
my($key) = "$name/$arity";
- &error($where, "invalid generic op $name/$arity")
+ error($where, "invalid generic op $name/$arity")
unless defined $gen_opnum{$name,$arity};
my $opnum = $gen_opnum{$name,$arity};
@@ -1689,15 +1694,17 @@ sub tr_gen_to {
my($var, $type, $type_val) = @$op;
if ($type eq '*') {
- push(@code, make_op($var, 'store_rest_args', $var{$var}));
+ push(@code, make_op($var, 'store_rest_args'));
} elsif ($var ne '') {
- &error($where, "variable '$var' unbound")
+ error($where, "variable '$var' unbound")
unless defined $var{$var};
- push(@code, &make_op($var, 'store_var_next_arg', $var{$var}));
+ my $op = make_op($var, 'store_var_next_arg', $var{$var});
+ op_slot_usage($op, $var{$var});
+ push(@code, $op);
} elsif ($type ne '') {
- push(@code, &make_op('', 'store_type', "TAG_$type"));
+ push(@code, make_op('', 'store_type', "TAG_$type"));
if ($type_val) {
- push(@code, &make_op('', 'store_val', $type_val));
+ push(@code, make_op('', 'store_val', $type_val));
}
push(@code, make_op('', 'next_arg'));
}
@@ -1708,6 +1715,10 @@ sub tr_gen_to {
push(@code, make_op('', 'end'))
unless is_instr($code[$#code], 'call_end');
+ tr_maybe_keep(\@code);
+ tr_maybe_rename(\@code);
+ tr_remove_unused(\@code);
+
#
# Chain together all codes segments having the same first operation.
#
@@ -1716,8 +1727,6 @@ sub tr_gen_to {
my($dummy, $arity);
($dummy, $op, $arity) = @$first;
my($comment) = "\n/*\n * Line $line:\n * $orig_transform\n */\n\n";
- $min_window{$key} = $min_window
- if $min_window{$key} > $min_window;
my $prev_last;
$prev_last = pop(@{$gen_transform{$key}})
@@ -1735,6 +1744,148 @@ sub tr_gen_to {
push(@{$gen_transform{$key}}, @code),
}
+sub tr_maybe_keep {
+ my($ref) = @_;
+ my @last_instr;
+ my $pos;
+ my $reused_instr;
+
+ for (my $i = 0; $i < @$ref; $i++) {
+ my $instr = $$ref[$i];
+ my($size, $instr_ref, $comment) = @$instr;
+ my($op, @args) = @$instr_ref;
+ if ($op eq 'next_instr') {
+ @last_instr = ($args[0]);
+ } elsif ($op eq 'set_var_next_arg') {
+ push @last_instr, $args[0];
+ } elsif ($op eq 'next_arg') {
+ push @last_instr, 'ignored';
+ } elsif ($op eq 'new_instr') {
+ unless (defined $pos) {
+ # 'new_instr' immediately after 'commit'.
+ $reused_instr = $args[0];
+ return unless shift(@last_instr) == $reused_instr;
+ $pos = $i - 1;
+ } else {
+ # Second 'new_instr' after 'commit'. The instructions
+ # from $pos up to and including $i - 1 rebuilds the
+ # existing instruction exactly.
+ my $name = $gen_opname[$reused_instr];
+ my $arity = $gen_arity[$reused_instr];
+ my $reuse = make_op("$name/$arity", 'keep');
+ splice @$ref, $pos, $i-$pos, ($reuse);
+ return;
+ }
+ } elsif ($op eq 'store_var_next_arg') {
+ return unless shift(@last_instr) eq $args[0];
+ } elsif (defined $pos) {
+ return;
+ }
+ }
+}
+
+sub tr_maybe_rename {
+ my($ref) = @_;
+ my $s = 'left';
+ my $a = 0;
+ my $num_args = 0;
+ my $new_instr;
+ my $first;
+ my $i;
+
+ for ($i = 1; $i < @$ref; $i++) {
+ my $instr = $$ref[$i];
+ my($size, $instr_ref, $comment) = @$instr;
+ my($op, @args) = @$instr_ref;
+
+ if ($s eq 'left') {
+ if ($op eq 'set_var_next_arg') {
+ if ($num_args == $a and $args[0] == $a) {
+ $num_args++;
+ }
+ $a++;
+ } elsif ($op eq 'next_arg') {
+ $a++;
+ } elsif ($op eq 'commit') {
+ $a = 0;
+ $first = $i;
+ $s = 'committed';
+ } elsif ($op eq 'next_instr') {
+ return;
+ }
+ } elsif ($s eq 'committed') {
+ if ($op eq 'new_instr') {
+ $new_instr = $args[0];
+ $a = 0;
+ $s = 'right';
+ } else {
+ return;
+ }
+ } elsif ($s eq 'right') {
+ if ($op eq 'store_var_next_arg' && $args[0] == $a) {
+ $a++;
+ } elsif ($op eq 'end' && $a <= $num_args) {
+ my $name = $gen_opname[$new_instr];
+ my $arity = $gen_arity[$new_instr];
+ my $new_op = make_op("$name/$arity", 'rename', $new_instr);
+ splice @$ref, $first, $i-$first+1, ($new_op);
+ return;
+ } else {
+ return;
+ }
+ }
+ }
+}
+
+sub tr_remove_unused {
+ my($ref) = @_;
+ my %used;
+
+ # Collect all used variables.
+ for my $instr (@$ref) {
+ my $uref = $$instr[3];
+ for my $slot (@$uref) {
+ $used{$slot} = 1;
+ }
+ }
+
+ # Replace 'set_var_next_arg' with 'next_arg' if the variable
+ # is never used.
+ for my $instr (@$ref) {
+ my($size, $instr_ref, $comment) = @$instr;
+ my($op, @args) = @$instr_ref;
+ if ($op eq 'set_var_next_arg') {
+ my $var = $args[0];
+ next if $used{$var};
+ $instr = make_op("$comment (ignored)", 'next_arg');
+ }
+ }
+
+ # Delete a sequence of 'next_arg' instructions when they are
+ # redundant before instructions such as 'commit'.
+ my @opcode;
+ my %ending = (call_end => 1,
+ commit => 1,
+ next_instr => 1,
+ pred => 1,
+ rename => 1,
+ keep => 1);
+ for (my $i = 0; $i < @$ref; $i++) {
+ my $instr = $$ref[$i];
+ my($size, $instr_ref, $comment) = @$instr;
+ my($opcode) = @$instr_ref;
+
+ if ($ending{$opcode}) {
+ my $first = $i;
+ $first-- while $first > 0 and $opcode[$first-1] eq 'next_arg';
+ my $n = $i - $first;
+ splice @$ref, $first, $n;
+ $i -= $n;
+ }
+ $opcode[$i] = $opcode;
+ }
+}
+
sub tr_code_len {
my($sum) = 0;
my($ref);
@@ -1747,7 +1898,12 @@ sub tr_code_len {
sub make_op {
my($comment, @op) = @_;
- [scalar(@op), [@op], $comment];
+ [scalar(@op), [@op], $comment, []];
+}
+
+sub op_slot_usage {
+ my($op_ref, @slots) = @_;
+ $$op_ref[3] = \@slots;
}
sub is_instr {
diff --git a/erts/emulator/utils/beam_strip b/erts/emulator/utils/beam_strip
index 1ce0fea180..2a2d761940 100755
--- a/erts/emulator/utils/beam_strip
+++ b/erts/emulator/utils/beam_strip
@@ -2,18 +2,19 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2001-2009. All Rights Reserved.
+# Copyright Ericsson AB 2001-2016. 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.
+# 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%
#
diff --git a/erts/emulator/utils/count b/erts/emulator/utils/count
index 617f5c25e8..e0a5e8bb9a 100755
--- a/erts/emulator/utils/count
+++ b/erts/emulator/utils/count
@@ -2,18 +2,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1998-2016. 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/.
+%% 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
%%
-%% 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.
+%% 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%
%%
diff --git a/erts/emulator/utils/gen_git_version b/erts/emulator/utils/gen_git_version
index ef06a4b8e2..9faf015b62 100755
--- a/erts/emulator/utils/gen_git_version
+++ b/erts/emulator/utils/gen_git_version
@@ -5,9 +5,9 @@ OUTPUT_FILE=$1
if command -v git 2>&1 >/dev/null &&
test -d $ERL_TOP/.git -o -f $ERL_TOP/.git
then
- VSN=`git describe --match "OTP_R[0-9][0-9][A-B]*" HEAD`
+ VSN=`git describe --match "OTP-[0-9]*" HEAD`
case "$VSN" in
- OTP_R*-g*)
+ OTP-*-g*)
VSN=`echo $VSN | sed -e 's/.*-g\\(.*\\)/\\1/g'` ;;
*) VSN="na" ;;
esac
@@ -36,4 +36,4 @@ then
fi
exit 0
fi
-exit 1 \ No newline at end of file
+exit 1
diff --git a/erts/emulator/utils/loaded b/erts/emulator/utils/loaded
index d124a64a78..5e0a29c014 100644
--- a/erts/emulator/utils/loaded
+++ b/erts/emulator/utils/loaded
@@ -2,18 +2,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2011. All Rights Reserved.
+%% Copyright Ericsson AB 1998-2016. 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/.
+%% 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
%%
-%% 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.
+%% 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%
%%
diff --git a/erts/emulator/utils/make_alloc_types b/erts/emulator/utils/make_alloc_types
index 53051b7692..33afe139a2 100755
--- a/erts/emulator/utils/make_alloc_types
+++ b/erts/emulator/utils/make_alloc_types
@@ -3,18 +3,19 @@
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2003-2009. All Rights Reserved.
+# Copyright Ericsson AB 2003-2016. 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.
+# 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%
@@ -190,16 +191,17 @@ print DST "/*
*
* Copyright Ericsson AB ", (1900 + (localtime)[5]), ". 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.
+ * 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.
*
*/
@@ -244,7 +246,7 @@ print DST "
print DST "#define ERTS_ALC_C_MIN ($c_no)\n\n";
-foreach my $c (keys(%c_tab)) {
+foreach my $c (sort keys(%c_tab)) {
push(@c_order, $c);
set_number($c_tab{$c}, $c_no);
print DST "#define ERTS_ALC_C_$c ($c_no)\n";
diff --git a/erts/emulator/utils/make_compiler_flags b/erts/emulator/utils/make_compiler_flags
index cebe8cd0c5..47491a4832 100755
--- a/erts/emulator/utils/make_compiler_flags
+++ b/erts/emulator/utils/make_compiler_flags
@@ -2,18 +2,19 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1999-2009. All Rights Reserved.
+# Copyright Ericsson AB 1999-2016. 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/.
+# 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
#
-# 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.
+# 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%
#
@@ -70,7 +71,7 @@ my($prog) = $prog[$#prog];
print "/* Warning: Do not edit this file.\n";
print " Auto-generated by '$prog'.*/\n";
-foreach(keys %constants) {
+foreach (sort(keys %constants)) {
print "const char* erts_build_flags_$_ = \"$constants{$_}\";\n"
}
diff --git a/erts/emulator/utils/make_driver_tab b/erts/emulator/utils/make_driver_tab
index 5c68143d58..ffb5f58ebf 100755
--- a/erts/emulator/utils/make_driver_tab
+++ b/erts/emulator/utils/make_driver_tab
@@ -2,18 +2,19 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1999-2013. All Rights Reserved.
+# Copyright Ericsson AB 1999-2016. 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.
+# 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%
#
@@ -30,7 +31,7 @@ my $file = "";
my $nif = "";
my @emu_drivers = ();
my @static_drivers = ();
-my @nifs = ();
+my @static_nifs = ();
my $mode = 1;
while (@ARGV) {
@@ -54,9 +55,14 @@ while (@ARGV) {
push(@static_drivers, $d);
}
if ($mode == 2) {
- push(@nifs, $d);
+ push(@static_nifs, $d);
}
next;
+ } elsif ($mode == 2) {
+ $d = basename $d;
+ $d =~ s/_nif(\..*|)$//; # strip nif.* or just nif
+ push(@static_nifs, $d);
+ next;
}
$d = basename $d;
$d =~ s/drv(\..*|)$//; # strip drv.* or just drv
@@ -119,7 +125,7 @@ typedef struct ErtsStaticNifEntry_ {
EOF
# prototypes
-foreach (@nifs) {
+foreach (@static_nifs) {
my $d = ${_};
$d =~ s/\.debug//; # strip .debug
print "void *".$d."_nif_init(void);\n";
@@ -128,7 +134,7 @@ foreach (@nifs) {
# The array itself
print "static ErtsStaticNifEntry static_nif_tab[] =\n{\n";
-foreach (@nifs) {
+foreach (@static_nifs) {
my $d = ${_};
$d =~ s/\.debug//; # strip .debug
print "{\"${_}\",&".$d."_nif_init},\n";
diff --git a/erts/emulator/utils/make_preload b/erts/emulator/utils/make_preload
index fade9829ca..0cd3509b62 100755
--- a/erts/emulator/utils/make_preload
+++ b/erts/emulator/utils/make_preload
@@ -2,18 +2,19 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1999-2012. All Rights Reserved.
+# Copyright Ericsson AB 1999-2017. 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.
+# 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%
#
@@ -89,12 +90,12 @@ foreach $file (@ARGV) {
open(FILE, $file) or error("failed to read $file: $!");
binmode(FILE);
$_ = <FILE>;
- $_ = beam_strip($_);
+ $_ = beam_strip($_, $file);
close(FILE);
push(@modules, " {\"$module\", " . length($_) . ", preloaded_$module},\n");
- print "unsigned preloaded_size_$module = ", length($_), ";\n";
- print "unsigned char preloaded_$module", "[] = {\n";
+ print "const unsigned preloaded_size_$module = ", length($_), ";\n";
+ print "const unsigned char preloaded_$module", "[] = {\n";
for ($i = 0; $i < length($_); $i++) {
if ($i % 8 == 0 && $comment ne '') {
$comment =~ s@/\*@..@g; # Comment start -- avoid warning.
@@ -124,10 +125,10 @@ if ($gen_rc) {
print @modules;
print "END\n";
} elsif ($gen_old) {
- print "struct {\n";
+ print "const struct {\n";
print " char* name;\n";
print " int size;\n";
- print " unsigned char* code;\n";
+ print " const unsigned char* code;\n";
print "} pre_loaded[] = {\n";
foreach (@modules) {
print;
@@ -146,20 +147,20 @@ sub error {
}
sub beam_strip {
- my($beam) = @_;
+ my($beam,$file) = @_;
my $size_left = length($beam);
my %chunk;
my %needed_chunk = ('Code' => 1,
- 'Atom' => 1,
+ 'AtU8' => 1,
'ImpT' => 1,
'ExpT' => 1,
'StrT' => 1,
'FunT' => 1,
'LitT' => 1);
- die "can't read Beam files for OTP R4 or earlier (sorry)"
+ die "$file: can't read Beam files for OTP R4 or earlier (sorry)"
if $beam =~ /^\x7fBEAM!/;
#
@@ -176,7 +177,7 @@ sub beam_strip {
die "form size $size greater than size ", $size_left, " of module"
if $size > $size_left;
$size_left -= 4;
- die "not a BEAM file: IFF form type is not 'BEAM'"
+ die "$file: not a BEAM file: IFF form type is not 'BEAM'"
unless $beam_id eq 'BEAM';
#
@@ -196,6 +197,14 @@ sub beam_strip {
}
#
+ # Abort if there is no new-style 'AtU8' atom chunk.
+ #
+
+ exists $chunk{'AtU8'} or
+ die "$file: no 'AtU8' chunk (re-compile with " .
+ "OTP 20 or later)\n";
+
+ #
# Create a new beam file with only the useful chunk types.
#
diff --git a/erts/emulator/utils/make_tables b/erts/emulator/utils/make_tables
index 597a201e5a..47e1528958 100755
--- a/erts/emulator/utils/make_tables
+++ b/erts/emulator/utils/make_tables
@@ -2,18 +2,19 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1999-2013. All Rights Reserved.
+# Copyright Ericsson AB 1999-2016. 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/.
+# 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
#
-# 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.
+# 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%
#
@@ -35,7 +36,10 @@ use File::Basename;
# <-src>/erl_am.c
# <-src>/erl_bif_table.c
# <-src>/erl_bif_wrap.c
-# <-src>/erl_pbifs.c
+# <-src>/erl_dirty_bif_wrap.c
+# <-src>/erl_guard_bifs.c
+# <-src>/hipe_nbif_impl.c
+# <-include>/hipe_nbif_impl.h
# <-include>/erl_atom_table.h
# <-include>/erl_bif_table.h
#
@@ -51,10 +55,13 @@ my %atom;
my %atom_alias;
my %aliases;
my $auto_alias_num = 0;
+my %dirty_bif_tab;
my @bif;
-my @implementation;
-my @pbif;
+my @bif_info;
+my $dirty_schedulers = 'no';
+my $dirty_schedulers_test = 'no';
+my $hipe = 'no';
while (@ARGV && $ARGV[0] =~ /^-(\w+)/) {
my $opt = shift;
@@ -66,6 +73,18 @@ while (@ARGV && $ARGV[0] =~ /^-(\w+)/) {
$include = shift;
die "No directory for -include argument specified"
unless defined $include;
+ } elsif($opt eq '-ds') {
+ $dirty_schedulers = shift;
+ die "No -ds argument specified"
+ unless defined $dirty_schedulers;
+ } elsif($opt eq '-dst') {
+ $dirty_schedulers_test = shift;
+ die "No -dst argument specified"
+ unless defined $dirty_schedulers_test;
+ } elsif($opt eq '-hipe') {
+ $hipe = shift;
+ die "No -hipe argument specified"
+ unless defined $hipe;
} else {
usage("bad option: $opt");
}
@@ -78,23 +97,64 @@ while (<>) {
my($type, @args) = split;
if ($type eq 'atom') {
save_atoms(@args);
- } elsif ($type eq 'bif' or $type eq 'ubif') {
- my($bif,$alias,$alias2) = (@args);
+ } elsif ($type eq 'bif' or $type eq 'ubif' or $type eq 'gcbif') {
+ if (@args > 2) {
+ error("$type only allows two arguments");
+ }
+ my($bif,$alias) = (@args);
$bif =~ m@^([a-z_.'0-9]+):(.*)/(\d)$@ or error("invalid BIF");
my($mod,$name,$arity) = ($1,$2,$3);
+ my $mfa = "$mod:$name/$arity";
save_atoms($mod, $name);
unless (defined $alias) {
$alias = "";
$alias = "${mod}_" unless $mod eq 'erlang';
$alias .= "${name}_$arity";
}
+ my $sched_type;
+ my $alias3 = $alias;
+
+ $sched_type = $dirty_bif_tab{$mfa};
+
+ if (!$sched_type or ($type eq 'ubif')) {
+ $sched_type = 'normal';
+ }
+ elsif ($sched_type eq 'dirty_cpu') {
+ $alias3 = "schedule_dirty_cpu_$alias"
+ }
+ elsif ($sched_type eq 'dirty_io') {
+ $alias3 = "schedule_dirty_io_$alias"
+ }
+ else {
+ error("invalid sched_type: $sched_type");
+ }
+
my $wrapper;
- $wrapper = "wrap_$alias" if $type eq 'bif';
- $wrapper = $alias if $type eq 'ubif';
+ if ($type eq 'bif') {
+ $wrapper = "wrap_$alias";
+ } else {
+ $wrapper = $alias;
+ }
push(@bif, ["am_$atom_alias{$mod}","am_$atom_alias{$name}",$arity,
- $alias,$wrapper]);
- push(@pbif, $bif =~ m/^'/ && $alias =~ m/^ebif_/);
- push(@implementation, $alias2);
+ $alias3,$wrapper,$alias]);
+ push(@bif_info, [$type, $sched_type, $alias3, $alias]);
+ } elsif ($type eq 'dirty-cpu' or $type eq 'dirty-io'
+ or $type eq 'dirty-cpu-test' or $type eq 'dirty-io-test') {
+ if ($dirty_schedulers eq 'yes') {
+ my($bif,$other) = (@args);
+ $bif =~ m@^([a-z_.'0-9]+):(.*)/(\d)$@ or error("invalid BIF");
+ my($mod,$name,$arity) = ($1,$2,$3);
+ my $mfa = "$mod:$name/$arity";
+ if (($type eq 'dirty-cpu')
+ or (($dirty_schedulers_test eq 'yes')
+ and ($type eq 'dirty-cpu-test'))) {
+ $dirty_bif_tab{$mfa} = 'dirty_cpu';
+ } elsif (($type eq 'dirty-io')
+ or (($dirty_schedulers_test eq 'yes')
+ and ($type eq 'dirty-io-test'))) {
+ $dirty_bif_tab{$mfa} = 'dirty_io';
+ }
+ }
} else {
error("invalid line");
}
@@ -143,7 +203,7 @@ open_file("$include/erl_bif_list.h");
my $i;
for ($i = 0; $i < @bif; $i++) {
# module atom, function atom, arity, C function, table index
- print "BIF_LIST($bif[$i]->[0],$bif[$i]->[1],$bif[$i]->[2],$bif[$i]->[3],$i)\n";
+ print "BIF_LIST($bif[$i]->[0],$bif[$i]->[1],$bif[$i]->[2],$bif[$i]->[3],$bif[$i]->[5],$i)\n";
}
#
@@ -163,10 +223,24 @@ typedef struct bif_entry {
int arity;
BifFunction f;
BifFunction traced;
+ BifFunction impl;
} BifEntry;
+typedef struct erts_gc_bif {
+ BifFunction bif;
+ BifFunction gc_bif;
+ int exp_ix;
+} ErtsGcBif;
+
+typedef struct erts_u_bif {
+ BifFunction bif;
+ int exp_ix;
+} ErtsUBif;
+
extern BifEntry bif_table[];
extern Export* bif_export[];
+extern const ErtsGcBif erts_gc_bifs[];
+extern const ErtsUBif erts_u_bifs[];
#define BIF_SIZE $bif_size
@@ -174,17 +248,28 @@ EOF
my $i;
for ($i = 0; $i < @bif; $i++) {
- print "#define BIF_$bif[$i]->[3] $i\n";
+ print "#define BIF_$bif_info[$i]->[3] $i\n";
}
print "\n";
for ($i = 0; $i < @bif; $i++) {
- my $args = join(', ', 'Process*', 'Eterm*');
- print "Eterm $bif[$i]->[3]($args);\n";
- print "Eterm wrap_$bif[$i]->[3]($args, UWord *I);\n";
+ my $args = join(', ', 'Process*', 'Eterm*', 'UWord*');
+ my $name = $bif_info[$i]->[3];
+ print "Eterm $name($args);\n";
+ print "Eterm wrap_$name($args);\n";
+ print "Eterm erts_gc_$name(Process* p, Eterm* reg, Uint live);\n"
+ if $bif_info[$i]->[0] eq 'gcbif';
+ print "Eterm $bif_info[$i]->[2]($args);\n"
+ unless $bif_info[$i]->[1] eq 'normal';
+ print "\n";
}
-print "#endif\n";
+
+if ($hipe eq 'yes') {
+ print "\n#include \"hipe_nbif_impl.h\"\n";
+}
+
+print "\n#endif\n";
#
# Generate the bif table file.
@@ -215,7 +300,7 @@ includes("export.h", "sys.h", "erl_vm.h", "global.h", "erl_process.h", "bif.h",
for ($i = 0; $i < @bif; $i++) {
next if $bif[$i]->[3] eq $bif[$i]->[4]; # Skip unwrapped bifs
my $arity = $bif[$i]->[2];
- my $func = $bif[$i]->[3];
+ my $func = $bif_info[$i]->[3];
print "Eterm\n";
print "wrap_$func(Process* p, Eterm* args, UWord* I)\n";
print "{\n";
@@ -224,27 +309,106 @@ for ($i = 0; $i < @bif; $i++) {
}
#
-# Generate the package bif file.
+# Generate erl_gc_bifs.c.
#
-open_file("$src/erl_pbifs.c");
+open_file("$src/erl_guard_bifs.c");
my $i;
includes("export.h", "sys.h", "erl_vm.h", "global.h", "erl_process.h", "bif.h",
- "erl_bif_table.h", "erl_atom_table.h");
+ "erl_bif_table.h");
+print "const ErtsGcBif erts_gc_bifs[] = {\n";
for ($i = 0; $i < @bif; $i++) {
- my $arity = $bif[$i]->[2];
- my $func = $bif[$i]->[3];
- my $arg;
- next unless $pbif[$i];
- next unless $func =~ m/^ebif_(.*)/;
- my $orig_func = $1;
- $orig_func = $implementation[$i] if $implementation[$i];
- print "Eterm\n";
- print "$func(Process* p, Eterm* BIF__ARGS)\n";
- print "{\n";
- print " return $orig_func(p, BIF__ARGS);\n";
- print "}\n\n";
+ next unless $bif_info[$i]->[0] eq 'gcbif';
+ print " {$bif[$i]->[3], erts_gc_$bif[$i]->[3], BIF_$bif[$i]->[5]},\n";
}
+print " {NULL, NULL, -1}\n";
+print "};\n";
+
+print "const ErtsUBif erts_u_bifs[] = {\n";
+for ($i = 0; $i < @bif; $i++) {
+ next unless $bif_info[$i]->[0] eq 'ubif';
+ print " {$bif[$i]->[3], BIF_$bif[$i]->[5]},\n";
+}
+print " {NULL, -1}\n";
+print "};\n";
+
+#
+# Generate the dirty bif wrappers file.
+#
+
+open_file("$src/erl_dirty_bif_wrap.c");
+my $i;
+includes("erl_process.h", "erl_nfunc_sched.h", "erl_bif_table.h", "erl_atom_table.h");
+for ($i = 0; $i < @bif_info; $i++) {
+ next if $bif_info[$i]->[1] eq 'normal';
+ my $dtype;
+ if ($bif_info[$i]->[1] eq 'dirty_cpu') {
+ $dtype = "ERTS_SCHED_DIRTY_CPU";
+ }
+ else {
+ $dtype = "ERTS_SCHED_DIRTY_IO";
+ }
+print <<EOF;
+Eterm $bif_info[$i]->[2](Process *c_p, Eterm *regs, BeamInstr *I)
+{
+ return erts_reschedule_bif(c_p, regs, I, $bif_info[$i]->[3], $dtype);
+}
+
+EOF
+
+}
+
+if ($hipe eq 'yes') {
+
+ #
+ # Generate the nbif_impl bif wrappers file.
+ #
+
+ open_file("$src/hipe_nbif_impl.h");
+ print <<EOF;
+
+#ifndef HIPE_NBIF_IMPL_H__
+#define HIPE_NBIF_IMPL_H__
+
+EOF
+
+ my $i;
+ for ($i = 0; $i < @bif; $i++) {
+ print <<EOF;
+Eterm nbif_impl_$bif[$i]->[5](Process *c_p, Eterm *regs);
+EOF
+ }
+
+ print <<EOF;
+
+#endif /* ERL_HIPE_NBIF_IMPL_H__ */
+
+EOF
+
+ #
+ # Generate the nbif_impl bif wrappers file.
+ #
+
+ open_file("$src/hipe_nbif_impl.c");
+ my $i;
+ includes("erl_process.h", "erl_nfunc_sched.h", "erl_bif_table.h", "erl_atom_table.h");
+ for ($i = 0; $i < @bif; $i++) {
+
+ print <<EOF;
+Eterm nbif_impl_$bif[$i]->[5](Process *c_p, Eterm *regs)
+{
+ return $bif[$i]->[3](c_p, regs, (UWord *) bif_export\[BIF_$bif[$i]->[5]\]);
+}
+
+EOF
+
+ }
+
+} # hipe
+
+#
+# Utilities follow.
+#
sub open_file { # or die
my($name) = @_;
diff --git a/erts/emulator/utils/make_version b/erts/emulator/utils/make_version
index 0ba1c77930..e02a42c66d 100755
--- a/erts/emulator/utils/make_version
+++ b/erts/emulator/utils/make_version
@@ -2,18 +2,19 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1999-2009. All Rights Reserved.
+# Copyright Ericsson AB 1999-2016. 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.
+# 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%
#
@@ -58,7 +59,11 @@ print FILE <<EOF;
#define ERLANG_OTP_RELEASE "$release"
#define ERLANG_OTP_VERSION "$otp_version"
#define ERLANG_VERSION "$version"
-#define ERLANG_COMPILE_DATE "$time_str"
+#if ERTS_SAVED_COMPILE_TIME
+# define ERLANG_COMPILE_DATE "$time_str"
+#else
+# define ERLANG_COMPILE_DATE ""
+#endif
#define ERLANG_ARCHITECTURE "$architecture"
EOF
diff --git a/erts/emulator/utils/mkver.c b/erts/emulator/utils/mkver.c
index 844014e8f5..6183246433 100644
--- a/erts/emulator/utils/mkver.c
+++ b/erts/emulator/utils/mkver.c
@@ -1,18 +1,19 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2009. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2016. 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.
+ * 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%
*/
@@ -34,8 +35,10 @@ int argc;
char** argv;
{
FILE *file;
+#if ERTS_SAVED_COMPILE_TIME
time_t now;
- char *cnow;
+#endif
+ char *cnow = "";
if (argc != 2) {
fprintf(stderr, "usage: mkver version\n");
@@ -47,9 +50,11 @@ char** argv;
exit(1);
}
+#if ERTS_SAVED_COMPILE_TIME
time(&now);
cnow = ctime(&now);
cnow[24] = '\0'; /* tidelipom */
+#endif
fprintf(file, "/* This file was created by mkver -- don't modify.*/\n");
fprintf(file, "#define ERLANG_VERSION \"%s\"\n", argv[1]);
fprintf(file, "#define ERLANG_COMPILE_DATE \"%s\"\n", cnow);
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 b3507bdba7..29f2d3d62d 100644
--- a/erts/emulator/valgrind/suppress.patched.3.6.0
+++ b/erts/emulator/valgrind/suppress.patched.3.6.0
@@ -273,6 +273,11 @@ obj:*/ssleay.*
fun:AES_cbc_encrypt
...
}
+{
+ crypto RC4 can do harmless word aligned read past end of input
+ Memcheck:Addr8
+ fun:RC4
+}
{
erts_bits_init_state; Why is this needed?
@@ -357,3 +362,22 @@ fun:async_main
...
}
+{
+Deliberate invalid read by test case bif_SUITE:erlang_halt
+Memcheck:Addr4
+...
+fun:erts_print_scheduler_info
+...
+fun:erts_exit
+fun:broken_halt_test
+fun:erts_debug_set_internal_state_2
+fun:process_main
+}
+
+{
+Thread specific dlerror buffer. Either bug in libc or valgrind.
+Memcheck:Leak
+...
+fun:_dlerror_run
+...
+}
diff --git a/erts/emulator/valgrind/suppress.standard b/erts/emulator/valgrind/suppress.standard
index a4da31a61d..99a3ee4048 100644
--- a/erts/emulator/valgrind/suppress.standard
+++ b/erts/emulator/valgrind/suppress.standard
@@ -260,6 +260,11 @@ obj:*/ssleay.*
fun:AES_cbc_encrypt
...
}
+{
+ crypto RC4 can do harmless word aligned read past end of input
+ Memcheck:Addr8
+ fun:RC4
+}
{
Prebuilt constant terms in os_info_init (PossiblyLost)
@@ -325,3 +330,23 @@ fun:async_main
...
}
+{
+Deliberate invalid read by test case bif_SUITE:erlang_halt
+Memcheck:Addr4
+...
+fun:erts_print_scheduler_info
+...
+fun:erts_exit
+fun:broken_halt_test
+fun:erts_debug_set_internal_state_2
+fun:process_main
+}
+
+{
+Thread specific dlerror buffer. Either bug in libc or valgrind.
+Memcheck:Leak
+...
+fun:_dlerror_run
+...
+}
+
diff --git a/erts/emulator/zlib/zlib.mk b/erts/emulator/zlib/zlib.mk
index ff5ffa5328..3f0d64d250 100644
--- a/erts/emulator/zlib/zlib.mk
+++ b/erts/emulator/zlib/zlib.mk
@@ -4,18 +4,19 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2011-2012. All Rights Reserved.
+# Copyright Ericsson AB 2011-2016. 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/.
+# 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
#
-# 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.
+# 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%
#